[f2j] 22/31: Imported Upstream version 0.8.1
Andreas Tille
tille at debian.org
Fri Jan 29 15:35:41 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository f2j.
commit 11b8a67b8441b9f7225c3d44264fad4521ef9bf2
Author: Andreas Tille <tille at debian.org>
Date: Fri Jan 29 15:46:32 2016 +0100
Imported Upstream version 0.8.1
---
CHANGES | 46 +
Makefile.in | 63 +
README | 20 +
configure | 3643 +++++
configure.in | 43 +
debian/changelog | 17 -
debian/compat | 1 -
debian/control | 30 -
debian/copyright | 114 -
debian/dirs | 1 -
debian/docs | 1 -
debian/f2j.doc-base | 8 -
debian/f2j.install | 2 -
debian/f2j.manpages | 2 -
debian/f2java.1 | 14 -
debian/javab.1 | 12 -
debian/patches/fix_clean_target | 33 -
debian/patches/generate_doc | 42 -
debian/patches/series | 2 -
debian/rules | 24 -
debian/source/format | 1 -
debian/watch | 4 -
doc/Makefile | 24 +
doc/f2j_ug.pdf | Bin 0 -> 36651 bytes
doc/f2j_ug.tex | 468 +
doc/title.tex | 17 +
f2j_TODO.txt | 50 +
goto_trans/LICENSE | 53 +
goto_trans/Makefile | 70 +
goto_trans/README | 54 +
goto_trans/byte.c | 1404 ++
goto_trans/class.c | 948 ++
goto_trans/class.h | 493 +
goto_trans/dump.c | 292 +
goto_trans/main.c | 306 +
goto_trans/make.def.in | 7 +
goto_trans/symtab.c | 130 +
goto_trans/symtab.h | 22 +
install-sh | 269 +
libbytecode/Makefile.in | 35 +
libbytecode/api.c | 4353 ++++++
libbytecode/api.h | 43 +
libbytecode/bytecode.h | 880 ++
libbytecode/bytecode.h.in | 879 ++
libbytecode/class.c | 2148 +++
libbytecode/class.h | 58 +
libbytecode/configure | 3601 +++++
libbytecode/configure.in | 50 +
libbytecode/constant_pool.c | 1560 +++
libbytecode/constant_pool.h | 49 +
libbytecode/dlist.c | 117 +
libbytecode/dlist.h | 50 +
libbytecode/globals.c | 438 +
libbytecode/make.def.in | 8 +
src/LICENSE | 273 +
src/Makefile | 80 +
src/codegen.c | 13218 +++++++++++++++++++
src/codegen.h | 335 +
src/dlist.c | 115 +
src/dlist.h | 50 +
src/f2j-config.h | 13 +
src/f2j-config.h.in | 13 +
src/f2j.h | 700 +
src/f2j_externs.h | 70 +
src/f2jlex.c | 1956 +++
src/f2jmain.c | 723 +
src/f2jmem.c | 173 +
src/f2jmem.h | 23 +
src/f2jparse.y | 5203 ++++++++
src/getopt.c | 104 +
src/globals.c | 916 ++
src/initialize.h | 48 +
src/make.def.in | 18 +
src/opcodes.h | 129 +
src/optimize.c | 1429 ++
src/symtab.c | 291 +
src/symtab.h | 67 +
src/typecheck.c | 1499 +++
src/vcg_emitter.c | 958 ++
src/y.tab.c | 7700 +++++++++++
src/y.tab.h | 242 +
util/Makefile | 21 +
util/make.def.in | 3 +
util/org/CVS/Entries | 2 +
util/org/CVS/Repository | 1 +
util/org/CVS/Root | 1 +
util/org/j_paine/CVS/Entries | 1 +
util/org/j_paine/CVS/Repository | 1 +
util/org/j_paine/CVS/Root | 1 +
util/org/j_paine/formatter/CVS/Entries | 17 +
util/org/j_paine/formatter/CVS/Repository | 1 +
util/org/j_paine/formatter/CVS/Root | 1 +
.../EndOfFileWhenStartingReadException.java | 33 +
util/org/j_paine/formatter/FormatParser.java | 505 +
util/org/j_paine/formatter/FormatParser.jj | 235 +
.../j_paine/formatter/FormatParserConstants.java | 42 +
.../formatter/FormatParserTokenManager.java | 408 +
util/org/j_paine/formatter/Formatter.buffered | 1758 +++
util/org/j_paine/formatter/Formatter.java | 1747 +++
util/org/j_paine/formatter/Formatter.java~ | 1724 +++
util/org/j_paine/formatter/NumberParser.java | 282 +
util/org/j_paine/formatter/NumberParser.jj | 95 +
.../j_paine/formatter/NumberParserConstants.java | 27 +
.../formatter/NumberParserTokenManager.java | 405 +
util/org/j_paine/formatter/ParseException.java | 192 +
util/org/j_paine/formatter/PrintfFormat.java | 3091 +++++
util/org/j_paine/formatter/README | 23 +
util/org/j_paine/formatter/SimpleCharStream.java | 439 +
util/org/j_paine/formatter/Token.java | 81 +
util/org/j_paine/formatter/TokenMgrError.java | 133 +
util/org/netlib/CVS/Entries | 1 +
util/org/netlib/CVS/Repository | 1 +
util/org/netlib/CVS/Root | 1 +
util/org/netlib/util/ArraySpec.java | 104 +
util/org/netlib/util/CVS/Entries | 14 +
util/org/netlib/util/CVS/Repository | 1 +
util/org/netlib/util/CVS/Root | 1 +
util/org/netlib/util/Dummy.java | 46 +
util/org/netlib/util/EasyIn.java | 500 +
util/org/netlib/util/Etime.java | 70 +
util/org/netlib/util/MatConv.java | 216 +
util/org/netlib/util/Second.java | 47 +
util/org/netlib/util/StrictUtil.java | 332 +
util/org/netlib/util/StringW.java | 27 +
util/org/netlib/util/Util.buffered | 551 +
util/org/netlib/util/Util.java | 543 +
util/org/netlib/util/booleanW.java | 27 +
util/org/netlib/util/doubleW.java | 28 +
util/org/netlib/util/floatW.java | 28 +
util/org/netlib/util/intW.java | 27 +
130 files changed, 72872 insertions(+), 308 deletions(-)
diff --git a/CHANGES b/CHANGES
new file mode 100644
index 0000000..5639caf
--- /dev/null
+++ b/CHANGES
@@ -0,0 +1,46 @@
+
+f2j 0.8.1 -- released June 30, 2008
+
+-minor bug fixes
+-added some examples
+-removed some obsolete code
+-fixed javadoc output
+-added hack for passing workspace of different types
+-added support for format specified as string literal without "fmt="
+ WRITE( *, '(A,A,A,I3,A)') ...etc...
+-changed Formatter to use PrintfFormat instead of CJFormat due to
+ license issues.
+-added version number to -h help information
+
+---------------------------------------------------------------------------
+f2j 0.8 -- released May 31, 2007
+
+-improved formatted I/O support by integrating Jocelyn Paine's Formatter
+ package (www.j-paine.org/Formatter). I hacked it up, so see Jocelyn's
+ site for the original version.
+-fixed a bug in expression code generation
+-fixed various syntax issues that prevented translating the latest
+ versions of LAPACK (as well as ARPACK)
+-finally fixed that niggling lexer bug that caused parsing to fail
+ when the last line had fewer than 6 characters.
+-changed quite a bit of the character/string handling code.
+-many various other bug fixes
+
+---------------------------------------------------------------------------
+f2j 0.7 -- released January 31, 2007
+
+-improved support for Fortran intrinsic functions
+-added support for generating strictfp code and code that calls StrictMath
+-added support for single precision
+-added support for implicit typing
+-implemented ASSIGN and assigned GOTO statements
+-split off the bytecode generator into an independent library for
+ generating class files.
+-using a rudimentary autoconf build process
+-added a user's guide
+-various other bug fixes
+
+---------------------------------------------------------------------------
+f2j 0.6 -- released May 29, 2002
+
+-this was the first version released on SourceForge
diff --git a/Makefile.in b/Makefile.in
new file mode 100644
index 0000000..c5cdb3f
--- /dev/null
+++ b/Makefile.in
@@ -0,0 +1,63 @@
+# Top level makefile for the f2j system.
+
+# $Author: keithseymour $
+# $Date: 2008/06/24 21:03:43 $
+# $Source: /cvsroot/f2j/f2j/Makefile.in,v $
+# $Revision: 1.10 $
+
+F2J_PACKAGE_NAME=@F2J_PACKAGE_STRING@
+
+all: f2java javab
+
+install:
+ cd util; $(MAKE) install
+ cd goto_trans; $(MAKE) install
+ cd libbytecode; $(MAKE) install
+ cd src; $(MAKE) install
+
+libbytecode/libbytecode.a:
+ cd libbytecode; $(MAKE)
+
+util/f2jutil.jar:
+ cd util; $(MAKE)
+
+f2java: libbytecode/libbytecode.a util/f2jutil.jar
+ cd src; $(MAKE)
+
+javab:
+ cd goto_trans; $(MAKE)
+
+srcdist: srcdist_common
+ zip -r $(F2J_PACKAGE_NAME).zip $(F2J_PACKAGE_NAME)
+ tar cvf - $(F2J_PACKAGE_NAME) | gzip > $(F2J_PACKAGE_NAME).tgz
+
+srcdist_common:
+ cd src; $(MAKE) y.tab.c
+ mkdir -p $(F2J_PACKAGE_NAME)/bin
+ mkdir -p $(F2J_PACKAGE_NAME)/src
+ mkdir -p $(F2J_PACKAGE_NAME)/doc
+ mkdir -p $(F2J_PACKAGE_NAME)/goto_trans
+ mkdir -p $(F2J_PACKAGE_NAME)/libbytecode
+ mkdir -p $(F2J_PACKAGE_NAME)/util/org/netlib/util
+ cd goto_trans; cp *.[ch] make.def.in README LICENSE Makefile ../$(F2J_PACKAGE_NAME)/goto_trans
+ cd libbytecode; cp *.[ch] *.in configure ../$(F2J_PACKAGE_NAME)/libbytecode
+ cd src; cp *.[chy] make.def.in LICENSE Makefile f2j-config.h.in ../$(F2J_PACKAGE_NAME)/src
+ cd util; cp make.def.in Makefile ../$(F2J_PACKAGE_NAME)/util
+ cd util; cp -r org ../$(F2J_PACKAGE_NAME)/util
+ cd doc; $(MAKE) f2j_ug.pdf; $(MAKE) almost_clean
+ cp doc/Makefile doc/*.tex doc/f2j_ug.pdf $(F2J_PACKAGE_NAME)/doc
+ cp README CHANGES install-sh configure configure.in f2j_TODO.txt Makefile.in $(F2J_PACKAGE_NAME)
+
+clean:
+ /bin/rm -rf $(F2J_PACKAGE_NAME) $(F2J_PACKAGE_NAME).zip $(F2J_PACKAGE_NAME).tgz f2jsrc.tgz f2jsrc.zip
+ cd goto_trans; $(MAKE) realclean
+ cd libbytecode; $(MAKE) clean
+ cd src; $(MAKE) clean
+ cd util; $(MAKE) clean
+ cd doc; $(MAKE) clean
+
+configclean: clean
+ cd libbytecode; $(MAKE) configclean
+ /bin/rm -rf autom4te.cache
+ /bin/rm -f config.log config.status config.cache Makefile src/make.def
+ /bin/rm -f configure goto_trans/make.def util/make.def
diff --git a/README b/README
new file mode 100644
index 0000000..d555115
--- /dev/null
+++ b/README
@@ -0,0 +1,20 @@
+Fortran-to-Java Source Code
+Version 0.8.1
+June 30, 2008
+
+---------------------------
+
+Before using the f2j source code, realize that f2j was originally geared
+to a very specific problem - that is, translating the LAPACK and BLAS numerical
+libraries. f2j does not and probably never will handle all Fortran code.
+
+To build the code:
+
+# ./configure
+# make
+
+and optionally:
+
+# make install
+
+For more details, see the f2j manual (doc/f2j_ug.pdf).
diff --git a/configure b/configure
new file mode 100755
index 0000000..112bf39
--- /dev/null
+++ b/configure
@@ -0,0 +1,3643 @@
+#! /bin/sh
+# From configure.in Revision: 1.4 .
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.59 for f2j 0.8.1.
+#
+# Report bugs to <f2j at cs.utk.edu>.
+#
+# Copyright (C) 2003 Free Software Foundation, Inc.
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+exec 6>&1
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_config_libobj_dir=.
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
+
+# Identity of this package.
+PACKAGE_NAME='f2j'
+PACKAGE_TARNAME='f2j'
+PACKAGE_VERSION='0.8.1'
+PACKAGE_STRING='f2j 0.8.1'
+PACKAGE_BUGREPORT='f2j at cs.utk.edu'
+
+ac_unique_file="f2j_TODO.txt"
+ac_subdirs_all="$ac_subdirs_all libbytecode"
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS F2J_INSTALL_PREFIX subdirs CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT SET_MAKE RANLIB ac_ct_RANLIB AR JAVAC JAVA YACC F2J_VERSION BYTE_DIR F2 [...]
+ac_subst_files=''
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+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'
+
+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
+
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+
+ # 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_alias ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build_alias=$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 ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir=$ac_optarg ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) 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 | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host_alias ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host_alias=$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 | -n)
+ 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_alias ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target_alias=$ac_optarg ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
+
+ -with-* | --with-*)
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_$ac_package='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ 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 "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
+ *)
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
+fi
+
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+# 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_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ 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 "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
+ fi
+fi
+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+ { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+ { (exit 1); exit 1; }; }
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # 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 <<_ACEOF
+\`configure' configures f2j 0.8.1 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -n, --no-create do not create output files
+ --srcdir=DIR find the sources in DIR [configure dir or \`..']
+
+_ACEOF
+
+ cat <<_ACEOF
+Installation directories:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
+_ACEOF
+
+ cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+ case $ac_init_help in
+ short | recursive ) echo "Configuration of f2j 0.8.1:";;
+ esac
+ cat <<\_ACEOF
+
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-libbytecode-dir=dir directory containing bytecode library
+
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to <f2j at cs.utk.edu>.
+_ACEOF
+fi
+
+if test "$ac_init_help" = "recursive"; then
+ # If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+ test -d $ac_dir || continue
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+f2j configure 0.8.1
+generated by GNU Autoconf 2.59
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+ exit 0
+fi
+exec 5>config.log
+cat >&5 <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by f2j $as_me 0.8.1, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
+
+/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_sep=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+ for ac_arg
+ do
+ case $ac_arg in
+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ continue ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ case $ac_pass in
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 2)
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ if test $ac_must_keep_next = true; then
+ ac_must_keep_next=false # Got value, back to normal.
+ else
+ case $ac_arg in
+ *=* | --config-cache | -C | -disable-* | --disable-* \
+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ | -with-* | --with-* | -without-* | --without-* | --x)
+ case "$ac_configure_args0 " in
+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ esac
+ ;;
+ -* ) ac_must_keep_next=true ;;
+ esac
+ fi
+ ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ # Get rid of the leading space.
+ ac_sep=" "
+ ;;
+ esac
+ done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log. We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
+ *)
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+}
+ echo
+
+ cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_vars
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+
+ if test -n "$ac_subst_files"; then
+ cat <<\_ASBOX
+## ------------- ##
+## Output files. ##
+## ------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_files
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+ fi
+
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h | sort
+ echo
+ fi
+ test "$ac_signal" != 0 &&
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
+ } >&5
+ rm -f core *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ exit $exit_status
+ ' 0
+for ac_signal in 1 2 13 15; do
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# 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
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# 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 "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+ sed 's/^/| /' "$ac_site_file" >&5
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
+ esac
+ fi
+else
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+ eval ac_old_set=\$ac_cv_env_${ac_var}_set
+ eval ac_new_set=\$ac_env_${ac_var}_set
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
+ case $ac_old_set,$ac_new_set in
+ set,)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # Pass precious variables to config.status.
+ if test "$ac_new_set" = set; then
+ case $ac_new_val in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *) ac_arg=$ac_var=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
+ fi
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+if test "x$prefix" != xNONE; then
+ F2J_INSTALL_PREFIX=${prefix}
+else
+ F2J_INSTALL_PREFIX=`pwd`
+fi
+
+
+prefix=$F2J_INSTALL_PREFIX
+
+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
+ elif test -f $ac_dir/shtool; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/shtool install -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5
+echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"
+ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
+
+
+
+subdirs="$subdirs libbytecode"
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ for ac_prog in gcc cc ecc xlc
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in gcc cc ecc xlc
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
+
+fi
+
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5
+echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6
+if test "${ac_cv_c_bigendian+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # See if sys/param.h defines the BYTE_ORDER macro.
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/param.h>
+
+int
+main ()
+{
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/param.h>
+
+int
+main ()
+{
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_bigendian=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_c_bigendian=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+# It does not; compile a test program.
+if test "$cross_compiling" = yes; then
+ # try to guess the endianness by grepping values into an object file
+ ac_cv_c_bigendian=unknown
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
+short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }
+int
+main ()
+{
+ _ascii (); _ebcdic ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
+ ac_cv_c_bigendian=yes
+fi
+if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+ if test "$ac_cv_c_bigendian" = unknown; then
+ ac_cv_c_bigendian=no
+ else
+ # finding both strings is unlikely to happen, but who knows?
+ ac_cv_c_bigendian=unknown
+ fi
+fi
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+int
+main ()
+{
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_bigendian=no
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_c_bigendian=yes
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5
+echo "${ECHO_T}$ac_cv_c_bigendian" >&6
+case $ac_cv_c_bigendian in
+ yes)
+
+cat >>confdefs.h <<\_ACEOF
+#define WORDS_BIGENDIAN 1
+_ACEOF
+ ;;
+ no)
+ ;;
+ *)
+ { { echo "$as_me:$LINENO: error: unknown endianness
+presetting ac_cv_c_bigendian=no (or yes) will help" >&5
+echo "$as_me: error: unknown endianness
+presetting ac_cv_c_bigendian=no (or yes) will help" >&2;}
+ { (exit 1); exit 1; }; } ;;
+esac
+
+
+echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'`
+if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.make <<\_ACEOF
+all:
+ @echo 'ac_maketemp="$(MAKE)"'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftest.make
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ SET_MAKE=
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ echo "$as_me:$LINENO: result: $RANLIB" >&5
+echo "${ECHO_T}$RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":"
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+# Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $AR in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_AR="$AR" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_AR="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+AR=$ac_cv_path_AR
+
+if test -n "$AR"; then
+ echo "$as_me:$LINENO: result: $AR" >&5
+echo "${ECHO_T}$AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+# Extract the first word of "javac", so it can be a program name with args.
+set dummy javac; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_JAVAC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $JAVAC in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_JAVAC="$JAVAC" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_JAVAC="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+JAVAC=$ac_cv_path_JAVAC
+
+if test -n "$JAVAC"; then
+ echo "$as_me:$LINENO: result: $JAVAC" >&5
+echo "${ECHO_T}$JAVAC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+# Extract the first word of "java", so it can be a program name with args.
+set dummy java; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_JAVA+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $JAVA in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_JAVA="$JAVA" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_JAVA="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+JAVA=$ac_cv_path_JAVA
+
+if test -n "$JAVA"; then
+ echo "$as_me:$LINENO: result: $JAVA" >&5
+echo "${ECHO_T}$JAVA" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+for ac_prog in 'bison -y' byacc
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_YACC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$YACC"; then
+ ac_cv_prog_YACC="$YACC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_YACC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+YACC=$ac_cv_prog_YACC
+if test -n "$YACC"; then
+ echo "$as_me:$LINENO: result: $YACC" >&5
+echo "${ECHO_T}$YACC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$YACC" && break
+done
+test -n "$YACC" || YACC="yacc"
+
+F2J_VERSION=0.8.1
+
+
+
+# Check whether --with-libbytecode-dir or --without-libbytecode-dir was given.
+if test "${with_libbytecode_dir+set}" = set; then
+ withval="$with_libbytecode_dir"
+ BYTE_DIR="$with_libbytecode_dir"
+else
+ BYTE_DIR="$PWD/libbytecode"
+fi;
+
+
+F2J_PACKAGE_STRING=f2j-0.8.1
+
+
+ ac_config_files="$ac_config_files Makefile src/make.def goto_trans/make.def util/make.def"
+
+ ac_config_files="$ac_config_files src/f2j-config.h"
+cat >confcache <<\_ACEOF
+# 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, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# 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 | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+} |
+ sed '
+ t clear
+ : clear
+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+ t end
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if diff $cache_file confcache >/dev/null 2>&1; then :; else
+ if test -w $cache_file; then
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ cat confcache >$cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
+fi
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+#
+# If the first sed substitution is executed (which looks for macros that
+# take arguments), then we branch to the quote section. Otherwise,
+# look for a macro that doesn't take arguments.
+cat >confdef2opt.sed <<\_ACEOF
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+t quote
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+t quote
+d
+: quote
+s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
+s,\[,\\&,g
+s,\],\\&,g
+s,\$,$$,g
+p
+_ACEOF
+# We use echo to avoid assuming a particular line-breaking character.
+# The extra dot is to prevent the shell from consuming trailing
+# line-breaks from the sub-command output. A line-break within
+# single-quotes doesn't work because, if this script is created in a
+# platform that uses two characters for line-breaks (e.g., DOS), tr
+# would break.
+ac_LF_and_DOT=`echo; echo .`
+DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
+rm -f confdef2opt.sed
+
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+ # 1. Remove the extension, and $U if already installed.
+ ac_i=`echo "$ac_i" |
+ sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+ # 2. Add them.
+ ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+exec 6>&1
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
+This file was extended by f2j $as_me 0.8.1, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_ACEOF
+
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, then exit
+ -q, --quiet do not print progress messages
+ -d, --debug don't remove temporary files
+ --recheck update $as_me by reconfiguring in the same conditions
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+
+Configuration files:
+$config_files
+
+Report bugs to <bug-autoconf at gnu.org>."
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+f2j config.status 0.8.1
+configured by $0, generated by GNU Autoconf 2.59,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+srcdir=$srcdir
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ ac_shift=:
+ ;;
+ -*)
+ ac_option=$1
+ ac_optarg=$2
+ ac_shift=shift
+ ;;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_option=$1
+ ac_need_defaults=false;;
+ esac
+
+ case $ac_option in
+ # Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ ac_cs_recheck=: ;;
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
+ debug=: ;;
+ --file | --fil | --fi | --f )
+ $ac_shift
+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ $ac_shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ ac_need_defaults=false;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil | --si | --s)
+ ac_cs_silent=: ;;
+
+ # This is an error.
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+if \$ac_cs_recheck; then
+ echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+fi
+
+_ACEOF
+
+
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_config_target in $ac_config_targets
+do
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "src/make.def" ) CONFIG_FILES="$CONFIG_FILES src/make.def" ;;
+ "goto_trans/make.def" ) CONFIG_FILES="$CONFIG_FILES goto_trans/make.def" ;;
+ "util/make.def" ) CONFIG_FILES="$CONFIG_FILES util/make.def" ;;
+ "src/f2j-config.h" ) CONFIG_FILES="$CONFIG_FILES src/f2j-config.h" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used. Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+fi
+
+# Have a temporary directory for convenience. Make it in the build tree
+# simply because there is no reason to put it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+
+# Create a (secure) tmp directory for tmp files.
+
+{
+ tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
+}
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s, at SHELL@,$SHELL,;t t
+s, at PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s, at PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s, at PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s, at PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s, at PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s, at PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s, at exec_prefix@,$exec_prefix,;t t
+s, at prefix@,$prefix,;t t
+s, at program_transform_name@,$program_transform_name,;t t
+s, at bindir@,$bindir,;t t
+s, at sbindir@,$sbindir,;t t
+s, at libexecdir@,$libexecdir,;t t
+s, at datadir@,$datadir,;t t
+s, at sysconfdir@,$sysconfdir,;t t
+s, at sharedstatedir@,$sharedstatedir,;t t
+s, at localstatedir@,$localstatedir,;t t
+s, at libdir@,$libdir,;t t
+s, at includedir@,$includedir,;t t
+s, at oldincludedir@,$oldincludedir,;t t
+s, at infodir@,$infodir,;t t
+s, at mandir@,$mandir,;t t
+s, at build_alias@,$build_alias,;t t
+s, at host_alias@,$host_alias,;t t
+s, at target_alias@,$target_alias,;t t
+s, at DEFS@,$DEFS,;t t
+s, at ECHO_C@,$ECHO_C,;t t
+s, at ECHO_N@,$ECHO_N,;t t
+s, at ECHO_T@,$ECHO_T,;t t
+s, at LIBS@,$LIBS,;t t
+s, at F2J_INSTALL_PREFIX@,$F2J_INSTALL_PREFIX,;t t
+s, at subdirs@,$subdirs,;t t
+s, at CC@,$CC,;t t
+s, at CFLAGS@,$CFLAGS,;t t
+s, at LDFLAGS@,$LDFLAGS,;t t
+s, at CPPFLAGS@,$CPPFLAGS,;t t
+s, at ac_ct_CC@,$ac_ct_CC,;t t
+s, at EXEEXT@,$EXEEXT,;t t
+s, at OBJEXT@,$OBJEXT,;t t
+s, at SET_MAKE@,$SET_MAKE,;t t
+s, at RANLIB@,$RANLIB,;t t
+s, at ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
+s, at AR@,$AR,;t t
+s, at JAVAC@,$JAVAC,;t t
+s, at JAVA@,$JAVA,;t t
+s, at YACC@,$YACC,;t t
+s, at F2J_VERSION@,$F2J_VERSION,;t t
+s, at BYTE_DIR@,$BYTE_DIR,;t t
+s, at F2J_PACKAGE_STRING@,$F2J_PACKAGE_STRING,;t t
+s, at LIBOBJS@,$LIBOBJS,;t t
+s, at LTLIBOBJS@,$LTLIBOBJS,;t t
+CEOF
+
+_ACEOF
+
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # 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_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # 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" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ fi
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+ fi
+fi # test -n "$CONFIG_FILES"
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+
+
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s, at configure_input@,$configure_input,;t t
+s, at srcdir@,$ac_srcdir,;t t
+s, at abs_srcdir@,$ac_abs_srcdir,;t t
+s, at top_srcdir@,$ac_top_srcdir,;t t
+s, at abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s, at builddir@,$ac_builddir,;t t
+s, at abs_builddir@,$ac_abs_builddir,;t t
+s, at top_builddir@,$ac_top_builddir,;t t
+s, at abs_top_builddir@,$ac_abs_top_builddir,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
+
+done
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ ac_config_status_args=
+ test "$silent" = yes &&
+ ac_config_status_args="$ac_config_status_args --quiet"
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
+
+#
+# CONFIG_SUBDIRS section.
+#
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case $ac_arg in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* \
+ | --c=*)
+ ;;
+ --config-cache | -C)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ # Always prepend --prefix to ensure using the same prefix
+ # in subdir configurations.
+ ac_sub_configure_args="--prefix=$prefix $ac_sub_configure_args"
+
+ ac_popdir=`pwd`
+ for ac_dir in : $subdirs; do test "x$ac_dir" = x: && continue
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ test -d $srcdir/$ac_dir || continue
+
+ { echo "$as_me:$LINENO: configuring in $ac_dir" >&5
+echo "$as_me: configuring in $ac_dir" >&6;}
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+
+ cd $ac_dir
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ ac_sub_configure="$SHELL '$ac_srcdir/configure.gnu'"
+ elif test -f $ac_srcdir/configure; then
+ ac_sub_configure="$SHELL '$ac_srcdir/configure'"
+ elif test -f $ac_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ { echo "$as_me:$LINENO: WARNING: no configuration information is in $ac_dir" >&5
+echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2;}
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+ # Make the cache file name correct relative to the subdirectory.
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file=$ac_top_builddir$cache_file ;;
+ esac
+
+ { echo "$as_me:$LINENO: running $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&5
+echo "$as_me: running $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&6;}
+ # The eval makes quoting arguments work.
+ eval $ac_sub_configure $ac_sub_configure_args \
+ --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir ||
+ { { echo "$as_me:$LINENO: error: $ac_sub_configure failed for $ac_dir" >&5
+echo "$as_me: error: $ac_sub_configure failed for $ac_dir" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
diff --git a/configure.in b/configure.in
new file mode 100644
index 0000000..a585e57
--- /dev/null
+++ b/configure.in
@@ -0,0 +1,43 @@
+AC_INIT(f2j, 0.8.1, [f2j at cs.utk.edu])
+AC_REVISION([$Revision: 1.5 $])
+
+AC_CONFIG_SRCDIR(f2j_TODO.txt)
+
+if test "x$prefix" != xNONE; then
+ F2J_INSTALL_PREFIX=${prefix}
+else
+ F2J_INSTALL_PREFIX=`pwd`
+fi
+AC_SUBST(F2J_INSTALL_PREFIX)
+
+prefix=$F2J_INSTALL_PREFIX
+
+AC_CONFIG_SUBDIRS(libbytecode)
+
+AC_PROG_CC(gcc cc ecc xlc)
+
+AC_C_BIGENDIAN
+
+AC_PROG_MAKE_SET
+AC_PROG_RANLIB
+AC_PATH_PROG(AR, ar)
+AC_SUBST(AR)
+AC_PATH_PROG(JAVAC, javac)
+AC_SUBST(JAVAC)
+AC_PATH_PROG(JAVA, java)
+AC_SUBST(JAVA)
+AC_PROG_YACC
+F2J_VERSION=AC_PACKAGE_VERSION
+AC_SUBST(F2J_VERSION)
+
+AC_ARG_WITH(libbytecode-dir,
+ [ --with-libbytecode-dir=dir directory containing bytecode library],
+ [BYTE_DIR="$with_libbytecode_dir"],
+ [BYTE_DIR="$PWD/libbytecode"])
+AC_SUBST(BYTE_DIR)
+
+F2J_PACKAGE_STRING=AC_PACKAGE_NAME-AC_PACKAGE_VERSION
+AC_SUBST(F2J_PACKAGE_STRING)
+
+AC_CONFIG_FILES(Makefile src/make.def goto_trans/make.def util/make.def)
+AC_OUTPUT(src/f2j-config.h)
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 9da5f7f..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,17 +0,0 @@
-f2j (0.8.1-2) unstable; urgency=low
-
- * debian/copyright: Add missing statement on non commercial usage
-
- -- Olivier Sallou <osallou at debian.org> Thu, 24 May 2012 14:25:02 +0200
-
-f2j (0.8.1-1) unstable; urgency=low
-
- [ Olivier Sallou ]
- * Initial release (Closes: #657184)
- * Move to non-free, license modification to DFSG compliant license
- in progress
-
- [ Thorsten Alteholz ]
- * debian/rules: target get-orig-source added
-
- -- Olivier Sallou <osallou at debian.org> Tue, 24 Jan 2012 17:34:50 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index 45a4fb7..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-8
diff --git a/debian/control b/debian/control
deleted file mode 100644
index 263ed37..0000000
--- a/debian/control
+++ /dev/null
@@ -1,30 +0,0 @@
-Source: f2j
-Section: non-free/java
-Priority: optional
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Olivier Sallou <osallou at debian.org>,
-DM-Upload-Allowed: yes
-Build-Depends: debhelper (>= 8), default-jdk, bison, javahelper
-Standards-Version: 3.9.2
-Homepage: http://sourceforge.net/projects/f2j/
-Vcs-Svn: svn://svn.debian.org/debian-med/trunk/packages/f2j/trunk/
-Vcs-Browser: http://svn.debian.org/wsvn/debian-med/trunk/packages/f2j/
-XS-Autobuild: yes
-
-Package: f2j
-Architecture: any
-Depends: ${shlibs:Depends}, ${misc:Depends}
-Description: Fortran to Java compiler
- The package contains a Fortran to Java converter, also used
- to create the libf2j-java package.
- It converts Fortran file to Java source and class files.
-
-
-Package: libf2j-java
-Architecture: all
-Depends: ${shlibs:Depends}, ${misc:Depends}
-Description: Java library port of Fortran numerical libraries
- The package provides the Java library (APIS)
- to numerical libraries originally
- written in Fortran (particularly BLAS and LAPACK).
-
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 6c8f5ac..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,114 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: f2j
-Upstream-Contact: Keith Seymour <seymour at cs.utk.edu>
-Source: http://sourceforge.net/projects/f2j/
-
-Files: goto_trans/*
-Copyright: 2008 Aart J.C. Bik
- 2008 Indiana University
-License: Indiana University
- This prototype bytecode parallelization tool has been developed
- at the Indiana University by Aart J.C. Bik. This software is *not*
- in the public domain. However, it is freely available without
- fee for education, research, and non-profit purposes. By obtaining
- copies of this, you, the Licensee, agree to abide by the following
- conditions and understandings with respect to the copyrighted software:
- .
- 1. The software is copyrighted by Indiana University (IU) and
- Aart J.C. Bik and they retain ownership of the software.
- .
- 2. Permission to use and modify this software and its documentation
- for education, research, and non-profit purposes is hereby granted to
- Licensee, provided that the copyright notice, the original author's
- names and unit identification, and this permission notice appear on
- all such works, and that no charge be made for such copies.
- .
- 3. Any entity desiring permission to incorporate this software into
- commercial products should contact:
- .
- Dennis Gannon gannon at cs.indiana.edu
- 215 Lindley Hall
- Department of Computer Science
- Indiana University
- Bloomington, IN 47405-4101 USA
- .
- 4. Licensee may not use the name, logo, or any other symbol of
- IU nor the names of any of its employees nor any adaptation thereof
- in advertising or publicity pertaining to the software without
- specific prior written approval of the IU.
- .
- 5. THE COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS ABOUT THE SUITABILITY
- OF THE SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS
- OR IMPLIED WARRANTY.
- .
- 6. The copyright holders shall not be liable for any damages suffered
- by Licensee from the use of this software.
- .
- 7. The software was developed under agreements between the IU and
- the Federal Government which entitle the Government to certain rights.
- .
- Your courtesy in mentioning the use of this bytecode compiler in any scientific
- work that presents results obtained by using (extensions or modifications
- of) this bytecode compiler is highly appreciated.
-
-
-Files: util/org/j_paine/formatter/PrintfFormat.java
-Copyright: 2000 Sun Microsystems, Inc.
-License: SUN
- Permission to use, copy, modify, and distribute this Software and its
- documentation for NON-COMMERCIAL or COMMERCIAL purposes and without fee is
- hereby granted.
- .
- This Software is provided "AS IS". All express warranties, including any
- implied warranty of merchantability, satisfactory quality, fitness for a
- particular purpose, or non-infringement, are disclaimed, except to the extent
- that such disclaimers are held to be legally invalid.
- .
- You acknowledge that Software is not designed, licensed or intended for use in
- the design, construction, operation or maintenance of any nuclear facility
- ("High Risk Activities"). Sun disclaims any express or implied warranty of
- fitness for such uses.
- .
- Please refer to the file http://www.sun.com/policies/trademarks/ for further
- important trademark information and to
- http://java.sun.com/nav/business/index.html for further important licensing
- information for the Java Technology.
-
-Files: *
-Copyright: 2008 Keith Seymour <seymour at cs.utk.edu>
-License: GPL-2+
- This package is free software; you can redistribute 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 package is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR 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, see <http://www.gnu.org/licenses/>
- .
- On Debian systems, the complete text of the GNU General
- Public License version 2 can be found in "/usr/share/common-licenses/GPL-2".
-
-Files: debian/*
-Copyright: 2012 Olivier Sallou <olivier.sallou at irisa.fr>
-License: GPL-2+
- This package is free software; you can redistribute 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 package is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR 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, see <http://www.gnu.org/licenses/>
- .
- On Debian systems, the complete text of the GNU General
- Public License version 2 can be found in "/usr/share/common-licenses/GPL-2".
-
diff --git a/debian/dirs b/debian/dirs
deleted file mode 100644
index e772481..0000000
--- a/debian/dirs
+++ /dev/null
@@ -1 +0,0 @@
-usr/bin
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index d84be4d..0000000
--- a/debian/docs
+++ /dev/null
@@ -1 +0,0 @@
-doc/f2j_ug.pdf
diff --git a/debian/f2j.doc-base b/debian/f2j.doc-base
deleted file mode 100644
index b2e9fe0..0000000
--- a/debian/f2j.doc-base
+++ /dev/null
@@ -1,8 +0,0 @@
-Document: f2j
-Title: f2java user guide
-Author: Keith Seymour
-Abstract: User guide of f2java
-Section: Help/HOWTO
-
-Format: PDF
-Files: /usr/share/doc/f2j/f2j_ug.pdf.gz
diff --git a/debian/f2j.install b/debian/f2j.install
deleted file mode 100644
index f2dfa7c..0000000
--- a/debian/f2j.install
+++ /dev/null
@@ -1,2 +0,0 @@
-goto_trans/javab usr/bin/
-src/f2java usr/bin
diff --git a/debian/f2j.manpages b/debian/f2j.manpages
deleted file mode 100644
index 86cb0cb..0000000
--- a/debian/f2j.manpages
+++ /dev/null
@@ -1,2 +0,0 @@
-debian/f2java.1
-debian/javab.1
diff --git a/debian/f2java.1 b/debian/f2java.1
deleted file mode 100644
index b1004be..0000000
--- a/debian/f2java.1
+++ /dev/null
@@ -1,14 +0,0 @@
-.TH f2java 1 "January 24, 2012" "version 0.8.1" "USER COMMANDS"
-.SH NAME
-f2java - produce java source and java class from Fortran file
-.SH SYNOPSIS
-.B f2java file
-.I file Fortran file to transform
-.SH DESCRIPTION
-If you translate a Fortran file with "f2java test.f", it will produce one class file and one Java source file for each program unit.
-We end up with several generated files: .java, .class.
-
-Before attempting to run the code, make sure that the org.netlib.util package (contained in f2jutil.jar) is in your CLASSPATH.
-.SH AUTHOR
-Man page by Olivier Sallou <olivier.sallou at irisa.fr>
-f2java project by Keith Seymour <seymour at cs.utk.edu>
diff --git a/debian/javab.1 b/debian/javab.1
deleted file mode 100644
index f50a7ef..0000000
--- a/debian/javab.1
+++ /dev/null
@@ -1,12 +0,0 @@
-.TH blastb 1 "January 24, 2012" "version 0.8.1" "USER COMMANDS"
-.SH NAME
-blastb - converts GOGO statements in java class files
-.SH SYNOPSIS
-.B blastb file
-.I file class file generated by f2java
-.SH DESCRIPTION
-To recompile java source files generated by f2java, using javac command, the generated class file must be post-treated with the javab tool.
- It converts the GOTO statements in the class file and remove warnings such as "Untransformed goto remaining in program).
-.SH AUTHOR
-Man page by Olivier Sallou <olivier.sallou at irisa.fr>
-f2java project by Keith Seymour <seymour at cs.utk.edu>
diff --git a/debian/patches/fix_clean_target b/debian/patches/fix_clean_target
deleted file mode 100644
index c46cbf8..0000000
--- a/debian/patches/fix_clean_target
+++ /dev/null
@@ -1,33 +0,0 @@
-Subject: remove targets referencing testing
-Author: Olivier Sallou <olivier.sallou at irisa.fr>
-Description: test and clean targets refer to testing dir but it
- does not exists. This creates an infinite loop on those targets.
-Last-Updated: 24/01/2012
---- a/libbytecode/Makefile.in
-+++ b/libbytecode/Makefile.in
-@@ -21,7 +21,7 @@
- dlist.o: dlist.h dlist.c
-
- test:
-- cd testing; $(MAKE) test
-+ #cd testing; $(MAKE) test
-
- docs:
- $(DOXYGEN)
-@@ -32,4 +32,4 @@
-
- clean:
- /bin/rm -rf *.o *.a latex html
-- cd testing; $(MAKE) clean
-+ #cd testing; $(MAKE) clean
---- a/src/Makefile
-+++ b/src/Makefile
-@@ -74,7 +74,7 @@
- clean:
- rm -f *.o *.class f2jparse.c y.tab.c y.tab.h \
- tmp f2j f2java core a.out *.output *~ *.vcg
-- cd test; $(MAKE) clean
-+ #cd test; $(MAKE) clean
-
- realclean: clean
- rm -f ../bin/f2java ../bin/puref2j
diff --git a/debian/patches/generate_doc b/debian/patches/generate_doc
deleted file mode 100644
index b2408d1..0000000
--- a/debian/patches/generate_doc
+++ /dev/null
@@ -1,42 +0,0 @@
-Subject: fix document generation
-Author: Olivier Sallou <olivier.sallou at irisa.fr>,
- Andreas Tille <tille at debian.org>
-Description: fix document generation makefile
- * use pdflatex rather than ps2pdf
- * make sure original pdf will be kept for restoring original source dir state
-Last-Updated: 24/01/2012
---- f2j-0.8.1.orig/doc/Makefile
-+++ f2j-0.8.1/doc/Makefile
-@@ -1,24 +1,18 @@
--LATEX=latex
-+LATEX=pdflatex
- BIBTEX=bibtex
-
- SOURCES = f2j_ug.tex title.tex
-
--f2j_ug.ps: f2j_ug.dvi
--
--f2j_ug.dvi: $(SOURCES)
-+all:
-+ if [ ! -e f2j_ug.orig.pdf ] ; then if [ -e f2j_ug.pdf ] ; then mv f2j_ug.pdf f2j_ug.orig.pdf ; else echo "Original file f2j_ug.pdf is missing" ; fi ; fi
- $(LATEX) f2j_ug.tex
--# $(BIBTEX) f2j_ug
--# $(LATEX) f2j_ug.tex
--# $(LATEX) f2j_ug.tex
--
--f2j_ug.ps: f2j_ug.dvi
-- dvips f2j_ug.dvi -o f2j_ug.ps
--
--f2j_ug.pdf: f2j_ug.ps
-- ps2pdf f2j_ug.ps
-+ # $(BIBTEX) f2j_ug
-+ # $(LATEX) f2j_ug.tex
-+ $(LATEX) f2j_ug.tex
-
- almost_clean:
- rm -f f2j_ug.dvi f2j_ug.ps *.aux *.log *.out
-
- clean:
-- rm -f f2j_ug.dvi f2j_ug.ps f2j_ug.pdf *.aux *.log *.out
-+ rm -f f2j_ug.dvi f2j_ug.ps *.aux *.log *.out *.bbl *.blg
-+ if [ -e f2j_ug.orig.pdf ] ; then mv f2j_ug.orig.pdf f2j_ug.pdf ; fi
diff --git a/debian/patches/series b/debian/patches/series
deleted file mode 100644
index 952bfff..0000000
--- a/debian/patches/series
+++ /dev/null
@@ -1,2 +0,0 @@
-fix_clean_target
-generate_doc
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index f6da015..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/usr/bin/make -f
-# -*- makefile -*-
-
-# Uncomment this to turn on verbose mode.
-#export DH_VERBOSE=1
-
-JAVA_HOME=/usr/lib/jvm/default-java
-
-%:
- dh $@
-
-override_dh_auto_install:
- jh_installlibs --package=libf2j-java util/f2jutil.jar
-
-
-override_dh_auto_build:
- dh_auto_build
-
-override_dh_clean:
- dh_clean
-
-get-orig-source:
- mkdir -p ../tarballs
- uscan --verbose --force-download --destdir=../tarballs
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index f7eb0a0..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,4 +0,0 @@
-# Compulsory line, this is a version 3 file
-version=3
-
-http://sf.net/f2j/f2j-(.+)\.tgz
diff --git a/doc/Makefile b/doc/Makefile
new file mode 100644
index 0000000..90c94e9
--- /dev/null
+++ b/doc/Makefile
@@ -0,0 +1,24 @@
+LATEX=latex
+BIBTEX=bibtex
+
+SOURCES = f2j_ug.tex title.tex
+
+f2j_ug.ps: f2j_ug.dvi
+
+f2j_ug.dvi: $(SOURCES)
+ $(LATEX) f2j_ug.tex
+# $(BIBTEX) f2j_ug
+# $(LATEX) f2j_ug.tex
+# $(LATEX) f2j_ug.tex
+
+f2j_ug.ps: f2j_ug.dvi
+ dvips f2j_ug.dvi -o f2j_ug.ps
+
+f2j_ug.pdf: f2j_ug.ps
+ ps2pdf f2j_ug.ps
+
+almost_clean:
+ rm -f f2j_ug.dvi f2j_ug.ps *.aux *.log *.out
+
+clean:
+ rm -f f2j_ug.dvi f2j_ug.ps f2j_ug.pdf *.aux *.log *.out
diff --git a/doc/f2j_ug.pdf b/doc/f2j_ug.pdf
new file mode 100644
index 0000000..233cdda
Binary files /dev/null and b/doc/f2j_ug.pdf differ
diff --git a/doc/f2j_ug.tex b/doc/f2j_ug.tex
new file mode 100644
index 0000000..0fd173c
--- /dev/null
+++ b/doc/f2j_ug.tex
@@ -0,0 +1,468 @@
+\documentclass[11pt]{article}
+\setlength{\oddsidemargin}{.25in}
+\setlength{\topmargin}{-.25in}
+\setlength{\textheight}{8.75in}
+\setlength{\textwidth}{6in}
+\setlength{\parindent}{.25in}
+\usepackage{moreverb}
+\usepackage{longtable}
+\usepackage{textcomp}
+\usepackage{graphicx}
+\usepackage{amstext,amssymb}
+\usepackage{pslatex}
+\usepackage{url}
+\usepackage[ps2pdf,colorlinks]{hyperref}
+
+\begin{document}
+
+\pagenumbering{roman}
+\include{title}
+
+%\include{license}
+%\tableofcontents
+%\listoftables
+%\listoffigures
+
+\newpage
+\pagenumbering{arabic}
+\setcounter{page}{1}
+
+\section{Introduction}
+
+Before using the f2j source code, realize that f2j was originally geared
+to a very specific problem - that is, translating the LAPACK and BLAS numerical
+libraries. However, now that the translation of the single and double precision
+versions of BLAS and LAPACK is complete, the goal is
+to handle as much Fortran as possible, but there's still a lot left to cover.
+We have a lot of confidence in the JLAPACK translation, but for a variety of
+reasons, f2j will most likely not correctly translate your code at first.
+
+One of the reasons for putting the code up on SourceForge is to enable easy
+collaboration with other developers. If you're interested in helping the
+development of f2j, we'll consider giving commit access to the CVS tree.
+
+The purpose of this document is to describe how to build and use the f2j compiler and
+to give some background on how to extend it to handle your Fortran code.
+
+\section{Obtaining the Code}
+
+For downloads and CVS access, see the f2j project page at SourceForge:
+
+\begin{verbatim}
+ http://sourceforge.net/projects/f2j
+\end{verbatim}
+
+There is a source tarball available in the download section and anonymous
+CVS access is also available.
+
+The GOTO translation code is based on the bytecode parser found in javab, a
+bytecode parallelizing tool under development at the University of Indiana.
+That code is covered under its original license, found in the translator source
+directory.
+
+\section{Limitations}
+
+There are many limitations to be aware of before using f2j:
+\begin{itemize}
+\item Parsing -- the parser has a bug that requires at least one variable
+declaration in every program unit. Also, the last line of the program
+cannot be blank.
+\item Typechecking -- f2j does not aim to do much typechecking. It assumes
+that you have already tested the code with a real Fortran compiler.
+\item Data types -- complex numbers are not supported.
+\item Input/Output -- f2j does not support any file I/O. Formatted
+I/O support is fairly weak, but works for many simple cases. At worst, the
+output will be missing or you'll get ``NULL'' printed out instead of numbers.
+\item Other Features -- Certain forms of Fortran EQUIVALENCE are not
+supported. f2j can handle a limited form of EQUIVALENCE as long as the variables
+being equivalenced do not differ in type and are not offset from each other.
+Multiple entry points are not supported.
+\end{itemize}
+
+With that said, if you have pretty straightforward numerical code (similar to
+BLAS or LAPACK) f2j may be able to handle it.
+
+\section{Building and Using f2java}
+
+We have been doing development and testing of f2j on Sun SPARCstations running
+various versions of Solaris as well as x86 machines running various versions
+of Linux and Solaris/x86. It may compile on
+other platforms, though. Using gcc 3.4.4 with the \verb|-Wall| flag, we get no
+warnings, but using some picky compilers, you may see warnings about
+unused variables, etc. You can safely ignore them.
+
+First, download and uncompress the source code. Building the code follows the typical configure/make process:
+
+\begin{verbatim}
+# ./configure
+# make
+\end{verbatim}
+
+Optionally, you can ``make install'' which will copy the executables to the
+location specified in the \verb|--prefix| argument to configure.
+
+Now you may want to add the relevant install directory to your PATH. This
+will vary depending on whether you did ``make install''. If so, the PATH
+should include \verb|$prefix/bin|. If not, your PATH should include
+\verb|$f2j_dir/src| and \verb|$f2j_dir/goto_trans|, where \verb|$f2j_dir|
+is the top-level f2j source directory. You may also want to modify your
+CLASSPATH to include the f2j util package.
+If you did ``make install'', this will be \verb|$prefix/lib/f2jutil.jar|.
+Otherwise, it will be \verb|$f2j_dir/util/f2jutil.jar|.
+
+Let's go through a simple example. Say you have the following Fortran code in a file
+called ``test.f''
+
+\begin{verbatim}
+ program blah
+ external foo
+ write(*,*) 'hi'
+ call foo(12)
+ stop
+ end
+ subroutine foo(y)
+ integer y
+ write(*,*) 'foo ', y
+ return
+ end
+\end{verbatim}
+
+If you translate it with ``\verb|f2java test.f|'', it will produce one class file and
+one Java source file for each program unit. So, in this case since we have
+two program units in the Fortran source file, we end up with four generated files:
+Blah.java, Blah.class, Foo.java, and Foo.class (note the first letter
+of the name becomes
+capitalized). You can run the generated class file directly:
+
+\begin{verbatim}
+# java Blah
+hi
+foo 12
+\end{verbatim}
+
+You don't need to compile the Java source, but if you wanted to modify it,
+you could recompile:
+
+\begin{verbatim}
+# javac Blah.java Foo.java
+\end{verbatim}
+
+However at this point the GOTO statements haven't been converted, so if you
+run it you'll see some warnings like this:
+
+\begin{verbatim}
+# java Blah
+hi
+foo 12
+Warning: Untransformed goto remaining in program! (Foo, 999999)
+Warning: Untransformed label remaining in program! (Foo, 999999)
+\end{verbatim}
+
+So you need to run the GOTO transformer (javab) on the class files:
+
+\begin{verbatim}
+# javab *.class
+\end{verbatim}
+
+and then it'll run fine:
+
+\begin{verbatim}
+# java Blah
+hi
+foo 12
+\end{verbatim}
+
+\section{Command-line Options}
+
+There are several command-line options that you should be aware of:
+
+\begin{itemize}
+\item -I specifies a path to be searched for included files (may be used
+ multiple times).
+
+\item -c specifies the search path for f2j ``descriptor'' files (ending in .f2j).
+ It is a colon-separated list of paths, like a Java CLASSPATH). For example:
+\begin{verbatim}
+ f2java -c .:../objects filename.f
+\end{verbatim}
+
+\item -p specifies the name of the package. For example:
+\begin{verbatim}
+ f2java -p org.netlib.blas filename.f
+\end{verbatim}
+
+\item -o specifies the destination directory to which the code should be
+ written.
+
+\item -w forces all scalars to be generated as wrapped objects. The default
+ behavior is to only wrap those scalars that must be passed by reference.
+ Note that using this option will generate less efficient Java code.
+
+\item -i causes f2j to generate a high-level interface to each subroutine and
+ function. The high-level interface uses a Java-style calling convention (2D
+ row-major arrays, etc). The low-level routine is still generated because the
+ high-level interface simply performs some conversions and then calls the
+ low-level routine.
+
+\item -h displays help information.
+
+\item -s causes f2j to simplify the interfaces by removing the offset parameter and
+ using a zero offset. It isn't necessary to specify -i in addition to -s.
+
+\item -d causes f2j to generate comments in a format suitable for javadoc. It is a
+ bit of a LAPACK-specific hack -- the longest comment in the program unit is
+ placed in the javadoc comment. It works fine for BLAS/LAPACK code (or any
+ other code where the longest comment is the one that describes the function),
+ but will most likely not work for other code.
+
+\item -fm causes f2j to generate code that calls java.lang.StrictMath
+ instead of java.lang.Math. By default, java.lang.Math is used.
+
+\item -fs causes f2j to declare the generated code as strictfp (strict
+ floating point). By default, the generated code is not strict.
+
+\item -fb enables both the -fm and -fs options.
+
+\item -vs causes f2j to generate all variables as static class
+ variables. By default f2j generates variables as locals.
+
+\item -va causes f2j to generate arrays as static class variables, but
+ other variables are generated as locals.
+\end{itemize}
+
+After issuing the command ``f2java file.f'' there should be one or more Java
+files in your current directory, one Java file and one class file per Fortran program unit
+(function, subroutine, program) in the source file. Initially, we would
+suggest concatenating all Fortran program units into one file because it makes
+it easier to perform correct code generation (more about this later). As the
+example above illustrated, you can run the class file corresponding to the main
+Fortran program unit or you can use the Java compiler of your choice to compile
+the resulting Java source code. Make sure that the org.netlib.util package is
+in your CLASSPATH. This package comes in both the f2j and JLAPACK distributions,
+so if your CLASSPATH already points to JLAPACK's f2jutil.jar, then you're ok.
+
+\section{Organizing Your Fortran Code}
+
+Any non-trivial Fortran program will consist of multiple source files, often
+in many different directories. This can present difficulties for f2j because
+resolving external functions and subroutines is critical for generating the
+call correctly.
+
+First, we will give some practical advice on organizing your code to be built
+using f2j. The following section will give a more detailed explanation of
+why this is all so important.
+
+\subsection{Practical Aspects}
+
+The easiest method is to just concatenate all your Fortran code into one file
+and run f2j on it. This might not be practical in all cases, though. If you have
+to keep code in separate files, you need to understand the dependence relationship
+between them. For example, if you have files \verb|a.f| and \verb|b.f|, and
+routines in \verb|a.f| call routines in \verb|b.f|, then you must translate
+\verb|b.f| first. If there is a cross dependency, then f2j will most likely
+not generate some calls correctly. Thinking of it as a call tree, you want
+to start translating at the leaves and work your way back up. This sometimes
+requires modifying the code.
+
+When code exists in separate subdirectories, the procedure is largely the same,
+except that f2j needs to know the subdirectory names containing files that the
+current program unit depends on. Modifying the previous example, let's say
+that \verb|b.f| is in a subdirectory named \verb|../code/foo|. We would first
+go to \verb|../code/foo| and translate \verb|b.f|, which would result in the
+creation of a number of descriptor files ending in \verb|.f2j|. Then in the subdirectory
+containing \verb|a.f|, specify the other subdirectory on the command line:
+\begin{verbatim}
+# f2java -c .:../code/foo a.f
+\end{verbatim}
+f2j will locate the descriptor files in \verb|../code/foo| and use them to
+generate the correct calls to the routines contained in \verb|b.f|. You can
+specify multiple paths separated by a colon.
+
+\subsection{Resolving External Routines}
+This section illustrates in more detail the importance of resolving calls to functions
+or subroutines which do not appear in the original source file.
+By ``resolving'', we mean determining the correct
+calling sequence for the function call, which
+depends on its method signature. For example, consider
+the following Fortran program segment:
+\begin{verbatim}
+ INTEGER X(10)
+
+ CALL FUNC1( X(5) )
+ CALL FUNC2( X(5) )
+ [...]
+ SUBROUTINE FUNC1(A)
+ INTEGER A
+ [...]
+ SUBROUTINE FUNC2(A)
+ INTEGER A(*)
+\end{verbatim}
+
+\begin{table*}[t]
+\begin{center}
+\begin{sffamily}
+ \begin{tabular}{ll}
+ \hline
+ \textbf{Calling FUNC1} & \textbf{Calling FUNC2}\\ \hline
+ \verb|getstatic #15 <Field Hello.x:int[]>|
+ & \verb|getstatic #15 <Field Hello.x:int[]>| \\
+
+ \verb|iconst_5|
+ & \verb|iconst_5| \\
+
+ \verb|iconst_1|
+ & \verb|iconst_1| \\
+
+ \verb|isub|
+ & \verb|isub| \\
+
+ \verb|iaload|
+ & \verb|invokestatic #28| \\
+
+ \verb|invokestatic #22|
+ & \verb| <Method Func2.func2(int[],int):void>| \\
+
+ \verb| <Method Func1.func1(int):void>|
+ & \verb|| \\
+
+ \hline
+ \end{tabular}
+\end{sffamily}
+\end{center}
+\caption{Differences in Argument Passing.}
+\label{tab:argpass}
+\end{table*}
+
+The first subroutine, {\tt FUNC1}, expects a scalar argument,
+while {\tt FUNC2} expects an array argument.
+These two calls would be generated identically in a standard
+Fortran compiler, regardless of how {\tt FUNC1} and
+{\tt FUNC2} were defined --- the address of the fifth element of X
+would be passed to the subroutine in both cases. However, things
+are not as simple in Java due to the lack of pointers.
+To simulate passing array subsections, as necessary for the
+second call, we actually pass two arguments --- the array
+reference and an additional integer offset parameter, as shown
+in the right column of Table \ref{tab:argpass}.
+
+However, the first subroutine expects a scalar, so we should pass only the value
+of the fifth element, without any offset parameter, as shown in the left column
+of Table \ref{tab:argpass} (in this case, assume that {\tt FUNC1} does not
+modify the argument, otherwise things get even more complex).
+
+Notice that the primary difference between the two calling sequences
+is that when calling {\tt FUNC1}, the array is first dereferenced using the {\tt iaload}
+instruction. Also note that the purpose of the arithmetic expression is
+to decrement the index by 1 to compensate for the fact that
+Java has 0-based indexing whereas Fortran has 1-based indexing.
+
+The only way to determine the correct calling sequence for
+any given call is to examine the
+parameters of the corresponding subroutine or function declaration.
+This is only possible if the declaration had been
+parsed at the same time as the current program unit, meaning
+that for code generation to work properly all the source files
+had to be joined into a big monolithic input file.
+
+This was a serious limitation, especially for large libraries,
+because a modification to any part of the code requires
+re-compiling {\em all} the source.
+There are at least a couple of ways to solve this problem.
+One way would be to obtain the parameter information directly
+from class files that have already been generated. While this
+would work well, f2j is written in C
+and does not have access to nice Java features like reflection,
+so it would require a lot of extra code
+to parse the class files.
+Instead, we use a more lightweight
+procedure in f2j. At compile-time, f2j creates a {\it descriptor file} which
+is a text file containing a list of every method generated. Each
+line of the descriptor file contains the following information:
+\begin{itemize}
+\item Class name -- the fully qualified class name which contains
+the given method.
+\item Method name -- the name of the method itself.
+\item Method descriptor -- this method's descriptor, which is
+a string representing the types of all the arguments as well
+as the return type.
+\end{itemize}
+Continuing with the previous example, the descriptor files
+for {\tt FUNC1} and {\tt FUNC2} would be:
+\begin{verbatim}
+# cat Func1.f2j
+Func1:func1:(I)V
+
+# cat Func2.f2j
+Func2:func2:([II)V
+\end{verbatim}
+
+To resolve a subroutine or function call, we search all
+the descriptor files for the matching method name and examine
+the method descriptor. Based on the method descriptor, we can then
+correctly generate the calling sequence.
+The code generator
+locates the descriptor files based on colon-separated paths specified
+on the command line or
+in the environment variable {\tt F2J\_SEARCH\_PATH}.
+
+\section{Extending f2j}
+
+So, at this point you may be wondering how to extend f2j to handle your code.
+Typically, the first problem you'll run into is that f2j doesn't parse your
+code. That could involve something as simple as changing a production in the
+parser or it could involve a bit more work - e.g. creating a new kind of AST
+node along with all the appropriate code generation routines. The first thing
+you'll want to check is whether the parser supports the syntax your code uses
+(the parsing code is machine generated from a Yacc grammar in f2jparse.y). For
+example, if your code contains an ENTRY statement, your code will not compile
+because f2j doesn't support alternate entry points. Suppose you wanted to
+implement ENTRY in f2j. Your first step would be to define a lexer token to
+represent the ENTRY keyword (in fact, this exists already, even though ENTRY is
+not implemented). The lexer sometimes needs to be modified to handle the token
+correctly, but usually it is sufficient to put the token in the appropriate
+lexer table. In this case, we would just put the ENTRY keyword in the
+\verb|tab_stmt| array defined in \verb|globals.c|. That array holds keywords
+that are at the beginning of statements. You'll notice that this has also been
+added already.
+
+If you're getting parse errors on a line of code that should compile based on
+your examination of the parser, then the lexer might not be sending the correct
+tokens to the parser. The lexical analysis code is in f2jlex.c, which is
+handwritten C code based on Sale's algorithm. There's not really an easy way of
+describing the structure of the lexer code, but if you enable debugging output
+(set lexdebug = TRUE) it will show which tokens are being passed from the lexer
+to the parser. That should help you figure out where the problem is.
+
+While you're working on the parsing, you can leave the code section in the Yacc
+grammar blank. You'll recognize when it finally parses correctly because
+you'll get a segmentation fault (meaning it passed the parsing phase and
+failed in a subsequent phase since you didn't pass an AST node back up from
+that production). At this point, you need to determine what information is
+needed by the back-end to generate the code. For example, a loop might need
+a statement label number, an initial value, a final value, and an increment
+value. The AST node types are defined in \verb|f2j.h|. If the node you're
+defining is close enough to an existing node, you can reuse it. Otherwise you'll
+have to create a new one. Then just initialize this node in the code
+section for your new production.
+
+If f2j can parse your code, but the resulting Java code does not compile or
+does not work, then this may indicate a problem in the f2j back-end. First, try
+concatenating all your Fortran files into one big file (ok, we admit this is
+cheesy, but it does work sometimes). This should help with the type analysis
+phase and may eliminate problems in the resulting Java code. After that, if the
+generated code is still incorrect, begin looking into the f2j code. After f2j
+parses your code, it passes through a couple of stages before actually
+generating code. First, the AST goes through ``type analysis'' (typecheck.c),
+which simply means that the tree is fully traversed and each node is assigned
+type information as appropriate. This is not semantic analysis, just
+annotation. Next, the AST goes through ``scalar optimization'' (optimize.c),
+which is an optimization stage designed to determine which scalar variables
+need to be wrapped in objects and which can remain primitives. After that, f2j
+generates the Java code (codegen.c) based on the modified AST. So, if you
+notice a type mismatch problem in the generated code, typecheck.c would be a
+good place to begin debugging. Similarly, if you notice that object wrappers
+are inappropriately used, check into optimize.c (hint: by passing the -w flag
+to f2java, the scalar optimization code will be skipped). Most other problems
+will be with the code generator itself.
+
+\end{document}
diff --git a/doc/title.tex b/doc/title.tex
new file mode 100644
index 0000000..e9a55ac
--- /dev/null
+++ b/doc/title.tex
@@ -0,0 +1,17 @@
+\thispagestyle{empty}
+\begin{center}
+\huge
+\bf
+User's Guide to f2j \\
+Version 0.8.1
+\vspace*{1in} \mbox{} \\
+\LARGE \rm
+Keith Seymour and Jack Dongarra
+
+\vspace*{.5in}
+Innovative Computing Laboratory\\
+Department of Computer Science\\
+University of Tennessee\\
+\vspace*{.5in}
+June 30, 2008
+\end{center}
diff --git a/f2j_TODO.txt b/f2j_TODO.txt
new file mode 100644
index 0000000..097426a
--- /dev/null
+++ b/f2j_TODO.txt
@@ -0,0 +1,50 @@
+Relatively high priority modifications. (not necessarily listed
+in order of priority)
+
+-Isolate the WRITE/FORMAT code in the lexer into a subroutine.
+
+-Work on front-end
+ The front-end of f2j is sufficient for BLAS/LAPACK code, but to
+ handle any other code it will have to be extended. I think the
+ best way to go would be to graft a full f77 parser from another
+ compiler or tool (such as FTNCHEK) onto f2j. This is no small
+ task since it could alter the structure of the syntax tree, thus
+ requiring all subsequent stages of the translator to be modified.
+
+-Port fortran I/O library to java
+ I have a BSD fortran I/O library somewhere (written in C) that would
+ make translating READ,WRITE,FORMAT statements much easier - if only
+ it was converted to Java. It's around 6000 lines of C code, if I
+ remember correctly.
+ [UPDATE: as of version 0.8, this is done to a certain extent, but
+ not from a C port. I integrated a hacked version of Jocelyn Paine's
+ Formatter package into f2j.]
+
+-Threadsafe version
+ One or two people have asked about this. It's not a bad idea, but
+ it would change the user interface and code generation. The code
+ that generates static initializers would need to be changed.
+
+-Support more data types
+ Having support for complex numbers would be nice, but it will require
+ a lot of changes in the code generator.
+
+-More translator optimizations
+ Might be interesting to see if we can optimize the array indexing
+ since it gets so cumbersome in the translation. The java compiler
+ probably optimizes the index expressions - however, even if it turns
+ out that there is no speed improvement, it would still help the
+ readability of the resulting source code a lot. If we end up
+ translating directly to Jasmin or bytecode, then we should definitely
+ try to optimize some of this. Also string operations (accessing a
+ single character, substring, etc) may leave some room for optimization.
+
+-Create AST documentation
+ It would help to have a chart of the structure of each kind of
+ node in the abstract syntax tree.
+
+-Create API documentation
+ Write some API documentation - something a little more extensive
+ than the current javadoc pages. There is a standard link
+ generated by javadoc, "API Users Guide", that should be linked
+ to the API docs whenever complete.
diff --git a/goto_trans/LICENSE b/goto_trans/LICENSE
new file mode 100644
index 0000000..4d58822
--- /dev/null
+++ b/goto_trans/LICENSE
@@ -0,0 +1,53 @@
+*********************************
+*** JAVAB License Information ***
+*********************************
+***
+*** --- This file is a REQUIRED part of JAVAB ---
+***
+*** This prototype bytecode parallelization tool has been developed
+*** at the Indiana University by Aart J.C. Bik. This software is *not*
+*** in the public domain. However, it is freely available without
+*** fee for education, research, and non-profit purposes. By obtaining
+*** copies of this, you, the Licensee, agree to abide by the following
+*** conditions and understandings with respect to the copyrighted software:
+***
+*** 1. The software is copyrighted by Indiana University (IU) and
+*** Aart J.C. Bik and they retain ownership of the software.
+***
+*** 2. Permission to use and modify this software and its documentation
+*** for education, research, and non-profit purposes is hereby granted to
+*** Licensee, provided that the copyright notice, the original author's
+*** names and unit identification, and this permission notice appear on
+*** all such works, and that no charge be made for such copies.
+***
+*** 3. Any entity desiring permission to incorporate this software into
+*** commercial products should contact:
+***
+*** Dennis Gannon gannon at cs.indiana.edu
+*** 215 Lindley Hall
+*** Department of Computer Science
+*** Indiana University
+*** Bloomington, IN 47405-4101 USA
+***
+*** 4. Licensee may not use the name, logo, or any other symbol of
+*** IU nor the names of any of its employees nor any adaptation thereof
+*** in advertising or publicity pertaining to the software without
+*** specific prior written approval of the IU.
+***
+*** 5. THE COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS ABOUT THE SUITABILITY
+*** OF THE SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS
+*** OR IMPLIED WARRANTY.
+***
+*** 6. The copyright holders shall not be liable for any damages suffered
+*** by Licensee from the use of this software.
+***
+*** 7. The software was developed under agreements between the IU and
+*** the Federal Government which entitle the Government to certain rights.
+***
+*** Your courtesy in mentioning the use of this bytecode compiler in any scientific
+*** work that presents results obtained by using (extensions or modifications
+*** of) this bytecode compiler is highly appreciated.
+***
+*** This project has been supported by DARPA under contract
+*** ARPA F19628-94-C-0057 through a subcontract from Syracuse University
+***
diff --git a/goto_trans/Makefile b/goto_trans/Makefile
new file mode 100644
index 0000000..0f9f9d3
--- /dev/null
+++ b/goto_trans/Makefile
@@ -0,0 +1,70 @@
+
+
+# *************
+# *** JAVAB ***
+# ****************************************************
+# *** Copyright (c) 1997 ***
+# *** Aart J.C. Bik Indiana University ***
+# *** All Rights Reserved ***
+# ****************************************************
+# *** Please refer to the LICENSE file distributed ***
+# *** with this software for further details on ***
+# *** the licensing terms and conditions. ***
+# *** ***
+# *** Please, report all bugs, comments, etc. ***
+# *** to: ajcbik at extreme.indiana.edu ***
+# ****************************************************
+# *** Makefile : javab construction
+# ***
+# ***
+# *** Your courtesy in mentioning the use of this bytecode tool
+# *** in any scientific work that presents results obtained
+# *** by using (extensions or modifications of) the tool
+# *** is highly appreciated.
+
+
+include make.def
+
+TARGET = javab
+
+OBJS = byte.o class.o dump.o main.o symtab.o
+
+# Executable
+# **********
+
+$(TARGET): $(OBJS)
+ $(CC) $(CFLAGS) -o $(TARGET) $(OBJS)
+
+install: $(TARGET)
+ install -d -m 755 $(F2J_BINDIR)
+ install -m 755 $(TARGET) $(F2J_BINDIR)
+
+# System Program
+# **************
+
+main.o : main.c class.h
+ $(CC) -c $(CFLAGS) main.c
+
+# Modules
+# *******
+
+symtab.o : symtab.c symtab.h
+ $(CC) -c $(CFLAGS) symtab.c
+
+byte.o : byte.c class.h
+ $(CC) -c $(CFLAGS) byte.c
+
+class.o : class.c class.h
+ $(CC) -c $(CFLAGS) class.c
+
+dump.o : dump.c class.h
+ $(CC) -c $(CFLAGS) dump.c
+
+# Cleanup
+# *******
+
+clean:
+ rm -f $(OBJS)
+
+realclean: clean
+ rm -f $(TARGET)
diff --git a/goto_trans/README b/goto_trans/README
new file mode 100644
index 0000000..bd873be
--- /dev/null
+++ b/goto_trans/README
@@ -0,0 +1,54 @@
+
+*****************************
+*** JAVAB VERSION 1.0BETA ***
+****************************************************
+*** Copyright (c) 1997 ***
+*** Aart J.C. Bik Indiana University ***
+*** All Rights Reserved ***
+****************************************************
+*** Please refer to the LICENSE file distributed ***
+*** with this software for further details on ***
+*** the licensing terms and conditions. ***
+*** ***
+*** Please, report all bugs, comments, etc. ***
+*** to: ajcbik at extreme.indiana.edu ***
+****************************************************
+
+Contents:
+--------
+JAVAB : The complete source of JAVAB,
+ the LICENSE file, and this README.
+JAVAB/DOC : Documentation of JAVAB (file VERSION summarizes
+ changes with respect to previous releases).
+JAVAB/EXAMPLES/SRC
+JAVAB/EXAMPLES/CLASSES : Source and class files of some examples.
+
+
+Note that there are now two Java research tools available at the
+HP-Java page at Indiana University:
+
+*** JAVAR -- A prototype Java restructuring compiler.
+*********
+ This restructuring compiler can be used to make loop parallelism
+ explicit at *source-code-level* using the multi-threading mechanism of
+ the Java programming language. In this tool, however, loop parallelism
+ must be identified by the programmer by means of annotations.
+
+*** JAVAB -- A prototype bytecode parallelization tool.
+*********
+ This tool can be used to exploit loop parallelism directly at
+ *bytecode-level* using the multi-threading mechanism of the JVM.
+ In addition, the tool provides some elementary support for the
+ automatic *detection* of implicit loop parallelism.
+
+Documentation, manuals, LICENSE information, and the complete
+source of both JAVAR and JAVAB are made available for education,
+research, and non-profit purposes at the HP-Java page:
+
+ http://www.extreme.indiana.edu/hpjava/
+
+Please keep in mind that both JAVAR and JAVAB are research
+tools, and not robust commercial products. Anyway, please
+send all your bug reports, but also other comments, experiences,
+or suggestions to: ajcbik at extreme.indiana.edu
+
diff --git a/goto_trans/byte.c b/goto_trans/byte.c
new file mode 100644
index 0000000..3372e1c
--- /dev/null
+++ b/goto_trans/byte.c
@@ -0,0 +1,1404 @@
+
+
+/* *************
+ *** JAVAB ***
+ ****************************************************
+ *** Copyright (c) 1997 ***
+ *** Aart J.C. Bik Indiana University ***
+ *** All Rights Reserved ***
+ ****************************************************
+ *** Please refer to the LICENSE file distributed ***
+ *** with this software for further details on ***
+ *** the licensing terms and conditions. ***
+ *** ***
+ *** Please, report all bugs, comments, etc. ***
+ *** to: ajcbik at extreme.indiana.edu ***
+ ****************************************************
+ *** byte.c : bytecode manipulations
+ ***
+ ***
+ *** Your courtesy in mentioning the use of this bytecode tool
+ *** in any scientific work that presents results obtained
+ *** by using (extensions or modifications of) the tool
+ *** is highly appreciated.
+ ***
+ *** */
+
+/* ********************************************************
+ *** INCLUDE FILES and DEFINITIONS ***
+ ******************************************************** */
+
+#include "class.h"
+
+#define CHECK_TABLE
+#define GET_IT(a,b) if (valid_cp_entry((a), entry, (b))) { \
+ n = constant_pool[entry] -> u.indices.index2; \
+ d = constant_pool[n] -> u.indices.index2; \
+ s = constant_pool[d] -> u.utf8.s; \
+ } \
+ else break;
+#define HAS_TARGET(b) (((b)>=1u)&&((b)<=3u))
+
+/* ********************************************************
+ *** EXTERNAL VARIABLES ***
+ ******************************************************** */
+
+extern char *filename;
+
+/* global information
+ ****************** */
+
+static attribute_ptr att;
+
+static u4_int len;
+static u1_int *byt, opc, bra, exc;
+static u2_int pre, pos;
+static char *mem;
+
+static u1_int is_wide;
+static u1_int is_instm;
+
+static u4_int target, next;
+
+static u2_int glo_sta, glo_pad, glo_loc, glo_stm;
+static s4_int glo_def, glo_npa, glo_low, glo_hig;
+
+static u2_int cur_sp;
+
+static char *thisClassName;
+
+#ifndef TRANS_DEBUG
+#define TRANS_DEBUG 0
+#endif
+
+static int trdebug = TRANS_DEBUG;
+
+static int numChanges;
+
+u4_int u4BigEndian(u4_int);
+char isBigEndian();
+
+/* reaching definitions and uses
+ ***************************** */
+
+static char rd_buf[510];
+static char *rd_sig[255]; /* fixed arrays */
+
+/* bytecode table
+ ************** */
+
+static struct bytecode_node {
+
+ u1_int opcode; /* redundant verify field:
+ bytecode[i].opcode == i
+ *********************** */
+ char *mnemonic;
+
+ u1_int operands; /* 9 == lookup */
+ u1_int stack_pre; /* 9 == lookup */
+ u1_int stack_post; /* 9 == lookup */
+ /* *********** */
+
+ u1_int exception; /* 0: no exception
+ 1: pot. RUN-TIME exception
+ 2: pot. RUN-TIME exception + has c.p.-entry
+ 3: pot. LINKING exception
+ 4: pot. pot. LINKING exception + has c.p.-entry
+ *********************************************** */
+
+ u1_int branch; /* 0: no branch,
+ ---------------------------
+ 1: cond. branch + target,
+ 2: uncond. branch + target,
+ 3: jsr/jsr_w + target,
+ ---------------------------
+ 4: special + continue next
+ 5: special + no-continue next
+ ************************************ */
+} bytecode[] = {
+
+/* ***--------------------------------------------> opcode
+ **************----------------------------> mnemonic
+ **-----------------------> #operands (in bytes)
+ **-------------------> stack pre (in words)
+ **---------------> stack post (in words)
+ **-----------> exception
+ **-------> branch */
+/* *** ************** ** ** ** ** ** */
+
+ { 0, "nop", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 1, "aconst_null", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 2, "iconst_m1", 0, 0, 1, 0, 0 },
+ { 3, "iconst_0", 0, 0, 1, 0, 0 },
+ { 4, "iconst_1", 0, 0, 1, 0, 0 },
+ { 5, "iconst_2", 0, 0, 1, 0, 0 },
+ { 6, "iconst_3", 0, 0, 1, 0, 0 },
+ { 7, "iconst_4", 0, 0, 1, 0, 0 },
+ { 8, "iconst_5", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 9, "lconst_0", 0, 0, 2, 0, 0 },
+ { 10, "lconst_1", 0, 0, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 11, "fconst_0", 0, 0, 1, 0, 0 },
+ { 12, "fconst_1", 0, 0, 1, 0, 0 },
+ { 13, "fconst_2", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 14, "dconst_0", 0, 0, 2, 0, 0 },
+ { 15, "dconst_1", 0, 0, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 16, "bipush", 1, 0, 1, 0, 0 },
+ { 17, "sipush", 2, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 18, "ldc", 1, 0, 1, 4, 0 },
+ { 19, "ldc_w", 2, 0, 1, 4, 0 },
+ { 20, "ldc2_w", 2, 0, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 21, "iload", 1, 0, 1, 0, 0 },
+ { 22, "lload", 1, 0, 2, 0, 0 },
+ { 23, "fload", 1, 0, 1, 0, 0 },
+ { 24, "dload", 1, 0, 2, 0, 0 },
+ { 25, "aload", 1, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 26, "iload_0", 0, 0, 1, 0, 0 },
+ { 27, "iload_1", 0, 0, 1, 0, 0 },
+ { 28, "iload_2", 0, 0, 1, 0, 0 },
+ { 29, "iload_3", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 30, "lload_0", 0, 0, 2, 0, 0 },
+ { 31, "lload_1", 0, 0, 2, 0, 0 },
+ { 32, "lload_2", 0, 0, 2, 0, 0 },
+ { 33, "lload_3", 0, 0, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 34, "fload_0", 0, 0, 1, 0, 0 },
+ { 35, "fload_1", 0, 0, 1, 0, 0 },
+ { 36, "fload_2", 0, 0, 1, 0, 0 },
+ { 37, "fload_3", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 38, "dload_0", 0, 0, 2, 0, 0 },
+ { 39, "dload_1", 0, 0, 2, 0, 0 },
+ { 40, "dload_2", 0, 0, 2, 0, 0 },
+ { 41, "dload_3", 0, 0, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 42, "aload_0", 0, 0, 1, 0, 0 },
+ { 43, "aload_1", 0, 0, 1, 0, 0 },
+ { 44, "aload_2", 0, 0, 1, 0, 0 },
+ { 45, "aload_3", 0, 0, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 46, "iaload", 0, 2, 1, 1, 0 },
+ { 47, "laload", 0, 2, 2, 1, 0 },
+ { 48, "faload", 0, 2, 1, 1, 0 },
+ { 49, "daload", 0, 2, 2, 1, 0 },
+ { 50, "aaload", 0, 2, 1, 1, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 51, "baload", 0, 2, 1, 1, 0 },
+ { 52, "caload", 0, 2, 1, 1, 0 },
+ { 53, "saload", 0, 2, 1, 1, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 54, "istore", 1, 1, 0, 0, 0 },
+ { 55, "lstore", 1, 2, 0, 0, 0 },
+ { 56, "fstore", 1, 1, 0, 0, 0 },
+ { 57, "dstore", 1, 2, 0, 0, 0 },
+ { 58, "astore", 1, 1, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 59, "istore_0", 0, 1, 0, 0, 0 },
+ { 60, "istore_1", 0, 1, 0, 0, 0 },
+ { 61, "istore_2", 0, 1, 0, 0, 0 },
+ { 62, "istore_3", 0, 1, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 63, "lstore_0", 0, 2, 0, 0, 0 },
+ { 64, "lstore_1", 0, 2, 0, 0, 0 },
+ { 65, "lstore_2", 0, 2, 0, 0, 0 },
+ { 66, "lstore_3", 0, 2, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 67, "fstore_0", 0, 1, 0, 0, 0 },
+ { 68, "fstore_1", 0, 1, 0, 0, 0 },
+ { 69, "fstore_2", 0, 1, 0, 0, 0 },
+ { 70, "fstore_3", 0, 1, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 71, "dstore_0", 0, 2, 0, 0, 0 },
+ { 72, "dstore_1", 0, 2, 0, 0, 0 },
+ { 73, "dstore_2", 0, 2, 0, 0, 0 },
+ { 74, "dstore_3", 0, 2, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 75, "astore_0", 0, 1, 0, 0, 0 },
+ { 76, "astore_1", 0, 1, 0, 0, 0 },
+ { 77, "astore_2", 0, 1, 0, 0, 0 },
+ { 78, "astore_3", 0, 1, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 79, "iastore", 0, 3, 0, 1, 0 },
+ { 80, "lastore", 0, 4, 0, 1, 0 },
+ { 81, "fastore", 0, 3, 0, 1, 0 },
+ { 82, "dastore", 0, 4, 0, 1, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 83, "aastore", 0, 3, 0, 1, 0 },
+ { 84, "bastore", 0, 3, 0, 1, 0 },
+ { 85, "castore", 0, 3, 0, 1, 0 },
+ { 86, "sastore", 0, 3, 0, 1, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 87, "pop", 0, 1, 0, 0, 0 },
+ { 88, "pop2", 0, 2, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 89, "dup", 0, 1, 2, 0, 0 },
+ { 90, "dup_x1", 0, 2, 3, 0, 0 },
+ { 91, "dup_x2", 0, 3, 4, 0, 0 },
+ { 92, "dup2", 0, 2, 4, 0, 0 },
+ { 93, "dup2_x1", 0, 3, 5, 0, 0 },
+ { 94, "dup2_x2", 0, 4, 6, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 95, "swap", 0, 2, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 96, "iadd", 0, 2, 1, 0, 0 },
+ { 97, "ladd", 0, 4, 2, 0, 0 },
+ { 98, "fadd", 0, 2, 1, 0, 0 },
+ { 99, "dadd", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 100, "isub", 0, 2, 1, 0, 0 },
+ { 101, "lsub", 0, 4, 2, 0, 0 },
+ { 102, "fsub", 0, 2, 1, 0, 0 },
+ { 103, "dsub", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 104, "imul", 0, 2, 1, 0, 0 },
+ { 105, "lmul", 0, 4, 2, 0, 0 },
+ { 106, "fmul", 0, 2, 1, 0, 0 },
+ { 107, "dmul", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 108, "idiv", 0, 2, 1, 1, 0 },
+ { 109, "ldiv", 0, 4, 2, 1, 0 },
+ { 110, "fdiv", 0, 2, 1, 0, 0 },
+ { 111, "ddiv", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 112, "irem", 0, 2, 1, 1, 0 },
+ { 113, "lrem", 0, 4, 2, 1, 0 },
+ { 114, "frem", 0, 2, 1, 0, 0 },
+ { 115, "drem", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 116, "ineg", 0, 1, 1, 0, 0 },
+ { 117, "lneg", 0, 2, 2, 0, 0 },
+ { 118, "fneg", 0, 1, 1, 0, 0 },
+ { 119, "dneg", 0, 2, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 120, "ishl", 0, 2, 1, 0, 0 },
+ { 121, "lshl", 0, 3, 2, 0, 0 },
+ { 122, "ishr", 0, 2, 1, 0, 0 },
+ { 123, "lshr", 0, 3, 2, 0, 0 },
+ { 124, "iushr", 0, 2, 1, 0, 0 },
+ { 125, "lushr", 0, 3, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 126, "iand", 0, 2, 1, 0, 0 },
+ { 127, "land", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 128, "ior", 0, 2, 1, 0, 0 },
+ { 129, "lor", 0, 4, 2, 0, 0 },
+ { 130, "ixor", 0, 2, 1, 0, 0 },
+ { 131, "lxor", 0, 4, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 132, "iinc", 2, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 133, "i2l", 0, 1, 2, 0, 0 },
+ { 134, "i2f", 0, 1, 1, 0, 0 },
+ { 135, "i2d", 0, 1, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 136, "l2i", 0, 2, 1, 0, 0 },
+ { 137, "l2f", 0, 2, 1, 0, 0 },
+ { 138, "l2d", 0, 2, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 139, "f2i", 0, 1, 1, 0, 0 },
+ { 140, "f2l", 0, 1, 2, 0, 0 },
+ { 141, "f2d", 0, 1, 2, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 142, "d2i", 0, 2, 1, 0, 0 },
+ { 143, "d2l", 0, 2, 2, 0, 0 },
+ { 144, "d2f", 0, 2, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 145, "i2b", 0, 1, 1, 0, 0 },
+ { 146, "i2c", 0, 1, 1, 0, 0 },
+ { 147, "i2s", 0, 1, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 148, "lcmp", 0, 4, 1, 0, 0 },
+ { 149, "fcmpl", 0, 2, 1, 0, 0 },
+ { 150, "fcmpg", 0, 2, 1, 0, 0 },
+ { 151, "dcmpl", 0, 4, 1, 0, 0 },
+ { 152, "dcmpg", 0, 4, 1, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 153, "ifeq", 2, 1, 0, 0, 1 },
+ { 154, "ifne", 2, 1, 0, 0, 1 },
+ { 155, "iflt", 2, 1, 0, 0, 1 },
+ { 156, "ifge", 2, 1, 0, 0, 1 },
+ { 157, "ifgt", 2, 1, 0, 0, 1 },
+ { 158, "ifle", 2, 1, 0, 0, 1 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 159, "if_icmpeq", 2, 2, 0, 0, 1 },
+ { 160, "if_icmpne", 2, 2, 0, 0, 1 },
+ { 161, "if_icmplt", 2, 2, 0, 0, 1 },
+ { 162, "if_icmpge", 2, 2, 0, 0, 1 },
+ { 163, "if_icmpgt", 2, 2, 0, 0, 1 },
+ { 164, "if_icmple", 2, 2, 0, 0, 1 },
+ { 165, "if_acmpeq", 2, 2, 0, 0, 1 },
+ { 166, "if_acmpne", 2, 2, 0, 0, 1 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 167, "goto", 2, 0, 0, 0, 2 },
+ { 168, "jsr", 2, 0, 1, 0, 3 },
+ { 169, "ret", 1, 0, 0, 0, 5 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 170, "tableswitch", 9, 1, 0, 0, 5 },
+ { 171, "lookupswitch", 9, 1, 0, 0, 5 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 172, "ireturn", 0, 1, 0, 0, 5 },
+ { 173, "lreturn", 0, 2, 0, 0, 5 },
+ { 174, "freturn", 0, 1, 0, 0, 5 },
+ { 175, "dreturn", 0, 2, 0, 0, 5 },
+ { 176, "areturn", 0, 1, 0, 0, 5 },
+ { 177, "return", 0, 0, 0, 0, 5 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 178, "getstatic", 2, 0, 9, 4, 0 },
+ { 179, "putstatic", 2, 9, 0, 4, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 180, "getfield", 2, 1, 9, 2, 0 },
+ { 181, "putfield", 2, 9, 0, 2, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 182, "invokevirtual", 2, 9, 9, 2, 4 },
+ { 183, "invokespecial", 2, 9, 9, 2, 4 },
+ { 184, "invokestatic", 2, 9, 9, 4, 4 },
+ { 185, "invokeinterface",4, 9, 9, 2, 4 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 186, "xxxunusedxxx", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 187, "new", 2, 0, 1, 4, 0 },
+ { 188, "newarray", 1, 1, 1, 1, 0 },
+ { 189, "anewarray", 2, 1, 1, 2, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 190, "arraylength", 0, 1, 1, 1, 0 },
+ { 191, "athrow", 0, 1, 0, 1, 5 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 192, "checkcast", 2, 1, 1, 2, 0 },
+ { 193, "instanceof", 2, 1, 1, 4, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 194, "monitorenter", 0, 1, 0, 1, 0 },
+ { 195, "monitorexit", 0, 1, 0, 1, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 196, "wide", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 197, "multianewarray", 3, 9, 1, 2, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 198, "ifnull", 2, 1, 0, 0, 1 },
+ { 199, "ifnonnull", 2, 1, 0, 0, 1 },
+
+/* *** ************** ** ** ** ** ** */
+
+ { 200, "goto_w", 4, 0, 0, 0, 2 },
+ { 201, "jsr_w", 4, 0, 1, 0, 3 },
+
+/* *** ************** ** ** ** ** ** */
+
+ /* reserved opcode: break */
+
+ { 202, "???", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ /* _quick opcodes */
+
+ { 203, "???", 0, 0, 0, 0, 0 },
+ { 204, "???", 0, 0, 0, 0, 0 },
+ { 205, "???", 0, 0, 0, 0, 0 },
+ { 206, "???", 0, 0, 0, 0, 0 },
+ { 207, "???", 0, 0, 0, 0, 0 },
+ { 208, "???", 0, 0, 0, 0, 0 },
+ { 209, "???", 0, 0, 0, 0, 0 },
+ { 210, "???", 0, 0, 0, 0, 0 },
+ { 211, "???", 0, 0, 0, 0, 0 },
+ { 212, "???", 0, 0, 0, 0, 0 },
+ { 213, "???", 0, 0, 0, 0, 0 },
+ { 214, "???", 0, 0, 0, 0, 0 },
+ { 215, "???", 0, 0, 0, 0, 0 },
+ { 216, "???", 0, 0, 0, 0, 0 },
+ { 217, "???", 0, 0, 0, 0, 0 },
+ { 218, "???", 0, 0, 0, 0, 0 },
+ { 219, "???", 0, 0, 0, 0, 0 },
+ { 220, "???", 0, 0, 0, 0, 0 },
+ { 221, "???", 0, 0, 0, 0, 0 },
+ { 222, "???", 0, 0, 0, 0, 0 },
+ { 223, "???", 0, 0, 0, 0, 0 },
+ { 224, "???", 0, 0, 0, 0, 0 },
+ { 225, "???", 0, 0, 0, 0, 0 },
+ { 226, "???", 0, 0, 0, 0, 0 },
+ { 227, "???", 0, 0, 0, 0, 0 },
+ { 228, "???", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ /* unused */
+
+ { 229, "???", 0, 0, 0, 0, 0 },
+ { 230, "???", 0, 0, 0, 0, 0 },
+ { 231, "???", 0, 0, 0, 0, 0 },
+ { 232, "???", 0, 0, 0, 0, 0 },
+ { 233, "???", 0, 0, 0, 0, 0 },
+ { 234, "???", 0, 0, 0, 0, 0 },
+ { 235, "???", 0, 0, 0, 0, 0 },
+ { 236, "???", 0, 0, 0, 0, 0 },
+ { 237, "???", 0, 0, 0, 0, 0 },
+ { 238, "???", 0, 0, 0, 0, 0 },
+ { 239, "???", 0, 0, 0, 0, 0 },
+ { 240, "???", 0, 0, 0, 0, 0 },
+ { 241, "???", 0, 0, 0, 0, 0 },
+ { 242, "???", 0, 0, 0, 0, 0 },
+ { 243, "???", 0, 0, 0, 0, 0 },
+ { 244, "???", 0, 0, 0, 0, 0 },
+ { 245, "???", 0, 0, 0, 0, 0 },
+ { 246, "???", 0, 0, 0, 0, 0 },
+ { 247, "???", 0, 0, 0, 0, 0 },
+ { 248, "???", 0, 0, 0, 0, 0 },
+ { 249, "???", 0, 0, 0, 0, 0 },
+ { 250, "???", 0, 0, 0, 0, 0 },
+ { 251, "???", 0, 0, 0, 0, 0 },
+ { 252, "???", 0, 0, 0, 0, 0 },
+ { 253, "???", 0, 0, 0, 0, 0 },
+
+/* *** ************** ** ** ** ** ** */
+
+ /* reserved opcodes: impdep1 impdep1 */
+
+ { 254, "???", 0, 0, 0, 0, 0 },
+ { 255, "???", 0, 0, 0, 0, 0 }
+} ;
+
+
+/* ********************************************************
+ *** PRIVATE FUNCTIONS ***
+ ******************************************************** */
+
+/* ****************************************
+ *** Processing of Method Descriptors ***
+ **************************************** */
+
+static u2_int res_width(u1_int *s) {
+ u2_int p = 1u;
+ u2_int r = 1u;
+
+ if ((! s) || (s[0] != '('))
+ javab_out(-1, "invalid method descriptor");
+
+ while (s[p++] != ')') ;
+
+ if (s[p] == 'V')
+ r = 0u;
+ else if ((s[p] == 'D') || (s[p] == 'J'))
+ r = 2u;
+
+ return r;
+}
+
+static u2_int arg_width(u1_int *s, u1_int set) {
+ u2_int p = 1u, i;
+ u2_int r = (set == 2u) ? 1u : 0u;
+ u2_int b = 0u;
+
+ if ((! s) || (s[0] != '('))
+ javab_out(-1, "invalid method descriptor");
+
+ while (s[p] != ')') {
+
+ u2_int oldp = p;
+
+ if (set)
+ rd_sig[r] = rd_buf + b;
+ r++;
+
+ switch (s[p]) {
+
+ case 'D':
+ case 'J':
+
+ /* additional word */
+
+ if (set)
+ rd_sig[r] = NULL;
+ r++;
+
+ p++;
+ break;
+
+ case 'L':
+
+ while (s[p++] != ';'); /* skip <classname> */
+ break;
+
+ case '[':
+
+ while (s[++p] == '['); /* skip [[[[[ */
+ if (s[p++] == 'L')
+ while (s[p++] != ';'); /* skip <classname> */
+ break;
+
+ case 'B':
+ case 'C':
+ case 'F':
+ case 'I':
+ case 'S':
+ case 'Z':
+
+ p++;
+ break;
+
+ default:
+
+ javab_out(0, "invalid character %c (=%i) in method descriptor",
+ s[p], s[p]);
+ return r;
+ }
+
+ if (set) {
+ for (i = oldp; i < p; i++)
+ rd_buf[b++] = s[i];
+ rd_buf[b++] = '\0';
+ }
+ }
+ return r;
+}
+
+/* ********************************************************
+ *** Computation of ByteContext Sensitive Information ***
+ *** (next is (mis-)used as an error flag) ***
+ ******************************************************** */
+
+static u2_int det_ops(u4_int i) {
+
+ u4_int j, lf, lb;
+
+ switch (byt[i]) {
+
+ case 170u: /* tableswitch */
+
+ glo_pad = (u2_int) (3u - (i % 4u)); /* zero padding */
+
+ for (j = i+1u; j <= glo_pad; j++)
+ if (byt[j]) {
+ next = 1;
+ javab_out(0, "invalid padding in 'tableswitch' at %u", j);
+ }
+
+ glo_def = B2S4(byt[i+glo_pad+1], byt[i+glo_pad+2],
+ byt[i+glo_pad+3], byt[i+glo_pad+4]);
+ glo_low = B2S4(byt[i+glo_pad+5], byt[i+glo_pad+6],
+ byt[i+glo_pad+7], byt[i+glo_pad+8]);
+ glo_hig = B2S4(byt[i+glo_pad+9], byt[i+glo_pad+10],
+ byt[i+glo_pad+11],byt[i+glo_pad+12]);
+
+ /* Check Validity of all targets */
+
+ if (((u4_int) (i+glo_def)) >= len) {
+ next = 1;
+ javab_out(0, "invalid default target in 'tableswitch' at %u", i);
+ }
+
+ lf = i+glo_pad+13u; lb = glo_hig-glo_low+1u;
+
+ for (j = 0u; j < lb; j++, lf += 4u) {
+ s4_int loc_off = B2S4(byt[lf],byt[lf+1],byt[lf+2],byt[lf+3]);
+
+ if (((u4_int) (i+loc_off)) >= len) {
+ next = 1u;
+ javab_out(0, "invalid target in '%s' at %u", mem, i);
+ }
+ }
+
+ /* Return number of operands (in bytes) */
+
+ return ((u2_int) (glo_pad+16u+(glo_hig-glo_low)*4u));
+
+ case 171u: /* lookupswitch */
+
+ glo_pad = (u2_int) (3u - (i % 4u)); /* zero padding */
+
+ for (j = i+1u; j <= glo_pad; j++)
+ if (byt[j]) {
+ next = 1u;
+ javab_out(0, "invalid padding in 'lookupswitch' at %u", j);
+ }
+
+ glo_def = B2S4(byt[i+glo_pad+1],byt[i+glo_pad+2],
+ byt[i+glo_pad+3],byt[i+glo_pad+4]);
+ glo_npa = B2S4(byt[i+glo_pad+5],byt[i+glo_pad+6],
+ byt[i+glo_pad+7],byt[i+glo_pad+8]);
+
+ /* Check Validity of all targets */
+
+ if (((u4_int) (i + glo_def)) >= len) {
+ next = 1u;
+ javab_out(0, "invalid default target in '%s' at %u", mem, i);
+ }
+
+ lf = i+glo_pad+9u; lb = glo_npa;
+
+ for (j = 0u; j < lb; j++, lf += 8u) {
+ s4_int loc_off = B2S4(byt[lf+4],byt[lf+5],byt[lf+6],byt[lf+7]);
+ if (((u4_int) (i+loc_off)) >= len) {
+ next = 1;
+ javab_out(0, "invalid target in '%s' at %u", mem, i);
+ }
+ }
+
+ /* Return number of operands (in bytes) */
+
+ return ((u2_int) (glo_pad+8u+glo_npa*8u));
+
+ default:
+ javab_out(-1, "error in det_ops %u at %u", byt[i], i);
+ }
+ return 0u; /* dummy return */
+}
+
+static u2_int det_pre(u4_int i) {
+
+ u2_int entry = B2U2(byt[i+1],byt[i+2]);
+ u2_int n, d;
+ u1_int *s;
+
+ switch(byt[i]) {
+
+ case 181u: /* putfield */
+
+ GET_IT(CONSTANT_Fieldref, mem)
+
+ return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 3u : 2u;
+
+ case 179u: /* putstatic */
+
+ GET_IT(CONSTANT_Fieldref, mem)
+
+ return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 2u : 1u;
+
+ case 185u: /* invokeinterface */
+
+ GET_IT(CONSTANT_InterfaceMethodref, mem)
+
+ if (byt[i+3u] != (1u+arg_width(s, 0u)))
+ javab_out(0, "nargs differs from method descriptor at %u", i);
+
+ return (u2_int) (byt[i+3u]);
+
+ case 183u: /* invokespecial */
+ case 182u: /* invokevirtual */
+
+ GET_IT(CONSTANT_Methodref, mem)
+
+ return (u2_int) (1u+arg_width(s, 0u));
+
+ case 184u: /* invokestatic */
+
+ GET_IT(CONSTANT_Methodref, mem)
+
+ return arg_width(s, 0u);
+
+ case 197u: /* multianewarray */
+
+ valid_cp_entry(CONSTANT_Class, entry, "multianewarray");
+
+ return (u2_int) (byt[i+3]);
+
+ default:
+ javab_out(-1, "error in det_pre %u at %u", byt[i], i);
+ }
+ return 0u;
+}
+
+static u2_int det_pos(u4_int i) {
+
+ u2_int entry = B2U2(byt[i+1],byt[i+2]);
+ u2_int n, d;
+ u1_int *s;
+
+ switch(byt[i]) {
+
+ case 180u: /* getfield */
+ case 178u: /* getstatic */
+
+ GET_IT(CONSTANT_Fieldref, mem)
+
+ return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 2u : 1u;
+
+ case 185u: /* invokeinterface */
+
+ GET_IT(CONSTANT_InterfaceMethodref, mem)
+
+ return (res_width(s));
+
+ case 183u: /* invokespecial */
+ case 184u: /* invokestatic */
+ case 182u: /* invokevirtual */
+
+ GET_IT(CONSTANT_Methodref, mem);
+
+ return (res_width(s));
+
+ default:
+ javab_out(-1, "error in det_pos %u at %u", byt[i], i);
+ }
+ return 0u;
+}
+
+/* **********************************
+ *** General bytecode traversal ***
+ ********************************** */
+
+static void byte_trav(u4_int offset) {
+
+ u4_int i; /* wide counter */
+ u2_int ops = 0u;
+ u2_int last_op = -1, prev_op = -1;
+ int last_offset = 0, prev_offset = 0;
+ int branch_label, idx, inst_size;
+ char lbuf[100];
+ int hash(char *);
+ void type_insert(HASHNODE **, int, char *);
+
+ len = att -> code_length;
+ byt = &(att -> info[8u]);
+
+ for (i = offset; i < len; i += (1u+ops)) {
+
+ /* Determine opcode Information */
+
+ is_wide = 0u;
+
+back:
+ opc = byt[i];
+
+ bra = bytecode[opc].branch;
+ ops = bytecode[opc].operands;
+ exc = bytecode[opc].exception;
+
+ pre = bytecode[opc].stack_pre;
+ pos = bytecode[opc].stack_post;
+
+ mem = bytecode[opc].mnemonic;
+
+ /* instruction 'wide'-handling
+ *************************** */
+
+ if (is_wide) {
+ if (opc == 132u) /* wide + iinc */
+ ops = 4u;
+ else if ((21u <= opc) && (opc <= 25u)) /* wide + load */
+ ops = 2u;
+ else if ((54u <= opc) && (opc <= 58u)) /* wide + store */
+ ops = 2u;
+ else if (opc == 169u) /* wide + ret */
+ ops = 2u;
+ else {
+ javab_out(0, "invalid operand '%s' of 'wide' at %u", mem, i);
+ return;
+ }
+ }
+
+ if (HAS_TARGET(bra)) {
+
+ /* Compute target from 2-, or 4-byte offset
+ **************************************** */
+
+ s4_int off = ((opc == 200u) || (opc == 201u))
+ ? B2S4(byt[i+1],byt[i+2],byt[i+3],byt[i+4]) /* 4-bytes */
+ : B2S2(byt[i+1],byt[i+2]); /* 2-bytes */
+ target = (u4_int) (i + off);
+
+ if ((target >= len) && (att -> reachable[i] == 1u)) {
+ javab_out(0, "invalid target %u in '%s' at %u", target, mem, i);
+ return;
+ }
+ }
+
+ /* Determine Context Sensitive Information
+ *************************************** */
+
+ glo_pad = 0u;
+ glo_def = glo_npa = glo_low = glo_hig = 0u;
+
+ next = 0u; /* (mis-)uses as error flag */
+
+ if (ops == 9u)
+ ops = det_ops(i);
+
+ if (pre == 9u)
+ pre = det_pre(i);
+
+ if (pos == 9u)
+ pos = det_pos(i);
+
+ if(!is_wide)
+ {
+ if( ((last_op == 18u) || (last_op == 19u))
+ &&
+ (((prev_op >= 3u) && (prev_op <= 8u))
+ || (prev_op == 16u) || (prev_op == 17u)
+ || (prev_op == 18u) || (prev_op == 19u))
+ &&
+ (opc == 184u))
+ {
+ u2_int e = B2U2(byt[i+1u], byt[i+2u]);
+ u2_int c1 = constant_pool[e] -> u.indices.index1;
+ u2_int n = constant_pool[e] -> u.indices.index2;
+ u2_int d = constant_pool[n] -> u.indices.index1;
+ u2_int c2 = constant_pool[c1] -> u.indices.index1;
+
+ char *cla = (char *) constant_pool[c2] -> u.utf8.s;
+ char *met = (char *) constant_pool[d] -> u.utf8.s;
+ char *op;
+
+ u2_int C1;
+ char *caller = NULL;
+
+ if(last_op == 18u) {
+ u1_int ee = byt[last_offset+1u];
+ C1 = constant_pool[ee] -> u.indices.index1;
+ inst_size = 2;
+ }
+ else if(last_op == 19u) {
+ u2_int ee = ((byt[last_offset+1u]) << 8) | byt[last_offset + 2u];
+ C1 = constant_pool[ee] -> u.indices.index1;
+ inst_size = 3;
+ }
+ else {
+ fprintf(stderr,"internal error\n");
+ exit(-1);
+ }
+
+ if(( !strcmp(cla,"Dummy") || !strcmp(cla,"org/netlib/util/Dummy"))
+ && !strcmp(met,"label"))
+ op = "label";
+ else if(( !strcmp(cla,"Dummy") || !strcmp(cla,"org/netlib/util/Dummy"))
+ && !strcmp(met,"go_to"))
+ op = "goto";
+ else
+ {
+ if(trdebug)
+ printf("%s: encountered unknown Dummy method! (%s.%s)\n",
+ filename, cla,met);
+ op = "unknown";
+ }
+
+ switch(prev_op) {
+ case 3u: /* iconst_0 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,0);
+ branch_label = 0;
+ inst_size += 1;
+ break;
+ case 4u: /* iconst_1 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,1);
+ branch_label = 1;
+ inst_size += 1;
+ break;
+ case 5u: /* iconst_2 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,2);
+ branch_label = 2;
+ inst_size += 1;
+ break;
+ case 6u: /* iconst_3 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,3);
+ branch_label = 3;
+ inst_size += 1;
+ break;
+ case 7u: /* iconst_4 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,4);
+ branch_label = 4;
+ inst_size += 1;
+ break;
+ case 8u: /* iconst_5 */
+ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,5);
+ branch_label = 5;
+ inst_size += 1;
+ break;
+ case 16u: /* bipush */
+ if(trdebug)
+ printf("%d: %s %d\n", prev_offset, op, byt[prev_offset+1u]);
+ branch_label = byt[prev_offset+1u];
+ inst_size += 2;
+ break;
+ case 17u: /* sipush */
+ if(trdebug)
+ printf("%d: %s %d\n", prev_offset, op,
+ B2U4(0,0,byt[prev_offset+1u],byt[prev_offset+2u]));
+ branch_label = B2U4(0,0,byt[prev_offset+1u],byt[prev_offset+2u]);
+ inst_size += 3;
+ break;
+ case 18u: /* ldc */
+ if(trdebug)
+ printf("%d: %s %d\n", prev_offset, op,
+ constant_pool[byt[prev_offset+1u]] -> u.data.val1);
+ branch_label = constant_pool[byt[prev_offset+1u]] -> u.data.val1;
+ inst_size += 2;
+ break;
+ case 19u: /* ldc_w */
+ {
+ u2_int po = ((byt[prev_offset+1u]) << 8) | byt[prev_offset + 2u];
+
+ if(trdebug)
+ printf("%d: %s %d\n", prev_offset, op,
+ constant_pool[po] -> u.data.val1);
+ branch_label = constant_pool[po] -> u.data.val1;
+ inst_size += 3;
+ }
+ break;
+ default:
+ fprintf(stderr,"%s:Bad opcode encountered, output may be incorrect.\n",
+ filename);
+ branch_label = 0;
+ }
+
+ sprintf(lbuf,"%d",branch_label);
+
+ if(!strcmp(op,"label"))
+ {
+ caller = (char *) constant_pool[C1]->u.utf8.s;
+
+ if(type_lookup(att->label_table,lbuf))
+ fprintf(stderr,"%s: duplicate label: %s\n",
+ filename,lbuf);
+ else if(strcmp(caller, thisClassName))
+ fprintf(stderr,"%s: invalid label: %s (caller = %s, this = %s)\n",
+ filename,lbuf,caller,thisClassName);
+ else {
+ idx = hash(lbuf) % att->label_table->num_entries;
+ type_insert(&(att->label_table->entry[idx]),
+ prev_offset, strdup(lbuf));
+ }
+
+ memset(byt+last_offset, 0, inst_size + 3);
+ numChanges++;
+ }
+ else if(!strcmp(op,"goto"))
+ {
+ HASHNODE *ht;
+
+ if(trdebug)
+ printf("ok, I'm looking at a goto branching to label %d\n",
+ branch_label);
+
+ caller = (char *) constant_pool[C1]->u.utf8.s;
+
+ if(!strcmp(caller,thisClassName)) {
+
+ if((ht=type_lookup(att->label_table,lbuf)) != NULL)
+ {
+ int temp = ht->val - i;
+ u4_int utemp;
+
+ if(trdebug)
+ printf("Found the label! offset = %d\n", ht->val);
+
+ /* zero out the 2 previous instructions. the
+ first 'ldc' is always 2 bytes, so add that
+ to the size of the previous instruction. */
+
+ memset(byt+last_offset, 0, inst_size);
+ numChanges++;
+
+ /* use the goto_w opcode just to be sure we
+ have enough space for the branchoffset */
+
+ byt[i-2] = 200;
+
+ if(trdebug)
+ printf("copying %d (%x) into byt\n",temp,temp);
+
+ utemp = u4BigEndian((u4_int)temp);
+ memcpy(byt+i-1, &utemp, 4);
+ }
+ else
+ {
+ if(trdebug)
+ printf("did NOT find the label!\n");
+ }
+ }
+ else {
+ fprintf(stderr,"%s: invalid goto: %s (caller = %s, this = %s)\n",
+ filename,lbuf,caller,thisClassName);
+ memset(byt+last_offset, 0, inst_size + 3);
+ numChanges++;
+ }
+ }
+ else if(!strcmp(op,"unknown")) {
+ if(trdebug)
+ fprintf(stderr,"%s:Skipping unknown method invocation at offset %d\n",
+ filename, i);
+ }
+ else
+ fprintf(stderr,"%s:Weird, op not set properly.\n",filename);
+
+ }
+
+ last_op = prev_op;
+ last_offset = prev_offset;
+ prev_op = opc;
+ prev_offset = i;
+ }
+
+ if (next)
+ return;
+
+ /* Compute Address of next Opcode
+ ****************************** */
+
+ next = (u4_int) (i+ops+1u);
+
+ if (next > len) {
+ javab_out(0, "invalid implicit target %u in '%s' at %u", next, mem, i);
+ return;
+ }
+
+ /* instruction 'wide'-handling
+ *************************** */
+
+ if (opc == 196u) {
+ if (i+1 < len) {
+ i++;
+ is_wide = 1;
+ goto back;
+ }
+ else {
+ javab_out(0, "invalid occurrence of '%s' at %u", mem, i);
+ return;
+ }
+ }
+ }
+}
+
+/* *******************************************************
+ *** The actual actions (PRIVATE TRAVERSAL ROUTINES) ***
+ ******************************************************** */
+
+/* *******************************************************
+ *** Process a Single Code Attributes in .class file ***
+ ******************************************************* */
+
+static void byte_codeattr(attribute_ptr a, u2_int w_arg,
+ u1_int *nm, u1_int *tp, u2_int w_res) {
+ u1_int comp_stuff(u4_int);
+ u4_int i; /* wide_counter */
+ u1_int *bytes = a -> info;
+ u2_int max_stack = B2U2(bytes[0],bytes[1]);
+ u2_int max_locals = B2U2(bytes[2],bytes[3]);
+ u4_int code_length = B2U4(bytes[4],bytes[5],bytes[6],bytes[7]);
+ u2_int exc_table_l;
+
+ a->label_table = new_symtable(211);
+
+ if (a -> attribute_length < 12u + code_length) {
+ javab_out(0, "corrupt code atttribute given for %s%s code_length = %u",
+ nm, tp, code_length);
+ return;
+ }
+
+ exc_table_l = B2U2(bytes[8+code_length],bytes[9+code_length]);
+
+ if (code_length + 10u + exc_table_l * 8u >= a -> attribute_length) {
+ javab_out(0, "corrupt exception handler table");
+ return;
+ }
+
+ /* Set global attribute (for all subsequent processing!)
+ ***************************************************** */
+
+ att = a;
+
+ /* Quit for empty method body (or for large codelength)
+ or in case too many parameters are passed to method
+ **************************************************** */
+
+ if (code_length == 0u) {
+ javab_out(2, " + empty method %s()", nm);
+ return;
+ }
+ else if (code_length >= (U4MAX-1)) {
+ javab_out(2, " + skipping method %s() (cannot be processed internally)", nm);
+ return;
+ }
+ else if (w_arg > max_locals) {
+ javab_out(0, "%u parameter words exceed %u local words of method %s()",
+ w_arg, max_locals, nm);
+ return;
+ }
+
+ /* Allocate Memory for BYTECODE Information
+ **************************************** */
+
+ a -> code_length = code_length;
+ a -> is_leader = (u1_int *) make_mem((code_length+1) * sizeof(u1_int));
+ a -> my_bb = (bb_ptr *) make_mem((code_length+1) * sizeof(bb_ptr));
+ a -> reachable = (u1_int *) make_mem(code_length * sizeof(u1_int));
+ a -> sp_before = (u2_int *) make_mem(code_length * sizeof(u2_int));
+ a -> st_state = (state_ptr **) make_mem(code_length * sizeof(state_ptr *));
+
+ for (i = 0u; i <= code_length; i++) {
+ a -> is_leader[i] = 0u;
+ a -> my_bb[i] = NULL;
+ }
+ for (i = 0u; i < code_length; i++) {
+ a -> reachable[i] = 2u;
+ a -> sp_before[i] = 0u;
+ a -> st_state[i] = NULL;
+ }
+
+ /* Compute Stack Information:
+ traverse entry point of method (with sp==0 on entry)
+ *and* entry point of every handler (with sp==1 on entry)
+ ******************************************************** */
+
+ glo_sta = max_stack;
+ glo_stm = 0u;
+ glo_loc = max_locals;
+
+ /* Empty Stack */
+
+ cur_sp = 0u;
+
+ byte_trav(0u);
+ byte_trav(0u);
+}
+
+/* ********************************************************
+ *** PUBLIC FUNCTIONS ***
+ ******************************************************** */
+
+/* ***************************
+ *** Bytecode Processing ***
+ *************************** */
+
+int byte_proc(void) {
+
+ u4_int i, j; /* wide counters */
+ char *strtok(char *, const char *);
+ extern char * thisClassName;
+
+ numChanges = 0;
+
+ thisClassName = strdup( (char *)
+ constant_pool[constant_pool[this_class]->u.indices.index1]->u.utf8.s);
+
+#ifdef CHECK_TABLE
+
+ /* Verify bytecode table */
+
+ for (i = 0u; i < 256u; i++)
+ if (bytecode[i].opcode != i)
+ javab_out(-1, "invalid bytecode initialization at %u", i);
+
+#endif
+
+ /* Scan over methods, and process code-attributes */
+
+ for (i = 0u; i < methods_count; i++) {
+
+ fm_ptr m = methods[i];
+ u1_int *nm = constant_pool[m -> name_index] -> u.utf8.s;
+ u1_int *tp = constant_pool[m -> descr_index] -> u.utf8.s;
+ u1_int is_inst = (m -> access_flags & ACC_STATIC) ? 0u : 1u;
+ attribute_ptr my_code = NULL;
+ attribute_ptr my_exc = NULL;
+
+ char *this_arg_type = NULL;
+
+ /* Determine number of locals that are defined
+ (for Instance Methods: `this' is first-word argument)
+ and number of words pushed back on the caller's operand stack */
+
+ u2_int w_arg = arg_width(tp, (is_inst) ? 2u : 1u);
+ u2_int w_res = res_width(tp);
+
+ if (is_inst) /* Determine type of `this': set to java.lang.Object */ {
+
+ u2_int e = constant_pool[this_class] -> u.indices.index1;
+ char *s = (char *) constant_pool[e] -> u.utf8.s;
+ u2_int l = strlen(s);
+
+ this_arg_type = (char *) make_mem((l+2u) * sizeof(char));
+ sprintf(this_arg_type, "L%s;", s);
+ rd_sig[0u] = this_arg_type;
+ }
+
+ is_instm = is_inst;
+
+ javab_out(2, " - processing %s method %s()",
+ (is_inst) ? "instance" : "class", nm);
+
+ /* Scan Attributes */
+
+ for (j = 0u; j < m -> attributes_count; j++) {
+ attribute_ptr a = m -> attributes[j];
+ constant_ptr ua = constant_pool[a -> attribute_name_index];
+
+ if (strcmp((char *) ua -> u.utf8.s, "Code") == 0) {
+ if (my_code)
+ javab_out(0, "multiple code attributes given for %s()", nm);
+ else
+ my_code = a;
+ }
+ else if (strcmp((char *) ua -> u.utf8.s, "Exceptions") == 0) {
+ if (my_exc)
+ javab_out(0, "multiple exception attributes given for %s()", nm);
+ else
+ my_exc = a;
+ }
+ }
+
+ /* Process Code Attribute */
+
+ if (my_code) {
+ if (my_code -> attribute_length < 12u)
+ javab_out(0, "corrupt code attribute given for %s()", nm);
+ else
+ byte_codeattr(my_code, w_arg, nm, tp, w_res);
+ }
+ else
+ javab_out(2, " + no code attribute given for %s()", nm);
+
+ if (this_arg_type)
+ free(this_arg_type);
+
+ if (error)
+ break; /* otherwise, a list of method
+ headers appears for switch `-d' */
+ }
+ return numChanges;
+}
+
+u4_int
+u4BigEndian(u4_int num)
+{
+ if(isBigEndian())
+ return num;
+ else
+ return ((num & 0xFF)<<24) +
+ ((num >> 8 & 0xFF)<<16) +
+ ((num >> 16 & 0xFF)<<8) +
+ (num >> 24);
+}
+
+char
+isBigEndian()
+{
+ int x = 1;
+
+ if (*((char *)&x)== 1)
+ return 0;
+ else
+ return 1;
+}
diff --git a/goto_trans/class.c b/goto_trans/class.c
new file mode 100644
index 0000000..979d222
--- /dev/null
+++ b/goto_trans/class.c
@@ -0,0 +1,948 @@
+
+/* *************
+ *** JAVAB ***
+ ****************************************************
+ *** Copyright (c) 1997 ***
+ *** Aart J.C. Bik Indiana University ***
+ *** All Rights Reserved ***
+ ****************************************************
+ *** Please refer to the LICENSE file distributed ***
+ *** with this software for further details on ***
+ *** the licensing terms and conditions. ***
+ *** ***
+ *** Please, report all bugs, comments, etc. ***
+ *** to: ajcbik at extreme.indiana.edu ***
+ ****************************************************
+ *** class.c : class file manipulations
+ ***
+ ***
+ *** Your courtesy in mentioning the use of this bytecode tool
+ *** in any scientific work that presents results obtained
+ *** by using (extensions or modifications of) the tool
+ *** is highly appreciated.
+ ***
+ *** */
+
+/* ********************************************************
+ *** INCLUDE FILES and DEFINITIONS ***
+ ******************************************************** */
+
+#include "class.h"
+
+#undef DEBUG_SHADOW
+
+/* ********************************************************
+ *** EXTERNAL VARIABLES ***
+ ******************************************************** */
+
+/* PUBLIC
+ ****** */
+
+u4_int magic;
+u2_int minor_version, major_version;
+
+u2_int constant_pool_count = 0u;
+constant_ptr *constant_pool = NULL;
+
+u2_int access_flags, this_class, super_class;
+
+u2_int interfaces_count = 0u;
+u2_int *interfaces = NULL;
+
+u2_int fields_count = 0u;
+fm_ptr *fields = NULL;
+
+u2_int methods_count = 0u;
+fm_ptr *methods = NULL;
+
+u2_int attributes_count = 0u;
+attribute_ptr *attributes = NULL;
+
+/* PRIVATE
+ ******* */
+
+static FILE *file = NULL;
+
+static u2_int extra_cp = 0u;
+static u2_int extra_field = 0u;
+static u2_int extra_method = 0u;
+
+static u2_int shadow_cnt = 0u;
+static constant_ptr *shadow_cp = NULL;
+
+/* ********************************************************
+ *** PRIVATE FUNCTIONS ***
+ ******************************************************** */
+
+/* read u1_int, u2_int, and u4_int routines
+ **************************************** */
+
+static u1_int read_u1(void) {
+ int u = fgetc(file);
+ if (u == EOF)
+ javab_out(0, "unexpected EOF");
+ return (u1_int) u;
+}
+
+static u2_int read_u2(void) {
+ u1_int u1 = read_u1();
+ u1_int u2 = read_u1();
+ return B2U2(u1,u2);
+}
+
+static u4_int read_u4(void) {
+ u1_int u1 = read_u1();
+ u1_int u2 = read_u1();
+ u1_int u3 = read_u1();
+ u1_int u4 = read_u1();
+ return B2U4(u1,u2,u3,u4);
+}
+
+/* Read Constant Pool
+ (entry constant_pool[0] is reserved, but included in count)
+ *********************************************************** */
+
+static void read_constant_pool(void) {
+ u4_int i, j; /* wide counters */
+
+ constant_pool_count = read_u2();
+ constant_pool = NULL;
+
+ if (constant_pool_count == 0u)
+ return;
+
+ /* Construct the constant pool */
+
+ constant_pool = (constant_ptr *)
+ make_mem( constant_pool_count * sizeof(constant_ptr) );
+
+ constant_pool[0] = NULL;
+
+ for (i = 1u; i < constant_pool_count; i++) {
+
+ constant_pool[i] = (constant_ptr) make_mem( sizeof(struct constant_node) );
+ constant_pool[i] -> tag = read_u1();
+
+ switch(constant_pool[i] -> tag) {
+
+ case CONSTANT_Class:
+ case CONSTANT_String:
+
+ constant_pool[i] -> u.indices.index1 = read_u2();
+ constant_pool[i] -> u.indices.index2 = 0u;
+ break;
+
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_NameAndType:
+
+ constant_pool[i] -> u.indices.index1 = read_u2();
+ constant_pool[i] -> u.indices.index2 = read_u2();
+ break;
+
+ case CONSTANT_Integer:
+ case CONSTANT_Float:
+
+ constant_pool[i] -> u.data.val1 = read_u4();
+ constant_pool[i] -> u.data.val2 = 0u;
+ break;
+
+ case CONSTANT_Long:
+ case CONSTANT_Double:
+
+ constant_pool[i] -> u.data.val1 = read_u4();
+ constant_pool[i] -> u.data.val2 = read_u4();
+
+ /* These entries make next entry invalid!
+ ************************************** */
+
+ constant_pool[ ++i ] = NULL;
+ break;
+
+ case CONSTANT_Utf8:
+
+ /* Read-in constant string value (represented as BYTE sequence) */
+
+ { u2_int len = read_u2();
+ u1_int *s = (u1_int *) make_mem((1+len) * sizeof(u1_int));
+
+ for (j = 0u; j < len; j++)
+ s[j] = read_u1();
+ s[len] = '\0';
+
+ constant_pool[i] -> u.utf8.l = len;
+ constant_pool[i] -> u.utf8.s = s;
+ }
+ break;
+
+ default:
+ javab_out(-1, "invalid constant pool tag (%u)", constant_pool[i] -> tag);
+ }
+ }
+}
+
+/* Read Interfaces
+ **************** */
+
+static void read_interfaces(void) {
+ u4_int i; /* wide counter */
+
+ interfaces_count = read_u2();
+
+ if (interfaces_count != 0u) {
+ interfaces = (u2_int *) make_mem(interfaces_count * sizeof(u2_int));
+ for (i = 0u; i < interfaces_count; i++)
+ interfaces[i] = read_u2();
+ }
+ else
+ interfaces = NULL;
+}
+
+/* Read Attributes
+ *************** */
+
+static attribute_ptr *read_attributes(u2_int ac) {
+ attribute_ptr *a = NULL;
+
+ if (ac != 0u) {
+ u4_int i, j; /* wide counters */
+ u4_int len;
+
+ a = (attribute_ptr *) make_mem(ac * sizeof(attribute_ptr));
+
+ for (i = 0u; i < ac; i++) {
+
+ a[i] = (attribute_ptr) new_attribute();
+
+ a[i] -> attribute_name_index = read_u2();
+ a[i] -> attribute_length = len = read_u4();
+
+ if (len == U4MAX)
+ javab_out(-1, "Sorry, my internal u4_int counter will wrap around");
+
+ a[i] -> info = (u1_int *) make_mem(len * sizeof(u1_int));
+
+ for (j = 0u; j < len; j++)
+ a[i] -> info[j] = read_u1();
+ }
+ }
+ return a;
+}
+
+/* Read Fields
+ *********** */
+
+static void read_fields(void) {
+ u4_int i; /* wide counter */
+
+ fields_count = read_u2();
+
+ if (fields_count != 0u) {
+ fields = (fm_ptr *) make_mem(fields_count * sizeof(fm_ptr));
+ for (i = 0u; i < fields_count; i++) {
+ fields[i] = (fm_ptr) make_mem(sizeof(struct fm_node));
+ fields[i] -> access_flags = read_u2();
+ fields[i] -> name_index = read_u2();
+ fields[i] -> descr_index = read_u2();
+ fields[i] -> attributes_count = read_u2();
+ fields[i] -> attributes = read_attributes(fields[i] -> attributes_count);
+ }
+ }
+ else
+ fields = NULL;
+}
+
+/* Read Methods
+ ************ */
+
+static void read_methods(void) {
+ u4_int i; /* wide counter */
+
+ methods_count = read_u2();
+
+ if (methods_count != 0u) {
+ methods = (fm_ptr *) make_mem(methods_count * sizeof(fm_ptr));
+ for (i = 0u; i < methods_count; i++) {
+ methods[i] = (fm_ptr) make_mem(sizeof(struct fm_node));
+ methods[i] -> access_flags = read_u2();
+ methods[i] -> name_index = read_u2();
+ methods[i] -> descr_index = read_u2();
+ methods[i] -> attributes_count = read_u2();
+ methods[i] -> attributes = read_attributes(methods[i] -> attributes_count);
+ }
+ }
+ else
+ methods = NULL;
+}
+
+/* Read Class-File
+ *************** */
+
+static void read_classfile(void) {
+
+ javab_out(2, " -- reading class file");
+
+ /* Read magic 0xCAFEBABE string and version
+ **************************************** */
+
+ magic = read_u4();
+
+ if (magic != 0xCAFEBABE) {
+ javab_out(0, "not a class file");
+ return;
+ }
+
+ minor_version = read_u2();
+ major_version = read_u2();
+
+ /* Read constant pool
+ ****************** */
+
+ read_constant_pool();
+
+ /* Read flags and class info
+ ************************* */
+
+ access_flags = read_u2();
+ this_class = read_u2();
+ super_class = read_u2();
+
+ /* Read interfaces, fields, and methods
+ ************************************ */
+
+ read_interfaces();
+ read_fields();
+ read_methods();
+
+ /* Read attributes
+ *************** */
+
+ attributes_count = read_u2();
+ attributes = read_attributes(attributes_count);
+
+ if (fgetc(file) != EOF)
+ javab_out(1, "additional bytes in class file ignored");
+}
+
+/* Check Attribute
+ *************** */
+
+static void check_attr(u4_int ac, attribute_ptr *a) {
+ u4_int i; /* wide counter */
+
+ for (i = 0; i < ac; i++)
+ valid_cp_entry(CONSTANT_Utf8, a[i] -> attribute_name_index, "attribute");
+}
+
+/* Check Field/Method
+ ****************** */
+
+static void check_fm(fm_ptr f) {
+ valid_cp_entry(CONSTANT_Utf8, f -> name_index, "fm name index");
+ valid_cp_entry(CONSTANT_Utf8, f -> descr_index, "fm descriptor index");
+
+ check_attr(f -> attributes_count, f -> attributes);
+}
+
+/* Check Class File
+ **************** */
+
+static void check_classfile(void) {
+ u4_int i; /* wide counter */
+
+ javab_out(2, " -- verifying class file");
+
+ /* Check class references */
+
+ valid_cp_entry(CONSTANT_Class, this_class, "this");
+
+ if (super_class)
+ valid_cp_entry(CONSTANT_Class, super_class, "super");
+
+ /* Check constant pool */
+
+ for (i = 1u; i < constant_pool_count; i++)
+ if (constant_pool[i])
+ switch (constant_pool[i] -> tag) {
+
+ case CONSTANT_Class:
+
+ valid_cp_entry(CONSTANT_Utf8,
+ constant_pool[i] -> u.indices.index1,
+ "Class");
+ break;
+
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+
+ valid_cp_entry(CONSTANT_Class,
+ constant_pool[i] -> u.indices.index1,
+ "ref");
+ valid_cp_entry(CONSTANT_NameAndType,
+ constant_pool[i] -> u.indices.index2,
+ "ref");
+ break;
+
+ case CONSTANT_String:
+
+ valid_cp_entry(CONSTANT_Utf8,
+ constant_pool[i] -> u.indices.index1,
+ "String");
+ break;
+
+ case CONSTANT_NameAndType:
+
+ valid_cp_entry(CONSTANT_Utf8,
+ constant_pool[i] -> u.indices.index1,
+ "N_and_T");
+ valid_cp_entry(CONSTANT_Utf8,
+ constant_pool[i] -> u.indices.index2,
+ "N_and_T");
+
+ { constant_ptr c =
+ constant_pool[constant_pool[i] -> u.indices.index2];
+
+ if (c -> u.utf8.l == 0)
+ javab_out(0, "invalid field/method descriptor");
+ }
+ break;
+ }
+
+ /* Check interfaces */
+
+ for (i = 0u; i < interfaces_count; i++)
+ valid_cp_entry(CONSTANT_Class, interfaces[i], "interface");
+
+ /* Check Fields */
+
+ for (i = 0u; i < fields_count; i++)
+ check_fm(fields[i]);
+
+ /* Check Methods */
+
+ for (i = 0u; i < methods_count; i++)
+ check_fm(methods[i]);
+
+ /* Check Attributes */
+
+ check_attr(attributes_count, attributes);
+}
+
+/* Release Memory Fields of an Attribute
+ ************************************* */
+
+static void cleanup_attributes(u4_int cnt, attribute_ptr *a) {
+
+ u4_int i, j; /* wide counters */
+
+ for (i = 0u; i < cnt; i++)
+ if (a[i]) {
+
+ if (a[i] -> info)
+ free(a[i] -> info);
+
+ if (a[i] -> reachable)
+ free(a[i] -> reachable);
+
+ if (a[i] -> is_leader)
+ free(a[i] -> is_leader);
+
+ if (a[i] -> sp_before)
+ free(a[i] -> sp_before);
+
+ if (a[i] -> my_bb)
+ free(a[i] -> my_bb);
+
+ if (a[i] -> st_state) {
+ for (j = 0u; j < a[i] -> code_length; j++)
+ if (a[i] -> st_state[j])
+ free(a[i] -> st_state[j]);
+ free(a[i] -> st_state);
+ }
+
+ free(a[i]);
+ }
+
+ if (a)
+ free(a);
+}
+
+/* Release Memory of a Constant Pool Entry
+ *************************************** */
+
+static void del_cp(constant_ptr c) {
+ if (c) {
+ if ((c -> tag == CONSTANT_Utf8) && (c -> u.utf8.s))
+ free(c -> u.utf8.s);
+ free(c);
+ }
+}
+
+/* Release Memory of Class File
+ **************************** */
+
+static void delete_classfile(void) {
+
+ u4_int i; /* wide counters */
+
+ javab_out(2, " -- deleting class file");
+
+ /* Delete Constant Pool
+ ******************** */
+
+ for (i = 1u; i < constant_pool_count; i++)
+ if (constant_pool[i])
+ del_cp(constant_pool[i]);
+
+ if (constant_pool)
+ free(constant_pool);
+
+ constant_pool_count = 0u;
+ constant_pool = NULL;
+
+ /* Delete Interfaces
+ ***************** */
+
+ if (interfaces)
+ free(interfaces);
+
+ interfaces = NULL;
+
+ /* Delete Fields
+ ************* */
+
+ if (fields) {
+ for (i = 0u; i < fields_count; i++)
+ if (fields[i]) {
+ cleanup_attributes(fields[i] -> attributes_count,
+ fields[i] -> attributes);
+ free(fields[i]);
+ }
+ free(fields);
+ }
+
+ fields_count = 0u;
+ fields = NULL;
+
+ /* Delete Methods
+ ************** */
+
+ if (methods) {
+ for (i = 0u; i < methods_count; i++)
+ if (methods[i]) {
+ cleanup_attributes(methods[i] -> attributes_count,
+ methods[i] -> attributes);
+ free(methods[i]);
+ }
+ free(methods);
+ }
+
+ methods_count = 0u;
+ methods = NULL;
+
+ /* Delete Attributes
+ **************** */
+
+ cleanup_attributes(attributes_count, attributes);
+
+ attributes_count = 0u;
+ attributes = NULL;
+
+ /* Delete Additional Space
+ *********************** */
+
+ extra_cp = 0u;
+ extra_field = 0u;
+ extra_method = 0u;
+}
+
+/* Show a Field/Method
+ ******************* */
+
+static void show_fm(u4_int i, fm_ptr f, char *s) {
+
+ u1_int *nm = constant_pool[f -> name_index] -> u.utf8.s;
+ u1_int *tp = constant_pool[f -> descr_index] -> u.utf8.s;
+
+ fprintf(stderr, " %s[%5u]: 0x%02x %s %s (attr=%u)\n",
+ s, i, f -> access_flags, nm, tp, f -> attributes_count);
+}
+
+/* Output of Class File Summary
+ **************************** */
+
+static void show_classfile(void) {
+ u4_int i; /* wide counter */
+
+ fprintf(stderr, "\n*** class file version : %u.%u\n",
+ major_version, minor_version);
+
+ fprintf(stderr, "*** constant_pool_count : %u\n", constant_pool_count);
+
+ for (i = 1u; i < constant_pool_count; i++)
+ if (constant_pool[i]) {
+ fprintf(stderr, " constant_pool[%5u]: ", i);
+ show_cp_entry(constant_pool[i]);
+ fputc('\n', stderr);
+ }
+
+ fprintf(stderr, "*** access flags : 0x%04x\n", access_flags);
+ fprintf(stderr, "*** this_class : %u\n", this_class);
+ fprintf(stderr, "*** super_class : %u\n", super_class);
+ fprintf(stderr, "*** interfaces_count : %u\n", interfaces_count);
+
+ for (i = 0u; i < interfaces_count; i++) {
+ u2_int i2 = interfaces[i];
+ u1_int *s = constant_pool[constant_pool[i2] -> u.indices.index1] -> u.utf8.s;
+ fprintf(stderr, " interfaces [%5u]: %u \"%s\"\n", i, i2, s);
+ }
+
+ fprintf(stderr, "*** fields_count : %u\n", fields_count);
+
+ for (i = 0u; i < fields_count; i++)
+ show_fm(i, fields[i], "fields ");
+
+ fprintf(stderr, "*** methods_count : %u\n", methods_count);
+
+ for (i = 0u; i < methods_count; i++)
+ show_fm(i, methods[i], "methods ");
+
+ fprintf(stderr, "*** attributes_count : %u\n", attributes_count);
+}
+
+/* ***********************************
+ *** Restore Parts of the Old CP ***
+ *********************************** */
+
+static void add_shadow_cp(void) {
+ u4_int i; /* wide counter */
+
+ constant_pool_count = shadow_cnt;
+
+ constant_pool = (constant_ptr *)
+ make_mem(constant_pool_count * sizeof(constant_ptr));
+
+ /* First Pass
+ ********** */
+
+ for (i = 0u; i < shadow_cnt; i++) {
+
+ constant_ptr old = shadow_cp[i];
+ constant_ptr new = (constant_ptr) make_mem( sizeof(struct constant_node) );
+
+ if (old) {
+
+#ifdef DEBUG_SHADOW
+ fprintf(stderr, "copy old entry %u\n", i);
+#endif
+
+ new -> tag = old -> tag;
+
+ switch (old -> tag) {
+
+ case CONSTANT_Class:
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_NameAndType:
+ case CONSTANT_String:
+ new -> u.indices.index1 = old -> u.indices.index1;
+ new -> u.indices.index2 = old -> u.indices.index2;
+ break;
+
+ case CONSTANT_Integer:
+ case CONSTANT_Float:
+ case CONSTANT_Long:
+ case CONSTANT_Double:
+ new -> u.data.val1 = old -> u.data.val1;
+ new -> u.data.val2 = old -> u.data.val2;
+ break;
+
+ case CONSTANT_Utf8:
+ new -> u.utf8.l = old -> u.utf8.l;
+ new -> u.utf8.s = (u1_int *) strdup((char *) old -> u.utf8.s);
+ break;
+
+ default:
+ javab_out(-1, "invalid new shadow cp entry %u\n", old -> tag);
+ }
+
+ constant_pool[i] = new;
+
+ if ((old -> tag == CONSTANT_Double) ||
+ (old -> tag == CONSTANT_Long))
+ i++; /* Account for NULL CP Entry */
+ }
+ else { /* Obsoleted Entry */
+
+ new -> tag = CONSTANT_Utf8;
+ new -> u.utf8.l = 1u;
+ new -> u.utf8.s = (u1_int *) strdup("-");
+
+ constant_pool[i] = new;
+ }
+ }
+}
+
+/* ********************************************************
+ *** PUBLIC FUNCTIONS ***
+ ******************************************************** */
+
+/* Shadow Constant Pool Operations
+ ******************************* */
+
+void make_shadow_cp(void) {
+ u4_int i; /* wide counter */
+
+ if ((shadow_cnt) || (shadow_cp))
+ javab_out(-1, "re-shadowing not allowed");
+
+ shadow_cnt = constant_pool_count;
+ shadow_cp = (constant_ptr *) make_mem(shadow_cnt * sizeof(constant_ptr));
+
+ for (i = 0u; i < shadow_cnt; i++)
+ shadow_cp[i] = NULL;
+}
+
+void mark_shadow_cp(u2_int index) {
+
+ if (index < shadow_cnt) {
+
+ if (! shadow_cp[index]) {
+
+ constant_ptr c = constant_pool[index];
+ shadow_cp[index] = c;
+
+#ifdef DEBUG_SHADOW
+ fprintf(stderr, "mark cp entry %u\n", index);
+#endif
+
+ switch(c -> tag) {
+
+ case CONSTANT_Class:
+ case CONSTANT_String:
+ mark_shadow_cp(c -> u.indices.index1);
+ break;
+
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_NameAndType:
+ mark_shadow_cp(c -> u.indices.index1);
+ mark_shadow_cp(c -> u.indices.index2);
+ break;
+
+ case CONSTANT_Integer:
+ case CONSTANT_Float:
+ case CONSTANT_Long:
+ case CONSTANT_Double:
+ case CONSTANT_Utf8:
+ break;
+
+ default:
+ javab_out(-1, "invalid new shadow cp entry %u\n", c -> tag);
+ }
+ }
+ }
+ else
+ javab_out(-1, "invalid index into shadow cp %u", index);
+}
+
+void take_shadow_cp(void) {
+ u4_int i; /* wide counter */
+
+ for (i = 0u; i < shadow_cnt; i++)
+ if (shadow_cp[i]) {
+ constant_pool[i] = NULL;
+#ifdef DEBUG_SHADOW
+ fprintf(stderr, "take cp entry %u\n", i);
+#endif
+ }
+}
+
+void dump_shadow_cp(void) {
+ u1_int set = 0u;
+ u4_int i; /* wide counter */
+
+ for (i = 0u; i < shadow_cnt; i++)
+ if (shadow_cp[i]) {
+ set = 1u;
+ break;
+ }
+
+ if (set)
+ add_shadow_cp();
+ else
+ constant_pool_count = 1u; /* reserved entry */
+}
+
+void elim_shadow_cp(void) {
+ u4_int i; /* wide counter */
+
+ if (shadow_cp) {
+ for (i = 0u; i < shadow_cnt; i++)
+ if (shadow_cp[i]) {
+#ifdef DEBUG_SHADOW
+ fprintf(stderr, "postponed deletion of cp entry %u\n", i);
+#endif
+ del_cp(shadow_cp[i]);
+ }
+ free(shadow_cp);
+ }
+
+ shadow_cnt = 0u;
+ shadow_cp = NULL;
+}
+
+/* Class File Processing
+ ********************* */
+
+void process_classfile(FILE *f, u1_int com) {
+
+ file = f;
+
+ switch (com) {
+
+ case 0u: /* Process a Class File */
+
+ if (f)
+ read_classfile();
+ break;
+
+ case 1u: /* Check a Class File */
+
+ check_classfile();
+ break;
+
+ case 2u: /* Show a Class File */
+
+ show_classfile();
+ break;
+
+ case 3u: /* Delete a Class File */
+
+ delete_classfile();
+ break;
+ }
+}
+
+/* Check constant pool entry
+ ************************* */
+
+u1_int valid_cp_entry(u1_int tag, u2_int entry, char *mess) {
+ if ((entry != 0u) && (entry < constant_pool_count)) {
+ constant_ptr p = constant_pool[entry];
+ if ((! p) || (p -> tag != tag)) {
+ javab_out(0, "invalid reference of %s to constant pool (%u)", mess, entry);
+ return 0;
+ }
+ }
+ else {
+ javab_out(0, "invalid index of %s into constant pool (%u)", mess, entry);
+ return 0;
+ }
+ return 1u;
+}
+
+/* Output information in class file
+ ******************************** */
+
+void show_cp_entry(constant_ptr c) {
+ switch (c -> tag) {
+
+ case CONSTANT_Class:
+
+ fprintf(stderr, "<Class> ");
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ break;
+
+ case CONSTANT_Fieldref:
+
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ fputc('.', stderr);
+ show_cp_entry(constant_pool[c -> u.indices.index2]);
+ break;
+
+ case CONSTANT_Methodref:
+
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ fputc('.', stderr);
+ show_cp_entry(constant_pool[c -> u.indices.index2]);
+ break;
+
+ case CONSTANT_InterfaceMethodref:
+
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ fputc('.', stderr);
+ show_cp_entry(constant_pool[c -> u.indices.index2]);
+ break;
+
+ case CONSTANT_String:
+
+ fputc('\"', stderr);
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ fputc('\"', stderr);
+ break;
+
+ case CONSTANT_Integer:
+
+ fprintf(stderr, "<Integer> %ix", (s4_int) c -> u.data.val1);
+ break;
+
+ case CONSTANT_Float:
+
+ fprintf(stderr, "<Float> 0x%04x", c -> u.data.val1);
+ break;
+
+ case CONSTANT_Long:
+
+ fprintf(stderr, "<Long> 0x%04x%04x",
+ c -> u.data.val1,
+ c -> u.data.val2);
+ break;
+
+ case CONSTANT_Double:
+
+ fprintf(stderr, "<Double> 0x%04x%04x",
+ c -> u.data.val1,
+ c -> u.data.val2);
+ break;
+
+ case CONSTANT_NameAndType:
+
+ show_cp_entry(constant_pool[c -> u.indices.index1]);
+ fputc(' ', stderr);
+ show_cp_entry(constant_pool[c -> u.indices.index2]);
+ break;
+
+ case CONSTANT_Utf8:
+
+ if (c -> u.utf8.s)
+ fprintf(stderr, (char *) c -> u.utf8.s);
+ break;
+ }
+}
+
+/* Obtain a new attribute
+ ********************** */
+
+attribute_ptr new_attribute(void) {
+
+ attribute_ptr a = (attribute_ptr) make_mem(sizeof(struct attribute_node));
+
+ a -> attribute_name_index = 0u;
+ a -> attribute_length = 0u;
+ a -> info = NULL;
+
+ /* JAVAB Specific Information */
+
+ a -> reachable = NULL;
+ a -> is_leader = NULL;
+ a -> sp_before = NULL;
+ a -> my_bb = NULL;
+ a -> st_state = NULL;
+
+ return a;
+}
diff --git a/goto_trans/class.h b/goto_trans/class.h
new file mode 100644
index 0000000..55b22f3
--- /dev/null
+++ b/goto_trans/class.h
@@ -0,0 +1,493 @@
+/* *************
+ *** JAVAB ***
+ ****************************************************
+ *** Copyright (c) 1997 ***
+ *** Aart J.C. Bik Indiana University ***
+ *** All Rights Reserved ***
+ ****************************************************
+ *** Please refer to the LICENSE file distributed ***
+ *** with this software for further details on ***
+ *** the licensing terms and conditions. ***
+ *** ***
+ *** Please, report all bugs, comments, etc. ***
+ *** to: ajcbik at extreme.indiana.edu ***
+ ****************************************************
+ *** class.h : definitions and function prototypes
+ ***
+ ***
+ *** Your courtesy in mentioning the use of this bytecode tool
+ *** in any scientific work that presents results obtained
+ *** by using (extensions or modifications of) the tool
+ *** is highly appreciated.
+ ***
+ ***
+ *** */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "symtab.h"
+
+#define MAX(a,b) (((a)>=(b)) ? (a) : (b))
+#define MIN(a,b) (((a)<=(b)) ? (a) : (b))
+
+/* *************************************
+ *** JVM-specific Type Definitions ***
+ *************************************
+ *** u1_int == unsigned 8 bits ***
+ *** s1_int == signed 8 bits ***
+ *************************************
+ *** u2_int == unsigned 16 bits ***
+ *** s2_int == signed 16 bits ***
+ *************************************
+ *** u4_int == unsigned 32 bits ***
+ *** s4_int == signed 32 bits ***
+ ************************************* */
+
+#define U1MAX 255u
+#define U2MAX 65535u
+#define U4MAX 4294967295u
+#define S4MAX 2147483647
+
+#if ((CHAR_BIT == 8u) && (UCHAR_MAX == U1MAX))
+#define U1 "char"
+typedef unsigned char u1_int;
+typedef signed char s1_int;
+#endif
+
+#if (USHRT_MAX == U2MAX)
+#define U2 "short int"
+typedef unsigned short int u2_int;
+typedef signed short int s2_int;
+#elif (UINT_MAX == U2MAX)
+#define U2 "int"
+typedef unsigned int u2_int;
+typedef signed int s2_int;
+#endif
+
+#if (UINT_MAX == U4MAX)
+#define U4 "int"
+typedef unsigned int u4_int;
+typedef signed int s4_int;
+#elif (ULONG_MAX == U4MAX)
+#define U4 "long int"
+typedef unsigned long int u4_int;
+typedef signed long int s4_int;
+#elif (ULONGLONG_MAX == U4MAX)
+#define U4 "long long int"
+typedef unsigned long long int u4_int;
+typedef signed long long int s4_int;
+#endif
+
+/* byte <-> int conversions (JVM uses big-endian order)
+ **************************************************** */
+
+#define B2U2(b1,b2) ((((u2_int)(b1))<<8)+((u2_int)(b2)))
+#define B2U4(b1,b2,b3,b4) ((((u4_int)(B2U2((b1),(b2)))<<16)) + \
+ ((u4_int)(B2U2((b3),(b4)))))
+#define B2S2(b1,b2) ((s2_int)(B2U2((b1),(b2))))
+#define B2S4(b1,b2,b3,b4) ((s4_int)(B2U4((b1),(b2),(b3),(b4))))
+
+#define LOWB_U2(u) ((u1_int)( (u) & 0xff))
+#define HIGB_U2(u) ((u1_int)(((u) >> 8) & 0xff))
+#define LOWB_U4(u) ((u1_int)(((u) >> 16) & 0xff))
+#define HIGB_U4(u) ((u1_int)(((u) >> 24) & 0xff))
+
+/* ********************************************
+ *** Class-file-specific Type Definitions ***
+ ******************************************** */
+
+/* Access and Modifier Flags
+ ************************* */
+
+#define ACC_PUBLIC 0x0001
+#define ACC_PRIVATE 0x0002
+#define ACC_PROTECTED 0x0004
+#define ACC_STATIC 0x0008
+#define ACC_FINAL 0x0010
+#define ACC_SUPER 0x0020
+#define ACC_SYNCHRONIZED 0x0020 /* overloaded */
+#define ACC_VOLATILE 0x0040
+#define ACC_TRANSIENT 0x0080
+#define ACC_NATIVE 0x0100
+#define ACC_INTERFACE 0x0200
+#define ACC_ABSTRACT 0x0400
+
+/* Constant Pool Tags
+ ****************** */
+
+#define CONSTANT_Utf8 1u
+#define CONSTANT_Integer 3u
+#define CONSTANT_Float 4u
+#define CONSTANT_Long 5u
+#define CONSTANT_Double 6u
+#define CONSTANT_Class 7u
+#define CONSTANT_String 8u
+#define CONSTANT_Fieldref 9u
+#define CONSTANT_Methodref 10u
+#define CONSTANT_InterfaceMethodref 11u
+#define CONSTANT_NameAndType 12u
+
+/* Constant Pool Entries
+ ********************* */
+
+struct constant_node {
+ union {
+ struct {
+ u4_int val1;
+ u4_int val2;
+ } data;
+ struct {
+ u2_int index1;
+ u2_int index2;
+ } indices;
+ struct {
+ u1_int *s;
+ u2_int l;
+ } utf8;
+ } u ;
+
+ u1_int tag;
+} ;
+
+typedef struct constant_node *constant_ptr;
+
+/* Attribute Entries
+ ***************** */
+
+struct attribute_node {
+ u2_int attribute_name_index;
+ u4_int attribute_length;
+ u1_int *info;
+
+ /* JAVAB specific information
+ ************************** */
+
+ u4_int code_length;
+
+ u1_int *reachable; /* 0u : unreachable
+ 1u : reachable/visited
+ 2u : unvisited
+ *********************** */
+ u1_int *is_leader;
+ u2_int *sp_before;
+ struct bb_node **my_bb;
+ struct state_node ***st_state;
+ SYMTABLE *label_table;
+} ;
+
+typedef struct attribute_node *attribute_ptr;
+
+/* Field/Method Entries
+ ******************** */
+
+struct fm_node {
+ u2_int access_flags;
+ u2_int name_index;
+ u2_int descr_index;
+ u2_int attributes_count;
+ attribute_ptr *attributes;
+} ;
+
+typedef struct fm_node *fm_ptr;
+
+/* ***************************************
+ *** JAVAB-specific Type Definitions ***
+ *************************************** */
+
+/* Stack State Component Types
+ *************************** */
+
+enum stack_states {
+ S_BOT, S_EXP, S_REF
+} ;
+
+/* Local Variable Types
+ ******************** */
+
+enum types {
+ TP_UNUSED, TP_2WORD, TP_INT, TP_LONG, TP_FLOAT, TP_DOUBLE, TP_REF, TP_ERROR
+} ;
+
+/* Small Nodes
+ *********** */
+
+struct array_node {
+
+ struct array_node *next;
+
+ /* Query Information */
+
+ u1_int *q;
+ s4_int *c;
+ u4_int *p;
+
+ s4_int *dep_l;
+ s4_int *dep_u;
+ u1_int *dep_s; /* 0u: unused
+ 1u: used as loop index
+ 2u: loop-carried
+ ********************** */
+ /* Other Information */
+
+ u4_int dim_ad;
+ u2_int dim_loc;
+ u1_int dim;
+ u1_int lhs;
+} ;
+
+typedef struct array_node *array_ptr;
+
+struct ref_node {
+
+ struct ref_node *gnext;
+
+ struct ref_node *next;
+ struct state_node *rf;
+ struct state_node *in;
+ u4_int ad;
+ u1_int lhs;
+} ;
+
+typedef struct ref_node *ref_ptr;
+
+/* Natural Loops
+ ************* */
+
+struct loop_node {
+
+ struct loop_node *next;
+
+ /* Loop Info
+ ********* */
+
+ struct bb_node *b;
+ struct bb_node *d;
+ struct bb_node **nl; /* nodes in natural loop
+ (defined by back-edge)
+ ********************** */
+ struct state_node *compare;
+ struct state_node *up_bnd;
+ struct state_node *lw_bnd;
+ u1_int strict; /* index/bound information
+ ************************ */
+ struct ref_node *refs;
+ struct array_node *array; /* array information
+ ***************** */
+ u1_int *load_type;
+ char **load_sig;
+ u2_int load_locs; /* local var. usage
+ **************** */
+ u4_int min_ad;
+ u4_int max_ad;
+ u4_int exit_ad;
+ u4_int cmp_ad; /* address information
+ ******************* */
+ u1_int ind_is_w;
+ u2_int ind_step;
+ u2_int ind_loc;
+ u4_int ind_add; /* trivial loop index information
+ ******************************* */
+ u4_int cnt;
+ u1_int triv;
+ u1_int par; /* loop information
+ **************** */
+} ;
+
+typedef struct loop_node *loop_ptr;
+
+/* Workers
+ ******* */
+
+struct worker_node {
+
+ struct worker_node *next;
+
+ /* Worker Fields
+ ************* */
+
+ char *qualified_name;
+ char *constr_d;
+
+ u2_int *load_ind;
+ u1_int *load_type;
+ char **load_sig; /* Local Usage Information
+ *********************** */
+ u1_int* loop_code;
+ u4_int l_len; /* Loop-Body
+ ********* */
+ u1_int ind_is_w;
+ u2_int ind_step;
+ u4_int ind_off; /* iinc Information
+ **************** */
+ u4_int entry_off;
+ u4_int exit_off;
+ u2_int max_stack;
+ u2_int max_locals; /* Additional Information
+ ********************** */
+} ;
+
+typedef struct worker_node *worker_ptr;
+
+/* Stack States
+ ************ */
+
+struct state_node {
+
+ struct state_node *gnext;
+
+ union {
+
+ struct {
+ char *sig;
+ u4_int ad;
+ u2_int loc;
+ u1_int d, d2, set;
+ } ref;
+
+ struct {
+ u1_int *rd;
+ s4_int con;
+ } exp;
+
+ } u;
+
+ u1_int prop;
+ u1_int kind;
+} ;
+
+typedef struct state_node *state_ptr;
+
+/* Basic Blocks
+ ************ */
+
+struct bbh_node {
+
+ struct bb_node *head;
+ struct bbh_node *tail;
+
+ loop_ptr loop;
+ u1_int exc; /* exception flag */
+} ;
+
+typedef struct bbh_node *bbh_ptr;
+
+struct bb_node {
+
+ struct bb_node *gnext;
+
+ /* Data Flow Information
+ ********************* */
+
+ u1_int *dominators;
+
+ u1_int *rd_gen;
+ u1_int *rd_kill;
+ u1_int *rd_in;
+ u1_int *rd_out;
+
+ u1_int *upw_use;
+
+ state_ptr *s_gen;
+ state_ptr *s_in;
+ state_ptr *s_out;
+
+ /* Control Flow Information
+ ************************ */
+
+ struct bbh_node *pred;
+ struct bbh_node *succ;
+
+ u4_int name;
+ u4_int low, high;
+
+ u1_int visited;
+} ;
+
+typedef struct bb_node *bb_ptr;
+
+/* *****************************************
+ *** Prototypes and External Variables ***
+ ***************************************** */
+
+/* main.c
+ ****** */
+
+extern u1_int my_not;
+extern u1_int error;
+extern u4_int n_par, n_nest, n_loop, n_triv;
+
+u1_int query(void);
+void javab_out(s1_int, char *, ...);
+void *make_mem(int);
+void *more_mem(void *, int);
+
+/* class.c
+ ******* */
+
+extern u4_int magic;
+extern u2_int minor_version, major_version;
+extern u2_int constant_pool_count;
+extern constant_ptr *constant_pool;
+extern u2_int access_flags, this_class, super_class;
+extern u2_int interfaces_count;
+extern u2_int *interfaces;
+extern u2_int fields_count;
+extern fm_ptr *fields;
+extern u2_int methods_count;
+extern fm_ptr *methods;
+extern u2_int attributes_count;
+extern attribute_ptr *attributes;
+
+void make_shadow_cp(void);
+void mark_shadow_cp(u2_int);
+void take_shadow_cp(void);
+void dump_shadow_cp(void);
+void elim_shadow_cp(void);
+
+void process_classfile(FILE *, u1_int);
+u1_int valid_cp_entry(u1_int, u2_int, char *);
+void show_cp_entry(constant_ptr);
+
+attribute_ptr new_attribute(void);
+
+void add_cp_entry(u1_int, char *, u2_int, u2_int);
+void add_field(fm_ptr);
+void add_method(fm_ptr);
+
+/* byte.c
+ ****** */
+
+state_ptr new_stack_state(u1_int, u4_int, s4_int);
+void check_triv_loop(loop_ptr);
+int byte_proc(void);
+
+/* basic.c
+ ******* */
+
+void nop_loop(attribute_ptr, loop_ptr, u1_int *);
+
+void bb_link_sub_back(u1_int *, bb_ptr, bb_ptr);
+bb_ptr bb_add(u2_int, u2_int, u1_int);
+void bb_add_pred(bb_ptr, bb_ptr, u1_int);
+void bb_add_succ(bb_ptr, bb_ptr, u1_int);
+
+void bb_first(u2_int, u2_int *, u4_int *, char **, u2_int,
+ u2_int, u2_int *, u4_int *, u1_int *, u2_int);
+void bb_second(u1_int *);
+void bb_par(attribute_ptr, u1_int *, u1_int *);
+void bb_delete(void);
+
+void dump_sta(state_ptr);
+
+/* dump.c
+ ****** */
+
+void dump_classfile(FILE *);
+
+/* par.c
+ ***** */
+
+void output_workers(char *);
+void parallelize_loop(attribute_ptr, loop_ptr, u1_int *);
diff --git a/goto_trans/dump.c b/goto_trans/dump.c
new file mode 100644
index 0000000..be737e5
--- /dev/null
+++ b/goto_trans/dump.c
@@ -0,0 +1,292 @@
+
+/* *************
+ *** JAVAB ***
+ ****************************************************
+ *** Copyright (c) 1997 ***
+ *** Aart J.C. Bik Indiana University ***
+ *** All Rights Reserved ***
+ ****************************************************
+ *** Please refer to the LICENSE file distributed ***
+ *** with this software for further details on ***
+ *** the licensing terms and conditions. ***
+ *** ***
+ *** Please, report all bugs, comments, etc. ***
+ *** to: ajcbik at extreme.indiana.edu ***
+ ****************************************************
+ *** dump.c : output to class file
+ ***
+ ***
+ *** Your courtesy in mentioning the use of this bytecode tool
+ *** in any scientific work that presents results obtained
+ *** by using (extensions or modifications of) the tool
+ *** is highly appreciated.
+ ***
+ *** */
+
+/* ********************************************************
+ *** INCLUDE FILES and DEFINITIONS ***
+ ******************************************************** */
+
+#include <stdarg.h>
+#include "class.h"
+
+/* ********************************************************
+ *** EXTERNAL VARIABLES ***
+ ******************************************************** */
+
+/* PRIVATE
+ ******* */
+
+static FILE *dumpfile;
+
+/* ********************************************************
+ *** PRIVATE FUNCTIONS ***
+ ******************************************************** */
+
+/* write u1_int, u2_int, and u4_int routines
+ **************************************** */
+
+static void write_u1(u1_int u) {
+ fputc(u, dumpfile);
+}
+
+static void write_u2(u2_int u) {
+ u1_int u1 = HIGB_U2(u);
+ u1_int u2 = LOWB_U2(u);
+
+ fputc(u1, dumpfile);
+ fputc(u2, dumpfile);
+}
+
+static void write_u4(u4_int u) {
+ u1_int u1 = HIGB_U4(u);
+ u1_int u2 = LOWB_U4(u);
+ u1_int u3 = HIGB_U2(u);
+ u1_int u4 = LOWB_U2(u);
+
+ fputc(u1, dumpfile);
+ fputc(u2, dumpfile);
+ fputc(u3, dumpfile);
+ fputc(u4, dumpfile);
+}
+
+/* **********************************************************
+ *** Output of the different components of a class file ***
+ ********************************************************** */
+
+/* output of attribute information
+ ******************************* */
+
+static void dump_attributes(u2_int cnt, attribute_ptr *a) {
+
+ u4_int i, j; /* wide counters */
+
+ write_u2(cnt);
+
+ if (cnt != 0u) {
+
+ if (! a)
+ javab_out(-1, "lost attributes in dump_attributes()");
+
+ for (i = 0u; i < cnt; i++) {
+
+ if ((! a[i]) || (! a[i] -> info))
+ javab_out(-1, "lost attribute entry in dump_attributes()");
+ else {
+
+ u2_int ind = a[i] -> attribute_name_index;
+ u4_int len = a[i] -> attribute_length;
+ u1_int *info = a[i] -> info;
+
+ write_u2(ind);
+ write_u4(len);
+
+ for (j = 0u; j < len; j++)
+ write_u1(info[j]);
+ }
+ }
+ }
+}
+
+/* output of constant pool information
+ *********************************** */
+
+static void dump_constant_pool(void) {
+
+ u4_int i, j; /* wide counters */
+
+ write_u2(constant_pool_count);
+
+ if ((constant_pool_count == 0u) || (! constant_pool))
+ javab_out(-1, "lost constant pool in dump_cpool()");
+
+ for (i = 1u; i < constant_pool_count; i++) {
+
+ constant_ptr ce = constant_pool[i];
+
+ if (! ce)
+ javab_out(-1, "lost pool entry in dump_cpool()");
+
+ write_u1(ce -> tag);
+
+ switch(ce -> tag) {
+
+ case CONSTANT_Class:
+ case CONSTANT_String:
+
+ write_u2(ce -> u.indices.index1);
+ break;
+
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_NameAndType:
+
+ write_u2(ce -> u.indices.index1);
+ write_u2(ce -> u.indices.index2);
+ break;
+
+ case CONSTANT_Integer:
+ case CONSTANT_Float:
+
+ write_u4(ce -> u.data.val1);
+ break;
+
+ case CONSTANT_Long:
+ case CONSTANT_Double:
+
+ write_u4(ce -> u.data.val1);
+ write_u4(ce -> u.data.val2);
+
+ i++; /* invalid next entry */
+
+ break;
+
+ case CONSTANT_Utf8:
+
+ { u2_int l = ce -> u.utf8.l;
+ u1_int *s = ce -> u.utf8.s;
+
+ if (! s)
+ javab_out(-1, "lost UTF8 string in dump_cpool()");
+
+ write_u2(l);
+
+ for (j = 0u; j < l; j++)
+ write_u1(s[j]);
+ }
+ break;
+
+ default:
+ javab_out(-1, "invalid constant pool entry in dump_cpool()");
+ }
+ }
+}
+
+/* output of interface information
+ ******************************* */
+
+static void dump_interfaces(void) {
+
+ u4_int i; /* wide counter */
+
+ write_u2(interfaces_count);
+
+ if (interfaces_count != 0u) {
+
+ if (! interfaces)
+ javab_out(-1, "lost interfaces in dump_interfaces()");
+
+ for (i = 0u; i < interfaces_count; i++)
+ write_u2(interfaces[i]);
+ }
+}
+
+/* output of field information
+ *************************** */
+
+static void dump_fields(void) {
+
+ u4_int i; /* wide counter */
+
+ write_u2(fields_count);
+
+ if (fields_count != 0u) {
+
+ if (! fields)
+ javab_out(-1, "lost fields in dump_fields()");
+
+ for (i = 0u; i < fields_count; i++) {
+
+ if (! fields[i])
+ javab_out(-1, "lost field entry in dump_fields()");
+
+ write_u2(fields[i] -> access_flags);
+ write_u2(fields[i] -> name_index);
+ write_u2(fields[i] -> descr_index);
+
+ dump_attributes(fields[i] -> attributes_count,
+ fields[i] -> attributes);
+ }
+ }
+}
+
+/* output of method information
+ **************************** */
+
+static void dump_methods(void) {
+
+ u4_int i; /* wide counter */
+
+ write_u2(methods_count);
+
+ if (methods_count != 0u) {
+
+ if (! methods)
+ javab_out(-1, "lost methods in dump_methods()");
+
+ for (i = 0u; i < methods_count; i++) {
+
+ if (! methods[i])
+ javab_out(-1, "lost method entry in dump_methods()");
+
+ write_u2(methods[i] -> access_flags);
+ write_u2(methods[i] -> name_index);
+ write_u2(methods[i] -> descr_index);
+
+ dump_attributes(methods[i] -> attributes_count,
+ methods[i] -> attributes);
+ }
+ }
+}
+
+/* output of complete class file structure
+ *************************************** */
+
+static void dump_class(void) {
+
+ write_u4(magic); /* magic */
+
+ write_u2(minor_version); /* versions */
+ write_u2(major_version);
+
+ dump_constant_pool();
+
+ write_u2(access_flags); /* class info */
+ write_u2(this_class);
+ write_u2(super_class);
+
+ dump_interfaces();
+ dump_fields();
+ dump_methods();
+ dump_attributes(attributes_count, attributes);
+}
+
+/* ********************************************************
+ *** PUBLIC FUNCTIONS ***
+ ******************************************************** */
+
+void dump_classfile(FILE *f) {
+ dumpfile = (f) ? f : stdout;
+ dump_class();
+}
diff --git a/goto_trans/main.c b/goto_trans/main.c
new file mode 100644
index 0000000..0f8d35c
--- /dev/null
+++ b/goto_trans/main.c
@@ -0,0 +1,306 @@
+
+/* *************
+ *** JAVAB ***
+ ****************************************************
+ *** Copyright (c) 1997 ***
+ *** Aart J.C. Bik Indiana University ***
+ *** All Rights Reserved ***
+ ****************************************************
+ *** Please refer to the LICENSE file distributed ***
+ *** with this software for further details on ***
+ *** the licensing terms and conditions. ***
+ *** ***
+ *** Please, report all bugs, comments, etc. ***
+ *** to: ajcbik at extreme.indiana.edu ***
+ ****************************************************
+ *** main.c : control program
+ ***
+ ***
+ *** Your courtesy in mentioning the use of this bytecode tool
+ *** in any scientific work that presents results obtained
+ *** by using (extensions or modifications of) the tool
+ *** is highly appreciated.
+ ***
+ *** */
+
+/* ********************************************************
+ *** INCLUDE FILES and DEFINITIONS ***
+ ******************************************************** */
+
+#include <stdarg.h>
+#include "class.h"
+
+#undef AUTO_QUERY
+
+/* ********************************************************
+ *** EXTERNAL VARIABLES ***
+ ******************************************************** */
+
+/* PUBLIC
+ ****** */
+
+u1_int my_not = 4u;
+u1_int error = 0u;
+u4_int n_par = 0u, n_nest = 0u, n_loop = 0u, n_triv = 0u;
+char *filename = NULL;
+
+/* PRIVATE
+ ******* */
+
+static u1_int tot_err = 0u;
+static u4_int files = 0u;
+static FILE *file = NULL;
+
+/* ********************************************************
+ *** PRIVATE FUNCTIONS ***
+ ******************************************************** */
+
+/* Move original 'file.ext' to 'file.old'
+ and open a new 'file.ext' for output
+ ************************************************* */
+
+static FILE *new_file(char *oldname) {
+ int i, last = -1;
+ char *newname = NULL, c = '\0';
+ FILE *newfile = NULL;
+
+ if (! oldname) /* Safety */
+ javab_out(-1, "incorrect invocation of new_file()");
+
+ /* Construct new name file.old by stripping
+ last extension from original file.ext */
+
+ for (i = 0; oldname[i]; i++)
+ if (oldname[i] == '.')
+ last = i;
+
+ if (last >= 0) {
+ c = oldname[last];
+ oldname[last] = '\0';
+ }
+
+ /* DYNAMIC MEMORY ALLOCATION -> no restriction on length */
+
+ newname = (char *) make_mem(sizeof(char) * (strlen(oldname) + 6));
+ sprintf(newname, "%s.old", oldname);
+
+ if (last >= 0)
+ oldname[last] = c;
+
+ /* Prevent Overwriting of existing file.old */
+
+ if((newfile = fopen(newname, "r"))) {
+ javab_out(0, "cannot apply javab to %s"
+ " (%s exists)", oldname, newname);
+ fclose(newfile);
+ newfile = NULL;
+ }
+ else {
+
+ /* DYNAMIC MEMORY ALLOCATION -> no restriction on length */
+
+ char *command = (char *) make_mem(sizeof(char) *
+ (strlen(oldname) + strlen(newname) + 5));
+
+ sprintf(command, "mv %s %s", oldname, newname);
+
+ /* Re-name original file.ext to file.old */
+
+ javab_out(2, " -- executing '%s'", command);
+
+ if (system(command))
+ javab_out(0, "command %s failed", command);
+ else {
+
+ /* Re-open original file.ext for new output */
+
+ if (! (newfile = fopen(oldname, "w")))
+ javab_out(0, "cannot open file %s", oldname);
+ else
+ javab_out(2, " -- output to file %s", oldname);
+ }
+ free(command);
+ }
+ free(newname);
+
+ return newfile;
+}
+
+/* Process a Class File
+ ******************** */
+
+static void process(void) {
+ FILE *outfile;
+ int num;
+
+ files++;
+ error = 0;
+
+ process_classfile(file, 0u); /* read */
+ /* process_classfile(NULL, 1u); */ /* verify */
+
+ num = byte_proc();
+
+ if(num > 0) {
+ outfile = new_file(filename);
+
+ if (outfile) {
+ dump_classfile(outfile);
+ fclose(outfile);
+ }
+ }
+}
+
+/* ********************************************************
+ *** PUBLIC FUNCTIONS ***
+ ******************************************************** */
+
+/* ****************************
+ *** User input on Query ***
+ ****************************
+ *** y/Y : yes ***
+ *** n/N : no ***
+ *** q/Q : no, quit query ***
+ **************************** */
+
+u1_int query(void) {
+ char str[80];
+ u1_int res = 2u;
+
+#ifdef AUTO_QUERY
+ fprintf(stderr, "(y/n/q) => Y\n");
+ return 1u;
+#endif
+
+ do {
+
+ fprintf(stderr, "(y/n/q) => ");
+ fflush(stderr);
+
+ fgets(str, 80, stdin);
+
+ if (strlen(str) != 0)
+ switch (str[0]) {
+
+ case 'y':
+ case 'Y':
+ res = 1u;
+ break;
+
+ case 'n':
+ case 'N':
+ res = 0u;
+ break;
+
+ case 'q':
+ case 'Q':
+ res = 0u;
+ break;
+ }
+ }
+ while (res == 2u);
+
+ return res;
+}
+
+/* **********************************
+ *** Error and Warning Messages ***
+ ***************************************************************
+ *** level == -1 : FATAL ERROR, EXIT PROGRAM ***
+ *** level == 0 : ERRROR, SET ERROR FLAG ***
+ *** level == 1 : STRONG MESSAGE ***
+ *** level == 2 : MESSAGE, PRINT ONLY FOR '-v' ***
+ *************************************************************** */
+
+void javab_out(s1_int level, char *fmt, ...) {
+ va_list argv;
+
+ if (level == 0)
+ tot_err = error = 1;
+ /* else if (level > 1 && ! s_verbose) */
+ else if (level > 1)
+ return;
+
+ va_start(argv, fmt);
+
+ if (file)
+ fprintf(stderr, "%s:: ", (filename) ? filename : "stdin");
+
+ vfprintf(stderr, fmt, argv);
+ putc('\n', stderr);
+
+ va_end(argv);
+
+ if (level < 0)
+ exit(1);
+}
+
+/* Memory Allocation Functions
+ [for size <= 0, size == 1 is used
+ because some systems return NULL for malloc(0);]
+ ************************************************* */
+
+void *make_mem(int size) {
+ void *p = calloc(((size > 0) ? size : 4), sizeof(u1_int));
+ if (! p)
+ javab_out(-1, "Out of Memory");
+ return p;
+}
+
+void *more_mem(void *p, int size) {
+ if (p) {
+ p = realloc(p, ((size > 0) ? size : 1));
+ if (! p)
+ javab_out(-1, "Out of Memory (re-allocation)");
+ return p;
+ }
+ else
+ return make_mem(size);
+}
+
+/* ********************
+ *** Main Program ***
+ ******************** */
+
+int main(int argc, char *argv[]) {
+ int i;
+ u1_int unproc = 1;
+
+ /* Process Environment Variable */
+
+ char *env = getenv("JAVAB_THREADS");
+
+ if (env) {
+ my_not = (u1_int) atoi(env);
+
+ if (my_not < 2u)
+ my_not = 4u;
+ else if (my_not > 16u)
+ my_not = 16u;
+ }
+
+ for (i = 1; i < argc; i++) {
+
+ if (argv[i]) {
+ file = fopen(filename = argv[i], "r");
+ unproc = 0;
+
+ if (file) {
+ process();
+ fclose(file);
+ }
+ else
+ javab_out(0, "cannot open file %s", filename);
+ }
+ }
+
+ /* Process Standard Input by Default */
+
+ if (unproc) {
+ file = stdin;
+ process();
+ }
+
+ return tot_err;
+}
+
diff --git a/goto_trans/make.def.in b/goto_trans/make.def.in
new file mode 100644
index 0000000..973e71a
--- /dev/null
+++ b/goto_trans/make.def.in
@@ -0,0 +1,7 @@
+
+CC=@CC@
+LIBS=@LIBS@
+
+F2J_BINDIR=@F2J_INSTALL_PREFIX@/bin
+
+CFLAGS=-Wall @CFLAGS@
diff --git a/goto_trans/symtab.c b/goto_trans/symtab.c
new file mode 100644
index 0000000..efcb2af
--- /dev/null
+++ b/goto_trans/symtab.c
@@ -0,0 +1,130 @@
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include "symtab.h"
+
+#define symdebug 0
+
+void *malloc(size_t);
+void *calloc(size_t, size_t);
+
+SYMTABLE *
+new_symtable (int numentries)
+{
+ SYMTABLE *newtable;
+ newtable = (SYMTABLE *) malloc (sizeof (SYMTABLE));
+
+ /* Handle out-of-mem. */
+ if (newtable == NULL)
+ {
+ perror ("malloc error creating new symboltable");
+ exit (-1);
+ }
+
+ newtable->num_entries = numentries;
+ newtable->entry = (HASHNODE **) calloc (numentries, sizeof (HASHNODE *));
+
+ /* Handle out-of-mem. */
+ if (newtable->entry == NULL)
+ {
+ perror ("calloc error creating new symbol table");
+ exit (-1);
+ }
+
+ return (newtable);
+} /* Close new_symtable(). */
+
+void
+type_insert (HASHNODE ** list, int node_val, char *tag)
+{
+
+ HASHNODE *newnode;
+
+ newnode = (HASHNODE *) malloc (sizeof (HASHNODE));
+ newnode->ident = tag;
+ newnode->val = node_val;
+
+ /* Note carefully the dereferencing operators. */
+ newnode->next = *list;
+ *list = newnode;
+}
+
+
+/* This is a specific lookup routine to match an id with
+ its associated type. I will need others for matching
+ externals, intrinsics, etc. */
+HASHNODE *
+type_lookup (SYMTABLE * table, char *id)
+{
+ int index;
+ HASHNODE *hash_entry;
+ int hash(char *);
+
+ if((table == NULL) || (id == NULL)) {
+ return NULL;
+ }
+
+ index = hash (id) % table->num_entries;
+
+ hash_entry = search_hashlist (table->entry[index], id);
+ if (hash_entry == NULL)
+ {
+ if(symdebug)printf ("Not in table.\n");
+ return NULL;
+ }
+ else /* Attempt to return the value pointed to by "type". */
+ {
+ if(symdebug)printf("In table.\n");
+ return (hash_entry);
+ }
+}
+
+HASHNODE * format_lookup(SYMTABLE *table, char *label)
+{
+ return type_lookup(table,label);
+}
+
+HASHNODE *
+search_hashlist (HASHNODE * list, char *id)
+{
+
+ if(id == NULL)
+ return NULL;
+
+ for (; list != NULL ; list = list->next)
+ {
+ if(list->ident == NULL)
+ continue;
+ if (!strcmp (list->ident, id))
+ return (list);
+ }
+
+ return NULL; /* Not in list. */
+}
+
+
+/* Simple hash function: just add the ascii integer
+ values of each character in the string.
+
+ Added error check for null string and made some
+ other minor changes. 12/5/97 --Keith
+ */
+
+int
+hash (char *str)
+{
+ int sum = 0;
+ int i=0, len;
+
+ if(str == NULL)
+ return 0;
+
+ len = strlen(str);
+
+ while (i < len)
+ {
+ sum += (int) str[i];
+ i++;
+ }
+ return sum;
+}
diff --git a/goto_trans/symtab.h b/goto_trans/symtab.h
new file mode 100644
index 0000000..2386ec6
--- /dev/null
+++ b/goto_trans/symtab.h
@@ -0,0 +1,22 @@
+
+typedef struct hash_node
+ {
+ int val;
+ char *ident;
+ struct hash_node *next;
+ }
+HASHNODE;
+
+
+typedef struct sym_table
+ {
+ int num_entries;
+ HASHNODE **entry;
+ }
+SYMTABLE;
+
+/* Prototypes. */
+
+HASHNODE * search_hashlist(HASHNODE *, char *);
+HASHNODE * type_lookup(SYMTABLE *, char *);
+SYMTABLE * new_symtable(int);
diff --git a/install-sh b/install-sh
new file mode 100755
index 0000000..d4744f0
--- /dev/null
+++ b/install-sh
@@ -0,0 +1,269 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+#
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# 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=""
+
+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=:
+ chmodcmd=""
+ 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/libbytecode/Makefile.in b/libbytecode/Makefile.in
new file mode 100644
index 0000000..cdd10d5
--- /dev/null
+++ b/libbytecode/Makefile.in
@@ -0,0 +1,35 @@
+include make.def
+
+default: libbytecode.a
+
+install: libbytecode.a
+ install -d -m 755 $(F2J_LIBDIR)
+ install -m 644 libbytecode.a $(F2J_LIBDIR)
+
+libbytecode.a: globals.o constant_pool.o api.o class.o dlist.o
+ $(AR) -r libbytecode.a dlist.o constant_pool.o \
+ api.o class.o globals.o
+
+api.o: api.h bytecode.h globals.c api.c
+
+class.o: bytecode.h class.h class.c
+
+constant_pool.o: dlist.o bytecode.h constant_pool.c
+
+globals.o: globals.c
+
+dlist.o: dlist.h dlist.c
+
+test:
+ cd testing; $(MAKE) test
+
+docs:
+ $(DOXYGEN)
+
+configclean: clean
+ /bin/rm -rf autom4te.cache configure Makefile config.cache config.log \
+ config.status make.def testing/Makefile bytecode.h
+
+clean:
+ /bin/rm -rf *.o *.a latex html
+ cd testing; $(MAKE) clean
diff --git a/libbytecode/api.c b/libbytecode/api.c
new file mode 100644
index 0000000..0dee034
--- /dev/null
+++ b/libbytecode/api.c
@@ -0,0 +1,4353 @@
+/** @file api.c
+ * Contains an API for generating Java bytecode.
+ */
+
+#include "api.h"
+
+/**
+ * This code creates the JVM_FIELD structure, assigns the
+ * appropriate values into it, and inserts it into the field list.
+ *
+ * @param cclass -- The class to which the field should be added.
+ * @param name -- The name of the field.
+ * @param desc -- The field descriptor.
+ * @param acc_flag -- The access flags for this field (for example
+ * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc)
+ *
+ * @returns The new JVM_FIELD structure.
+ */
+
+JVM_FIELD *
+bc_add_field(JVM_CLASS *cclass, char *name, char *desc, u2 acc_flag)
+{
+ JVM_FIELD * tmpfield;
+ int c;
+
+ if(!cclass || !name || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ debug_msg("bc_add_field() creating new field for %s - %s\n",name,desc);
+
+ tmpfield = (JVM_FIELD *) malloc(sizeof(JVM_FIELD));
+
+ if(!tmpfield)
+ return NULL;
+
+ tmpfield->access_flags = acc_flag;
+ tmpfield->class = cclass;
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, name);
+ if(c < 0) {
+ free(tmpfield);
+ return NULL;
+ }
+
+ tmpfield->name_index = c;
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, desc);
+ if(c < 0) {
+ free(tmpfield);
+ return NULL;
+ }
+
+ tmpfield->descriptor_index = c;
+
+ tmpfield->attributes_count = 0;
+ tmpfield->attributes = make_dl();
+
+ if(!tmpfield->attributes) {
+ free(tmpfield);
+ return NULL;
+ }
+
+ dl_insert_b(cclass->fields, tmpfield);
+
+ cclass->fields_count++;
+
+ return tmpfield;
+}
+
+/**
+ * Returns the fully-qualified class name for the given class.
+ * Generally this is the package name followed by the class name,
+ * however the class name could already be a qualified name.
+ *
+ * @param thisclass -- The name of the class.
+ * @param package_name -- The name of the package. If NULL, the
+ * fully-qualified name is just the class name.
+ *
+ * @returns The fully-qualified class name. Returns NULL on error.
+ */
+
+char *
+bc_get_full_classname(char *thisclass, char *package_name)
+{
+ char *pname, *t;
+
+ if(!thisclass) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ /* maybe this is already qualified. if so, just return a dup of the
+ * class name.
+ */
+ for(t = thisclass; *t != '\0'; t++)
+ if( (*t == '/') || (*t == '.') )
+ return char_substitute(thisclass, '.', '/');
+
+ if(package_name != NULL) {
+ pname = (char *)malloc(strlen(thisclass) + strlen(package_name) + 2);
+
+ if(!pname)
+ return NULL;
+
+ /* issue a warning if the package name has some trailing junk. */
+ if(!isalnum((int)*(package_name + (strlen(package_name)-1))))
+ debug_err("WARNING: last char of package name not alphanumeric.\n");
+
+ t = char_substitute(package_name, '.', '/');
+
+ if(!t) {
+ free(pname);
+ return NULL;
+ }
+
+ strcpy(pname, t);
+ strcat(pname, "/");
+ strcat(pname, thisclass);
+
+ free(t);
+ return pname;
+ }
+ else
+ return strdup(thisclass);
+}
+
+/**
+ * Creates a new class file structure.
+ *
+ * @param name -- The name of the class.
+ * @param srcFile -- The name of the source code file from which this
+ * class was compiled. If NULL, no SourceFile attribute will be created
+ * for this class.
+ * @param super_class -- The name of the superclass for this class. If NULL,
+ * the superclass is set to java.lang.Object.
+ * @param package_name -- The name of the package this class file belongs to.
+ * If NULL, no package will be specified.
+ * @param acc_flag -- The access flags for this class (for example
+ * JVM_ACC_PUBLIC, etc)
+ *
+ * @returns The new class file structure.
+ */
+
+JVM_CLASS *
+bc_new_class(char *name, char *srcFile, char *super_class,
+ char *package_name, u2 acc_flag)
+{
+ CP_INFO *utf8node = NULL, *classnode = NULL;
+ JVM_CLASS * tmp = NULL;
+ char * fullclassname = NULL;
+ int c;
+
+#define err_new_class() \
+ if(tmp->constant_pool) dl_delete_list(tmp->constant_pool); \
+ tmp->constant_pool = NULL; \
+ if(tmp->fields) dl_delete_list(tmp->fields); \
+ tmp->fields = NULL; \
+ if(tmp->interfaces) dl_delete_list(tmp->interfaces); \
+ tmp->interfaces = NULL; \
+ if(tmp->attributes) dl_delete_list(tmp->attributes); \
+ tmp->attributes = NULL; \
+ if(tmp->methods) dl_delete_list(tmp->methods); \
+ tmp->methods = NULL; \
+ if(fullclassname) free(fullclassname); \
+ if(tmp) free(tmp); \
+ if(utf8node && utf8node->cpnode.Utf8.bytes) \
+ free(utf8node->cpnode.Utf8.bytes); \
+ if(classnode && classnode->cpnode.Utf8.bytes) \
+ free(classnode->cpnode.Utf8.bytes);
+
+ if(!name) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ tmp = (JVM_CLASS *)malloc(sizeof(JVM_CLASS));
+
+ if(!tmp)
+ return NULL;
+
+ tmp->magic = JVM_MAGIC;
+
+ bc_set_class_version(tmp, JVM_MAJOR_VER, JVM_MINOR_VER);
+
+ /* we'll fill out the constant pool and fields later. */
+ tmp->constant_pool_count = 0;
+ tmp->constant_pool = make_dl();
+
+ tmp->fields_count = 0;
+ tmp->fields = make_dl();
+
+ tmp->interfaces_count = 0;
+ tmp->interfaces = make_dl();
+
+ tmp->attributes_count = 0;
+ tmp->attributes = make_dl();
+
+ tmp->methods_count = 0;
+ tmp->methods = make_dl();
+
+ tmp->access_flags = acc_flag;
+
+ if(!tmp->constant_pool || !tmp->fields || !tmp->interfaces ||
+ !tmp->attributes || !tmp->methods)
+ {
+ err_new_class();
+ return NULL;
+ }
+
+ /* first create an entry for 'this'. the class file variable this_class
+ * points to a CONSTANT_Class_info entry in the constant pool, which in
+ * turn points to a CONSTANT_Utf8_info entry representing the name of
+ * this class. so, first we create the Utf8 entry, then the Class entry.
+ */
+
+ fullclassname = bc_get_full_classname(name, package_name);
+
+ if(!fullclassname) {
+ err_new_class();
+ return NULL;
+ }
+
+ debug_msg("##creating new entry, this -> %s\n",fullclassname);
+
+ c = cp_find_or_insert(tmp, CONSTANT_Class, fullclassname);
+ if(c < 0) {
+ err_new_class();
+ return NULL;
+ }
+
+ tmp->this_class = c;
+
+ /* if a superclass was specified, then insert an entry for it into
+ * the constant pool and set the superclass field in the class struct.
+ * otherwise, set the superclass to java.lang.Object.
+ */
+
+ if(super_class) {
+ char *sc;
+
+ sc = char_substitute(super_class, '.', '/');
+
+ if(!sc) {
+ err_new_class();
+ return NULL;
+ }
+
+ c = cp_find_or_insert(tmp, CONSTANT_Class, sc);
+
+ free(sc);
+
+ if(c < 0) {
+ err_new_class();
+ if(sc) free(sc);
+ return NULL;
+ }
+
+ tmp->super_class = c;
+ }
+ else {
+ c = cp_find_or_insert(tmp, CONSTANT_Class, "java/lang/Object");
+
+ if(c < 0) {
+ err_new_class();
+ return NULL;
+ }
+
+ tmp->super_class = c;
+ }
+
+ /* the only attributes allowed for a class file are SourceFile and
+ * Deprecated. if srcFile was supplied by the user, then add a
+ * SourceFile attribute to this class.
+ */
+
+ if(srcFile) {
+ if(bc_add_source_file_attr(tmp, srcFile)) {
+ err_new_class();
+ return NULL;
+ }
+ }
+
+ free(fullclassname);
+
+ return tmp;
+}
+
+/**
+ * Sets the version for this class file. From the JVM Spec:
+ *
+ * The Java virtual machine implementation of Sun's JDK release 1.0.2
+ * supports class file format versions 45.0 through 45.3 inclusive.
+ * Sun's JDK releases 1.1.X can support class file formats of versions
+ * in the range 45.0 through 45.65535 inclusive. Implementations of
+ * version 1.2 of the Java 2 platform can support class file formats
+ * of versions in the range 45.0 through 46.0 inclusive.
+ *
+ * @param class -- The class file whose version is to be set.
+ * @param major -- The major version.
+ * @param minor -- The minor version.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_class_version(JVM_CLASS *class, int major, int minor)
+{
+ if(!class) {
+ BAD_ARG();
+ return -1;
+ }
+
+ class->major_version = (u2)major;
+ class->minor_version = (u2)minor;
+
+ if((unsigned int)class->major_version != major)
+ debug_err("Warning: possible truncation in bc_set_class_version.\n");
+
+ if((unsigned int)class->minor_version != minor)
+ debug_err("Warning: possible truncation in bc_set_class_version.\n");
+
+ return 0;
+}
+
+/**
+ * Creates a SourceFile attribute containing the specified name and adds it
+ * to the given class file.
+ *
+ * @param class -- The class to which the SourceFile attribute should be
+ * added.
+ * @param filename -- The name of the source code file from which this
+ * class was compiled.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_source_file_attr(JVM_CLASS *class, char *filename)
+{
+ JVM_ATTRIBUTE *attr_temp;
+ int c;
+
+ if(!class || !filename) {
+ BAD_ARG();
+ return -1;
+ }
+
+ class->attributes_count++;
+
+ attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!attr_temp)
+ return -1;
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, "SourceFile");
+
+ if(c < 0) {
+ free(attr_temp);
+ return -1;
+ }
+
+ attr_temp->attribute_name_index = c;
+ attr_temp->attribute_length = 2; /* SourceFile attr length always 2 */
+ attr_temp->attr.SourceFile = (struct SourceFile_attribute *)
+ malloc(sizeof(struct SourceFile_attribute));
+
+ if(!attr_temp->attr.SourceFile) {
+ free(attr_temp);
+ return -1;
+ }
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, filename);
+
+ if(c < 0) {
+ free(attr_temp);
+ free(attr_temp->attr.SourceFile);
+ return -1;
+ }
+
+ attr_temp->attr.SourceFile->sourcefile_index = c;
+
+ dl_insert_b(class->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Lets the user define their own attribute and add it to the class file.
+ *
+ * @param class -- The class to which this attribute should be added.
+ * @param attribute_name -- The name of the attribute.
+ * @param attribute_length -- The length of the attribute pointed to by the
+ * 'attribute_data' parameter.
+ * @param attribute_data -- Pointer to the attribute contents.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_user_defined_class_attr(JVM_CLASS *class, char *attribute_name,
+ int attribute_length, void *attribute_data)
+{
+ JVM_ATTRIBUTE *attr_temp;
+ int c;
+
+ if(!class || !attribute_name || !attribute_data) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!attr_temp)
+ return -1;
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, attribute_name);
+
+ if(c < 0) {
+ free(attr_temp);
+ return -1;
+ }
+
+ attr_temp->attribute_name_index = c;
+ attr_temp->attribute_length = attribute_length;
+ attr_temp->attr.UserDefined = (struct UserDefined_attribute *)
+ malloc(sizeof(struct UserDefined_attribute));
+
+ if(!attr_temp->attr.UserDefined) {
+ free(attr_temp);
+ return -1;
+ }
+
+ attr_temp->attr.UserDefined->data = (void *)malloc(attribute_length);
+
+ if(!attr_temp->attr.UserDefined->data) {
+ free(attr_temp->attr.UserDefined);
+ free(attr_temp);
+ return -1;
+ }
+
+ memcpy(attr_temp->attr.UserDefined->data, attribute_data, attribute_length);
+
+ class->attributes_count++;
+
+ dl_insert_b(class->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds the "Deprecated" attribute to the specified class.
+ *
+ * @param class -- The class to be set as deprecated.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_class_deprecated(JVM_CLASS *class)
+{
+ JVM_ATTRIBUTE *attr_temp;
+
+ if(!class) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = bc_new_deprecated_attr(class);
+
+ if(!attr_temp)
+ return -1;
+
+ class->attributes_count++;
+
+ dl_insert_b(class->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds the specified interface to the list of interfaces that
+ * this class implements.
+ *
+ * @param class -- The class to which the interface should be added.
+ * @param interface -- The name of the interface that this class implements.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_class_interface(JVM_CLASS *class, char *interface)
+{
+ int *copy;
+ int c;
+ char *t;
+
+ if(!class || !interface) {
+ BAD_ARG();
+ return -1;
+ }
+
+ t = char_substitute(interface, '.', '/');
+
+ if(!t)
+ return -1;
+
+ c = cp_find_or_insert(class, CONSTANT_Class, t);
+
+ free(t);
+
+ if(c < 0) {
+ free(t);
+ return -1;
+ }
+
+ copy = (int *)malloc(sizeof(int));
+
+ if(!copy) {
+ free(t);
+ return -1;
+ }
+
+ *copy = c;
+
+ class->interfaces_count++;
+
+ dl_insert_b(class->interfaces, copy);
+
+ return 0;
+}
+
+/**
+ * Adds the "ConstantValue" attribute to the specified field. This allows
+ * specifying the value that the field should have when the class containing
+ * it is initialized. Since a field with a ConstantValue attribue must be
+ * static, this function will set the JVM_ACC_STATIC flag in the field's
+ * access flags.
+ *
+ * @param field -- The field to which the ConstantValue attribute should be
+ * added.
+ * @param tag -- The type of this constant (e.g. CONSTANT_Integer,
+ * CONSTANT_Utf8, etc). See the JVM_CONSTANT enum for the possible
+ * data types.
+ * @param value -- Pointer to the constant value.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_constant_value_attr(JVM_FIELD *field,
+ JVM_CONSTANT tag, const void *value)
+{
+ JVM_ATTRIBUTE *attr_temp;
+ int c;
+ int val_idx;
+
+ if(!field || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ c = cp_manual_insert(field->class, tag, value);
+
+ if(c < 0)
+ return -1;
+
+ val_idx = c;
+
+ /* JVM spec says that the ACC_STATIC flag must be set for a field
+ * which has a ConstantValue attribute.
+ */
+ field->access_flags |= JVM_ACC_STATIC;
+
+ attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!attr_temp)
+ return -1;
+
+ c = cp_find_or_insert(field->class, CONSTANT_Utf8, "ConstantValue");
+ if(c < 0) {
+ free(attr_temp);
+ return -1;
+ }
+
+ attr_temp->attribute_name_index = c;
+ attr_temp->attribute_length = 2; /* ConstantValue attr length always 2 */
+ attr_temp->attr.ConstantValue = (struct ConstantValue_attribute *)
+ malloc(sizeof(struct ConstantValue_attribute));
+
+ if(!attr_temp->attr.ConstantValue) {
+ free(attr_temp);
+ return -1;
+ }
+
+ attr_temp->attr.ConstantValue->constantvalue_index = val_idx;
+
+ field->attributes_count++;
+
+ dl_insert_b(field->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds the "Synthetic" attribute to the specified field. The Synthetic
+ * attribute is used for class members that do not appear in the source code.
+ *
+ * @param field -- The field to which the Synthetic attribute should be
+ * added.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_field_synthetic(JVM_FIELD *field)
+{
+ JVM_ATTRIBUTE *attr_temp;
+
+ if(!field) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = bc_new_synthetic_attr(field->class);
+
+ if(!attr_temp)
+ return -1;
+
+ field->attributes_count++;
+
+ dl_insert_b(field->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds the "Deprecated" attribute to the specified field.
+ *
+ * @param field -- The field to which the Deprecated attribute should be
+ * added.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_field_deprecated(JVM_FIELD *field)
+{
+ JVM_ATTRIBUTE *attr_temp;
+
+ if(!field) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = bc_new_deprecated_attr(field->class);
+
+ if(!attr_temp)
+ return -1;
+
+ field->attributes_count++;
+
+ dl_insert_b(field->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds the "Deprecated" attribute to the specified method.
+ *
+ * @param meth -- The method to which the Deprecated attribute should be
+ * added.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_method_deprecated(JVM_METHOD *meth)
+{
+ JVM_ATTRIBUTE *attr_temp;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = bc_new_deprecated_attr(meth->class);
+
+ if(!attr_temp)
+ return -1;
+
+ meth->attributes_count++;
+
+ dl_insert_b(meth->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Creates a new "Deprecated" attribute. This attribute can be
+ * added to a class, field, or method.
+ *
+ * @param class -- Class containing the constant pool where this
+ * attribute will be stored.
+ *
+ * @returns Pointer to the new JVM_ATTRIBUTE.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_deprecated_attr(JVM_CLASS *class)
+{
+ JVM_ATTRIBUTE *attr_temp;
+ int c;
+
+ if(!class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!attr_temp)
+ return NULL;
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, "Deprecated");
+
+ if(c < 0) {
+ free(attr_temp);
+ return NULL;
+ }
+
+ attr_temp->attribute_name_index = c;
+ attr_temp->attribute_length = 0; /* Deprecated attr length always 0 */
+
+ return attr_temp;
+}
+
+/**
+ * Creates a new "Synthetic" attribute. This attribute can be
+ * added to a field or method.
+ *
+ * @param class -- Class containing the constant pool where this
+ * attribute will be stored.
+ *
+ * @returns Pointer to the new JVM_ATTRIBUTE.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_synthetic_attr(JVM_CLASS *class)
+{
+ JVM_ATTRIBUTE *attr_temp;
+ int c;
+
+ if(!class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!attr_temp)
+ return NULL;
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, "Synthetic");
+
+ if(c < 0) {
+ free(attr_temp);
+ return NULL;
+ }
+
+ attr_temp->attribute_name_index = c;
+ attr_temp->attribute_length = 0; /* Synthetic attr length always 0 */
+
+ return attr_temp;
+}
+
+/**
+ * Adds the "Synthetic" attribute to the specified method of the specified
+ * class.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_method_synthetic(JVM_METHOD *meth)
+{
+ JVM_ATTRIBUTE *attr_temp;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr_temp = bc_new_synthetic_attr(meth->class);
+
+ if(!attr_temp)
+ return -1;
+
+ meth->attributes_count++;
+
+ dl_insert_b(meth->attributes,attr_temp);
+
+ return 0;
+}
+
+/**
+ * Adds an exception that this method could throw.
+ *
+ * @param meth -- The method to which the exception should be added.
+ * @param exception -- The name of the exception that this method
+ * may throw.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_method_exception(JVM_METHOD *meth, char *exception)
+{
+ JVM_ATTRIBUTE *attr;
+ int *copy;
+ int c;
+ char *t;
+
+ if(!meth || !exception) {
+ BAD_ARG();
+ return -1;
+ }
+
+ t = char_substitute(exception, '.', '/');
+
+ if(!t) return -1;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, t);
+
+ free(t);
+
+ if(c < 0) return -1;
+
+ copy = (int *)malloc(sizeof(int));
+
+ if(!copy) return -1;
+
+ *copy = c;
+
+ attr = find_attribute(meth->class, meth->attributes, "Exceptions");
+
+ if(!attr) {
+ attr = bc_new_exceptions_attr(meth->class);
+
+ if(!attr) {
+ free(copy);
+ return -1;
+ }
+
+ meth->attributes_count++;
+ dl_insert_b(meth->attributes, attr);
+ }
+
+ attr->attribute_length+=2;
+ attr->attr.Exceptions->number_of_exceptions++;
+
+ dl_insert_b(attr->attr.Exceptions->exception_index_table, copy);
+
+ return 0;
+}
+
+/**
+ * Adds the "InnerClasses" attribute to the specified class.
+ *
+ * @param class -- The class to which the attribute should be added.
+ * @param inner_class -- The name of the inner class.
+ * @param outer_class -- The name of the class containing the inner class.
+ * @param inner_name -- Specify NULL for an anonymous inner class. Otherwise
+ * this is the simple name of the inner class.
+ * @param acc_flags -- The access flags for the inner class (for example
+ * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc)
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_inner_classes_attr(JVM_CLASS *class, char *inner_class,
+ char *outer_class, char *inner_name, int acc_flags)
+{
+ struct InnerClassEntry *entry;
+ JVM_ATTRIBUTE *attr;
+ int c;
+ char *t;
+
+ if(!class) {
+ BAD_ARG();
+ return -1;
+ }
+
+ attr = find_attribute(class, class->attributes, "InnerClasses");
+
+ if(!attr) {
+ attr = bc_new_inner_classes_attr(class);
+ if(!attr) return -1;
+ class->attributes_count++;
+ dl_insert_b(class->attributes, attr);
+ }
+
+ /* increment the length by the size of one entry in the inner class list */
+
+ entry = (struct InnerClassEntry *)malloc(sizeof(struct InnerClassEntry));
+
+ if(!entry) return -1;
+
+ entry->inner_class_info_index = 0;
+ entry->outer_class_info_index = 0;
+ entry->inner_name_index = 0;
+
+ entry->inner_class_access_flags = acc_flags;
+
+ if(inner_class) {
+ t = char_substitute(inner_class, '.', '/');
+ if(!t) {
+ free(entry);
+ return -1;
+ }
+
+ c = cp_find_or_insert(class, CONSTANT_Class, t);
+
+ free(t);
+
+ if(c < 0) {
+ free(entry);
+ return -1;
+ }
+
+ entry->inner_class_info_index = c;
+ }
+
+ if(outer_class) {
+ t = char_substitute(outer_class, '.', '/');
+ if(!t) {
+ free(entry);
+ return -1;
+ }
+
+ c = cp_find_or_insert(class, CONSTANT_Class, t);
+
+ free(t);
+
+ if(c < 0) {
+ free(entry);
+ return -1;
+ }
+
+ entry->outer_class_info_index = c;
+ }
+
+ if(inner_name) {
+ t = char_substitute(inner_name, '.', '/');
+ if(!t) {
+ free(entry);
+ return -1;
+ }
+
+ c = cp_find_or_insert(class, CONSTANT_Utf8, t);
+
+ free(t);
+
+ if(c < 0) {
+ free(entry);
+ return -1;
+ }
+
+ entry->inner_name_index = c;
+ }
+
+ attr->attribute_length+=8;
+ attr->attr.InnerClasses->number_of_classes++;
+
+ dl_insert_b(attr->attr.InnerClasses->classes, entry);
+
+ return 0;
+}
+
+/**
+ * Sets the name of a local variable in the specified method.
+ *
+ * @param meth -- The method containing the local variable.
+ * @param num -- The local variable number whose name should be set.
+ * @param name -- The name of the variable.
+ * @param desc -- The descriptor of the variable.
+ *
+ * @returns Pointer to the local variable table entry created for
+ * this variable. Returns NULL on error.
+ */
+
+JVM_LOCAL_VARIABLE_TABLE_ENTRY *
+bc_set_local_var_name(JVM_METHOD *meth, int num, char *name, char *desc)
+{
+ JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc;
+
+ if(!meth || !name || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ loc = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *)
+ malloc(sizeof(JVM_LOCAL_VARIABLE_TABLE_ENTRY));
+
+ if(!loc) return NULL;
+
+ loc->index = num;
+ loc->name = strdup(name);
+ loc->name_index = 0;
+ loc->descriptor = char_substitute(desc, '.', '/');
+ loc->descriptor_index = 0;
+ loc->start = NULL;
+ loc->end = NULL;
+
+ if(!loc->descriptor || !loc->name) {
+ if(loc->name) free(loc->name);
+ if(loc->descriptor) free(loc->descriptor);
+ free(loc);
+ return NULL;
+ }
+
+ dl_insert_b(meth->locals_table, loc);
+
+ return loc;
+}
+
+/**
+ * Sets the start of this named local variable. That is, the instruction from
+ * which the given local variable table entry is valid.
+ *
+ * @param loc -- The local variable table entry for the variable.
+ * @param instr -- The first instruction for which this variable is defined.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc, JVM_CODE_GRAPH_NODE *instr)
+{
+ if(!loc || !instr) {
+ BAD_ARG();
+ return -1;
+ }
+
+ loc->start = instr;
+
+ return 0;
+}
+
+/**
+ * Sets the end of this named local variable. That is, the instruction after
+ * which the given local variable table entry would not be valid.
+ *
+ * @param loc -- The local variable table entry for the variable.
+ * @param instr -- The last instruction for which this variable is defined.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc, JVM_CODE_GRAPH_NODE *instr)
+{
+ if(!loc || !instr) {
+ BAD_ARG();
+ return -1;
+ }
+
+ loc->end = instr;
+
+ return 0;
+}
+
+/**
+ * Sets the line number (from the original source file) for the given
+ * JVM instruction.
+ *
+ * @param meth -- The method containing the line number table to be updated.
+ * @param instr -- The instruction corresponding to the given line number.
+ * @param lnum -- The line number from the original source code.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_line_number(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *instr, int lnum)
+{
+ JVM_LINE_NUMBER_TABLE_ENTRY *tmp;
+
+ if(!meth || !instr) {
+ BAD_ARG();
+ return -1;
+ }
+
+ tmp = (JVM_LINE_NUMBER_TABLE_ENTRY *) malloc(sizeof(JVM_LINE_NUMBER_TABLE_ENTRY));
+
+ if(!tmp) return -1;
+
+ tmp->op = instr;
+ tmp->line_number = lnum;
+
+ dl_insert_b(meth->line_table, tmp);
+
+ return 0;
+}
+
+/**
+ * Creates a new exception table entry. The exception table entry
+ * represents the range of instructions for which the given exception
+ * should be trapped.
+ *
+ * @param meth -- The method containing the following instructions.
+ * @param from -- The first instruction from which the exception should be
+ * caught.
+ * @param to -- The last instruction to which the exception applies.
+ * @param target -- The first instruction of the catch block. This is where
+ * the JVM branches when the exception is caught.
+ * @param exc_class -- The name of the exception class which should be caught.
+ *
+ * @returns The exception table entry.
+ */
+
+JVM_EXCEPTION_TABLE_ENTRY *
+bc_new_exception_table_entry(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *from,
+ JVM_CODE_GRAPH_NODE * to, JVM_CODE_GRAPH_NODE * target, char *exc_class)
+{
+ JVM_EXCEPTION_TABLE_ENTRY *new_et;
+
+ if(!meth || !from || !to || !target) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ new_et = (JVM_EXCEPTION_TABLE_ENTRY *)malloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY));
+
+ if(!new_et) return NULL;
+
+ new_et->from = from;
+ new_et->to = to;
+ new_et->target = target;
+
+ /* check if the exception type was specified, then insert an entry
+ * in the constant pool if necessary and set the catch_type field.
+ * otherwise it should be set to 0.
+ */
+
+ if(exc_class) {
+ char *etmp;
+ int c;
+
+ etmp = char_substitute(exc_class, '.', '/');
+ if(!etmp) {
+ free(new_et);
+ return NULL;
+ }
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, etmp);
+
+ free(etmp);
+
+ if(c < 0) {
+ free(new_et);
+ return NULL;
+ }
+
+ new_et->catch_type = c;
+ }
+ else
+ new_et->catch_type = 0;
+
+ return new_et;
+}
+
+/**
+ * Adds the specified exception table entry to the specified method.
+ *
+ * @param meth -- The method to which the exception table entry should be
+ * added.
+ * @param et_entry -- The exception table entry to add to this method.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_exception_handler(JVM_METHOD *meth,
+ JVM_EXCEPTION_TABLE_ENTRY *et_entry)
+{
+ if(!meth || !et_entry) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_insert_b(meth->exc_table, et_entry);
+
+ return 0;
+}
+
+/**
+ * Returns a new code graph node initialized with the given opcode, operand,
+ * and pc.
+ *
+ * @param meth -- The method containing the instruction.
+ * @param op -- The opcode of the instruction.
+ * @param operand -- The instruction's operand.
+ *
+ * @returns The new code graph node with this opcode.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_new_graph_node(JVM_METHOD *meth, JVM_OPCODE op, u4 operand)
+{
+ JVM_CODE_GRAPH_NODE *tmp;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ tmp = (JVM_CODE_GRAPH_NODE *)malloc(sizeof(JVM_CODE_GRAPH_NODE));
+
+ if(!tmp) return NULL;
+
+ tmp->op = op;
+ tmp->operand = operand;
+ tmp->width = bc_op_width(op);
+
+ /* set pc and branch targets later */
+ tmp->pc = meth->pc;
+ tmp->branch_target = NULL;
+ tmp->next = NULL;
+ tmp->branch_label = NULL;
+ tmp->stack_depth = -1;
+ tmp->visited = FALSE;
+
+ return tmp;
+}
+
+/**
+ * Creates a new method structure with the given access flags.
+ *
+ * @param cclass -- The class to which the new method should be added.
+ * @param name -- The name of the method.
+ * @param desc -- The method descriptor. This can be NULL initially but
+ * the method descriptor must be set before calling bc_write_class().
+ * @param flags -- The access flags for the method.
+ *
+ * @returns Pointer to the new method structure.
+ * Returns NULL on error.
+ */
+
+JVM_METHOD *
+bc_new_method(JVM_CLASS *cclass, char *name, char *desc, unsigned int flags)
+{
+ JVM_METHOD *meth;
+ int lv_start;
+ int c;
+ u2 acc;
+
+ if(!cclass || !name) {
+ BAD_ARG();
+ return NULL;
+ }
+
+#define err_new_meth() \
+ if(meth && meth->name) free(meth->name); \
+ free(meth);
+
+ acc = (u2) flags;
+
+ if((unsigned int)acc != flags)
+ debug_err("Warning: possible truncation in bc_new_method.\n");
+
+ meth = (JVM_METHOD *)malloc(sizeof(JVM_METHOD));
+
+ if(!meth) return NULL;
+
+ meth->access_flags = acc;
+
+ meth->class = cclass;
+
+ meth->gen_bytecode = TRUE;
+
+ /* if this is a static method, then local variables are numbered
+ * starting at 0, otherwise they start at 1.
+ */
+
+ if(acc & JVM_ACC_STATIC)
+ lv_start = 0;
+ else
+ lv_start = 1;
+
+ debug_msg("access flags = %d\n", flags);
+
+ meth->name = strdup(name);
+
+ if(!meth->name) {
+ err_new_meth();
+ return NULL;
+ }
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, name);
+
+ if(c < 0) {
+ err_new_meth();
+ return NULL;
+ }
+
+ meth->name_index = c;
+
+ if(desc) {
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, desc);
+
+ if(c < 0) {
+ err_new_meth();
+ return NULL;
+ }
+
+ meth->descriptor_index = c;
+
+ /* if there was a descriptor specified, then go ahead and
+ * set the current local and maximum variable numbers.
+ */
+
+ meth->cur_local_number = lv_start + num_locals_in_descriptor(desc);
+ meth->max_locals = meth->cur_local_number;
+ }
+ else {
+ /* no descriptor specified yet. we will rely on the user to set
+ * it later. for now set the index to 0 which should cause a
+ * verification error in case the user forgets to set a proper
+ * descriptor index.
+ */
+
+ meth->descriptor_index = 0;
+ meth->cur_local_number = 1;
+ meth->max_locals = 1;
+ }
+
+ meth->attributes = make_dl();
+ meth->attributes_count = 0;
+
+ meth->cur_code = new_code_attr(cclass);
+
+ meth->line_table = make_dl();
+ meth->locals_table = make_dl();
+ meth->label_list = make_dl();
+ meth->exc_table = make_dl();
+
+ if(!meth->attributes || !meth->line_table || !meth->locals_table ||
+ !meth->label_list || !meth->exc_table)
+ {
+ if(meth->attributes) dl_delete_list(meth->attributes);
+ if(meth->line_table) dl_delete_list(meth->line_table);
+ if(meth->locals_table) dl_delete_list(meth->locals_table);
+ if(meth->label_list) dl_delete_list(meth->label_list);
+ if(meth->exc_table) dl_delete_list(meth->exc_table);
+
+ if(meth->cur_code)
+ bc_free_code_attribute(cclass, meth->cur_code);
+
+ meth->attributes = NULL;
+ meth->line_table = NULL;
+ meth->locals_table = NULL;
+ meth->label_list = NULL;
+ meth->exc_table = NULL;
+ meth->cur_code = NULL;
+
+ err_new_meth();
+ return NULL;
+ }
+
+ meth->lastOp = jvm_nop;
+
+ meth->stacksize = meth->pc = meth->num_handlers = 0;
+
+ cclass->methods_count++;
+ dl_insert_b(cclass->methods, meth);
+
+ return meth;
+}
+
+/**
+ * Removes the specified method from its containing class.
+ *
+ * @param meth -- The method to be removed.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_remove_method(JVM_METHOD *meth)
+{
+ JVM_METHOD *tmpmeth;
+ Dlist tmpPtr;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(tmpPtr,meth->class->methods) {
+ tmpmeth = (JVM_METHOD *) tmpPtr->val;
+
+ if(tmpmeth == meth) {
+ meth->class->methods_count--;
+ dl_delete_node(tmpPtr);
+ return 0;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Gets the number of bytes of code in this method.
+ *
+ * @param meth -- The method whose length should be returned.
+ *
+ * @returns The code length (in bytes). Returns -1 on failure.
+ */
+
+int
+bc_get_code_length(JVM_METHOD *meth)
+{
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ return meth->pc;
+}
+
+/**
+ * Gets the instruction following this instruction.
+ *
+ * @param node -- Pointer to an instruction node.
+ *
+ * @returns The next instruction.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_get_next_instr(JVM_CODE_GRAPH_NODE *node)
+{
+ if(!node) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return node->next;
+}
+
+/**
+ * Sets the stack depth at the given instruction. Most of the
+ * time it won't be necessary to use this call, however there
+ * may be some exceptional circumstances that require manually
+ * setting the stack depth.
+ *
+ * @param node -- The instruction node for which the stack depth
+ * should be set.
+ * @param depth -- The depth in number of stack entries.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_stack_depth(JVM_CODE_GRAPH_NODE *node, int depth)
+{
+ if(!node) {
+ BAD_ARG();
+ return -1;
+ }
+
+ node->stack_depth = depth;
+ return 0;
+}
+
+/**
+ * Gets the last opcode in the given method.
+ *
+ * @param meth -- Pointer to a method structure.
+ *
+ * @returns The last opcode (see the JVM_OPCODE enum). Returns -1 on failure.
+ */
+
+JVM_OPCODE
+bc_get_last_opcode(JVM_METHOD *meth)
+{
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ return meth->lastOp;
+}
+
+/**
+ * Sets the method descriptor index in the specified method. This would be
+ * useful in situations where you don't know the descriptor when the method
+ * is first created.
+ *
+ * @param meth -- The method whose descriptor should be set.
+ * @param desc -- The method descriptor.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_method_descriptor(JVM_METHOD *meth, char *desc)
+{
+ int c;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ if(desc) {
+ c = cp_find_or_insert(meth->class, CONSTANT_Utf8, desc);
+
+ if(c < 0)
+ return -1;
+
+ meth->descriptor_index = c;
+ }
+
+ return 0;
+}
+
+/**
+ * Creates a new local variable table attribute.
+ *
+ * @param meth -- The method which will contain the local variable table.
+ *
+ * @returns Pointer to the new local variable table attribute.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_local_variable_table_attr(JVM_METHOD *meth)
+{
+ JVM_ATTRIBUTE * tmp;
+ int c;
+ Dlist list_tmp, entries, const_table;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ const_table = meth->class->constant_pool;
+ entries = meth->locals_table;
+
+ tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Utf8, "LocalVariableTable");
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attribute_name_index = c;
+
+ tmp->attribute_length = 0;
+ tmp->attr.LocalVariableTable = (struct LocalVariableTable_attribute *)
+ malloc(sizeof(struct LocalVariableTable_attribute));
+
+ if(!tmp->attr.LocalVariableTable) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attr.LocalVariableTable->local_variable_table_length = 0;
+
+ dl_traverse(list_tmp, entries) {
+ JVM_LOCAL_VARIABLE_TABLE_ENTRY *entry;
+
+ entry = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *)list_tmp->val;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Utf8, entry->name);
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ entry->name_index = c;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Utf8, entry->descriptor);
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ entry->descriptor_index = c;
+
+ if(!entry->end)
+ entry->end = dl_last(meth->cur_code->attr.Code->code)->val;
+
+ tmp->attr.LocalVariableTable->local_variable_table_length++;
+ }
+
+ /* each local var table entry is 10 bytes, plus 2 bytes for the length */
+ tmp->attribute_length =
+ (tmp->attr.LocalVariableTable->local_variable_table_length * 10) + 2;
+
+ tmp->attr.LocalVariableTable->local_variable_table = entries;
+
+ return tmp;
+}
+
+/**
+ * Creates a new line number table attribute.
+ *
+ * @param meth -- The method which will contain the line number table.
+ *
+ * @returns Pointer to the new line number table attribute.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_line_number_table_attr(JVM_METHOD *meth)
+{
+ JVM_ATTRIBUTE * tmp;
+ int c;
+ Dlist list_tmp, entries;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ entries = meth->line_table;
+
+ tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Utf8, "LineNumberTable");
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attribute_name_index = c;
+
+ tmp->attribute_length = 0;
+ tmp->attr.LineNumberTable = (struct LineNumberTable_attribute *)
+ malloc(sizeof(struct LineNumberTable_attribute));
+
+ if(!tmp->attr.LineNumberTable) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attr.LineNumberTable->line_number_table_length = 0;
+
+ dl_traverse(list_tmp, entries) {
+ tmp->attr.LineNumberTable->line_number_table_length++;
+ }
+
+ /* each line number table entry is 4 bytes, plus 2 bytes for the length */
+ tmp->attribute_length =
+ (tmp->attr.LineNumberTable->line_number_table_length * 4) + 2;
+
+ tmp->attr.LineNumberTable->line_number_table = entries;
+
+ return tmp;
+}
+
+/**
+ * Creates a new attribute structure and initializes the
+ * Exception_attribute section with some initial values.
+ *
+ * @param cclass -- The class which will contain the attribute.
+ *
+ * @returns Pointer to the new exceptions attribute.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_exceptions_attr(JVM_CLASS *cclass)
+{
+ JVM_ATTRIBUTE * tmp;
+ int c;
+
+ if(!cclass) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, "Exceptions");
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attribute_name_index = c;
+
+ tmp->attr.Exceptions = (struct Exceptions_attribute *)
+ malloc(sizeof(struct Exceptions_attribute));
+
+ if(!tmp->attr.Exceptions) {
+ free(tmp);
+ return NULL;
+ }
+
+ /* initially the attribute length is 2 which covers the size of the
+ * 2-byte length field.
+ */
+
+ tmp->attribute_length = 2;
+ tmp->attr.Exceptions->number_of_exceptions = (u2) 0;
+ tmp->attr.Exceptions->exception_index_table = make_dl();
+
+ if(!tmp->attr.Exceptions->exception_index_table) {
+ free(tmp->attr.Exceptions);
+ free(tmp);
+ return NULL;
+ }
+
+ return tmp;
+}
+
+/**
+ * Creates a new InnerClasses attribute structure.
+ *
+ * @param cclass -- The class which will contain the attribute.
+ *
+ * @returns Pointer to the new InnerClasses attribute.
+ * Returns NULL on error.
+ */
+
+JVM_ATTRIBUTE *
+bc_new_inner_classes_attr(JVM_CLASS *cclass)
+{
+ JVM_ATTRIBUTE * tmp;
+ int c;
+
+ if(!cclass) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, "InnerClasses");
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attribute_name_index = c;
+
+ tmp->attr.InnerClasses = (struct InnerClasses_attribute *)
+ malloc(sizeof(struct InnerClasses_attribute));
+
+ if(!tmp->attr.InnerClasses) {
+ free(tmp);
+ return NULL;
+ }
+
+ /* initially the attribute length is 2 which covers the size of the
+ * 2-byte length field.
+ */
+
+ tmp->attribute_length = 2;
+ tmp->attr.InnerClasses->number_of_classes = (u2) 0;
+ tmp->attr.InnerClasses->classes = make_dl();
+
+ if(!tmp->attr.InnerClasses->classes) {
+ free(tmp->attr.InnerClasses);
+ free(tmp);
+ return NULL;
+ }
+
+ return tmp;
+}
+
+/**
+ * This function 'releases' a local variable. That is, calling this
+ * function signifies that we no longer need this local variable.
+ *
+ * @param meth -- The method containing the local variable.
+ * @param vtype -- The JVM data type of the variable (see the JVM_DATA_TYPE
+ * enum).
+ *
+ * @returns The current local variable number. Returns -1 on error.
+ */
+
+int
+bc_release_local(JVM_METHOD *meth, JVM_DATA_TYPE vtype)
+{
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ if((vtype == jvm_Double) || (vtype == jvm_Long))
+ meth->cur_local_number-=2;
+ else
+ meth->cur_local_number--;
+
+ return meth->cur_local_number;
+}
+
+/**
+ * This function returns the next available local variable number and
+ * updates the max if necessary.
+ *
+ * @param meth -- The method containing the local variable.
+ * @param vtype -- The JVM data type of the variable (see the JVM_DATA_TYPE
+ * enum).
+ *
+ * @returns The next local variable number. Returns -1 on error.
+ */
+
+int
+bc_get_next_local(JVM_METHOD *meth, JVM_DATA_TYPE vtype)
+{
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ if((vtype == jvm_Double) || (vtype == jvm_Long))
+ meth->cur_local_number+=2;
+ else
+ meth->cur_local_number++;
+
+ if(meth->cur_local_number > meth->max_locals)
+ meth->max_locals = meth->cur_local_number;
+
+ return meth->cur_local_number -
+ (((vtype == jvm_Double) || (vtype == jvm_Long)) ? 2 : 1);
+}
+
+/**
+ * Sets the current local variable number for this method. If the new value
+ * is greater than the current maximum number of locals, then the max_locals
+ * field is set also.
+ *
+ * @param meth -- The method whose local variable number should be set.
+ * @param curlocal -- The current local variable number.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_cur_local_num(JVM_METHOD *meth, unsigned int curlocal) {
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ meth->cur_local_number = curlocal;
+
+ if(curlocal > meth->max_locals)
+ meth->max_locals = curlocal;
+
+ return 0;
+}
+
+/**
+ * Allow suspending the generation of bytecode for situations in which the
+ * code generation ordering is very different between java source and JVM
+ * bytecode.
+ *
+ * @param meth -- The method to suspend/enable bytecode generation.
+ * @param value -- If TRUE, calls which generate code (e.g. bc_append())
+ * will actually add the instructions to the code graph. If FALSE, you
+ * can still call these routines, but they will have no effect.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_gen_status(JVM_METHOD *meth, BOOL value) {
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ meth->gen_bytecode = value;
+ return 0;
+}
+
+/**
+ * Creates the bytecode for a new default constructor and adds it to the
+ * given class.
+ *
+ * @param cur_class -- The class for which the default constructor should
+ * be created.
+ * @param acc_flag -- The access flags for the constructor (for example
+ * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc)
+ *
+ * @returns Pointer to the new constructor (a JVM_METHOD structure).
+ * Returns NULL on error.
+ */
+
+JVM_METHOD *
+bc_add_default_constructor(JVM_CLASS *cur_class, u2 acc_flag)
+{
+ JVM_METHOD *meth_tmp;
+ char *cur_sc;
+ CP_NODE *c;
+ int idx;
+
+ if(!cur_class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ c = cp_entry_by_index(cur_class, cur_class->super_class);
+
+ if(!c) return NULL;
+
+ c = cp_entry_by_index(cur_class, c->val->cpnode.Class.name_index);
+
+ if(!c) return NULL;
+
+ cur_sc = cp_null_term_utf8(c->val);
+
+ if(!cur_sc) return NULL;
+
+ meth_tmp = bc_new_method(cur_class, "<init>", "()V", acc_flag);
+
+ if(!meth_tmp) {
+ free(cur_sc);
+ return NULL;
+ }
+
+ idx = bc_new_methodref(cur_class, cur_sc, "<init>", "()V");
+
+ if(idx < 0) {
+ free(cur_sc);
+ return NULL;
+ }
+
+ bytecode0(meth_tmp, jvm_aload_0);
+ bytecode1(meth_tmp, jvm_invokespecial, idx);
+ bytecode0(meth_tmp, jvm_return);
+
+ bc_set_cur_local_num(meth_tmp, 1);
+
+ free(cur_sc);
+
+ return meth_tmp;
+}
+
+/**
+ * Creates bytecode for a new multi dimensional array.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param dimensions -- The number of dimensions to be created.
+ * @param desc -- The descriptor of the array.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_new_multi_array(JVM_METHOD *meth, u4 dimensions, char *desc)
+{
+ u4 operand;
+ int c;
+
+ if(!meth || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, desc);
+
+ if(c < 0) return NULL;
+
+ operand = (c<<8) | dimensions;
+ return bytecode1(meth, jvm_multianewarray, operand);
+}
+
+/**
+ * Generates an instruction to load the specified field onto the
+ * stack (jvm_getfield).
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class containing the field.
+ * @param field -- The field name.
+ * @param desc -- The field descriptor.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_get_field(JVM_METHOD *meth, char *class, char *field, char *desc)
+{
+ int field_idx;
+
+ if(!meth || !class || !field || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ field_idx = bc_new_fieldref(meth->class, class, field, desc);
+
+ if(field_idx < 0) return NULL;
+
+ return bytecode1(meth, jvm_getfield, field_idx);
+}
+
+/**
+ * Generates an instruction to store the top stack value to the
+ * specified field (jvm_putfield).
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class containing the field.
+ * @param field -- The field name.
+ * @param desc -- The field descriptor.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_put_field(JVM_METHOD *meth, char *class, char *field, char *desc)
+{
+ int field_idx;
+
+ if(!meth || !class || !field || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ field_idx = bc_new_fieldref(meth->class, class, field, desc);
+
+ if(field_idx < 0) return NULL;
+
+ return bytecode1(meth, jvm_putfield, field_idx);
+}
+
+/**
+ * Generates an instruction to load the specified static field onto the
+ * stack (jvm_getstatic).
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class containing the field.
+ * @param field -- The field name.
+ * @param desc -- The field descriptor.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_get_static(JVM_METHOD *meth, char *class, char *field, char *desc)
+{
+ int field_idx;
+
+ if(!meth || !class || !field || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ field_idx = bc_new_fieldref(meth->class, class, field, desc);
+
+ if(field_idx < 0) return NULL;
+
+ return bytecode1(meth, jvm_getstatic, field_idx);
+}
+
+/**
+ * Generates an instruction to store the top stack value to the
+ * specified static field (jvm_putstatic).
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class containing the field.
+ * @param field -- The field name.
+ * @param desc -- The field descriptor.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_put_static(JVM_METHOD *meth, char *class, char *field, char *desc)
+{
+ int field_idx;
+
+ if(!meth || !class || !field || !desc) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ field_idx = bc_new_fieldref(meth->class, class, field, desc);
+
+ if(field_idx < 0) return NULL;
+
+ return bytecode1(meth, jvm_putstatic, field_idx);
+}
+
+/**
+ * Generates an "instanceof" instruction which determines whether the
+ * operand on top of the stack is an instance of the specified class.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class which the object might be an
+ * instance of.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_instanceof(JVM_METHOD *meth, char *class)
+{
+ int c;
+
+ if(!meth || !class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, class);
+
+ if(c < 0) return NULL;
+
+ return bytecode1(meth, jvm_instanceof, c);
+}
+
+/**
+ * Generates a "checkcast" instruction which determines whether the
+ * operand on top of the stack is of the specified type.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param class -- The name of the class which might be the object's type.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_checkcast(JVM_METHOD *meth, char *class)
+{
+ int c;
+
+ if(!meth || !class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, class);
+
+ if(c < 0) return NULL;
+
+ return bytecode1(meth, jvm_checkcast, c);
+}
+
+/**
+ * Generates a switch instruction. This will either be a "tableswitch" or
+ * a "lookupswitch" depending on how many empty cases there are after all
+ * cases have been specified. When most of the cases are specified, then
+ * the "tableswitch" instruction is used, but if the switch is more sparsely
+ * filled with cases, the "lookupswitch" would use less space. The value
+ * defined for JVM_SWITCH_FILL_THRESH in bytecode.h determines how many empty
+ * cases there must be before the "lookupswitch" is used.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_switch(JVM_METHOD *meth) {
+ JVM_CODE_GRAPH_NODE *instr;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ instr = bytecode0(meth, jvm_tableswitch);
+
+ instr->switch_info =
+ (JVM_SWITCH_INFO *)malloc(sizeof(JVM_SWITCH_INFO));
+
+ if(!instr->switch_info) return NULL;
+
+ /* we will calculate the cell padding, and low/high case numbers later */
+
+ instr->switch_info->cell_padding = 0;
+ instr->switch_info->low = 0;
+ instr->switch_info->high = 0;
+
+ instr->switch_info->offsets = make_dl();
+ instr->switch_info->num_entries = 0;
+
+ if(!instr->switch_info->offsets) {
+ free(instr->switch_info);
+ return NULL;
+ }
+
+ /* the width is unknown at this time, but it doesn't matter because
+ * the real width will be calculated later.
+ */
+ instr->width = bc_op_width(jvm_tableswitch);
+
+ return instr;
+}
+
+/**
+ * Adds another case to the given switch instruction.
+ *
+ * @param instr -- The node of the switch instruction.
+ * @param target -- The node of the first instruction in the case to be added.
+ * @param case_num -- The integer corresponding to this case.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_switch_case(JVM_CODE_GRAPH_NODE *instr, JVM_CODE_GRAPH_NODE *target,
+ int case_num)
+{
+ JVM_SWITCH_ENTRY *newcase;
+
+ if(!instr || !target) {
+ BAD_ARG();
+ return -1;
+ }
+
+ if(dl_empty(instr->switch_info->offsets)) {
+ instr->switch_info->low = case_num;
+ instr->switch_info->high = case_num;
+ }
+ else {
+ if(case_num < instr->switch_info->low)
+ instr->switch_info->low = case_num;
+
+ if(case_num > instr->switch_info->high)
+ instr->switch_info->high = case_num;
+ }
+
+ newcase = (JVM_SWITCH_ENTRY *)malloc(sizeof(JVM_SWITCH_ENTRY));
+
+ if(!newcase) return -1;
+
+ newcase->instr = target;
+ newcase->case_num = case_num;
+
+ dl_insert_b(instr->switch_info->offsets, newcase);
+
+ instr->switch_info->num_entries++;
+
+ return 0;
+}
+
+/**
+ * Specifies the default case for the given switch instruction.
+ *
+ * @param instr -- The node of the switch instruction.
+ * @param target -- The node of the first instruction in the default
+ * case to be added.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_add_switch_default(JVM_CODE_GRAPH_NODE *instr, JVM_CODE_GRAPH_NODE *target)
+{
+ if(!instr || !target) {
+ BAD_ARG();
+ return -1;
+ }
+
+ instr->switch_info->default_case = target;
+
+ return 0;
+}
+
+/**
+ * Sets the branch target of a JVM_CODE_GRAPH_NODE (that is, which instruction
+ * this instruction branches to, either conditionally or unconditionally).
+ *
+ * @param node -- The node of the conditional or unconditional branching
+ * instruction.
+ * @param target -- The target of the branch instruction.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_branch_target(JVM_CODE_GRAPH_NODE *node, JVM_CODE_GRAPH_NODE *target)
+{
+ if(!node || !target) {
+ BAD_ARG();
+ return -1;
+ }
+
+ node->branch_target = target;
+
+ return 0;
+}
+
+/**
+ * Sets the label to which this instruction branches. This is used
+ * when implementing languages which can branch forward to labeled
+ * statements. Thus the forward instruction does not need to have been
+ * emitted when the branch target is set. Later the address will be
+ * resolved.
+ *
+ * @param node -- The node of the branch instruction.
+ * @param label -- The label to which the instruction branches.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_branch_label(JVM_CODE_GRAPH_NODE *node, const char *label)
+{
+ if(!node || !label) {
+ BAD_ARG();
+ return -1;
+ }
+
+ node->branch_label = strdup(label);
+
+ if(!node->branch_label) return -1;
+
+ return 0;
+}
+
+/**
+ * Same as bc_set_branch_label() except that the label is specified
+ * as an integer instead of a string.
+ *
+ * @param node -- The node of the branch instruction.
+ * @param label -- The label to which the instruction branches.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *node, int label_num)
+{
+ char label[20];
+
+ if(!node) {
+ BAD_ARG();
+ return -1;
+ }
+
+ sprintf(label, "%d", label_num);
+
+ return bc_set_branch_label(node, label);
+}
+
+
+/**
+ * Generates an iinc instruction. First check if the iinc needs to be
+ * preceeded by a jvm_wide opcode and generate that if necessary. The wide
+ * instruction is required if the local variable index or the immediate
+ * operand would exceed a one-byte value.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param idx -- The index of the local variable to be incremented.
+ * @param inc_const -- The constant value to add to the specified local variable.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_iinc(JVM_METHOD *meth, unsigned int idx, int inc_const)
+{
+ unsigned int operand;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ if((idx > 255) || (inc_const < -128) || (inc_const > 127)) {
+ bytecode0(meth, jvm_wide);
+ operand = ((idx & 0xFFFF) << 16) | ((u2)inc_const & 0xFFFF);
+ }
+ else
+ operand = ((idx & 0xFF) << 8) | (inc_const & 0xFF);
+
+ return bytecode1(meth, jvm_iinc, operand);
+}
+
+/**
+ * This function returns a pointer to the next field type in this descriptor.
+ *
+ * @param str -- The descriptor to be parsed.
+ *
+ * @returns Pointer to the beginning of the next field in the descriptor.
+ * If there are no more field types this function returns NULL. On error,
+ * this function also returns NULL.
+ */
+
+char *
+bc_next_desc_token(char *str)
+{
+ char *p = str;
+
+ if(!str) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ switch(*p) {
+ case 'B': case 'C': case 'D': case 'F':
+ case 'I': case 'J': case 'S': case 'Z':
+ return p+1;
+
+ case 'L':
+ while((*p != ';') && (*p != '\0'))
+ p++;
+
+ if(*p == '\0') {
+ debug_err("bc_next_desc_token() incomplete classname in desc\n");
+ return NULL;
+ }
+
+ return p+1;
+
+ case '[':
+ return bc_next_desc_token(p+1);
+
+ case '(':
+ /* we should hit this case at the beginning of the descriptor */
+ return p+1;
+
+ case ')':
+ return NULL;
+
+ default:
+ debug_err("bc_next_desc_token() unrecognized char in desc:%s\n",str);
+ return NULL;
+ }
+
+ /* should never reach here */
+}
+
+/**
+ * Generates a return instruction. This can be used in a generic way
+ * and when the class is emitted, the proper type-specific return
+ * instruction is generated based on the method descriptor.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_return(JVM_METHOD *meth)
+{
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return bytecode0(meth, jvm_return);
+}
+
+/**
+ * Pushes an integer constant onto the stack. The exact instruction
+ * generated depends on the value of the constant (sipush, bipush, etc).
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param ival -- The integer constant to be loaded.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_int_const(JVM_METHOD *meth, int ival)
+{
+ JVM_CODE_GRAPH_NODE *node = NULL;
+ int ct;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ ct = cp_find_or_insert(meth->class, CONSTANT_Integer, (void*)&ival);
+
+ if(ct >= 0) {
+ if(ct > CP_IDX_MAX)
+ node = bytecode1(meth, jvm_ldc_w,ct);
+ else
+ node = bytecode1(meth, jvm_ldc,ct);
+ } else { /* not found, use literal */
+ if((ival < JVM_SHORT_MIN) || (ival > JVM_SHORT_MAX)) {
+ debug_err("WARNING:expr_emit() bad int literal: %d\n", ival);
+ return NULL;
+ }
+ else if((ival < JVM_BYTE_MIN) || (ival > JVM_BYTE_MAX))
+ node = bytecode1(meth, jvm_sipush, ival);
+ else if((ival < JVM_ICONST_MIN) || (ival > JVM_ICONST_MAX))
+ node = bytecode1(meth, jvm_bipush, ival);
+ else
+ node = bytecode0(meth, jvm_iconst_op[ival+1]);
+ }
+
+ return node;
+}
+
+/**
+ * Pushes a null object value onto the stack.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_null_const(JVM_METHOD *meth)
+{
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return bytecode0(meth, jvm_aconst_null);
+}
+
+/**
+ * Pushes a float constant onto the stack.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param fval -- The floating point value to be loaded.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_float_const(JVM_METHOD *meth, float fval)
+{
+ JVM_CODE_GRAPH_NODE *node = NULL;
+ int ct;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ ct = cp_find_or_insert(meth->class, CONSTANT_Float, (void*)&fval);
+
+ if(ct >= 0) {
+ if(ct > CP_IDX_MAX)
+ node = bytecode1(meth, jvm_ldc_w,ct);
+ else
+ node = bytecode1(meth, jvm_ldc,ct);
+ }
+ else if(fval == 0.0)
+ node = bytecode0(meth, jvm_fconst_0);
+ else if(fval == 1.0)
+ node = bytecode0(meth, jvm_fconst_1);
+ else if(fval == 2.0)
+ node = bytecode0(meth, jvm_fconst_2);
+ else
+ debug_err("bc_push_float_const(): bad float precision literal\n");
+
+ return node;
+}
+
+/**
+ * Pushes a double constant onto the stack.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param dval -- The double precision floating point value to be loaded.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_double_const(JVM_METHOD *meth, double dval)
+{
+ JVM_CODE_GRAPH_NODE *node = NULL;
+ int ct;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ ct = cp_find_or_insert(meth->class, CONSTANT_Double, (void*)&dval);
+
+ if(ct >= 0)
+ node = bytecode1(meth, jvm_ldc2_w, ct);
+ else if(dval == 0.0)
+ node = bytecode0(meth, jvm_dconst_0);
+ else if(dval == 1.0)
+ node = bytecode0(meth, jvm_dconst_1);
+ else
+ debug_err("bc_push_double_const(): bad double precision literal\n");
+
+ return node;
+}
+
+/**
+ * Pushes a long constant onto the stack.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param lval -- The long constant to be loaded.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_long_const(JVM_METHOD *meth, long long lval)
+{
+ JVM_CODE_GRAPH_NODE *node = NULL;
+ int ct;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ ct = cp_find_or_insert(meth->class, CONSTANT_Long, (void*)&lval);
+
+ if(ct >= 0)
+ node = bytecode1(meth, jvm_ldc2_w, ct);
+ else if(lval == 0)
+ node = bytecode0(meth, jvm_lconst_0);
+ else if(lval == 1)
+ node = bytecode0(meth, jvm_lconst_1);
+ else
+ debug_err("bc_push_long_const(): bad literal\n");
+
+ return node;
+}
+
+/**
+ * Pushes a string constant onto the stack.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param str -- The string value to be loaded.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_push_string_const(JVM_METHOD *meth, char *str)
+{
+ JVM_CODE_GRAPH_NODE *node = NULL;
+ int ct;
+
+ if(!meth || !str) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ ct = cp_find_or_insert(meth->class, CONSTANT_String, (void*)str);
+
+ if(ct < 0) return NULL;
+
+ if(ct > CP_IDX_MAX)
+ node = bytecode1(meth, jvm_ldc_w, ct);
+ else
+ node = bytecode1(meth, jvm_ldc, ct);
+
+ return node;
+}
+
+/**
+ * This function searches the list of nodes for the given PC. Returns the
+ * node if found, otherwise NULL. This is not very efficient - we should
+ * probably modify it eventually if it becomes an issue.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param num -- The address of the node to find.
+ *
+ * @returns Pointer to the instruction node with the specified address.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_node_at_pc(JVM_METHOD *meth, int num)
+{
+ JVM_CODE_GRAPH_NODE *nodeptr;
+ Dlist tmp;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ dl_traverse(tmp, meth->cur_code->attr.Code->code) {
+ nodeptr = (JVM_CODE_GRAPH_NODE *)tmp->val;
+ if(nodeptr->pc == (unsigned int)num)
+ return nodeptr;
+ if(nodeptr->pc > (unsigned int)num)
+ return NULL;
+ }
+
+ return NULL;
+}
+
+/**
+ * Get the width of the specified op.
+ *
+ * @param op -- The op to return the length of.
+ *
+ * @returns The width in bytes of this op, including operands.
+ */
+
+u1
+bc_op_width(JVM_OPCODE op)
+{
+ return jvm_opcode[op].width;
+}
+
+/**
+ * Given the local variable number, this function generates a store opcode
+ * to store a value to the local var.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param lvnum -- The local variable number to which the value should
+ * be stored.
+ * @param rt -- The JVM data type of the local variable (see the enumeration
+ * JVM_DATA_TYPE).
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_store_op(JVM_METHOD *meth, unsigned int lvnum,
+ JVM_DATA_TYPE rt)
+{
+ JVM_CODE_GRAPH_NODE *node;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ if(lvnum > 255) {
+ node = bytecode0(meth, jvm_wide);
+ bytecode1(meth, jvm_store_op[rt], lvnum);
+ }
+ else if(lvnum <= 3)
+ node = bytecode0(meth, jvm_short_store_op[rt][lvnum]);
+ else
+ node = bytecode1(meth, jvm_store_op[rt], lvnum);
+
+ updateMaxLocals(meth, lvnum, rt);
+
+ return node;
+}
+
+/**
+ * Given the local variable number, this function generates a load opcode
+ * to load a value from the local var.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param lvnum -- The local variable from which the value should be loaded.
+ * @param rt -- The JVM data type of the local variable (see the enumeration
+ * JVM_DATA_TYPE).
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_load_op(JVM_METHOD *meth, unsigned int lvnum,
+ JVM_DATA_TYPE rt)
+{
+ JVM_CODE_GRAPH_NODE *node;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ if(lvnum > 255) {
+ node = bytecode0(meth, jvm_wide);
+ bytecode1(meth, jvm_load_op[rt], lvnum);
+ }
+ else if(lvnum <= 3)
+ node = bytecode0(meth, jvm_short_load_op[rt][lvnum]);
+ else
+ node = bytecode1(meth, jvm_load_op[rt], lvnum);
+
+ updateMaxLocals(meth, lvnum, rt);
+
+ return node;
+}
+
+/**
+ * This function generates a load opcode to load a value from an array.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param rt -- The JVM data type of the array (see the enumeration
+ * JVM_DATA_TYPE).
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_array_load_op(JVM_METHOD *meth, JVM_DATA_TYPE rt)
+{
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return bytecode0(meth, jvm_array_load_op[rt]);
+}
+
+/**
+ * This function generates a store opcode to store a value to an array.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param rt -- The JVM data type of the array (see the enumeration
+ * JVM_DATA_TYPE).
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_array_store_op(JVM_METHOD *meth, JVM_DATA_TYPE rt)
+{
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return bytecode0(meth, jvm_array_store_op[rt]);
+}
+
+/**
+ * Generates an instruction to create a new object of the specified class.
+ * Note: this does not completely create a new instance. For that, you will
+ * still need to call the constructor.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param classname -- The name of the class to be created.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_new_obj(JVM_METHOD *meth, char *classname)
+{
+ int c;
+ char *class;
+
+ if(!meth || !classname) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ class = char_substitute(classname, '.', '/');
+
+ if(!class) return NULL;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, class);
+
+ free(class);
+
+ if(c < 0) return NULL;
+
+ return bc_append(meth, jvm_new, c);
+}
+
+/**
+ * Generates two instructions. The first creates a new object of the
+ * specified class. The second instruction duplicates the new object.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param classname -- The name of the class to be created.
+ *
+ * @returns Pointer to the instruction node (the first instruction).
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_new_obj_dup(JVM_METHOD *meth, char *classname)
+{
+ JVM_CODE_GRAPH_NODE *newobj;
+
+ if(!meth || !classname) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ newobj = bc_gen_new_obj(meth, classname);
+
+ if(!newobj) return NULL;
+
+ bc_append(meth, jvm_dup);
+
+ return newobj;
+}
+
+/**
+ * Generates a sequence of instructions which completely creates a new
+ * instance of the specified class which must have a constructor with no
+ * arguments.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param classname -- The name of the class to be created.
+ *
+ * @returns Pointer to the first instruction node in the sequence (it will
+ * be the jvm_new instruction). Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_obj_instance_default(JVM_METHOD *meth, char *classname)
+{
+ JVM_CODE_GRAPH_NODE *newobj;
+ int meth_idx;
+
+ if(!meth || !classname) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ newobj = bc_gen_new_obj_dup(meth, classname);
+
+ if(!newobj) return NULL;
+
+ meth_idx = bc_new_methodref(meth->class, classname, "<init>", "()V");
+
+ if(meth_idx < 0) return NULL;
+
+ bc_append(meth, jvm_invokespecial, meth_idx);
+
+ return newobj;
+}
+
+/**
+ * Generates the instructions to create a new array for any type except
+ * objects (use bc_gen_new_object_array() for objects).
+ *
+ * This will generate an instruction to push the specified size onto the
+ * stack. If you want to omit that instruction (if you're pushing the
+ * size yourself before calling this function), then just specify -1 as
+ * the size.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param size -- The size of the array to be created (-1 to omit the
+ * instruction to push this value).
+ * @param rt -- The JVM data type of the array (see the enumeration
+ * JVM_DATA_TYPE).
+ *
+ * @returns Pointer to the first instruction node emitted. This will
+ * either be an integer load (if the size was specified) or the
+ * jvm_newarray instruction. Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_new_array(JVM_METHOD *meth, int size, JVM_DATA_TYPE rt)
+{
+ JVM_CODE_GRAPH_NODE *node, *first;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ first = NULL;
+
+ if(size >= 0)
+ first = bc_push_int_const(meth, size);
+
+ if(rt == jvm_Object)
+ debug_err(
+ "Warning: bc_gen_new_array() shouldn't be used for objects\n");
+
+ node = bytecode1(meth, jvm_newarray, jvm_newarray_type[rt]);
+
+ if(first)
+ return first;
+ else
+ return node;
+}
+
+/**
+ * Generates the instructions to create a new object array.
+ *
+ * This will push the specified size onto the stack. If you want to omit
+ * that instruction (if you're pushing the size yourself before calling this
+ * function), then just specify -1 as the size.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param size -- The size of the array to be created (-1 to omit the
+ * instruction to push this value).
+ * @param class -- The name of the class which represents the data type of
+ * the array elements.
+ *
+ * @returns Pointer to the first instruction node emitted. This will
+ * either be an integer load (if the size was specified) or the
+ * jvm_newarray instruction. Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_gen_new_object_array(JVM_METHOD *meth, int size, char *class)
+{
+ JVM_CODE_GRAPH_NODE *node, *first;
+ int c;
+ char *tmp;
+
+ if(!meth || !class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ first = NULL;
+
+ if(size >= 0)
+ first = bc_push_int_const(meth, size);
+
+ tmp = char_substitute(class, '.', '/');
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(meth->class, CONSTANT_Class, tmp);
+
+ free(tmp);
+
+ if(c < 0) return NULL;
+
+ node = bytecode1(meth, jvm_anewarray, c);
+
+ if(first)
+ return first;
+ else
+ return node;
+}
+
+/**
+ * This function creates a new method reference and inserts it into the
+ * constant pool if necessary. The return value is a pointer to the
+ * constant pool node containing the method reference.
+ *
+ * @param class -- Class containing the constant pool where this
+ * method reference will be stored.
+ * @param cname -- The name of the class.
+ * @param mname -- The name of the method.
+ * @param dnmae -- The method descriptor.
+ *
+ * @returns The constant pool index of the method reference.
+ * Returns -1 on failure.
+ */
+
+int
+bc_new_methodref(JVM_CLASS *class, char *cname, char *mname, char *dname)
+{
+ JVM_METHODREF *methodref;
+ int retval;
+
+ if(!class || !cname || !mname || !dname) {
+ BAD_ARG();
+ return -1;
+ }
+
+ methodref = bc_new_method_node(cname,mname,dname);
+
+ if(!methodref) return -1;
+
+ retval = cp_find_or_insert(class, CONSTANT_Methodref, methodref);
+
+ bc_free_fieldref(methodref);
+
+ return retval;
+}
+
+/**
+ * This function creates a new interface method reference and inserts it
+ * into the constant pool if necessary. The return value is a pointer to
+ * the constant pool node containing the interface method reference.
+ *
+ * @param class -- Class containing the constant pool where this
+ * interface reference will be stored.
+ * @param cname -- The name of the class.
+ * @param mname -- The name of the method.
+ * @param dnmae -- The method descriptor.
+ *
+ * @returns The constant pool index of the interface reference.
+ * Returns -1 on failure.
+ */
+
+int
+bc_new_interface_methodref(JVM_CLASS *class, char *cname, char *mname,
+ char *dname)
+{
+ JVM_METHODREF *interfaceref;
+ int retval;
+
+ if(!class || !cname || !mname || !dname) {
+ BAD_ARG();
+ return -1;
+ }
+
+ interfaceref = bc_new_method_node(cname,mname,dname);
+
+ if(!interfaceref) return -1;
+
+ retval = cp_find_or_insert(class, CONSTANT_InterfaceMethodref, interfaceref);
+
+ bc_free_interfaceref(interfaceref);
+
+ return retval;
+}
+
+/**
+ * This function creates a new method 'node' initialized with the given
+ * values for class name, method name, and descriptor.
+ *
+ * @param cname -- The name of the class.
+ * @param mname -- The name of the method.
+ * @param dnmae -- The method descriptor.
+ *
+ * @returns Pointer to the created method reference node.
+ */
+
+JVM_METHODREF *
+bc_new_method_node(char *cname, char *mname, char *dname)
+{
+ JVM_METHODREF *methodref;
+
+ if(!cname || !mname || !dname) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ debug_msg("%%%% new node '%s','%s','%s'\n", cname,mname,dname);
+
+ methodref = (JVM_METHODREF *)malloc(sizeof(JVM_METHODREF));
+
+ if(!methodref) return NULL;
+
+ methodref->classname = char_substitute(cname, '.', '/');
+ methodref->methodname = strdup(mname);
+ methodref->descriptor = char_substitute(dname, '.', '/');
+
+ if(!methodref->classname || !methodref->methodname || !methodref->descriptor)
+ {
+ if(methodref->classname) free(methodref->classname);
+ if(methodref->methodname) free(methodref->methodname);
+ if(methodref->descriptor) free(methodref->descriptor);
+
+ free(methodref);
+ return NULL;
+ }
+
+ return methodref;
+}
+
+/**
+ * This function creates a new reference to a name and descriptor in the
+ * constant pool.
+ *
+ * @param class -- Class containing the constant pool where this
+ * namd-and-type reference will be stored.
+ * @param name -- The name of the item.
+ * @param desc -- The descriptor of the item.
+ *
+ * @returns The constant pool index of the name-and-type reference.
+ * Returns -1 on failure.
+ */
+
+int
+bc_new_name_and_type(JVM_CLASS *class, char *name, char *desc)
+{
+ JVM_METHODREF *nameref;
+ int retval;
+
+ if(!class || !name || !desc) {
+ BAD_ARG();
+ return -1;
+ }
+
+ nameref = (JVM_METHODREF *)malloc(sizeof(JVM_METHODREF));
+
+ if(!nameref) return -1;
+
+ nameref->classname = NULL;
+ nameref->methodname = strdup(name);
+ nameref->descriptor = char_substitute(desc, '.', '/');
+
+ if(!nameref->methodname || !nameref->descriptor)
+ {
+ bc_free_nameandtype(nameref);
+ return -1;
+ }
+
+ retval = cp_find_or_insert(class, CONSTANT_NameAndType, nameref);
+
+ bc_free_nameandtype(nameref);
+
+ return retval;
+}
+
+/**
+ * This function creates a new field reference and inserts it into the
+ * constant pool if necessary. The return value is a pointer to the
+ * constant pool node containing the field reference.
+ *
+ * @param class -- Class containing the constant pool where this
+ * field reference will be stored.
+ * @param cname -- The name of the class.
+ * @param mname -- The name of the field.
+ * @param dnmae -- The field descriptor.
+ *
+ * @returns The constant pool index of the interface reference.
+ * Returns -1 on failure.
+ */
+
+int
+bc_new_fieldref(JVM_CLASS *class, char *cname, char *mname, char *dname)
+{
+ JVM_METHODREF *fieldref;
+ int retval;
+
+ if(!class || !cname || !mname || !dname) {
+ BAD_ARG();
+ return -1;
+ }
+
+ fieldref = bc_new_method_node(cname, mname, dname);
+
+ if(!fieldref) return -1;
+
+ retval = cp_find_or_insert(class, CONSTANT_Fieldref, fieldref);
+
+ bc_free_fieldref(fieldref);
+
+ return retval;
+}
+
+/**
+ * This function associates a label with a particular instruction.
+ * This information is used later to calculate the branch target
+ * offsets for branch instructions whose targets were labels.
+ * See the bc_set_branch_label() function.
+ *
+ * Misc notes: this function creates a JVM_BRANCH_PC struct and fills
+ * it in with the pc and label number. This is then inserted into the
+ * method info struct. Used later by calc_offsets for goto stmts.
+ *
+ * @param meth -- The method containing the branch and target instructions.
+ * @param node -- The node of the target (that is, the instruction which
+ * corresponds to the label in the source code).
+ * @param label -- The label specified for this instruction.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_associate_branch_label(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *node,
+ const char *label)
+{
+ JVM_BRANCH_PC *bp;
+
+ if(!meth || !node) {
+ BAD_ARG();
+ return -1;
+ }
+
+ bp = (JVM_BRANCH_PC *)malloc(sizeof(JVM_BRANCH_PC));
+
+ if(!bp) return -1;
+
+ bp->instr = node;
+ bp->label = strdup(label);
+
+ dl_insert_b(meth->label_list, bp);
+
+ return 0;
+}
+
+/**
+ * This function associates a label with a particular instruction.
+ * Same as bc_associate_branch_label() except that the label is
+ * specified as an integer rather than string.
+ *
+ * @param meth -- The method containing the branch and target instructions.
+ * @param node -- The node of the target (that is, the instruction which
+ * corresponds to the label in the source code).
+ * @param label_num -- The label number specified for this instruction.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_associate_integer_branch_label(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *node,
+ int label_num)
+{
+ char label[20];
+
+ if(!meth || !node) {
+ BAD_ARG();
+ return -1;
+ }
+
+ sprintf(label, "%d", label_num);
+
+ return bc_associate_branch_label(meth, node, label);
+}
+
+/**
+ * This function gets a variable length argument and calls the appropriate
+ * routine. All routines deal with appending an opcode instruction to a
+ * methods code array.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param op -- The opcode to be generated.
+ * @param ... -- The remaining arguments represent the operands of the
+ * instruction.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+JVM_CODE_GRAPH_NODE *
+bc_append(JVM_METHOD *meth, JVM_OPCODE op, ...)
+{
+ JVM_CODE_GRAPH_NODE *cgNode;
+ int inv_idx, inv_cnt;
+ va_list pvar;
+ u1 index, value;
+ u2 dimensions, idx2;
+ u4 operand;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ va_start(pvar, op);
+
+ switch(op) {
+ case jvm_multianewarray:
+ idx2 = (u2)va_arg(pvar, int);
+ dimensions = (u1)va_arg(pvar, int);
+ operand =(idx2<<8) | dimensions;
+ cgNode = bytecode1(meth, jvm_multianewarray, operand);
+ break;
+ case jvm_tableswitch:
+ case jvm_lookupswitch:
+ cgNode = bc_gen_switch(meth);
+ break;
+ case jvm_invokeinterface:
+ inv_idx = va_arg(pvar, int);
+ inv_cnt = va_arg(pvar, int);
+
+ operand = (inv_idx << 16) | (inv_cnt << 8);
+ cgNode = bytecode1(meth, op, operand);
+ break;
+ case jvm_xxxunusedxxx:
+ cgNode = bytecode0(meth, op);
+ break;
+ case jvm_goto:
+ cgNode = bytecode0(meth, op);
+ break;
+ case jvm_jsr:
+ cgNode = bytecode0(meth, op);
+ break;
+ case jvm_iinc:
+ index = (u1)va_arg(pvar, int);
+ value = (u1)va_arg(pvar, int);
+ cgNode = bc_gen_iinc(meth, index, value);
+ break;
+ default:
+ if(jvm_opcode[op].width <= 1) {
+ cgNode = bytecode0(meth, op);
+ }
+ else if(jvm_opcode[op].width > 1) {
+ operand = (u4)va_arg(pvar, int);
+ cgNode = bytecode1(meth, op, operand);
+ }
+ }
+
+ va_end(pvar);
+
+ return cgNode;
+}
+
+/**
+ * Given a file path, open and create directories along the way, if needed.
+ *
+ * @param file -- The name of the file to be opened.
+ * @param mode -- The file creation mode (man fopen(3)).
+ * @param output_dir -- The prefix for the full file name (if NULL, just
+ * open the file in the current directory).
+ *
+ * @returns A file pointer to the created file.
+ */
+
+FILE *
+bc_fopen_fullpath(char *file, char *mode, char *output_dir)
+{
+ char *pwd = NULL, *prev = NULL, *segment = NULL, *full_file = NULL;
+ struct stat *buf = NULL;
+ int cur_size;
+ FILE *f;
+
+#define err_fopen_full() \
+ if(buf) free(buf); \
+ if(pwd) free(pwd); \
+ if(segment) free(segment); \
+ if(full_file) free(full_file);
+
+ if(!file) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ if(!mode) mode = "wb";
+
+ cur_size = 2;
+ pwd = (char *)malloc(cur_size);
+ if(!pwd) return NULL;
+
+ buf = (struct stat *)malloc(sizeof(struct stat));
+ if(!buf) {
+ err_fopen_full();
+ return NULL;
+ }
+
+ while(getcwd(pwd, cur_size) == NULL) {
+ char *tmp;
+
+ cur_size *= 2;
+
+ tmp = pwd;
+ pwd = (char *)realloc(pwd,cur_size);
+
+ if(!pwd) {
+ free(tmp);
+ err_fopen_full();
+ return NULL;
+ }
+ }
+
+ if(output_dir != NULL) {
+ full_file = (char *)malloc(strlen(output_dir) + strlen(file) + 3);
+
+ strcpy(full_file, output_dir);
+ if(output_dir[strlen(output_dir)-1] != BC_FILE_DELIM[0])
+ strcat(full_file, BC_FILE_DELIM);
+ strcat(full_file, file);
+ }
+ else
+ full_file = strdup(file);
+
+ if(!full_file) {
+ err_fopen_full();
+ return NULL;
+ }
+
+ debug_msg("full_file = '%s'\n", full_file);
+
+ if( stat(full_file, buf) == 0)
+ if(! S_ISREG(buf->st_mode) ) {
+ err_fopen_full();
+ return NULL;
+ }
+
+ if( (f = fopen(full_file, mode)) != NULL ) {
+ err_fopen_full();
+ return f;
+ }
+
+ if(full_file[0] == BC_FILE_DELIM[0])
+ chdir(BC_FILE_DELIM);
+
+ prev = strtok(full_file, BC_FILE_DELIM);
+
+ while( (segment = strtok(NULL,BC_FILE_DELIM)) != NULL ) {
+
+ if( stat(prev, buf) == -1) {
+ if(errno == ENOENT) {
+#ifdef _WIN32
+ if(mkdir(prev) == -1) {
+#else
+ if(mkdir(prev, 0755) == -1) {
+#endif
+ chdir(pwd);
+ err_fopen_full();
+ return NULL;
+ }
+ }
+ else {
+ chdir(pwd);
+ err_fopen_full();
+ return NULL;
+ }
+ }
+ else {
+ if(! S_ISDIR(buf->st_mode)) {
+ chdir(pwd);
+ err_fopen_full();
+ return NULL;
+ }
+ }
+
+ if(chdir(prev) == -1) {
+ chdir(pwd);
+ err_fopen_full();
+ return NULL;
+ }
+
+ prev = segment;
+ }
+
+ if( (f = fopen(prev, mode)) != NULL ) {
+ chdir(pwd);
+ err_fopen_full();
+ return f;
+ }
+
+ chdir(pwd);
+ free(full_file);
+ free(buf);
+ free(pwd);
+ return NULL;
+}
+
+/**
+ * Frees a method info structure.
+ *
+ * @param m -- The method to be freed.
+ */
+
+void
+bc_free_method(JVM_METHOD *m)
+{
+ JVM_ATTRIBUTE *code_attr = NULL;
+
+ if(!m) {
+ BAD_ARG();
+ return;
+ }
+
+ code_attr = find_attribute(m->class,m->attributes,"Code");
+
+ bc_free_attributes(m->class, m->attributes);
+ m->attributes = NULL;
+
+ /* if this method was abstract or native, then the code graph would not
+ * have been inserted as an attribute to this method (because such methods
+ * do not have any code). therefore the code graph (actually a Dlist)
+ * would not have been freed yet, so we free it here.
+ */
+
+ if(!code_attr)
+ {
+ bc_free_code_attribute(m->class, m->cur_code);
+ m->cur_code = NULL;
+ }
+
+ if(m->exc_table) dl_delete_list(m->exc_table);
+
+ bc_free_locals_table(m);
+ bc_free_line_number_table(m);
+ bc_free_label_list(m);
+
+ m->attributes = NULL;
+ m->exc_table = NULL;
+ m->label_list = NULL;
+ m->line_table = NULL;
+
+ if(m->name) free(m->name);
+ free(m);
+}
+
+/**
+ * Frees a line number table.
+ *
+ * @param m -- The method containing the line number table.
+ */
+
+void
+bc_free_line_number_table(JVM_METHOD *m)
+{
+ Dlist tmp;
+
+ dl_traverse(tmp, m->line_table) {
+ free(dl_val(tmp));
+ }
+ dl_delete_list(m->line_table);
+ m->line_table = NULL;
+}
+
+/**
+ * Frees a local variable table.
+ *
+ * @param m -- The method containing the local variable table.
+ */
+
+void
+bc_free_locals_table(JVM_METHOD *m)
+{
+ Dlist tmp;
+
+ dl_traverse(tmp, m->locals_table) {
+ JVM_LOCAL_VARIABLE_TABLE_ENTRY * loc;
+
+ loc = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *) dl_val(tmp);
+
+ if(loc->name) free(loc->name);
+ if(loc->descriptor) free(loc->descriptor);
+ free(loc);
+ }
+
+ dl_delete_list(m->locals_table);
+ m->locals_table = NULL;
+}
+
+/**
+ * Frees the list of branch labels in a method.
+ *
+ * @param m -- The method containing the local variable table.
+ */
+
+void
+bc_free_label_list(JVM_METHOD *m)
+{
+ Dlist tmp;
+
+ dl_traverse(tmp, m->label_list) {
+ JVM_BRANCH_PC *bp = (JVM_BRANCH_PC *)dl_val(tmp);
+ free(bp->label);
+ free(bp);
+ }
+ dl_delete_list(m->label_list);
+ m->label_list = NULL;
+}
+
+/**
+ * Frees a class (and frees all fields of the class file structure).
+ *
+ * @param class -- The class to be freed.
+ */
+
+void
+bc_free_class(JVM_CLASS *class)
+{
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ bc_free_interfaces(class);
+ bc_free_fields(class);
+ bc_free_methods(class);
+ bc_free_attributes(class, class->attributes);
+
+ /* NOTE: free constant pool last. */
+ bc_free_constant_pool(class);
+
+ free(class);
+}
+
+/**
+ * Frees the list of interfaces the class implements.
+ *
+ * @param class -- The class containing the list of interfaces.
+ */
+
+void
+bc_free_interfaces(JVM_CLASS *class)
+{
+ int * tmpconst;
+ Dlist tmpPtr;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->interfaces) {
+ tmpconst = (int *) tmpPtr->val;
+ free(tmpconst);
+ }
+
+ dl_delete_list(class->interfaces);
+ class->interfaces = NULL;
+}
+
+/**
+ * Frees the constant pool.
+ *
+ * @param class -- The class containing the constant pool.
+ */
+
+void
+bc_free_constant_pool(JVM_CLASS *class)
+{
+ CP_NODE * tmpconst;
+ Dlist tmpPtr;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->constant_pool) {
+ tmpconst = (CP_NODE *) tmpPtr->val;
+
+ if(tmpconst->val->tag == CONSTANT_Utf8)
+ free(tmpconst->val->cpnode.Utf8.bytes);
+ free(tmpconst->val);
+ free(tmpconst);
+ }
+
+ dl_delete_list(class->constant_pool);
+ class->constant_pool = NULL;
+}
+
+/**
+ * Frees the list of fields of this class.
+ *
+ * @param class -- The class containing the list of fields.
+ */
+
+void
+bc_free_fields(JVM_CLASS *class)
+{
+ JVM_FIELD *tmpfield;
+ Dlist tmpPtr;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->fields) {
+ tmpfield = (JVM_FIELD *) tmpPtr->val;
+
+ bc_free_attributes(class, tmpfield->attributes);
+ free(tmpfield);
+ }
+
+ dl_delete_list(class->fields);
+ class->fields = NULL;
+}
+
+/**
+ * Frees the list of methods of this class.
+ *
+ * @param class -- The class containing the list of methods.
+ */
+
+void
+bc_free_methods(JVM_CLASS *class)
+{
+ Dlist tmpPtr;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->methods) {
+ bc_free_method((JVM_METHOD *) tmpPtr->val);
+ }
+
+ dl_delete_list(class->methods);
+ class->methods = NULL;
+}
+
+/**
+ * Frees a list of attributes. The attribute list may correspond to
+ * a class, method, or field.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * the attributes.
+ * @param attr_list -- The attribute list to be freed.
+ */
+
+void
+bc_free_attributes(JVM_CLASS *class, Dlist attr_list)
+{
+ JVM_ATTRIBUTE *tmpattr;
+ char *attr_name;
+ Dlist tmpPtr, tmpPtr2;
+ CP_NODE *c;
+
+ if(!attr_list || !class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,attr_list) {
+ tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val;
+
+ c = cp_entry_by_index(class, tmpattr->attribute_name_index);
+ if(c==NULL) {
+ debug_err("WARNING: bc_free_attributes() can't find attr name\n");
+ continue;
+ }
+
+ attr_name = cp_null_term_utf8(c->val);
+ if(!attr_name)
+ continue;
+
+ if(!strcmp(attr_name,"SourceFile")) {
+ free(tmpattr->attr.SourceFile);
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"Deprecated") ||
+ !strcmp(attr_name,"Synthetic")) {
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"LocalVariableTable")) {
+ free(tmpattr->attr.LocalVariableTable);
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"LineNumberTable")) {
+ free(tmpattr->attr.LineNumberTable);
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"InnerClasses")) {
+ dl_traverse(tmpPtr2, tmpattr->attr.InnerClasses->classes)
+ free(tmpPtr2->val);
+
+ dl_delete_list(tmpattr->attr.InnerClasses->classes);
+ free(tmpattr->attr.InnerClasses);
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"ConstantValue")) {
+ free(tmpattr->attr.ConstantValue);
+ free(tmpattr);
+ }
+ else if(!strcmp(attr_name,"Code")) {
+ bc_free_code_attribute(class, tmpattr);
+ }
+ else if(!strcmp(attr_name,"Exceptions")) {
+ dl_traverse(tmpPtr2, tmpattr->attr.Exceptions->exception_index_table)
+ free(tmpPtr2->val);
+
+ dl_delete_list(tmpattr->attr.Exceptions->exception_index_table);
+ tmpattr->attr.Exceptions->exception_index_table = NULL;
+ free(tmpattr->attr.Exceptions);
+ free(tmpattr);
+ }
+ else {
+ /* if the attribute name doesn't match any of the known attributes
+ * then assume it's a user defined attribute.
+ */
+ free(tmpattr->attr.UserDefined->data);
+ free(tmpattr->attr.UserDefined);
+ free(tmpattr);
+ }
+
+ free(attr_name);
+ }
+
+ dl_delete_list(attr_list);
+}
+
+/**
+ * Frees a code attribute.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * the code attribute.
+ * @param attr -- The code attribute to be freed.
+ */
+
+void
+bc_free_code_attribute(JVM_CLASS *class, JVM_ATTRIBUTE *attr)
+{
+ if(!attr) {
+ BAD_ARG();
+ return;
+ }
+
+ bc_free_code(attr->attr.Code->code);
+
+ if(attr->attr.Code->exception_table_length > 0)
+ free(attr->attr.Code->exception_table);
+
+ if((attr->attr.Code->attributes_count > 0) && (class != NULL))
+ bc_free_attributes(class, attr->attr.Code->attributes);
+ else
+ dl_delete_list(attr->attr.Code->attributes);
+
+ attr->attr.Code->attributes = NULL;
+
+ free(attr->attr.Code);
+ free(attr);
+}
+
+/**
+ * Frees the list of instruction nodes.
+ *
+ * @param g -- The list of instructions to be freed.
+ */
+
+void
+bc_free_code(Dlist g)
+{
+ Dlist tmp;
+ int i;
+
+ if(!g) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmp, g) {
+ JVM_CODE_GRAPH_NODE *instr = (JVM_CODE_GRAPH_NODE *)dl_val(tmp);
+
+ if((instr->op == jvm_tableswitch) ||
+ (instr->op == jvm_lookupswitch))
+ {
+ dl_delete_list(instr->switch_info->offsets);
+
+ for(i=0;i<instr->switch_info->num_entries;i++)
+ free(instr->switch_info->sorted_entries[i]);
+ free(instr->switch_info->sorted_entries);
+ free(instr->switch_info);
+ }
+
+ if(instr->branch_label) free(instr->branch_label);
+
+ free(tmp->val);
+ }
+
+ dl_delete_list(g);
+}
+
+/**
+ * This function frees memory previously allocated for a fieldref.
+ *
+ * @param fieldref -- The field reference to be freed.
+ */
+
+void
+bc_free_fieldref(JVM_METHODREF *fieldref)
+{
+ if(!fieldref) {
+ BAD_ARG();
+ return;
+ }
+
+ free(fieldref->classname);
+ free(fieldref->methodname);
+ free(fieldref->descriptor);
+ free(fieldref);
+}
+
+/**
+ * This function frees memory previously allocated for a methodref.
+ *
+ * @param methodref -- The method reference to be freed.
+ */
+
+void
+bc_free_methodref(JVM_METHODREF *methodref)
+{
+ if(!methodref) {
+ BAD_ARG();
+ return;
+ }
+
+ bc_free_fieldref(methodref);
+}
+
+/**
+ * This function frees memory previously allocated for an interface method
+ * reference.
+ *
+ * @param interfaceref -- The interface reference to be freed.
+ */
+
+void
+bc_free_interfaceref(JVM_METHODREF *interfaceref)
+{
+ if(!interfaceref) {
+ BAD_ARG();
+ return;
+ }
+
+ bc_free_fieldref(interfaceref);
+}
+
+/**
+ * This function frees memory previously allocated for a name and descriptor
+ * reference.
+ *
+ * @param nameref -- The name-and-type reference to be freed.
+ */
+
+void
+bc_free_nameandtype(JVM_METHODREF *nameref)
+{
+ if(!nameref) {
+ BAD_ARG();
+ return;
+ }
+
+ bc_free_fieldref(nameref);
+}
+
+/*****************************************************************************
+ *****************************************************************************
+ ** **
+ ** Functions after this point are not exposed as part of the API. **
+ ** **
+ *****************************************************************************
+ *****************************************************************************/
+
+
+/**
+ * Finds the given attribute in an attribute list.
+ * Returns NULL if the attribute cannot be found.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * the attribute.
+ * @param attr_list -- The list of attributes to be searched.
+ * @param attr -- The name of the attribute to find.
+ *
+ * @returns Pointer to the attribute, if found. If the attribute is not
+ * found, returns NULL.
+ */
+
+static JVM_ATTRIBUTE *
+find_attribute(JVM_CLASS *class, Dlist attr_list, char *attr)
+{
+ JVM_ATTRIBUTE *tmpattr;
+ char *attr_name;
+ Dlist tmpPtr;
+ CP_NODE *c;
+
+ if(!attr_list || !class || !attr) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ dl_traverse(tmpPtr,attr_list) {
+ tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val;
+
+ c = cp_entry_by_index(class, tmpattr->attribute_name_index);
+
+ if(c == NULL) {
+ debug_err("WARNING: find_attribute() can't find attr name\n");
+ continue;
+ }
+
+ attr_name = cp_null_term_utf8(c->val);
+ if(!attr_name)
+ continue;
+
+ if(!strcmp(attr_name,attr)) {
+ free(attr_name);
+ return tmpattr;
+ }
+
+ free(attr_name);
+ }
+
+ return NULL;
+}
+
+/**
+ * Creates a new attribute structure and initializes the Code_attribute
+ * section with some initial values.
+ *
+ * @param cclass -- The class containing the constant pool relevant to
+ * the attribute.
+ *
+ * @returns Pointer to the new attribute.
+ */
+
+static JVM_ATTRIBUTE *
+new_code_attr(JVM_CLASS *cclass)
+{
+ JVM_ATTRIBUTE * tmp;
+ int c;
+
+ if(!cclass) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE));
+
+ if(!tmp) return NULL;
+
+ c = cp_find_or_insert(cclass, CONSTANT_Utf8, "Code");
+
+ if(c < 0) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attribute_name_index = c;
+ tmp->attribute_length = 0;
+ tmp->attr.Code = (struct Code_attribute *)
+ malloc(sizeof(struct Code_attribute));
+
+ if(!tmp->attr.Code) {
+ free(tmp);
+ return NULL;
+ }
+
+ tmp->attr.Code->max_stack = 0;
+ tmp->attr.Code->max_locals = 0;
+ tmp->attr.Code->code_length = 0;
+ tmp->attr.Code->code = make_dl();
+ tmp->attr.Code->exception_table_length = 0;
+ tmp->attr.Code->exception_table = NULL;
+ tmp->attr.Code->attributes_count = 0;
+ tmp->attr.Code->attributes = make_dl();
+
+ if(!tmp->attr.Code->code || !tmp->attr.Code->attributes) {
+ if(tmp->attr.Code->code) dl_delete_list(tmp->attr.Code->code);
+ if(tmp->attr.Code->attributes) dl_delete_list(tmp->attr.Code->attributes);
+
+ tmp->attr.Code->code = NULL;
+ tmp->attr.Code->attributes = NULL;
+
+ free(tmp->attr.Code);
+ tmp->attr.Code = NULL;
+
+ free(tmp);
+ return NULL;
+ }
+
+ return tmp;
+}
+
+/**
+ * Inserts the given instruction into the code graph.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param op -- The opcode to be generated.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+static JVM_CODE_GRAPH_NODE *
+bytecode0(JVM_METHOD *meth, JVM_OPCODE op)
+{
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ return bytecode1(meth, op,0);
+}
+
+/**
+ * Inserts the given instruction into the code graph.
+ *
+ * @param meth -- The method to which this instruction should be added.
+ * @param op -- The opcode to be generated.
+ * @param operand -- The operand to this instruction.
+ *
+ * @returns Pointer to the instruction node.
+ * Returns NULL on error.
+ */
+
+static JVM_CODE_GRAPH_NODE *
+bytecode1(JVM_METHOD *meth, JVM_OPCODE op, u4 operand)
+{
+ JVM_CODE_GRAPH_NODE *tmp, *prev;
+
+ if(!meth) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ /* if we should not generate bytecode, then just return a dummy node */
+ if(!meth->gen_bytecode) {
+ JVM_CODE_GRAPH_NODE *g;
+
+ /* keep track of the dummy node so that we may reclaim the memory later. */
+ g = bc_new_graph_node(meth, op, operand);
+ return g;
+ }
+
+ meth->lastOp = op;
+
+ if(meth->cur_code->attr.Code->code == NULL)
+ debug_err("ERROR: null code graph.\n");
+
+ prev = (JVM_CODE_GRAPH_NODE *) dl_val(dl_last(meth->cur_code->attr.Code->code));
+
+ if((prev != NULL) && (prev->op == jvm_xxxunusedxxx)) {
+ prev->op = op;
+ prev->operand = operand;
+ prev->width = bc_op_width(op);
+ meth->pc += bc_op_width(op) - bc_op_width(jvm_xxxunusedxxx);
+ return prev;
+ }
+
+ tmp = bc_new_graph_node(meth, op, operand);
+
+ if(!tmp) return NULL;
+
+ if(prev != NULL)
+ prev->next = tmp;
+
+ dl_insert_b(meth->cur_code->attr.Code->code, tmp);
+
+ /* if the previous instruction was 'wide', then we need to
+ * increase the width of this instruction.
+ */
+ if((prev != NULL) && (prev->op == jvm_wide)) {
+ if( (op == jvm_iload) || (op == jvm_fload) || (op == jvm_aload) ||
+ (op == jvm_lload) || (op == jvm_dload) || (op == jvm_istore) ||
+ (op == jvm_fstore) || (op == jvm_astore) || (op == jvm_lstore) ||
+ (op == jvm_dstore) || (op == jvm_ret))
+ tmp->width = bc_op_width(op) + 1;
+ else if(op == jvm_iinc)
+ tmp->width = bc_op_width(op) + 2;
+ else
+ debug_err("Error: bad op used after wide instruction (%s)\n",
+ jvm_opcode[op].op);
+ }
+
+ meth->pc += tmp->width;
+
+ return tmp;
+}
+
+/**
+ * Given a local variable number (which presumably is the target of some
+ * load/store or other instruction that uses a local), make sure that the
+ * total number of local variables for this method is large enough to
+ * accommodate the specified local variable. If not, then update it based
+ * on the given number.
+ *
+ * @param meth -- The current method.
+ * @param lvnum -- The local variable number being used in some instruction.
+ * @param rt -- The JVM data type of the local variable (see the enumeration
+ * JVM_DATA_TYPE).
+ */
+
+static void
+updateMaxLocals(JVM_METHOD *meth, unsigned int lvnum,
+ JVM_DATA_TYPE rt)
+{
+ int max = lvnum + jvm_localvar_width[rt];
+
+ if(!meth) {
+ BAD_ARG();
+ return;
+ }
+
+ if(max > meth->max_locals)
+ meth->max_locals = max;
+}
+
+/**
+ * Given a method descriptor, this function returns the number of local
+ * variables needed to hold the arguments. doubles and longs use 2 local
+ * vars, while every other data type only uses 1 local.
+ *
+ * @param d -- The method descriptor.
+ *
+ * @returns The number of local variables in this descriptor.
+ */
+
+static int
+num_locals_in_descriptor(char *d)
+{
+ int vlen = 0;
+
+ if(!d) {
+ BAD_ARG();
+ return 0;
+ }
+
+ while( (d = bc_next_desc_token(d)) != NULL) {
+
+ /* if the next token is NULL, then we have no more useful tokens in
+ * this descriptor.
+ */
+ if(bc_next_desc_token(d) == NULL)
+ break;
+
+ if((d[0] == 'D') || (d[0] == 'J'))
+ vlen += 2;
+ else
+ vlen++;
+ }
+
+ return vlen;
+}
+
+/**
+ * This function substitutes every occurrence of 'from_char' with 'to_char'
+ * typically this is used to convert package names:
+ *
+ * e.g. "java.lang.whatever" -> "java/lang/whatever"
+ *
+ * Space for the modified string is allocated by this function.
+ *
+ * @param str -- The string to be converted.
+ * @param from_char -- The character to change from.
+ * @param to_char -- The character to change to.
+ *
+ * @returns The modified string (in newly allocated memory).
+ */
+
+static char *
+char_substitute(char *str, int from_char, int to_char)
+{
+ char *newstr, *idx;
+
+ if(!str) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ newstr = strdup(str);
+ if(!newstr) return NULL;
+
+ while( (idx = strchr(newstr, from_char)) != NULL )
+ *idx = to_char;
+
+ return newstr;
+}
diff --git a/libbytecode/api.h b/libbytecode/api.h
new file mode 100644
index 0000000..2ab184b
--- /dev/null
+++ b/libbytecode/api.h
@@ -0,0 +1,43 @@
+#ifndef _API_H
+#define _API_H
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<stdarg.h>
+#include<string.h>
+#include<ctype.h>
+#include<sys/stat.h>
+#include<errno.h>
+
+#ifdef _WIN32
+#include<dir.h>
+#else
+#include<unistd.h>
+#endif
+
+#ifdef _WIN32
+#define BC_FILE_DELIM "\\"
+#else
+#define BC_FILE_DELIM "/"
+#endif
+
+#include "bytecode.h"
+
+static JVM_ATTRIBUTE
+ *find_attribute(JVM_CLASS *, Dlist, char *),
+ *new_code_attr(JVM_CLASS *);
+
+static JVM_CODE_GRAPH_NODE
+ *bytecode0(JVM_METHOD *, JVM_OPCODE),
+ *bytecode1(JVM_METHOD *, JVM_OPCODE, u4);
+
+static void
+ updateMaxLocals(JVM_METHOD *, unsigned int, JVM_DATA_TYPE);
+
+static int
+ num_locals_in_descriptor(char *);
+
+static char
+ *char_substitute(char *, int, int);
+
+#endif
diff --git a/libbytecode/bytecode.h b/libbytecode/bytecode.h
new file mode 100644
index 0000000..1f69bbe
--- /dev/null
+++ b/libbytecode/bytecode.h
@@ -0,0 +1,880 @@
+/* bytecode.h. Generated by configure. */
+/** @file */
+
+/*****************************************************************************
+ * bytecode.h *
+ * *
+ * Main include file for the bytecode library. Users of the library can *
+ * just include this single header file in their code. *
+ * *
+ *****************************************************************************/
+
+#ifndef _BYTECODE_H
+#define _BYTECODE_H
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include"dlist.h"
+
+/* Define if your processor stores words with the most significant
+ byte first (like Motorola and SPARC, unlike Intel and VAX). */
+/* #undef WORDS_BIGENDIAN */
+
+#define JVM_MAX_RETURNS 7
+
+#define TRUE 1
+#define FALSE 0
+
+/*****************************************************************************
+ * CPIDX_MAX is the largest index that can be used with the ldc instruction *
+ * since it has a 1 byte operand. For values larger than CPIDX_MAX, we must *
+ * generate ldc_w. *
+ *****************************************************************************/
+
+#define CP_IDX_MAX 255
+
+/* MAX_CODE_LEN: Currently a method can only have 64k of code. */
+
+#define JVM_MAX_CODE_LEN 65535
+
+/*
+ * If there are more than JVM_SWITCH_FILL_THRESH empty cases in a switch, then
+ * use lookupswitch instead of tableswitch.
+ */
+
+#define JVM_SWITCH_FILL_THRESH 10
+
+/*
+ * Definitions of class/field/method modifiers:
+ */
+
+#define JVM_ACC_PUBLIC 0x0001
+#define JVM_ACC_PRIVATE 0x0002
+#define JVM_ACC_PROTECTED 0x0004
+#define JVM_ACC_STATIC 0x0008
+#define JVM_ACC_FINAL 0x0010
+#define JVM_ACC_SYNCHRONIZED 0x0020
+#define JVM_ACC_SUPER 0x0020
+#define JVM_ACC_VOLATILE 0x0040
+#define JVM_ACC_TRANSIENT 0x0080
+#define JVM_ACC_NATIVE 0x0100
+#define JVM_ACC_INTERFACE 0x0200
+#define JVM_ACC_ABSTRACT 0x0400
+#define JVM_ACC_STRICT 0x0800
+
+/*
+ * array data types for newarray opcode.
+ */
+#define JVM_T_UNUSED 0
+#define JVM_T_BOOLEAN 4
+#define JVM_T_CHAR 5
+#define JVM_T_FLOAT 6
+#define JVM_T_DOUBLE 7
+#define JVM_T_BYTE 8
+#define JVM_T_SHORT 9
+#define JVM_T_INT 10
+#define JVM_T_LONG 11
+
+#define JVM_MAGIC 0xCAFEBABEu
+#define JVM_MINOR_VER 3
+#define JVM_MAJOR_VER 45
+
+/*****************************************************************************
+ * *
+ * Following are some constants that help determine which integer load *
+ * instruction to use. *
+ * *
+ * if intval < JVM_SHORT_MIN or intval > JVM_SHORT_MAX, use ldc *
+ * else if intval < JVM_BYTE_MIN or intval > JVM_BYTE_MAX, use sipush *
+ * else if intval < JVM_ICONST_MIN or intval > JVM_ICONST_MAX, use bipush *
+ * else use iconst_<intval> *
+ * *
+ *****************************************************************************/
+
+#define JVM_SHORT_MIN (-32768)
+#define JVM_SHORT_MAX 32767
+#define JVM_BYTE_MIN (-128)
+#define JVM_BYTE_MAX 127
+#define JVM_ICONST_MIN -1
+#define JVM_ICONST_MAX 5
+
+#define CP_INTEGER_CONST 277
+#define CP_FLOAT_CONST 279
+#define CP_DOUBLE_CONST 276
+#define CP_LONG_CONST 282
+#define CP_EXPONENTIAL_CONST 278
+#define CP_TRUE_CONST 280
+#define CP_FALSE_CONST 281
+#define CP_STRING_CONST 304
+
+#define CP_CHECK_NONZERO(str,val)\
+ if((val) == 0)\
+ fprintf(stderr,"Not expecting zero value (%s)\n", (str))
+
+#define BAD_ARG() fprintf(stderr,"%s:%d -- bad arg.\n", __FILE__, __LINE__);
+
+#ifdef BC_DEBUG
+#define debug_msg(...) fprintf(stderr, __VA_ARGS__)
+#else
+#define debug_msg(...) /* nop */
+#endif
+
+#ifdef BC_VIEW
+#define debug_err(...) fprintf(stderr, __VA_ARGS__)
+#else
+#define debug_err(...) /* nop */
+#endif
+
+typedef int BOOL;
+typedef unsigned char u1;
+typedef unsigned short u2;
+typedef unsigned int u4;
+typedef unsigned long long u8;
+
+/* the following structure represents a single JVM instruction: */
+typedef struct _jvm_op_info {
+ char *op; /* character representation of opcode */
+ u1 width; /* width in bytes of the opcode + operands */
+ u1 stack_pre; /* stack before the operation */
+ u1 stack_post; /* stack after the operation */
+} JVM_OP_INFO;
+
+/*****************************************************************************
+ * Enumeration of all the JVM instruction opcodes. *
+ *****************************************************************************/
+
+typedef enum _opcode {
+ jvm_nop = 0x0,
+ jvm_aconst_null,
+ jvm_iconst_m1,
+ jvm_iconst_0,
+ jvm_iconst_1,
+ jvm_iconst_2,
+ jvm_iconst_3,
+ jvm_iconst_4,
+ jvm_iconst_5,
+ jvm_lconst_0,
+ jvm_lconst_1,
+ jvm_fconst_0,
+ jvm_fconst_1,
+ jvm_fconst_2,
+ jvm_dconst_0,
+ jvm_dconst_1,
+ jvm_bipush,
+ jvm_sipush,
+ jvm_ldc,
+ jvm_ldc_w,
+ jvm_ldc2_w,
+ jvm_iload,
+ jvm_lload,
+ jvm_fload,
+ jvm_dload,
+ jvm_aload,
+ jvm_iload_0,
+ jvm_iload_1,
+ jvm_iload_2,
+ jvm_iload_3,
+ jvm_lload_0,
+ jvm_lload_1,
+ jvm_lload_2,
+ jvm_lload_3,
+ jvm_fload_0,
+ jvm_fload_1,
+ jvm_fload_2,
+ jvm_fload_3,
+ jvm_dload_0,
+ jvm_dload_1,
+ jvm_dload_2,
+ jvm_dload_3,
+ jvm_aload_0,
+ jvm_aload_1,
+ jvm_aload_2,
+ jvm_aload_3,
+ jvm_iaload,
+ jvm_laload,
+ jvm_faload,
+ jvm_daload,
+ jvm_aaload,
+ jvm_baload,
+ jvm_caload,
+ jvm_saload,
+ jvm_istore,
+ jvm_lstore,
+ jvm_fstore,
+ jvm_dstore,
+ jvm_astore,
+ jvm_istore_0,
+ jvm_istore_1,
+ jvm_istore_2,
+ jvm_istore_3,
+ jvm_lstore_0,
+ jvm_lstore_1,
+ jvm_lstore_2,
+ jvm_lstore_3,
+ jvm_fstore_0,
+ jvm_fstore_1,
+ jvm_fstore_2,
+ jvm_fstore_3,
+ jvm_dstore_0,
+ jvm_dstore_1,
+ jvm_dstore_2,
+ jvm_dstore_3,
+ jvm_astore_0,
+ jvm_astore_1,
+ jvm_astore_2,
+ jvm_astore_3,
+ jvm_iastore,
+ jvm_lastore,
+ jvm_fastore,
+ jvm_dastore,
+ jvm_aastore,
+ jvm_bastore,
+ jvm_castore,
+ jvm_sastore,
+ jvm_pop,
+ jvm_pop2,
+ jvm_dup,
+ jvm_dup_x1,
+ jvm_dup_x2,
+ jvm_dup2,
+ jvm_dup2_x1,
+ jvm_dup2_x2,
+ jvm_swap,
+ jvm_iadd,
+ jvm_ladd,
+ jvm_fadd,
+ jvm_dadd,
+ jvm_isub,
+ jvm_lsub,
+ jvm_fsub,
+ jvm_dsub,
+ jvm_imul,
+ jvm_lmul,
+ jvm_fmul,
+ jvm_dmul,
+ jvm_idiv,
+ jvm_ldiv,
+ jvm_fdiv,
+ jvm_ddiv,
+ jvm_irem,
+ jvm_lrem,
+ jvm_frem,
+ jvm_drem,
+ jvm_ineg,
+ jvm_lneg,
+ jvm_fneg,
+ jvm_dneg,
+ jvm_ishl,
+ jvm_lshl,
+ jvm_ishr,
+ jvm_lshr,
+ jvm_iushr,
+ jvm_lushr,
+ jvm_iand,
+ jvm_land,
+ jvm_ior,
+ jvm_lor,
+ jvm_ixor,
+ jvm_lxor,
+ jvm_iinc,
+ jvm_i2l,
+ jvm_i2f,
+ jvm_i2d,
+ jvm_l2i,
+ jvm_l2f,
+ jvm_l2d,
+ jvm_f2i,
+ jvm_f2l,
+ jvm_f2d,
+ jvm_d2i,
+ jvm_d2l,
+ jvm_d2f,
+ jvm_i2b,
+ jvm_i2c,
+ jvm_i2s,
+ jvm_lcmp,
+ jvm_fcmpl,
+ jvm_fcmpg,
+ jvm_dcmpl,
+ jvm_dcmpg,
+ jvm_ifeq,
+ jvm_ifne,
+ jvm_iflt,
+ jvm_ifge,
+ jvm_ifgt,
+ jvm_ifle,
+ jvm_if_icmpeq,
+ jvm_if_icmpne,
+ jvm_if_icmplt,
+ jvm_if_icmpge,
+ jvm_if_icmpgt,
+ jvm_if_icmple,
+ jvm_if_acmpeq,
+ jvm_if_acmpne,
+ jvm_goto,
+ jvm_jsr,
+ jvm_ret,
+ jvm_tableswitch,
+ jvm_lookupswitch,
+ jvm_ireturn,
+ jvm_lreturn,
+ jvm_freturn,
+ jvm_dreturn,
+ jvm_areturn,
+ jvm_return,
+ jvm_getstatic,
+ jvm_putstatic,
+ jvm_getfield,
+ jvm_putfield,
+ jvm_invokevirtual,
+ jvm_invokespecial,
+ jvm_invokestatic,
+ jvm_invokeinterface,
+ jvm_xxxunusedxxx, /* opcode 186 not used */
+ jvm_new,
+ jvm_newarray,
+ jvm_anewarray,
+ jvm_arraylength,
+ jvm_athrow,
+ jvm_checkcast,
+ jvm_instanceof,
+ jvm_monitorenter,
+ jvm_monitorexit,
+ jvm_wide,
+ jvm_multianewarray,
+ jvm_ifnull,
+ jvm_ifnonnull,
+ jvm_goto_w,
+ jvm_jsr_w,
+ jvm_breakpoint,
+ /* skip 203 - 253 */
+ jvm_impdep1 = 254,
+ jvm_impdep2
+} JVM_OPCODE;
+
+/*****************************************************************************
+ * this structure holds information about the state of the stack before and *
+ * after a method call. to correctly calculate the maximum stack depth, we *
+ * need to know how many arguments an invoke[static,virtual,etc] instruction *
+ * will pop off the stack. even though there is only one return value, it *
+ * can occupy zero, one, or two stack entries depending on the return type *
+ * of the method. *
+ *****************************************************************************/
+
+typedef struct _bc_stack_info {
+ int arg_len, /* depth of stack when this method is invoked */
+ ret_len; /* depth of stack when this method returns */
+} JVM_STACK_INFO;
+
+/****************************************************************************
+ * this structure is stored in the dlist label_list in a method info *
+ * struct and is used by calc_offsets. *
+ ****************************************************************************/
+
+typedef struct _bc_branch_pc {
+ struct _code_node *instr; /* instruction with this label */
+ char *label; /* the label number */
+} JVM_BRANCH_PC;
+
+typedef struct _bc_switch_entry {
+ struct _code_node *instr;
+ int case_num;
+} JVM_SWITCH_ENTRY;
+
+typedef struct _bc_switch_info {
+ int cell_padding;
+ int low;
+ int high;
+ Dlist offsets;
+ struct _code_node *default_case;
+
+ int num_entries;
+ struct _bc_switch_entry **sorted_entries;
+} JVM_SWITCH_INFO;
+
+typedef struct _code_node {
+ JVM_OPCODE op; /* the opcode for this instruction */
+ u4 pc; /* the address in bytecode of this instruction */
+ u4 operand; /* this opcode's operand (may be u1, u2, u4) */
+ u1 width; /* width of this op (may vary with wide modifier)*/
+
+ struct _bc_switch_info
+ * switch_info; /* parameters for tableswitch if appropriate */
+
+ struct _code_node
+ * branch_target, /* the node to which we might optionally branch *
+ * (comparison ops) or unconditionally branch */
+
+ * next; /* next op in code, but not necessarily next to *
+ * execute since we may branch over it. */
+
+ char *branch_label; /* f77 label to which this instruction branches */
+ int stack_depth; /* stack depth prior to execution of this opcode */
+
+ BOOL visited; /* for traversal - has this node been visited? */
+} JVM_CODE_GRAPH_NODE;
+
+typedef struct _bc_exception_table_entry {
+ struct _code_node
+ * from, /* PC at which the try block begins */
+ * to, /* PC at which the try block ends */
+ * target; /* PC at which the exception handler begins */
+ int catch_type; /* exception class corresponding to this catch */
+} JVM_EXCEPTION_TABLE_ENTRY;
+
+typedef struct _bc_line_number_table_entry {
+ struct _code_node *op; /* idx to code where original src stmt begins */
+ u2 line_number; /* the corresponding original line number */
+} JVM_LINE_NUMBER_TABLE_ENTRY;
+
+typedef struct _bc_local_variable_table_entry {
+ struct _code_node
+ *start, /* start idx of valid range for this variable */
+ *end; /* end index of valid range for this variable */
+ char *name; /* name of this variable */
+ u2 name_index; /* cp index to name of variable */
+ char *descriptor; /* descriptor for this variable */
+ u2 descriptor_index; /* cp index to descriptor for variable */
+ u2 index; /* this variable's index into local var table */
+} JVM_LOCAL_VARIABLE_TABLE_ENTRY;
+
+/*
+ * Enumeration of the JVM data types.
+ */
+
+typedef enum jvm_data_type {
+ jvm_Byte = 0x0,
+ jvm_Short,
+ jvm_Int,
+ jvm_Long,
+ jvm_Char,
+ jvm_Float,
+ jvm_Double,
+ jvm_Object
+} JVM_DATA_TYPE;
+
+/*
+ * Structures representing the JVM class file.
+ */
+
+typedef enum _constant_tags {
+ CONSTANT_Utf8 = 1, /* 1 */
+ /* note missing tag 2 */
+ CONSTANT_Integer = 3, /* 3 */
+ CONSTANT_Float, /* 4 */
+ CONSTANT_Long, /* 5 */
+ CONSTANT_Double, /* 6 */
+ CONSTANT_Class, /* 7 */
+ CONSTANT_String, /* 8 */
+ CONSTANT_Fieldref, /* 9 */
+ CONSTANT_Methodref, /* 10 */
+ CONSTANT_InterfaceMethodref, /* 11 */
+ CONSTANT_NameAndType /* 12 */
+} JVM_CONSTANT;
+
+typedef struct _bc_class_file {
+ u4 magic; /* class file magic number: 0xCAFEBABE */
+ u2 minor_version; /* minor version of the class file */
+ u2 major_version; /* major version of the class file */
+ u2 constant_pool_count; /* num entries in constant pool + 1 */
+ Dlist constant_pool; /* constant pool:constant_pool_count-1 entries */
+ u2 access_flags; /* access permissions for this class */
+ u2 this_class; /* cp index to entry representing this class */
+ u2 super_class; /* cp index to superclass or 0 for Object */
+ u2 interfaces_count; /* number of superinterfaces for this class */
+ Dlist interfaces; /* list of interfaces (each entry a cp index) */
+ u2 fields_count; /* num fields, both class vars & instance vars */
+ Dlist fields; /* list of fields declared in this class */
+ u2 methods_count; /* number of methods in this class */
+ Dlist methods; /* list of methods */
+ u2 attributes_count; /* number of attributes for this class */
+ Dlist attributes; /* only SourceFile & Deprecated allowed here */
+} JVM_CLASS;
+
+struct CONSTANT_Class_info {
+ u2 name_index; /* index into constant pool */
+};
+
+struct CONSTANT_Methodref_info {
+ u2 class_index; /* cp index of class which declares this field */
+ u2 name_and_type_index; /* cp index of name & descriptor of this field */
+};
+
+struct CONSTANT_String_info {
+ u2 string_index; /* cp index of Utf8 rep of this string */
+};
+
+struct CONSTANT_Integer_info {
+ u4 bytes; /* the integer value */
+};
+
+struct CONSTANT_Float_info {
+ u4 bytes; /* the float value */
+};
+
+struct CONSTANT_Long_info {
+ u4 high_bytes; /* the high bytes of the long value */
+ u4 low_bytes; /* the low bytes of the long value */
+};
+
+struct CONSTANT_Double_info {
+ u4 high_bytes; /* the high bytes of the double value */
+ u4 low_bytes; /* the low bytes of the double value */
+};
+
+struct CONSTANT_NameAndType_info {
+ u2 name_index; /* cp index of name or <init> stored as Utf8 */
+ u2 descriptor_index; /* cp index of valid field, method descriptor */
+};
+
+struct CONSTANT_Utf8_info {
+ u2 length; /* # bytes, not necessarily string length */
+ u1 *bytes; /* byte array containing the Utf8 string */
+};
+
+typedef struct _cp_info {
+ u1 tag;
+ union {
+ struct CONSTANT_Class_info Class;
+ struct CONSTANT_Methodref_info Methodref;
+ struct CONSTANT_String_info String;
+ struct CONSTANT_Integer_info Integer;
+ struct CONSTANT_Float_info Float;
+ struct CONSTANT_Long_info Long;
+ struct CONSTANT_Double_info Double;
+ struct CONSTANT_NameAndType_info NameAndType;
+ struct CONSTANT_Utf8_info Utf8;
+ } cpnode;
+} CP_INFO;
+
+typedef struct _field_info {
+ u2 access_flags; /* access flags mask, see table 4.4 in vm spec */
+ u2 name_index; /* cp index of field name, rep. as Utf8 string */
+ u2 descriptor_index; /* cp index of valid field descriptor */
+ u2 attributes_count; /* number of additional field attributes */
+ Dlist attributes; /* attributes of this field */
+
+ struct _bc_class_file
+ *class; /* the class containing this field */
+} JVM_FIELD;
+
+typedef struct _method_info {
+ u2 access_flags; /* access flags mask, see table 4.5 in vm spec */
+ u2 name_index; /* cp index of methodname, <init>, or <clinit> */
+ u2 descriptor_index; /* cp index of valid method descriptor */
+ u2 attributes_count; /* number of additional method attributes */
+ Dlist attributes; /* attributes of this method */
+
+ BOOL gen_bytecode; /* set to FALSE to suspend bytecode generation */
+
+ /* The following fields are not really part of the method struct as
+ * defined by the JVM spec, but they're here for convenience.
+ */
+
+ Dlist exc_table; /* list of exception table entries */
+ Dlist label_list; /* list of statements with label numbers */
+
+ BOOL reCalcAddr; /* Do node's addrs need to be recalculated? */
+
+ struct _attribute_info
+ *cur_code; /* code attribute */
+
+ Dlist
+ line_table, /* list of line number table entries */
+ locals_table; /* list of local variable table entries */
+
+ JVM_OPCODE lastOp; /* the last opcode emitted */
+
+ int stacksize; /* size of stack for current unit */
+
+ unsigned int
+ cur_local_number, /* current local variable number */
+ max_locals, /* number of locals needed for this method */
+ num_handlers, /* number of exception handlers in this method */
+ pc; /* current program counter */
+
+ char *name; /* name of this method */
+ char *file; /* name of the file containing this method */
+
+ struct _bc_class_file
+ *class; /* the class containing this method */
+} JVM_METHOD;
+
+struct ConstantValue_attribute {
+ u2 constantvalue_index; /* cp index to the actual constant value */
+};
+
+struct ExceptionTable {
+ u2 start_pc; /* index into code of start opcode (inclusive) */
+ u2 end_pc; /* index into code of end opcode (exclusive) */
+ u2 handler_pc; /* start of exception handler code */
+ u2 catch_type; /* cp index of exception class to catch */
+};
+
+struct Code_attribute {
+ u2 max_stack; /* max depth of operand stack for this method */
+ u2 max_locals; /* max num of local variables including params */
+ u4 code_length; /* number of bytes in the code array */
+ Dlist code; /* list containing code for this method */
+ u2 exception_table_length; /* number of entries in the exception table */
+
+ struct ExceptionTable * exception_table; /* table of exception handlers */
+
+ u2 attributes_count; /* number of additional code attributes */
+ Dlist attributes; /* attributes of this code */
+};
+
+struct Exceptions_attribute {
+ u2 number_of_exceptions; /* number of entries in exception_index_table */
+ Dlist exception_index_table;/* table of exceptions a method can throw */
+};
+
+struct SourceFile_attribute {
+ u2 sourcefile_index; /* cp index to name of source file (in Utf8) */
+};
+
+struct LineNumberTable_attribute {
+ u2 line_number_table_length; /* number of entries in line_number_table */
+ Dlist line_number_table; /* list of line number table entries */
+};
+
+struct LocalVariableTable_attribute {
+ u2 local_variable_table_length; /* number of entries in line_number_table */
+ Dlist local_variable_table; /* list of line number table entries */
+};
+
+struct InnerClassEntry {
+ u2 inner_class_info_index; /* cp index to the inner class */
+ u2 outer_class_info_index; /* cp index to the outer (enclosing) class */
+ u2 inner_name_index; /* cp index to simple name of inner class */
+ u2 inner_class_access_flags; /* access flags for the inner class */
+};
+
+struct InnerClasses_attribute {
+ u2 number_of_classes; /* number of entries in the classes array */
+ Dlist classes; /* list of inner class references */
+};
+
+struct UserDefined_attribute {
+ void *data;
+};
+
+typedef struct _attribute_info {
+ u2 attribute_name_index; /* cp index to name of attribute (in Utf8) */
+ u4 attribute_length; /* # bytes pointed to by the info field */
+ union {
+ struct ConstantValue_attribute * ConstantValue;
+ struct Code_attribute * Code;
+ struct Exceptions_attribute * Exceptions;
+ void * Synthetic;
+ struct SourceFile_attribute * SourceFile;
+ struct LineNumberTable_attribute * LineNumberTable;
+ struct LocalVariableTable_attribute * LocalVariableTable;
+ struct InnerClasses_attribute * InnerClasses;
+ struct UserDefined_attribute * UserDefined;
+ } attr;
+} JVM_ATTRIBUTE;
+
+/*
+ * We build a linked list containing all the constant pool entries.
+ * Each entry in the list has the following structure:
+ */
+
+typedef struct _constListNode {
+ unsigned int index;
+ unsigned int next_idx;
+ CP_INFO * val;
+} CP_NODE;
+
+/*****************************************************************************
+ * this structure holds information about a method reference, including the *
+ * name of the class which contains the method, the name of the method, and *
+ * the method descriptor. *
+ *****************************************************************************/
+
+typedef struct _methodref {
+ char *classname,
+ *methodname,
+ *descriptor;
+} JVM_METHODREF;
+
+/*****************************************************************************
+ * Definitions of opcodes related to code generation. *
+ *****************************************************************************/
+
+extern const int
+ jvm_newarray_type[JVM_MAX_RETURNS+1];
+
+extern const JVM_OPCODE
+ jvm_iconst_op[7],
+ jvm_array_load_op[JVM_MAX_RETURNS+1],
+ jvm_load_op[JVM_MAX_RETURNS+1],
+ jvm_store_op[JVM_MAX_RETURNS+1],
+ jvm_array_store_op[JVM_MAX_RETURNS+1],
+ jvm_short_store_op[JVM_MAX_RETURNS+1][4],
+ jvm_short_load_op[JVM_MAX_RETURNS+1][4];
+
+extern const JVM_OP_INFO
+ jvm_opcode[];
+
+extern const int
+ cp_entry_width[],
+ jvm_localvar_width[];
+
+/*****************************************************************************
+ ** Function prototypes **
+ *****************************************************************************/
+
+int
+ bc_write_class(JVM_CLASS *, char *),
+ bc_get_code_length(JVM_METHOD *),
+ bc_add_user_defined_class_attr(JVM_CLASS *, char *, int, void *),
+ bc_set_class_deprecated(JVM_CLASS *),
+ bc_set_class_version(JVM_CLASS *, int, int),
+ bc_add_class_interface(JVM_CLASS *, char *),
+ bc_set_constant_value_attr(JVM_FIELD *,
+ JVM_CONSTANT, const void *),
+ bc_set_field_deprecated(JVM_FIELD *),
+ bc_set_field_synthetic(JVM_FIELD *),
+ bc_set_method_deprecated(JVM_METHOD *),
+ bc_set_method_synthetic(JVM_METHOD *),
+ bc_add_method_exception(JVM_METHOD *, char *),
+ bc_add_inner_classes_attr(JVM_CLASS *, char *, char *, char *, int),
+ bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *),
+ bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *),
+ bc_set_stack_depth(JVM_CODE_GRAPH_NODE *, int),
+ bc_set_line_number(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int),
+ bc_add_exception_handler(JVM_METHOD *, JVM_EXCEPTION_TABLE_ENTRY *),
+ bc_remove_method(JVM_METHOD *),
+ bc_set_method_descriptor(JVM_METHOD *, char *),
+ bc_release_local(JVM_METHOD *, JVM_DATA_TYPE),
+ bc_set_cur_local_num(JVM_METHOD *, unsigned int),
+ bc_set_gen_status(JVM_METHOD *, BOOL),
+ bc_add_switch_case(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, int),
+ bc_add_switch_default(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *),
+ bc_associate_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, const char *),
+ bc_associate_integer_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int),
+ bc_set_branch_target(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *),
+ bc_set_branch_label(JVM_CODE_GRAPH_NODE *, const char *),
+ bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *, int),
+ bc_get_next_local(JVM_METHOD *, JVM_DATA_TYPE),
+ bc_add_source_file_attr(JVM_CLASS *, char *),
+ bc_new_methodref(JVM_CLASS *, char *, char *, char *),
+ bc_new_name_and_type(JVM_CLASS *, char *, char *),
+ bc_new_fieldref(JVM_CLASS *, char *, char *, char *),
+ bc_new_interface_methodref(JVM_CLASS *, char *, char *, char *);
+
+void
+ bc_free_method(JVM_METHOD *),
+ bc_free_class(JVM_CLASS *),
+ bc_free_constant_pool(JVM_CLASS *),
+ bc_free_interfaces(JVM_CLASS *),
+ bc_free_fields(JVM_CLASS *),
+ bc_free_methods(JVM_CLASS *),
+ bc_free_attributes(JVM_CLASS *, Dlist),
+ bc_free_fieldref(JVM_METHODREF *),
+ bc_free_nameandtype(JVM_METHODREF *),
+ bc_free_methodref(JVM_METHODREF *),
+ bc_free_interfaceref(JVM_METHODREF *),
+ bc_free_code_attribute(JVM_CLASS *, JVM_ATTRIBUTE *),
+ bc_free_line_number_table(JVM_METHOD *),
+ bc_free_locals_table(JVM_METHOD *),
+ bc_free_label_list(JVM_METHOD *),
+ bc_free_code(Dlist);
+
+JVM_LOCAL_VARIABLE_TABLE_ENTRY
+ *bc_set_local_var_name(JVM_METHOD *, int, char *, char *);
+
+char
+ *bc_next_desc_token(char *),
+ *bc_get_full_classname(char *, char *);
+
+FILE
+ *bc_fopen_fullpath(char *, char *, char *);
+
+JVM_CLASS
+ *bc_new_class(char *, char *, char *, char *, u2);
+
+JVM_METHOD
+ *bc_new_method(JVM_CLASS *, char *, char *, unsigned int),
+ *bc_add_default_constructor(JVM_CLASS *, u2);
+
+JVM_ATTRIBUTE
+ *bc_new_inner_classes_attr(JVM_CLASS *),
+ *bc_new_line_number_table_attr(JVM_METHOD *),
+ *bc_new_local_variable_table_attr(JVM_METHOD *),
+ *bc_new_synthetic_attr(JVM_CLASS *),
+ *bc_new_deprecated_attr(JVM_CLASS *),
+ *bc_new_exceptions_attr(JVM_CLASS *);
+
+JVM_FIELD
+ *bc_add_field(JVM_CLASS *, char *, char *, u2);
+
+JVM_CODE_GRAPH_NODE
+ *bc_get_next_instr(JVM_CODE_GRAPH_NODE *),
+ *bc_new_graph_node(JVM_METHOD *, JVM_OPCODE, u4),
+ *bc_push_int_const(JVM_METHOD *, int),
+ *bc_push_null_const(JVM_METHOD *),
+ *bc_push_double_const(JVM_METHOD *, double),
+ *bc_push_float_const(JVM_METHOD *, float),
+ *bc_push_long_const(JVM_METHOD *, long long),
+ *bc_push_string_const(JVM_METHOD *, char *),
+ *bc_gen_iinc(JVM_METHOD *, unsigned int, int),
+ *bc_gen_switch(JVM_METHOD *),
+ *bc_new_multi_array(JVM_METHOD *, u4, char *),
+ *bc_get_field(JVM_METHOD *, char *, char *, char *),
+ *bc_put_field(JVM_METHOD *, char *, char *, char *),
+ *bc_get_static(JVM_METHOD *, char *, char *, char *),
+ *bc_put_static(JVM_METHOD *, char *, char *, char *),
+ *bc_gen_instanceof(JVM_METHOD *, char *),
+ *bc_gen_checkcast(JVM_METHOD *, char *),
+ *bc_append(JVM_METHOD *, JVM_OPCODE, ...),
+ *bc_node_at_pc(JVM_METHOD *, int),
+ *bc_gen_new_object_array(JVM_METHOD *, int, char *),
+ *bc_gen_new_array(JVM_METHOD *, int, JVM_DATA_TYPE),
+ *bc_gen_array_load_op(JVM_METHOD *, JVM_DATA_TYPE),
+ *bc_gen_array_store_op(JVM_METHOD *, JVM_DATA_TYPE),
+ *bc_gen_return(JVM_METHOD *),
+ *bc_gen_new_obj(JVM_METHOD *, char *),
+ *bc_gen_new_obj_dup(JVM_METHOD *, char *),
+ *bc_gen_obj_instance_default(JVM_METHOD *, char *),
+ *bc_gen_store_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE),
+ *bc_gen_load_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE);
+
+JVM_EXCEPTION_TABLE_ENTRY
+ *bc_new_exception_table_entry(JVM_METHOD *, JVM_CODE_GRAPH_NODE *,
+ JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, char *);
+
+JVM_METHODREF
+ *bc_new_method_node(char *, char *, char *);
+
+JVM_OPCODE
+ bc_get_last_opcode(JVM_METHOD *);
+
+u1
+ bc_op_width(JVM_OPCODE);
+
+CP_NODE
+ *cp_entry_by_index(JVM_CLASS *, unsigned int);
+
+int
+ cp_lookup(JVM_CLASS *, JVM_CONSTANT, const void *),
+ cp_find_or_insert(JVM_CLASS *, JVM_CONSTANT, const void *),
+ cp_manual_insert(JVM_CLASS *, JVM_CONSTANT, const void *);
+
+void
+ cp_fields_dump(JVM_CLASS *),
+ cp_dump(JVM_CLASS *),
+ cp_quickdump(JVM_CLASS *);
+
+u4
+ cp_big_endian_u4(u4);
+
+u2
+ cp_big_endian_u2(u2);
+
+char
+ *cp_null_term_utf8(CP_INFO *);
+
+#endif
diff --git a/libbytecode/bytecode.h.in b/libbytecode/bytecode.h.in
new file mode 100644
index 0000000..bdd56fe
--- /dev/null
+++ b/libbytecode/bytecode.h.in
@@ -0,0 +1,879 @@
+/** @file */
+
+/*****************************************************************************
+ * bytecode.h *
+ * *
+ * Main include file for the bytecode library. Users of the library can *
+ * just include this single header file in their code. *
+ * *
+ *****************************************************************************/
+
+#ifndef _BYTECODE_H
+#define _BYTECODE_H
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include"dlist.h"
+
+/* Define if your processor stores words with the most significant
+ byte first (like Motorola and SPARC, unlike Intel and VAX). */
+#undef WORDS_BIGENDIAN
+
+#define JVM_MAX_RETURNS 7
+
+#define TRUE 1
+#define FALSE 0
+
+/*****************************************************************************
+ * CPIDX_MAX is the largest index that can be used with the ldc instruction *
+ * since it has a 1 byte operand. For values larger than CPIDX_MAX, we must *
+ * generate ldc_w. *
+ *****************************************************************************/
+
+#define CP_IDX_MAX 255
+
+/* MAX_CODE_LEN: Currently a method can only have 64k of code. */
+
+#define JVM_MAX_CODE_LEN 65535
+
+/*
+ * If there are more than JVM_SWITCH_FILL_THRESH empty cases in a switch, then
+ * use lookupswitch instead of tableswitch.
+ */
+
+#define JVM_SWITCH_FILL_THRESH 10
+
+/*
+ * Definitions of class/field/method modifiers:
+ */
+
+#define JVM_ACC_PUBLIC 0x0001
+#define JVM_ACC_PRIVATE 0x0002
+#define JVM_ACC_PROTECTED 0x0004
+#define JVM_ACC_STATIC 0x0008
+#define JVM_ACC_FINAL 0x0010
+#define JVM_ACC_SYNCHRONIZED 0x0020
+#define JVM_ACC_SUPER 0x0020
+#define JVM_ACC_VOLATILE 0x0040
+#define JVM_ACC_TRANSIENT 0x0080
+#define JVM_ACC_NATIVE 0x0100
+#define JVM_ACC_INTERFACE 0x0200
+#define JVM_ACC_ABSTRACT 0x0400
+#define JVM_ACC_STRICT 0x0800
+
+/*
+ * array data types for newarray opcode.
+ */
+#define JVM_T_UNUSED 0
+#define JVM_T_BOOLEAN 4
+#define JVM_T_CHAR 5
+#define JVM_T_FLOAT 6
+#define JVM_T_DOUBLE 7
+#define JVM_T_BYTE 8
+#define JVM_T_SHORT 9
+#define JVM_T_INT 10
+#define JVM_T_LONG 11
+
+#define JVM_MAGIC 0xCAFEBABEu
+#define JVM_MINOR_VER 3
+#define JVM_MAJOR_VER 45
+
+/*****************************************************************************
+ * *
+ * Following are some constants that help determine which integer load *
+ * instruction to use. *
+ * *
+ * if intval < JVM_SHORT_MIN or intval > JVM_SHORT_MAX, use ldc *
+ * else if intval < JVM_BYTE_MIN or intval > JVM_BYTE_MAX, use sipush *
+ * else if intval < JVM_ICONST_MIN or intval > JVM_ICONST_MAX, use bipush *
+ * else use iconst_<intval> *
+ * *
+ *****************************************************************************/
+
+#define JVM_SHORT_MIN (-32768)
+#define JVM_SHORT_MAX 32767
+#define JVM_BYTE_MIN (-128)
+#define JVM_BYTE_MAX 127
+#define JVM_ICONST_MIN -1
+#define JVM_ICONST_MAX 5
+
+#define CP_INTEGER_CONST 277
+#define CP_FLOAT_CONST 279
+#define CP_DOUBLE_CONST 276
+#define CP_LONG_CONST 282
+#define CP_EXPONENTIAL_CONST 278
+#define CP_TRUE_CONST 280
+#define CP_FALSE_CONST 281
+#define CP_STRING_CONST 304
+
+#define CP_CHECK_NONZERO(str,val)\
+ if((val) == 0)\
+ fprintf(stderr,"Not expecting zero value (%s)\n", (str))
+
+#define BAD_ARG() fprintf(stderr,"%s:%d -- bad arg.\n", __FILE__, __LINE__);
+
+#ifdef BC_DEBUG
+#define debug_msg(...) fprintf(stderr, __VA_ARGS__)
+#else
+#define debug_msg(...) /* nop */
+#endif
+
+#ifdef BC_VIEW
+#define debug_err(...) fprintf(stderr, __VA_ARGS__)
+#else
+#define debug_err(...) /* nop */
+#endif
+
+typedef int BOOL;
+typedef unsigned char u1;
+typedef unsigned short u2;
+typedef unsigned int u4;
+typedef unsigned long long u8;
+
+/* the following structure represents a single JVM instruction: */
+typedef struct _jvm_op_info {
+ char *op; /* character representation of opcode */
+ u1 width; /* width in bytes of the opcode + operands */
+ u1 stack_pre; /* stack before the operation */
+ u1 stack_post; /* stack after the operation */
+} JVM_OP_INFO;
+
+/*****************************************************************************
+ * Enumeration of all the JVM instruction opcodes. *
+ *****************************************************************************/
+
+typedef enum _opcode {
+ jvm_nop = 0x0,
+ jvm_aconst_null,
+ jvm_iconst_m1,
+ jvm_iconst_0,
+ jvm_iconst_1,
+ jvm_iconst_2,
+ jvm_iconst_3,
+ jvm_iconst_4,
+ jvm_iconst_5,
+ jvm_lconst_0,
+ jvm_lconst_1,
+ jvm_fconst_0,
+ jvm_fconst_1,
+ jvm_fconst_2,
+ jvm_dconst_0,
+ jvm_dconst_1,
+ jvm_bipush,
+ jvm_sipush,
+ jvm_ldc,
+ jvm_ldc_w,
+ jvm_ldc2_w,
+ jvm_iload,
+ jvm_lload,
+ jvm_fload,
+ jvm_dload,
+ jvm_aload,
+ jvm_iload_0,
+ jvm_iload_1,
+ jvm_iload_2,
+ jvm_iload_3,
+ jvm_lload_0,
+ jvm_lload_1,
+ jvm_lload_2,
+ jvm_lload_3,
+ jvm_fload_0,
+ jvm_fload_1,
+ jvm_fload_2,
+ jvm_fload_3,
+ jvm_dload_0,
+ jvm_dload_1,
+ jvm_dload_2,
+ jvm_dload_3,
+ jvm_aload_0,
+ jvm_aload_1,
+ jvm_aload_2,
+ jvm_aload_3,
+ jvm_iaload,
+ jvm_laload,
+ jvm_faload,
+ jvm_daload,
+ jvm_aaload,
+ jvm_baload,
+ jvm_caload,
+ jvm_saload,
+ jvm_istore,
+ jvm_lstore,
+ jvm_fstore,
+ jvm_dstore,
+ jvm_astore,
+ jvm_istore_0,
+ jvm_istore_1,
+ jvm_istore_2,
+ jvm_istore_3,
+ jvm_lstore_0,
+ jvm_lstore_1,
+ jvm_lstore_2,
+ jvm_lstore_3,
+ jvm_fstore_0,
+ jvm_fstore_1,
+ jvm_fstore_2,
+ jvm_fstore_3,
+ jvm_dstore_0,
+ jvm_dstore_1,
+ jvm_dstore_2,
+ jvm_dstore_3,
+ jvm_astore_0,
+ jvm_astore_1,
+ jvm_astore_2,
+ jvm_astore_3,
+ jvm_iastore,
+ jvm_lastore,
+ jvm_fastore,
+ jvm_dastore,
+ jvm_aastore,
+ jvm_bastore,
+ jvm_castore,
+ jvm_sastore,
+ jvm_pop,
+ jvm_pop2,
+ jvm_dup,
+ jvm_dup_x1,
+ jvm_dup_x2,
+ jvm_dup2,
+ jvm_dup2_x1,
+ jvm_dup2_x2,
+ jvm_swap,
+ jvm_iadd,
+ jvm_ladd,
+ jvm_fadd,
+ jvm_dadd,
+ jvm_isub,
+ jvm_lsub,
+ jvm_fsub,
+ jvm_dsub,
+ jvm_imul,
+ jvm_lmul,
+ jvm_fmul,
+ jvm_dmul,
+ jvm_idiv,
+ jvm_ldiv,
+ jvm_fdiv,
+ jvm_ddiv,
+ jvm_irem,
+ jvm_lrem,
+ jvm_frem,
+ jvm_drem,
+ jvm_ineg,
+ jvm_lneg,
+ jvm_fneg,
+ jvm_dneg,
+ jvm_ishl,
+ jvm_lshl,
+ jvm_ishr,
+ jvm_lshr,
+ jvm_iushr,
+ jvm_lushr,
+ jvm_iand,
+ jvm_land,
+ jvm_ior,
+ jvm_lor,
+ jvm_ixor,
+ jvm_lxor,
+ jvm_iinc,
+ jvm_i2l,
+ jvm_i2f,
+ jvm_i2d,
+ jvm_l2i,
+ jvm_l2f,
+ jvm_l2d,
+ jvm_f2i,
+ jvm_f2l,
+ jvm_f2d,
+ jvm_d2i,
+ jvm_d2l,
+ jvm_d2f,
+ jvm_i2b,
+ jvm_i2c,
+ jvm_i2s,
+ jvm_lcmp,
+ jvm_fcmpl,
+ jvm_fcmpg,
+ jvm_dcmpl,
+ jvm_dcmpg,
+ jvm_ifeq,
+ jvm_ifne,
+ jvm_iflt,
+ jvm_ifge,
+ jvm_ifgt,
+ jvm_ifle,
+ jvm_if_icmpeq,
+ jvm_if_icmpne,
+ jvm_if_icmplt,
+ jvm_if_icmpge,
+ jvm_if_icmpgt,
+ jvm_if_icmple,
+ jvm_if_acmpeq,
+ jvm_if_acmpne,
+ jvm_goto,
+ jvm_jsr,
+ jvm_ret,
+ jvm_tableswitch,
+ jvm_lookupswitch,
+ jvm_ireturn,
+ jvm_lreturn,
+ jvm_freturn,
+ jvm_dreturn,
+ jvm_areturn,
+ jvm_return,
+ jvm_getstatic,
+ jvm_putstatic,
+ jvm_getfield,
+ jvm_putfield,
+ jvm_invokevirtual,
+ jvm_invokespecial,
+ jvm_invokestatic,
+ jvm_invokeinterface,
+ jvm_xxxunusedxxx, /* opcode 186 not used */
+ jvm_new,
+ jvm_newarray,
+ jvm_anewarray,
+ jvm_arraylength,
+ jvm_athrow,
+ jvm_checkcast,
+ jvm_instanceof,
+ jvm_monitorenter,
+ jvm_monitorexit,
+ jvm_wide,
+ jvm_multianewarray,
+ jvm_ifnull,
+ jvm_ifnonnull,
+ jvm_goto_w,
+ jvm_jsr_w,
+ jvm_breakpoint,
+ /* skip 203 - 253 */
+ jvm_impdep1 = 254,
+ jvm_impdep2
+} JVM_OPCODE;
+
+/*****************************************************************************
+ * this structure holds information about the state of the stack before and *
+ * after a method call. to correctly calculate the maximum stack depth, we *
+ * need to know how many arguments an invoke[static,virtual,etc] instruction *
+ * will pop off the stack. even though there is only one return value, it *
+ * can occupy zero, one, or two stack entries depending on the return type *
+ * of the method. *
+ *****************************************************************************/
+
+typedef struct _bc_stack_info {
+ int arg_len, /* depth of stack when this method is invoked */
+ ret_len; /* depth of stack when this method returns */
+} JVM_STACK_INFO;
+
+/****************************************************************************
+ * this structure is stored in the dlist label_list in a method info *
+ * struct and is used by calc_offsets. *
+ ****************************************************************************/
+
+typedef struct _bc_branch_pc {
+ struct _code_node *instr; /* instruction with this label */
+ char *label; /* the label number */
+} JVM_BRANCH_PC;
+
+typedef struct _bc_switch_entry {
+ struct _code_node *instr;
+ int case_num;
+} JVM_SWITCH_ENTRY;
+
+typedef struct _bc_switch_info {
+ int cell_padding;
+ int low;
+ int high;
+ Dlist offsets;
+ struct _code_node *default_case;
+
+ int num_entries;
+ struct _bc_switch_entry **sorted_entries;
+} JVM_SWITCH_INFO;
+
+typedef struct _code_node {
+ JVM_OPCODE op; /* the opcode for this instruction */
+ u4 pc; /* the address in bytecode of this instruction */
+ u4 operand; /* this opcode's operand (may be u1, u2, u4) */
+ u1 width; /* width of this op (may vary with wide modifier)*/
+
+ struct _bc_switch_info
+ * switch_info; /* parameters for tableswitch if appropriate */
+
+ struct _code_node
+ * branch_target, /* the node to which we might optionally branch *
+ * (comparison ops) or unconditionally branch */
+
+ * next; /* next op in code, but not necessarily next to *
+ * execute since we may branch over it. */
+
+ char *branch_label; /* f77 label to which this instruction branches */
+ int stack_depth; /* stack depth prior to execution of this opcode */
+
+ BOOL visited; /* for traversal - has this node been visited? */
+} JVM_CODE_GRAPH_NODE;
+
+typedef struct _bc_exception_table_entry {
+ struct _code_node
+ * from, /* PC at which the try block begins */
+ * to, /* PC at which the try block ends */
+ * target; /* PC at which the exception handler begins */
+ int catch_type; /* exception class corresponding to this catch */
+} JVM_EXCEPTION_TABLE_ENTRY;
+
+typedef struct _bc_line_number_table_entry {
+ struct _code_node *op; /* idx to code where original src stmt begins */
+ u2 line_number; /* the corresponding original line number */
+} JVM_LINE_NUMBER_TABLE_ENTRY;
+
+typedef struct _bc_local_variable_table_entry {
+ struct _code_node
+ *start, /* start idx of valid range for this variable */
+ *end; /* end index of valid range for this variable */
+ char *name; /* name of this variable */
+ u2 name_index; /* cp index to name of variable */
+ char *descriptor; /* descriptor for this variable */
+ u2 descriptor_index; /* cp index to descriptor for variable */
+ u2 index; /* this variable's index into local var table */
+} JVM_LOCAL_VARIABLE_TABLE_ENTRY;
+
+/*
+ * Enumeration of the JVM data types.
+ */
+
+typedef enum jvm_data_type {
+ jvm_Byte = 0x0,
+ jvm_Short,
+ jvm_Int,
+ jvm_Long,
+ jvm_Char,
+ jvm_Float,
+ jvm_Double,
+ jvm_Object
+} JVM_DATA_TYPE;
+
+/*
+ * Structures representing the JVM class file.
+ */
+
+typedef enum _constant_tags {
+ CONSTANT_Utf8 = 1, /* 1 */
+ /* note missing tag 2 */
+ CONSTANT_Integer = 3, /* 3 */
+ CONSTANT_Float, /* 4 */
+ CONSTANT_Long, /* 5 */
+ CONSTANT_Double, /* 6 */
+ CONSTANT_Class, /* 7 */
+ CONSTANT_String, /* 8 */
+ CONSTANT_Fieldref, /* 9 */
+ CONSTANT_Methodref, /* 10 */
+ CONSTANT_InterfaceMethodref, /* 11 */
+ CONSTANT_NameAndType /* 12 */
+} JVM_CONSTANT;
+
+typedef struct _bc_class_file {
+ u4 magic; /* class file magic number: 0xCAFEBABE */
+ u2 minor_version; /* minor version of the class file */
+ u2 major_version; /* major version of the class file */
+ u2 constant_pool_count; /* num entries in constant pool + 1 */
+ Dlist constant_pool; /* constant pool:constant_pool_count-1 entries */
+ u2 access_flags; /* access permissions for this class */
+ u2 this_class; /* cp index to entry representing this class */
+ u2 super_class; /* cp index to superclass or 0 for Object */
+ u2 interfaces_count; /* number of superinterfaces for this class */
+ Dlist interfaces; /* list of interfaces (each entry a cp index) */
+ u2 fields_count; /* num fields, both class vars & instance vars */
+ Dlist fields; /* list of fields declared in this class */
+ u2 methods_count; /* number of methods in this class */
+ Dlist methods; /* list of methods */
+ u2 attributes_count; /* number of attributes for this class */
+ Dlist attributes; /* only SourceFile & Deprecated allowed here */
+} JVM_CLASS;
+
+struct CONSTANT_Class_info {
+ u2 name_index; /* index into constant pool */
+};
+
+struct CONSTANT_Methodref_info {
+ u2 class_index; /* cp index of class which declares this field */
+ u2 name_and_type_index; /* cp index of name & descriptor of this field */
+};
+
+struct CONSTANT_String_info {
+ u2 string_index; /* cp index of Utf8 rep of this string */
+};
+
+struct CONSTANT_Integer_info {
+ u4 bytes; /* the integer value */
+};
+
+struct CONSTANT_Float_info {
+ u4 bytes; /* the float value */
+};
+
+struct CONSTANT_Long_info {
+ u4 high_bytes; /* the high bytes of the long value */
+ u4 low_bytes; /* the low bytes of the long value */
+};
+
+struct CONSTANT_Double_info {
+ u4 high_bytes; /* the high bytes of the double value */
+ u4 low_bytes; /* the low bytes of the double value */
+};
+
+struct CONSTANT_NameAndType_info {
+ u2 name_index; /* cp index of name or <init> stored as Utf8 */
+ u2 descriptor_index; /* cp index of valid field, method descriptor */
+};
+
+struct CONSTANT_Utf8_info {
+ u2 length; /* # bytes, not necessarily string length */
+ u1 *bytes; /* byte array containing the Utf8 string */
+};
+
+typedef struct _cp_info {
+ u1 tag;
+ union {
+ struct CONSTANT_Class_info Class;
+ struct CONSTANT_Methodref_info Methodref;
+ struct CONSTANT_String_info String;
+ struct CONSTANT_Integer_info Integer;
+ struct CONSTANT_Float_info Float;
+ struct CONSTANT_Long_info Long;
+ struct CONSTANT_Double_info Double;
+ struct CONSTANT_NameAndType_info NameAndType;
+ struct CONSTANT_Utf8_info Utf8;
+ } cpnode;
+} CP_INFO;
+
+typedef struct _field_info {
+ u2 access_flags; /* access flags mask, see table 4.4 in vm spec */
+ u2 name_index; /* cp index of field name, rep. as Utf8 string */
+ u2 descriptor_index; /* cp index of valid field descriptor */
+ u2 attributes_count; /* number of additional field attributes */
+ Dlist attributes; /* attributes of this field */
+
+ struct _bc_class_file
+ *class; /* the class containing this field */
+} JVM_FIELD;
+
+typedef struct _method_info {
+ u2 access_flags; /* access flags mask, see table 4.5 in vm spec */
+ u2 name_index; /* cp index of methodname, <init>, or <clinit> */
+ u2 descriptor_index; /* cp index of valid method descriptor */
+ u2 attributes_count; /* number of additional method attributes */
+ Dlist attributes; /* attributes of this method */
+
+ BOOL gen_bytecode; /* set to FALSE to suspend bytecode generation */
+
+ /* The following fields are not really part of the method struct as
+ * defined by the JVM spec, but they're here for convenience.
+ */
+
+ Dlist exc_table; /* list of exception table entries */
+ Dlist label_list; /* list of statements with label numbers */
+
+ BOOL reCalcAddr; /* Do node's addrs need to be recalculated? */
+
+ struct _attribute_info
+ *cur_code; /* code attribute */
+
+ Dlist
+ line_table, /* list of line number table entries */
+ locals_table; /* list of local variable table entries */
+
+ JVM_OPCODE lastOp; /* the last opcode emitted */
+
+ int stacksize; /* size of stack for current unit */
+
+ unsigned int
+ cur_local_number, /* current local variable number */
+ max_locals, /* number of locals needed for this method */
+ num_handlers, /* number of exception handlers in this method */
+ pc; /* current program counter */
+
+ char *name; /* name of this method */
+ char *file; /* name of the file containing this method */
+
+ struct _bc_class_file
+ *class; /* the class containing this method */
+} JVM_METHOD;
+
+struct ConstantValue_attribute {
+ u2 constantvalue_index; /* cp index to the actual constant value */
+};
+
+struct ExceptionTable {
+ u2 start_pc; /* index into code of start opcode (inclusive) */
+ u2 end_pc; /* index into code of end opcode (exclusive) */
+ u2 handler_pc; /* start of exception handler code */
+ u2 catch_type; /* cp index of exception class to catch */
+};
+
+struct Code_attribute {
+ u2 max_stack; /* max depth of operand stack for this method */
+ u2 max_locals; /* max num of local variables including params */
+ u4 code_length; /* number of bytes in the code array */
+ Dlist code; /* list containing code for this method */
+ u2 exception_table_length; /* number of entries in the exception table */
+
+ struct ExceptionTable * exception_table; /* table of exception handlers */
+
+ u2 attributes_count; /* number of additional code attributes */
+ Dlist attributes; /* attributes of this code */
+};
+
+struct Exceptions_attribute {
+ u2 number_of_exceptions; /* number of entries in exception_index_table */
+ Dlist exception_index_table;/* table of exceptions a method can throw */
+};
+
+struct SourceFile_attribute {
+ u2 sourcefile_index; /* cp index to name of source file (in Utf8) */
+};
+
+struct LineNumberTable_attribute {
+ u2 line_number_table_length; /* number of entries in line_number_table */
+ Dlist line_number_table; /* list of line number table entries */
+};
+
+struct LocalVariableTable_attribute {
+ u2 local_variable_table_length; /* number of entries in line_number_table */
+ Dlist local_variable_table; /* list of line number table entries */
+};
+
+struct InnerClassEntry {
+ u2 inner_class_info_index; /* cp index to the inner class */
+ u2 outer_class_info_index; /* cp index to the outer (enclosing) class */
+ u2 inner_name_index; /* cp index to simple name of inner class */
+ u2 inner_class_access_flags; /* access flags for the inner class */
+};
+
+struct InnerClasses_attribute {
+ u2 number_of_classes; /* number of entries in the classes array */
+ Dlist classes; /* list of inner class references */
+};
+
+struct UserDefined_attribute {
+ void *data;
+};
+
+typedef struct _attribute_info {
+ u2 attribute_name_index; /* cp index to name of attribute (in Utf8) */
+ u4 attribute_length; /* # bytes pointed to by the info field */
+ union {
+ struct ConstantValue_attribute * ConstantValue;
+ struct Code_attribute * Code;
+ struct Exceptions_attribute * Exceptions;
+ void * Synthetic;
+ struct SourceFile_attribute * SourceFile;
+ struct LineNumberTable_attribute * LineNumberTable;
+ struct LocalVariableTable_attribute * LocalVariableTable;
+ struct InnerClasses_attribute * InnerClasses;
+ struct UserDefined_attribute * UserDefined;
+ } attr;
+} JVM_ATTRIBUTE;
+
+/*
+ * We build a linked list containing all the constant pool entries.
+ * Each entry in the list has the following structure:
+ */
+
+typedef struct _constListNode {
+ unsigned int index;
+ unsigned int next_idx;
+ CP_INFO * val;
+} CP_NODE;
+
+/*****************************************************************************
+ * this structure holds information about a method reference, including the *
+ * name of the class which contains the method, the name of the method, and *
+ * the method descriptor. *
+ *****************************************************************************/
+
+typedef struct _methodref {
+ char *classname,
+ *methodname,
+ *descriptor;
+} JVM_METHODREF;
+
+/*****************************************************************************
+ * Definitions of opcodes related to code generation. *
+ *****************************************************************************/
+
+extern const int
+ jvm_newarray_type[JVM_MAX_RETURNS+1];
+
+extern const JVM_OPCODE
+ jvm_iconst_op[7],
+ jvm_array_load_op[JVM_MAX_RETURNS+1],
+ jvm_load_op[JVM_MAX_RETURNS+1],
+ jvm_store_op[JVM_MAX_RETURNS+1],
+ jvm_array_store_op[JVM_MAX_RETURNS+1],
+ jvm_short_store_op[JVM_MAX_RETURNS+1][4],
+ jvm_short_load_op[JVM_MAX_RETURNS+1][4];
+
+extern const JVM_OP_INFO
+ jvm_opcode[];
+
+extern const int
+ cp_entry_width[],
+ jvm_localvar_width[];
+
+/*****************************************************************************
+ ** Function prototypes **
+ *****************************************************************************/
+
+int
+ bc_write_class(JVM_CLASS *, char *),
+ bc_get_code_length(JVM_METHOD *),
+ bc_add_user_defined_class_attr(JVM_CLASS *, char *, int, void *),
+ bc_set_class_deprecated(JVM_CLASS *),
+ bc_set_class_version(JVM_CLASS *, int, int),
+ bc_add_class_interface(JVM_CLASS *, char *),
+ bc_set_constant_value_attr(JVM_FIELD *,
+ JVM_CONSTANT, const void *),
+ bc_set_field_deprecated(JVM_FIELD *),
+ bc_set_field_synthetic(JVM_FIELD *),
+ bc_set_method_deprecated(JVM_METHOD *),
+ bc_set_method_synthetic(JVM_METHOD *),
+ bc_add_method_exception(JVM_METHOD *, char *),
+ bc_add_inner_classes_attr(JVM_CLASS *, char *, char *, char *, int),
+ bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *),
+ bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *),
+ bc_set_stack_depth(JVM_CODE_GRAPH_NODE *, int),
+ bc_set_line_number(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int),
+ bc_add_exception_handler(JVM_METHOD *, JVM_EXCEPTION_TABLE_ENTRY *),
+ bc_remove_method(JVM_METHOD *),
+ bc_set_method_descriptor(JVM_METHOD *, char *),
+ bc_release_local(JVM_METHOD *, JVM_DATA_TYPE),
+ bc_set_cur_local_num(JVM_METHOD *, unsigned int),
+ bc_set_gen_status(JVM_METHOD *, BOOL),
+ bc_add_switch_case(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, int),
+ bc_add_switch_default(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *),
+ bc_associate_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, const char *),
+ bc_associate_integer_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int),
+ bc_set_branch_target(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *),
+ bc_set_branch_label(JVM_CODE_GRAPH_NODE *, const char *),
+ bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *, int),
+ bc_get_next_local(JVM_METHOD *, JVM_DATA_TYPE),
+ bc_add_source_file_attr(JVM_CLASS *, char *),
+ bc_new_methodref(JVM_CLASS *, char *, char *, char *),
+ bc_new_name_and_type(JVM_CLASS *, char *, char *),
+ bc_new_fieldref(JVM_CLASS *, char *, char *, char *),
+ bc_new_interface_methodref(JVM_CLASS *, char *, char *, char *);
+
+void
+ bc_free_method(JVM_METHOD *),
+ bc_free_class(JVM_CLASS *),
+ bc_free_constant_pool(JVM_CLASS *),
+ bc_free_interfaces(JVM_CLASS *),
+ bc_free_fields(JVM_CLASS *),
+ bc_free_methods(JVM_CLASS *),
+ bc_free_attributes(JVM_CLASS *, Dlist),
+ bc_free_fieldref(JVM_METHODREF *),
+ bc_free_nameandtype(JVM_METHODREF *),
+ bc_free_methodref(JVM_METHODREF *),
+ bc_free_interfaceref(JVM_METHODREF *),
+ bc_free_code_attribute(JVM_CLASS *, JVM_ATTRIBUTE *),
+ bc_free_line_number_table(JVM_METHOD *),
+ bc_free_locals_table(JVM_METHOD *),
+ bc_free_label_list(JVM_METHOD *),
+ bc_free_code(Dlist);
+
+JVM_LOCAL_VARIABLE_TABLE_ENTRY
+ *bc_set_local_var_name(JVM_METHOD *, int, char *, char *);
+
+char
+ *bc_next_desc_token(char *),
+ *bc_get_full_classname(char *, char *);
+
+FILE
+ *bc_fopen_fullpath(char *, char *, char *);
+
+JVM_CLASS
+ *bc_new_class(char *, char *, char *, char *, u2);
+
+JVM_METHOD
+ *bc_new_method(JVM_CLASS *, char *, char *, unsigned int),
+ *bc_add_default_constructor(JVM_CLASS *, u2);
+
+JVM_ATTRIBUTE
+ *bc_new_inner_classes_attr(JVM_CLASS *),
+ *bc_new_line_number_table_attr(JVM_METHOD *),
+ *bc_new_local_variable_table_attr(JVM_METHOD *),
+ *bc_new_synthetic_attr(JVM_CLASS *),
+ *bc_new_deprecated_attr(JVM_CLASS *),
+ *bc_new_exceptions_attr(JVM_CLASS *);
+
+JVM_FIELD
+ *bc_add_field(JVM_CLASS *, char *, char *, u2);
+
+JVM_CODE_GRAPH_NODE
+ *bc_get_next_instr(JVM_CODE_GRAPH_NODE *),
+ *bc_new_graph_node(JVM_METHOD *, JVM_OPCODE, u4),
+ *bc_push_int_const(JVM_METHOD *, int),
+ *bc_push_null_const(JVM_METHOD *),
+ *bc_push_double_const(JVM_METHOD *, double),
+ *bc_push_float_const(JVM_METHOD *, float),
+ *bc_push_long_const(JVM_METHOD *, long long),
+ *bc_push_string_const(JVM_METHOD *, char *),
+ *bc_gen_iinc(JVM_METHOD *, unsigned int, int),
+ *bc_gen_switch(JVM_METHOD *),
+ *bc_new_multi_array(JVM_METHOD *, u4, char *),
+ *bc_get_field(JVM_METHOD *, char *, char *, char *),
+ *bc_put_field(JVM_METHOD *, char *, char *, char *),
+ *bc_get_static(JVM_METHOD *, char *, char *, char *),
+ *bc_put_static(JVM_METHOD *, char *, char *, char *),
+ *bc_gen_instanceof(JVM_METHOD *, char *),
+ *bc_gen_checkcast(JVM_METHOD *, char *),
+ *bc_append(JVM_METHOD *, JVM_OPCODE, ...),
+ *bc_node_at_pc(JVM_METHOD *, int),
+ *bc_gen_new_object_array(JVM_METHOD *, int, char *),
+ *bc_gen_new_array(JVM_METHOD *, int, JVM_DATA_TYPE),
+ *bc_gen_array_load_op(JVM_METHOD *, JVM_DATA_TYPE),
+ *bc_gen_array_store_op(JVM_METHOD *, JVM_DATA_TYPE),
+ *bc_gen_return(JVM_METHOD *),
+ *bc_gen_new_obj(JVM_METHOD *, char *),
+ *bc_gen_new_obj_dup(JVM_METHOD *, char *),
+ *bc_gen_obj_instance_default(JVM_METHOD *, char *),
+ *bc_gen_store_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE),
+ *bc_gen_load_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE);
+
+JVM_EXCEPTION_TABLE_ENTRY
+ *bc_new_exception_table_entry(JVM_METHOD *, JVM_CODE_GRAPH_NODE *,
+ JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, char *);
+
+JVM_METHODREF
+ *bc_new_method_node(char *, char *, char *);
+
+JVM_OPCODE
+ bc_get_last_opcode(JVM_METHOD *);
+
+u1
+ bc_op_width(JVM_OPCODE);
+
+CP_NODE
+ *cp_entry_by_index(JVM_CLASS *, unsigned int);
+
+int
+ cp_lookup(JVM_CLASS *, JVM_CONSTANT, const void *),
+ cp_find_or_insert(JVM_CLASS *, JVM_CONSTANT, const void *),
+ cp_manual_insert(JVM_CLASS *, JVM_CONSTANT, const void *);
+
+void
+ cp_fields_dump(JVM_CLASS *),
+ cp_dump(JVM_CLASS *),
+ cp_quickdump(JVM_CLASS *);
+
+u4
+ cp_big_endian_u4(u4);
+
+u2
+ cp_big_endian_u2(u2);
+
+char
+ *cp_null_term_utf8(CP_INFO *);
+
+#endif
diff --git a/libbytecode/class.c b/libbytecode/class.c
new file mode 100644
index 0000000..1eab413
--- /dev/null
+++ b/libbytecode/class.c
@@ -0,0 +1,2148 @@
+/** @file class.c
+ * Routines for writing the class file to disk.
+ */
+
+#include "class.h"
+
+/**
+ * Given a pointer to a classfile structure, this function writes the class
+ * file to disk.
+ *
+ * @param class -- The class structure to be written.
+ * @param output_dir -- The name of the output directory to which the class file
+ * should be written. If NULL, the class file is written to the current
+ * directory.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+int
+bc_write_class(JVM_CLASS *class, char *output_dir)
+{
+ Dlist tmpPtr;
+ FILE *cfp;
+
+ if(!class) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(tmpPtr,class->methods) {
+ if(finalizeMethod((JVM_METHOD *) tmpPtr->val))
+ return -1;
+ }
+
+ class->constant_pool_count =
+ (u2) ((CP_NODE *)dl_val(dl_last(class->constant_pool)))->next_idx;
+
+ cfp = open_output_classfile(class, output_dir);
+
+ if(!cfp) return -1;
+
+ clearerr(cfp);
+
+ write_u4(class->magic, cfp);
+
+ write_u2(class->minor_version, cfp);
+
+ write_u2(class->major_version, cfp);
+
+ write_u2(class->constant_pool_count, cfp);
+
+ write_constant_pool(class, cfp);
+
+ write_u2(class->access_flags, cfp);
+
+ write_u2(class->this_class, cfp);
+
+ write_u2(class->super_class, cfp);
+
+ write_u2(class->interfaces_count, cfp);
+
+ write_interfaces(class,cfp);
+
+ write_u2(class->fields_count, cfp);
+
+ write_fields(class,cfp);
+
+ write_u2(class->methods_count, cfp);
+
+ write_methods(class,cfp);
+
+ write_u2(class->attributes_count, cfp);
+
+ write_attributes(class, class->attributes, cfp);
+
+ if(ferror(cfp)) {
+ fclose(cfp);
+ return -1;
+ }
+
+ fclose(cfp);
+
+ return 0;
+}
+
+/*****************************************************************************
+ *****************************************************************************
+ ** **
+ ** Functions after this point are not exposed as part of the API. **
+ ** **
+ *****************************************************************************
+ *****************************************************************************/
+
+
+/**
+ * This function writes the all the constants to disk. this could be more
+ * efficient if we could assume that there was no padding in the structures.
+ * then it would just be a matter of writing out however many bytes is
+ * allocated. but i'm not really sure how different compilers might pad
+ * structures, so i'm going to play it safe here and just write each item
+ * individually. --kgs 4/25/00
+ *
+ * @param class -- The class structure to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_constant_pool(JVM_CLASS *class, FILE *out)
+{
+ CP_NODE * tmpconst;
+ Dlist tmpPtr;
+
+ if(!class || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->constant_pool) {
+ tmpconst = (CP_NODE *) tmpPtr->val;
+
+ debug_msg("write_constant_pool() - tag = %d\n",tmpconst->val->tag);
+
+ write_u1(tmpconst->val->tag, out);
+
+ switch(tmpconst->val->tag) {
+ case CONSTANT_Utf8:
+ write_u2(tmpconst->val->cpnode.Utf8.length,out);
+ fwrite(tmpconst->val->cpnode.Utf8.bytes,
+ tmpconst->val->cpnode.Utf8.length,1,out);
+ break;
+ case CONSTANT_Integer:
+ fwrite(&(tmpconst->val->cpnode.Integer.bytes),
+ sizeof(tmpconst->val->cpnode.Integer.bytes),1,out);
+ break;
+ case CONSTANT_Float:
+ fwrite(&(tmpconst->val->cpnode.Float.bytes),
+ sizeof(tmpconst->val->cpnode.Float.bytes),1,out);
+ break;
+ case CONSTANT_Long:
+ fwrite(&(tmpconst->val->cpnode.Long.high_bytes),
+ sizeof(tmpconst->val->cpnode.Long.high_bytes),1,out);
+ fwrite(&(tmpconst->val->cpnode.Long.low_bytes),
+ sizeof(tmpconst->val->cpnode.Long.low_bytes),1,out);
+ break;
+ case CONSTANT_Double:
+ fwrite(&(tmpconst->val->cpnode.Double.high_bytes),
+ sizeof(tmpconst->val->cpnode.Double.high_bytes),1,out);
+ fwrite(&(tmpconst->val->cpnode.Double.low_bytes),
+ sizeof(tmpconst->val->cpnode.Double.low_bytes),1,out);
+ break;
+ case CONSTANT_Class:
+ write_u2(tmpconst->val->cpnode.Class.name_index,out);
+ break;
+ case CONSTANT_String:
+ write_u2(tmpconst->val->cpnode.String.string_index, out);
+ break;
+ case CONSTANT_Fieldref:
+ case CONSTANT_Methodref:
+ case CONSTANT_InterfaceMethodref:
+ write_u2(tmpconst->val->cpnode.Methodref.class_index,out);
+ write_u2(tmpconst->val->cpnode.Methodref.name_and_type_index,out);
+ break;
+ case CONSTANT_NameAndType:
+ write_u2(tmpconst->val->cpnode.NameAndType.name_index,out);
+ write_u2(tmpconst->val->cpnode.NameAndType.descriptor_index,out);
+ break;
+ default:
+ debug_err("WARNING: unknown tag in write_constant_pool()\n");
+ break; /* ANSI requirement */
+ }
+ }
+}
+
+/**
+ * This function writes the all the interfaces to disk.
+ *
+ * @param class -- The class structure to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_interfaces(JVM_CLASS *class, FILE *out)
+{
+ int i=0, ival;
+ Dlist tmpPtr;
+
+ if(!class || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ debug_msg("in write_interfaces %p %p\n", (void*)class, (void*)out);
+
+ dl_traverse(tmpPtr,class->interfaces) {
+ ival = *((int *) tmpPtr->val);
+ write_u2((u2)ival,out);
+ i++;
+ }
+
+ if(i != class->interfaces_count)
+ debug_err("Warning: expected to write %d interfaces, but wrote %d.\n",
+ class->interfaces_count, i);
+}
+
+/**
+ * This function writes the all the fields to disk.
+ *
+ * @param class -- The class structure to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_fields(JVM_CLASS *class, FILE *out)
+{
+ JVM_FIELD *tmpfield;
+ Dlist tmpPtr;
+ int cnt;
+
+ if(!class || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->fields) {
+ tmpfield = (JVM_FIELD *) tmpPtr->val;
+
+ debug_msg("write_fields() %d, %d, %d\n",
+ tmpfield->access_flags, tmpfield->name_index,
+ tmpfield->descriptor_index);
+
+ write_u2(tmpfield->access_flags,out);
+ write_u2(tmpfield->name_index,out);
+ write_u2(tmpfield->descriptor_index,out);
+
+ write_u2(tmpfield->attributes_count,out);
+
+ cnt = write_attributes(class, tmpfield->attributes, out);
+
+ if(tmpfield->attributes_count != cnt) {
+ debug_err("WARNING: expected to write %d attributes,",
+ tmpfield->attributes_count);
+ debug_err("but actually wrote %d attributes.", cnt);
+ }
+ }
+}
+
+/**
+ * This function writes the all the methods to disk.
+ *
+ * @param class -- The class structure to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_methods(JVM_CLASS *class, FILE *out)
+{
+ JVM_METHOD *tmpmeth;
+ Dlist tmpPtr;
+ int cnt;
+
+ if(!class || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->methods) {
+ tmpmeth = (JVM_METHOD *) tmpPtr->val;
+
+ write_u2(tmpmeth->access_flags,out);
+
+ write_u2(tmpmeth->name_index,out);
+
+ write_u2(tmpmeth->descriptor_index,out);
+
+ write_u2(tmpmeth->attributes_count,out);
+
+ cnt = write_attributes(class, tmpmeth->attributes, out);
+
+ if(tmpmeth->attributes_count != cnt) {
+ debug_err("WARNING: expected to write %d attributes,",
+ tmpmeth->attributes_count);
+ debug_err("but actually wrote %d attributes.", cnt);
+ }
+ }
+}
+
+/**
+ * This function writes the all the attributes in the given list
+ * to disk. Even though the first argument is a class structure, this
+ * function can be used to write attributes of a class, method, or field.
+ * In any case the class structure is needed for access to its constant
+ * pool.
+ *
+ * @param class -- The class structure to be written.
+ * @param attr_list -- The list of attributes to be written. It should
+ * be a Dlist of JVM_ATTRIBUTE pointers.
+ * @param out -- File pointer to which the data should be written.
+ *
+ * @returns Number of attributes written or -1 on failure.
+ */
+
+static int
+write_attributes(JVM_CLASS *class, Dlist attr_list, FILE *out)
+{
+ JVM_ATTRIBUTE *tmpattr;
+ char *attr_name;
+ Dlist tmpPtr, tmpPtr2;
+ CP_NODE *c;
+ int cnt = 0;
+
+ if(!attr_list || !class || !out) {
+ BAD_ARG();
+ return cnt;
+ }
+
+ dl_traverse(tmpPtr,attr_list) {
+ tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val;
+
+ c = cp_entry_by_index(class, tmpattr->attribute_name_index);
+
+ if(c==NULL) {
+ debug_err("WARNING: write_attributes() can't find attribute name\n");
+ continue;
+ }
+
+ attr_name = cp_null_term_utf8(c->val);
+
+ if(!attr_name)
+ return -1;
+
+ debug_msg("attribute name = '%s'\n", attr_name);
+
+ write_u2(tmpattr->attribute_name_index,out);
+
+ write_u4(tmpattr->attribute_length,out);
+
+ debug_msg("write_attributes() - attribute length: %d, idx: %d\n",
+ tmpattr->attribute_length, tmpattr->attribute_name_index);
+
+ if(!strcmp(attr_name,"SourceFile")) {
+ write_u2(tmpattr->attr.SourceFile->sourcefile_index,out);
+ }
+ else if(!strcmp(attr_name,"ConstantValue")) {
+ write_u2(tmpattr->attr.ConstantValue->constantvalue_index,out);
+ }
+ else if(!strcmp(attr_name,"Deprecated")) {
+ /* The Deprecated attribute has length 0, so there is nothing to write */
+ }
+ else if(!strcmp(attr_name,"Synthetic")) {
+ /* The Synthetic attribute has length 0, so there is nothing to write */
+ }
+ else if(!strcmp(attr_name,"Code")) {
+ write_u2(tmpattr->attr.Code->max_stack,out);
+
+ write_u2(tmpattr->attr.Code->max_locals,out);
+
+ write_u4(tmpattr->attr.Code->code_length,out);
+
+ write_code(tmpattr->attr.Code->code, out);
+
+ write_u2(tmpattr->attr.Code->exception_table_length,out);
+
+ if(tmpattr->attr.Code->exception_table_length > 0) {
+
+ write_exception_table(tmpattr->attr.Code->exception_table,
+ tmpattr->attr.Code->exception_table_length, out);
+ }
+
+ debug_msg("code attributes count = %d\n", tmpattr->attr.Code->attributes_count);
+
+ write_u2(tmpattr->attr.Code->attributes_count,out);
+
+ if(tmpattr->attr.Code->attributes_count > 0) {
+ write_attributes(class, tmpattr->attr.Code->attributes, out);
+ }
+ }
+ else if(!strcmp(attr_name,"Exceptions")) {
+ int *idx;
+
+ write_u2(tmpattr->attr.Exceptions->number_of_exceptions, out);
+
+ dl_traverse(tmpPtr2, tmpattr->attr.Exceptions->exception_index_table) {
+ idx = (int *) tmpPtr2->val;
+
+ write_u2(*idx, out);
+ }
+ }
+ else if(!strcmp(attr_name,"LineNumberTable")) {
+ JVM_LINE_NUMBER_TABLE_ENTRY *entry;
+
+ write_u2(tmpattr->attr.LineNumberTable->line_number_table_length, out);
+
+ dl_traverse(tmpPtr2, tmpattr->attr.LineNumberTable->line_number_table) {
+ entry = (JVM_LINE_NUMBER_TABLE_ENTRY *) tmpPtr2->val;
+
+ write_u2(entry->op->pc, out);
+ write_u2(entry->line_number, out);
+ }
+ }
+ else if(!strcmp(attr_name,"LocalVariableTable")) {
+ JVM_LOCAL_VARIABLE_TABLE_ENTRY *entry;
+ int len;
+
+ write_u2(tmpattr->attr.LocalVariableTable->local_variable_table_length,
+ out);
+
+ dl_traverse(tmpPtr2, tmpattr->attr.LocalVariableTable->local_variable_table) {
+ entry = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *) tmpPtr2->val;
+ len = (entry->end->pc - entry->start->pc) + entry->end->width;
+
+ write_u2(entry->start->pc, out);
+ write_u2(len, out);
+ write_u2(entry->name_index, out);
+ write_u2(entry->descriptor_index, out);
+ write_u2(entry->index, out);
+ }
+ }
+ else if(!strcmp(attr_name,"InnerClasses")) {
+ struct InnerClassEntry *entry;
+
+ write_u2(tmpattr->attr.InnerClasses->number_of_classes, out);
+
+ dl_traverse(tmpPtr2, tmpattr->attr.InnerClasses->classes) {
+ entry = (struct InnerClassEntry *)tmpPtr2->val;
+
+ write_u2(entry->inner_class_info_index, out);
+ write_u2(entry->outer_class_info_index, out);
+ write_u2(entry->inner_name_index, out);
+ write_u2(entry->inner_class_access_flags, out);
+ }
+ }
+ else {
+ /* Don't recognize this attribute, so it must be user-defined. */
+
+ fwrite(tmpattr->attr.UserDefined->data,1,tmpattr->attribute_length,out);
+ }
+
+ free(attr_name);
+ cnt++;
+ }
+
+ return cnt;
+}
+
+/**
+ * This function writes the exception table to disk.
+ *
+ * @param et -- Array of exception table structures to be written.
+ * @param len -- The number of exception table entries in the array.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_exception_table(struct ExceptionTable *et, int len, FILE *out)
+{
+ int i;
+
+ if(!et || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ for(i=0;i<len;i++) {
+ write_u2( et[i].start_pc, out );
+ write_u2( et[i].end_pc, out );
+ write_u2( et[i].handler_pc, out );
+ write_u2( et[i].catch_type, out );
+ }
+}
+
+/**
+ * Traverse the code graph and write each opcode to disk.
+ *
+ * @param g -- List of pointers to JVM_CODE_GRAPH_NODE structures,
+ * each node representing one instruction.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_code(Dlist g, FILE *out)
+{
+ Dlist tmp;
+ JVM_CODE_GRAPH_NODE *node;
+ u1 op;
+ u1 op1;
+ u2 op2;
+ u4 op4;
+
+ if(!g || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmp, g) {
+ node = (JVM_CODE_GRAPH_NODE *) dl_val(tmp);
+
+ op = (u1) node->op;
+ write_u1(op,out);
+
+ switch(node->width) {
+ case 1:
+ /* if the width is 1, then there is no operand */
+ break;
+ case 2:
+ op1 = (u1) node->operand;
+ write_u1(op1,out);
+ break;
+ case 3:
+ op2 = (u2) node->operand;
+ write_u2(op2,out);
+ break;
+ case 4:
+ op4 = (u4) node->operand;
+ write_u3(op4,out);
+ break;
+ case 5:
+ op4 = (u4) node->operand;
+ write_u4(op4,out);
+ break;
+ default:
+ if(op == jvm_tableswitch)
+ write_tableswitch(node, out);
+ else if(op == jvm_lookupswitch)
+ write_lookupswitch(node, out);
+ else
+ debug_err( "write_code(): hit default unexpectedly\n");
+
+ break;
+ }
+ }
+}
+
+/**
+ * This function opens the file to which we write the bytecode.
+ * We derive the name of the class by looking at the "this_class" entry
+ * in the class file's constant pool.
+ *
+ * @param class -- The class structure to be written.
+ * @param output_dir -- The name of the output directory to which the class file
+ * should be written. If NULL, the class file is written to the current
+ * directory.
+ *
+ * @returns Pointer to the opened file. Returns NULL on error.
+ */
+
+static FILE *
+open_output_classfile(JVM_CLASS *class, char *output_dir)
+{
+ char *filename;
+ FILE *newfp;
+ CP_NODE *c;
+
+ if(!class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ c = cp_entry_by_index(class, class->this_class);
+ if(!c) return NULL;
+
+ c = cp_entry_by_index(class, c->val->cpnode.Class.name_index);
+ if(!c) return NULL;
+
+ /* malloc enough characters in the filename for:
+ * - the class name
+ * - plus 6 chars for ".class"
+ * - plus 1 char for the null terminator
+ */
+
+ filename = (char *)malloc(c->val->cpnode.Utf8.length + 7);
+ if(!filename) return NULL;
+
+ strncpy(filename, (char *)c->val->cpnode.Utf8.bytes, c->val->cpnode.Utf8.length);
+ filename[c->val->cpnode.Utf8.length] = '\0';
+ strcat(filename,".class");
+
+ debug_msg("going to write class file: '%s'\n", filename);
+
+ newfp = bc_fopen_fullpath(filename,"wb", output_dir);
+
+ free(filename);
+ return newfp;
+}
+
+/**
+ * Finishes initialization of the method structure. Before writing, the
+ * method requires some preparation. This involves:
+ * -# Setting up the Line Number Table, Local Variable Table, and
+ * Exception table.
+ * -# Computing the code attribute length.
+ * -# Inserting the cur_code list as an attribute of this method.
+ *
+ * @param meth -- The method to be finalized.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+static int
+finalizeMethod(JVM_METHOD *meth)
+{
+ JVM_EXCEPTION_TABLE_ENTRY *et_entry;
+ Dlist tmp;
+ int idx, code_attr_len;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ /* at the end of the method, the stacksize should always be zero.
+ * if not, we're gonna have verification problems at the very least.
+ * at this point, there's not much we can do about it, but issue a
+ * warning.
+ */
+ if(meth->stacksize != 0)
+ debug_err("WARNING: ending method with stacksize = %d\n",
+ meth->stacksize);
+
+ if(traverse_code(meth) < 0) {
+ debug_err("Error: failure finalizing method\n");
+ return -1;
+ }
+
+ meth->cur_code->attr.Code->exception_table_length = meth->num_handlers;
+
+ if(meth->num_handlers > 0) {
+ meth->cur_code->attr.Code->exception_table = (struct ExceptionTable *)
+ malloc(sizeof(struct ExceptionTable) * meth->num_handlers);
+
+ if(!meth->cur_code->attr.Code->exception_table) return -1;
+
+ debug_msg("Code set exception_table_length = %d\n",meth->num_handlers);
+
+ idx = 0;
+ dl_traverse(tmp, meth->exc_table) {
+ et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) tmp->val;
+
+ meth->cur_code->attr.Code->exception_table[idx].start_pc = et_entry->from->pc;
+ meth->cur_code->attr.Code->exception_table[idx].end_pc = et_entry->to->pc;
+ meth->cur_code->attr.Code->exception_table[idx].handler_pc =
+ et_entry->target->pc;
+ meth->cur_code->attr.Code->exception_table[idx].catch_type =
+ et_entry->catch_type;
+ idx++;
+
+ free(et_entry);
+ }
+ }
+
+ dl_delete_list(meth->exc_table);
+ meth->exc_table = NULL;
+
+ /* check if there were any line number table entries created.
+ * if so, create the LineNumberTable attribute.
+ */
+
+ if(!dl_empty(meth->line_table)) {
+ JVM_ATTRIBUTE *lnt = bc_new_line_number_table_attr(meth);
+
+ if(!lnt) return -1;
+
+ dl_insert_b(meth->cur_code->attr.Code->attributes, lnt);
+ meth->cur_code->attr.Code->attributes_count++;
+ }
+
+ /* check if there were any local variable table entries created.
+ * if so, create the LocalVariableTable attribute.
+ */
+
+ if(!dl_empty(meth->locals_table)) {
+ JVM_ATTRIBUTE *lvt = bc_new_local_variable_table_attr(meth);
+
+ if(!lvt) return -1;
+
+ dl_insert_b(meth->cur_code->attr.Code->attributes, lvt);
+ meth->cur_code->attr.Code->attributes_count++;
+ }
+
+ /* calculate the size of the code attribute's attributes */
+
+ code_attr_len = 0;
+ dl_traverse(tmp, meth->cur_code->attr.Code->attributes) {
+ JVM_ATTRIBUTE *attr = (JVM_ATTRIBUTE *) tmp->val;
+
+ code_attr_len += attr->attribute_length + 6;
+ }
+
+ /* attribute_length is calculated as follows:
+ * max_stack = 2 bytes
+ * max_locals = 2 bytes
+ * code_length = 4 bytes
+ * code = pc bytes
+ * exception_table_length = 2 bytes
+ * exception_table = exc_table_len * sizeof(exc table) bytes
+ * attributes_count = 2 bytes
+ * attributes = code_attr_len bytes
+ * ---------------------------------
+ * total (in bytes) = 12 + exc_table_length * sizeof(exc table) + code_attr_len
+ */
+
+ meth->cur_code->attribute_length = meth->pc + 12 + meth->num_handlers *
+ sizeof(struct ExceptionTable) + code_attr_len;
+
+ meth->cur_code->attr.Code->max_locals = (u2)meth->max_locals;
+ meth->cur_code->attr.Code->code_length = meth->pc;
+
+ debug_msg("Code: set code_length = %d\n",meth->pc);
+
+ /*
+ * If the method was declared abstract or native, then it should not
+ * have a Code attribute.
+ */
+
+ if((meth->access_flags & JVM_ACC_ABSTRACT) ||
+ (meth->access_flags & JVM_ACC_NATIVE))
+ {
+ if(meth->cur_code->attr.Code->code_length > 0) {
+ debug_err("Warning: code_length > 0 for abstract method '%s'.\n",
+ meth->name);
+ }
+ }
+ else {
+ meth->attributes_count++;
+ dl_insert_b(meth->attributes, meth->cur_code);
+ }
+
+ return 0;
+}
+
+/**
+ * Writes an unsigned byte to the specified file pointer. there are no
+ * issues with endianness here, but this function is included for
+ * consistency.
+ *
+ * @param num -- The unsigned byte to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_u1(u1 num, FILE *out)
+{
+ if(!out) {
+ BAD_ARG();
+ return;
+ }
+
+ fwrite(&num, sizeof(num), 1, out);
+}
+
+/**
+ * Writes an unsigned short to the specified file pointer, changing
+ * endianness if necessary.
+ *
+ * @param num -- The unsigned short to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_u2(u2 num, FILE *out)
+{
+ if(!out) {
+ BAD_ARG();
+ return;
+ }
+
+ num = cp_big_endian_u2(num);
+ fwrite(&num, sizeof(num), 1, out);
+}
+
+/**
+ * Writes an unsigned short and then an unsigned byte to the
+ * specified file pointer, changing endianness if necessary.
+ *
+ * @param num -- The short/byte pair to be written. The parameter holds
+ * four bytes, but only the low-order three bytes are used. First the two
+ * low-order bytes of (num>>8) are written (endianness adjusted as
+ * necessary) followed by the low-order byte of num.
+ *
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_u3(u4 num, FILE *out){
+ u2 u2tmp;
+ u1 u1tmp;
+
+ if(!out) {
+ BAD_ARG();
+ return;
+ }
+
+ u1tmp = u2tmp = (u2)(num>>8);
+ u2tmp = cp_big_endian_u2(u2tmp);
+ fwrite(&u2tmp, sizeof(u2tmp), 1, out);
+
+ u1tmp = (u1)(num - (u1tmp<<8));
+ fwrite(&u1tmp, sizeof(u1tmp), 1, out);
+}
+
+/**
+ * Writes an unsigned int to the specified file pointer, changing endianness
+ * if necessary.
+ *
+ * @param num -- The unsigned int to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_u4(u4 num, FILE *out)
+{
+ if(!out) {
+ BAD_ARG();
+ return;
+ }
+
+ num = cp_big_endian_u4(num);
+ fwrite(&num, sizeof(num), 1, out);
+}
+
+/**
+ * Writes a tableswitch instruction. First writes any necessary padding
+ * followed by the variable-length instruction.
+ *
+ * @param node -- The instruction node to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_tableswitch(JVM_CODE_GRAPH_NODE *node, FILE *out)
+{
+ int i, n, zero = 0;
+
+ if(!node || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ fwrite(&zero, 1, node->switch_info->cell_padding, out);
+
+ if(node->switch_info->default_case)
+ write_u4(node->switch_info->default_case->pc - node->pc, out);
+ else
+ debug_err("warning, unspecified default not implemented yet.\n");
+
+ write_u4(node->switch_info->low, out);
+ write_u4(node->switch_info->high, out);
+
+ n = node->switch_info->high - node->switch_info->low + 1;
+
+ for(i = 0; i < n; i++)
+ write_u4(node->switch_info->sorted_entries[i]->instr->pc - node->pc, out);
+}
+
+/**
+ * Writes a lookupswitch instruction. First writes any necessary padding
+ * followed by the variable-length instruction.
+ *
+ * @param node -- The instruction node to be written.
+ * @param out -- File pointer to which the data should be written.
+ */
+
+static void
+write_lookupswitch(JVM_CODE_GRAPH_NODE *node, FILE *out){
+ int i, zero = 0;
+
+ if(!node || !out) {
+ BAD_ARG();
+ return;
+ }
+
+ fwrite(&zero, 1, node->switch_info->cell_padding, out);
+
+ if(node->switch_info->default_case)
+ write_u4(node->switch_info->default_case->pc - node->pc, out);
+ else
+ debug_err("warning, unspecified default not implemented yet.\n");
+
+ write_u4(node->switch_info->num_entries, out);
+
+ for(i = 0; i < node->switch_info->num_entries; i++) {
+ write_u4(node->switch_info->sorted_entries[i]->case_num, out);
+ write_u4(node->switch_info->sorted_entries[i]->instr->pc - node->pc, out);
+ }
+}
+
+/**
+ * This function traverses the code graph, determines the maximum stack size,
+ * and assigns branch target offsets to each instruction node. Also handles
+ * recalculating all branch target offsets in case the addresses shift (due to
+ * changing a goto to goto_w for example). Address shift also requires
+ * recomputing the cell padding for switch instructions.
+ *
+ * @param meth -- The method to be traversed.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+static int
+traverse_code(JVM_METHOD *meth)
+{
+ JVM_EXCEPTION_TABLE_ENTRY *et_entry;
+ JVM_CODE_GRAPH_NODE *val;
+ Dlist tmp, cgraph;
+
+ if(!meth) {
+ BAD_ARG();
+ return -1;
+ }
+
+ cgraph = meth->cur_code->attr.Code->code;
+
+ if(dl_empty(cgraph))
+ return 0;
+
+ /* set initial stack depth to zero */
+ val = (JVM_CODE_GRAPH_NODE *) dl_val(dl_first(cgraph));
+ val->stack_depth = 0;
+
+ meth->reCalcAddr = FALSE;
+
+ /* traverse the whole graph calculating branch target offsets. */
+ calc_offsets(meth, val);
+
+ /* now traverse paths originating from exception handlers */
+ meth->num_handlers = 0;
+ dl_traverse(tmp, meth->exc_table) {
+ /* count number of handlers.. we'll use this info later */
+ meth->num_handlers++;
+ et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) tmp->val;
+
+ /*
+ * set stack depth for the beginning of the exception handler to
+ * the depth of the stack at the beginning of the 'try' block plus 1
+ * (to account for the reference to the exception which is sitting on
+ * the stack now).
+ */
+
+ et_entry->target->stack_depth = et_entry->from->stack_depth + 1;
+
+ calc_offsets(meth, et_entry->target);
+ }
+
+ /*
+ * if there was a branch offset that exceeds the JVM instruction's
+ * limit (signed 16-bit value), then the width of that instruction
+ * must change (e.g. from goto to goto_w), thus altering the
+ * addresses of all instructions following that one. here we are
+ * recalculating the PCs and all branch target offsets (only if
+ * necessary though). there are only a few instances in the LAPACK
+ * code where the branch exceeds the limits, so this shouldn't
+ * increase the compilation time very much.
+ */
+
+ if(meth->reCalcAddr) {
+ int tmpPC = 0;
+
+ dl_traverse(tmp,cgraph) {
+ val = (JVM_CODE_GRAPH_NODE *) tmp->val;
+
+ val->pc = tmpPC;
+
+ /* if this is a switch, then the cell padding and op width need
+ * to be recalculated based on the pc of this instruction.
+ */
+
+ if(val->op == jvm_tableswitch) {
+ val->switch_info->cell_padding = 3-(val->pc%4);
+ val->width = 1 + val->switch_info->cell_padding + 12 +
+ (val->switch_info->high - val->switch_info->low + 1) * 4;
+ }
+ else if(val->op == jvm_lookupswitch) {
+ val->switch_info->cell_padding = 3-(val->pc%4);
+ val->width = 1 + val->switch_info->cell_padding + 8 +
+ val->switch_info->num_entries * 8;
+ }
+
+ tmpPC += val->width;
+ }
+
+ /* now that all the instruction addresses are correct, recalculate
+ * the branch target offsets.
+ */
+
+ meth->reCalcAddr = FALSE;
+ dl_traverse(tmp,cgraph) {
+ val = (JVM_CODE_GRAPH_NODE *) tmp->val;
+
+ if ( val->branch_target != NULL) {
+ meth->reCalcAddr =
+ check_distance(val->op, val->branch_target->pc, val->pc);
+
+ val->operand = val->branch_target->pc - val->pc;
+ }
+ }
+
+ if(meth->reCalcAddr) {
+ debug_err("BAD NEWS - things are still screwed.\n");
+ return -1;
+ }
+
+ meth->pc = tmpPC;
+ }
+
+ if(meth->pc > JVM_MAX_CODE_LEN)
+ debug_err("WARNING: code length (%d) exceeds max of %d\n",
+ meth->pc, JVM_MAX_CODE_LEN);
+
+ /* print the instructions if debugging is enabled */
+#ifdef BC_DEBUG
+ dl_traverse(tmp,cgraph) {
+ char *warn;
+
+ val = (JVM_CODE_GRAPH_NODE *) tmp->val;
+
+ if(!val->visited)
+ warn = "(UNVISITED!!)";
+ else
+ warn = "";
+
+ if(bc_op_width(val->op) > 1)
+ debug_msg("%d: %s %d %s\n", val->pc, jvm_opcode[val->op].op,
+ val->operand, warn);
+ else
+ debug_msg("%d: %s %s\n", val->pc, jvm_opcode[val->op].op, warn);
+ }
+#endif
+
+ return 0;
+}
+
+/**
+ * This function calculates the branch target offsets for instructions that
+ * branch (gotos, compares, etc). Also set the stack depth for the
+ * instruction(s) following this one. Also perform sanity checks on the
+ * stack values to make sure that we aren't hitting some instruction from
+ * different places with different stack depths.
+ *
+ * @param meth -- The method to be traversed.
+ * @param val -- The node in the code graph to start traversing from.
+ */
+
+static void
+calc_offsets(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *val)
+{
+ JVM_CODE_GRAPH_NODE *label_node;
+ Dlist cgraph;
+ int temp_pc, stack_inc, stack_dec;
+
+ if(!meth || !val) {
+ BAD_ARG();
+ return;
+ }
+
+ cgraph = meth->cur_code->attr.Code->code;
+
+ debug_msg("in calc_offsets, before op %d : %s, stack_Depth = %d\n",
+ val->pc, jvm_opcode[val->op].op,val->stack_depth);
+
+ if(val->next == NULL)
+ debug_msg("next is NULL\n");
+ else
+ debug_msg("next is %s\n", jvm_opcode[val->next->op].op);
+
+ if(val->visited)
+ return;
+
+ val->visited = TRUE;
+
+ meth->stacksize = val->stack_depth;
+
+ stack_dec = get_stack_decrement(meth, val->op, val->operand);
+ stack_inc = get_stack_increment(meth, val->op, val->operand);
+
+ if((stack_dec < 0) || (stack_inc < 0)) {
+ debug_err("Could not determine stack inc/dec\n");
+ stack_dec = 0;
+ stack_inc = 0;
+ }
+
+ dec_stack(meth, stack_dec);
+
+ if(meth->stacksize < 0)
+ debug_msg("\tpc = %d\n", val->pc);
+
+ inc_stack(meth, stack_inc);
+
+ if((val->op == jvm_tableswitch) || (val->op == jvm_lookupswitch)) {
+ int i=0;
+
+ meth->reCalcAddr = TRUE;
+
+ if(num_empty_switch_cases(val) > JVM_SWITCH_FILL_THRESH)
+ i = setup_lookupswitch(val);
+ else
+ i = setup_tableswitch(val);
+
+ if(i < 0) {
+ debug_err("Error setting up switch\n");
+ return;
+ }
+
+ /* now visit the code for each case in this switch */
+
+ for(i = 0; i < val->switch_info->num_entries; i++) {
+ JVM_SWITCH_ENTRY *entry = val->switch_info->sorted_entries[i];
+
+ if(entry->instr->stack_depth == -1)
+ entry->instr->stack_depth = meth->stacksize;
+
+ calc_offsets(meth, entry->instr);
+ }
+
+ calc_offsets(meth, val->switch_info->default_case);
+
+ return;
+ }else if((val->op == jvm_goto) || (val->op == jvm_goto_w) ||
+ (val->op == jvm_jsr) || (val->op == jvm_jsr_w)) {
+ if(val->branch_target == NULL) {
+
+ debug_msg("looking at GOTO %s\n", val->branch_label);
+
+ if( (temp_pc = find_label(meth->label_list, val->branch_label)) != -1)
+ {
+ label_node = bc_node_at_pc(meth, temp_pc);
+
+ if(label_node != NULL) {
+
+ debug_msg(" **found** target pc is %d\n", label_node->pc);
+
+ if(label_node->stack_depth == -1)
+ label_node->stack_depth = meth->stacksize;
+ else if(label_node->stack_depth != meth->stacksize)
+ debug_err("WARNING: hit pc %d with diff stack sizes (%s)\n",
+ label_node->pc, meth->name);
+
+ if(check_distance(val->op, label_node->pc, val->pc)) {
+ meth->reCalcAddr = TRUE;
+ if(val->op == jvm_goto) {
+ val->op = jvm_goto_w;
+ val->width = bc_op_width(jvm_goto_w);
+ }
+ else if(val->op == jvm_jsr) {
+ val->op = jvm_jsr_w;
+ val->width = bc_op_width(jvm_jsr_w);
+ }
+ else
+ debug_err("did not expect to be here\n");
+ }
+
+ val->operand = label_node->pc - val->pc;
+ val->branch_target = label_node;
+ calc_offsets(meth, label_node);
+ }
+ else
+ debug_err("WARNING: cannot find node for pc %d\n", temp_pc);
+ }
+ else
+ debug_err("WARNING: cannot find label %s\n", val->branch_label);
+ }
+ else {
+ debug_msg("goto branching to pc %d\n", val->branch_target->pc);
+
+ if(val->branch_target->stack_depth == -1)
+ val->branch_target->stack_depth = meth->stacksize;
+ else if (val->branch_target->stack_depth != meth->stacksize)
+ debug_err("WARNING: hit pc %d with diff stack sizes (%s).\n",
+ val->branch_target->pc, meth->name);
+
+ if(check_distance(val->op, val->branch_target->pc, val->pc)) {
+ meth->reCalcAddr = TRUE;
+ if(val->op == jvm_goto) {
+ val->op = jvm_goto_w;
+ val->width = bc_op_width(jvm_goto_w);
+ }
+ else if(val->op == jvm_jsr) {
+ val->op = jvm_jsr_w;
+ val->width = bc_op_width(jvm_jsr_w);
+ }
+ else
+ debug_err("did not expect to be here\n");
+ }
+
+ val->operand = val->branch_target->pc - val->pc;
+ calc_offsets(meth, val->branch_target);
+ }
+
+ /* if this is a jsr, then the subroutine will return back to the
+ * instruction following the jsr, so continue visiting those nodes now.
+ */
+
+ if((val->op == jvm_jsr) || (val->op == jvm_jsr_w)) {
+ if(val->next != NULL) {
+ val->next->stack_depth = meth->stacksize;
+ calc_offsets(meth, val->next);
+ }
+ }
+ }
+ else if ( val->branch_target != NULL) {
+ if(val->next != NULL)
+ val->next->stack_depth = meth->stacksize;
+
+ if(check_distance(val->op, val->branch_target->pc, val->pc)) {
+ JVM_CODE_GRAPH_NODE *gotoNode, *wideGotoNode;
+ Dlist listNode;
+
+ meth->reCalcAddr = TRUE;
+
+ val->branch_target->stack_depth = meth->stacksize;
+ val->operand = val->branch_target->pc - val->pc;
+
+ gotoNode = bc_new_graph_node(meth, jvm_goto, 0);
+ wideGotoNode = bc_new_graph_node(meth, jvm_goto_w, 0);
+
+ if(!gotoNode || !wideGotoNode)
+ return;
+
+ gotoNode->visited = TRUE;
+ wideGotoNode->visited = TRUE;
+
+ gotoNode->branch_target = val->next;
+ wideGotoNode->next = val->next;
+ gotoNode->next = wideGotoNode;
+ val->next = gotoNode;
+ wideGotoNode->branch_target = val->branch_target;
+ val->branch_target = wideGotoNode;
+
+ listNode = get_list_node(cgraph, val);
+ dl_insert_a(listNode, gotoNode);
+ listNode = dl_next(listNode);
+ dl_insert_a(listNode, wideGotoNode);
+
+ if(gotoNode->branch_target != NULL){
+ calc_offsets(meth, gotoNode->branch_target);
+ }
+ calc_offsets(meth, wideGotoNode->branch_target);
+ }
+ else {
+
+ val->branch_target->stack_depth = meth->stacksize;
+ val->operand = val->branch_target->pc - val->pc;
+
+ if(val->next != NULL){
+ calc_offsets(meth, val->next);
+ }
+ calc_offsets(meth, val->branch_target);
+ }
+ }
+ else {
+ if(val->next != NULL) {
+ if((val->op != jvm_return) && (val->op != jvm_areturn) &&
+ (val->op != jvm_dreturn) && (val->op != jvm_freturn) &&
+ (val->op != jvm_ireturn) && (val->op != jvm_areturn) &&
+ (val->op != jvm_ret))
+ {
+ val->next->stack_depth = meth->stacksize;
+ calc_offsets(meth, val->next);
+ }
+ }
+
+ /* if this is a return statement, then reset the opcode to
+ * the one matching the method descriptor.
+ */
+
+ if((val->op == jvm_return) || (val->op == jvm_areturn) ||
+ (val->op == jvm_dreturn) || (val->op == jvm_freturn) ||
+ (val->op == jvm_ireturn) || (val->op == jvm_areturn))
+ {
+ if(meth->descriptor_index != 0) {
+ CP_NODE *c;
+ char *desc;
+
+ c = cp_entry_by_index(meth->class, meth->descriptor_index);
+
+ if(c) {
+ desc = cp_null_term_utf8(c->val);
+
+ if(desc)
+ val->op = get_method_return_op(desc);
+
+ free(desc);
+ }
+ }
+ else
+ debug_err("warning: method descriptor still unspecified!!\n");
+ }
+ }
+
+ return;
+}
+
+/**
+ * Calculates the number of empty cases in a switch instruction.
+ * This information is used to determine whether to use the
+ * tableswitch or lookupswitch instruction. If there are a lot
+ * of empty cases, then the lookupswitch is preferred.
+ *
+ * @param switch_instr -- The switch instruction to examine.
+ *
+ * @returns The number of empty switch cases.
+ */
+
+static int
+num_empty_switch_cases(JVM_CODE_GRAPH_NODE *switch_instr)
+{
+ Dlist tmp;
+ int n, cnt=0;
+
+ if(!switch_instr) {
+ BAD_ARG();
+ return 0;
+ }
+
+ n = switch_instr->switch_info->high - switch_instr->switch_info->low + 1;
+
+ dl_traverse(tmp, switch_instr->switch_info->offsets) {
+ cnt++;
+ }
+
+ return n-cnt;
+}
+
+/**
+ * Determines the number of bytes that this instruction removes from the
+ * stack prior to execution. This depends on the instruction and on the
+ * data types involved. e.g. a method invoke instruction will remove one or
+ * two entries per argument, depending on the data type.
+ *
+ * @param meth -- The method in which this instruction is located.
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes removed from the stack before execution.
+ */
+
+static int
+get_stack_decrement(JVM_METHOD *meth, JVM_OPCODE op, u4 index)
+{
+ int stack_decrement;
+ Dlist const_table;
+
+ if(!meth) {
+ BAD_ARG();
+ return 0;
+ }
+
+ const_table = meth->class->constant_pool;
+
+ switch(op) {
+ case jvm_multianewarray:
+ stack_decrement = index-((index>>8) * 256);
+ break;
+ case jvm_invokespecial:
+ case jvm_invokevirtual:
+ case jvm_invokestatic:
+ case jvm_invokeinterface:
+ stack_decrement = get_stack_dec_invocation(meth->class, op, index);
+ break;
+ case jvm_putstatic:
+ case jvm_getstatic:
+ case jvm_putfield:
+ case jvm_getfield:
+ stack_decrement = get_stack_dec_field_acc(meth->class, op, index);
+ break;
+ default:
+ /* else we can determine the stack decrement from a table. */
+ stack_decrement = jvm_opcode[op].stack_pre;
+ }
+
+ return stack_decrement;
+}
+
+/**
+ * Determines the number of bytes that this field access instruction
+ * (getfield, putfield, getstatic, putstatic) removes from the
+ * stack prior to execution.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * this instruction (i.e. the class containing the method containing the
+ * instruction).
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes removed from the stack before execution.
+ */
+
+static int
+get_stack_dec_field_acc(JVM_CLASS *class, JVM_OPCODE op, u4 index)
+{
+ int stack_decrement;
+ char *this_desc;
+ int tmpsize;
+ CP_NODE *c;
+
+ if(!class) {
+ BAD_ARG();
+ return 0;
+ }
+
+ c = cp_entry_by_index(class, index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index);
+ if(!c) return -1;
+
+ this_desc = cp_null_term_utf8(c->val);
+ if(!this_desc) return -1;
+
+ if((this_desc[0] == 'D') || (this_desc[0] == 'J'))
+ tmpsize = 2;
+ else
+ tmpsize = 1;
+
+ switch(op) {
+ case jvm_getstatic:
+ stack_decrement = 0;
+ break;
+ case jvm_putstatic:
+ stack_decrement = tmpsize;
+ break;
+ case jvm_getfield:
+ stack_decrement = 1;
+ break;
+ case jvm_putfield:
+ stack_decrement = tmpsize + 1;
+ break;
+ default:
+ debug_err("get_stack_decrement(): unexpected op type\n");
+ free(this_desc);
+ return -1;
+ }
+
+ free(this_desc);
+
+ return stack_decrement;
+}
+
+/**
+ * Determines the number of bytes that this method invocation instruction
+ * (invokespecial, invokevirtual, invokestatic, invokeinterface) removes
+ * from the stack prior to execution.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * this instruction (i.e. the class containing the method containing the
+ * instruction).
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes removed from the stack before execution.
+ */
+
+static int
+get_stack_dec_invocation(JVM_CLASS *class, JVM_OPCODE op, u4 index)
+{
+ JVM_STACK_INFO *stackinf;
+ int stack_decrement;
+ char *this_desc;
+ int int_idx;
+ CP_NODE *c;
+
+ if(!class) {
+ BAD_ARG();
+ return 0;
+ }
+
+ int_idx = (int)index;
+
+ if(op == jvm_invokeinterface)
+ int_idx >>= 16;
+
+ /* now we need to determine how many parameters are sitting on the stack */
+ c = cp_entry_by_index(class, int_idx);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index);
+ if(!c) return -1;
+
+ this_desc = cp_null_term_utf8(c->val);
+ if(!this_desc) return -1;
+
+ stackinf = calc_stack(this_desc);
+ if(!stackinf) {
+ free(this_desc);
+ return -1;
+ }
+
+ /* if the opcode is invokespecial or invokevirtual, then there is one
+ * object reference + parameters on the stack. if this is an invokestatic
+ * instruction, then there's just parameters.
+ */
+ if(op == jvm_invokestatic)
+ stack_decrement = stackinf->arg_len;
+ else
+ stack_decrement = stackinf->arg_len + 1;
+
+ free(stackinf);
+ free(this_desc);
+
+ return stack_decrement;
+}
+
+/**
+ * Determines the number of bytes that this instruction leaves on the stack
+ * after execution. this depends on the instruction and on the data types.
+ * e.g. for a method invoke instruction, the number of bytes depends on the
+ * return type of the method (double/long = 2 stack entries).
+ *
+ * @param meth -- The method in which this instruction is located.
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes added to the stack after execution.
+ */
+
+static int
+get_stack_increment(JVM_METHOD *meth, JVM_OPCODE op, u4 index)
+{
+ int stack_increment;
+ Dlist const_table;
+
+ if(!meth) {
+ BAD_ARG();
+ return 0;
+ }
+
+ const_table = meth->class->constant_pool;
+
+ switch(op) {
+ case jvm_invokespecial:
+ case jvm_invokevirtual:
+ case jvm_invokestatic:
+ case jvm_invokeinterface:
+ stack_increment = get_stack_inc_invocation(meth->class, op, index);
+ break;
+ case jvm_putstatic:
+ case jvm_getstatic:
+ case jvm_putfield:
+ case jvm_getfield:
+ stack_increment = get_stack_inc_field_acc(meth->class, op, index);
+ break;
+ default:
+ /* else we can determine the stack increment from a table. */
+ stack_increment = jvm_opcode[op].stack_post;
+ }
+
+ return stack_increment;
+}
+
+
+/**
+ * Determines the number of bytes that this method invocation instruction
+ * (invokespecial, invokevirtual, invokestatic, invokeinterface) leaves
+ * on the stack after execution.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * this instruction (i.e. the class containing the method containing the
+ * instruction).
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes left on the stack after execution.
+ */
+
+static int
+get_stack_inc_invocation(JVM_CLASS *class, JVM_OPCODE op, u4 index)
+{
+ JVM_STACK_INFO *stackinf;
+ int stack_increment;
+ char *this_desc;
+ CP_NODE *c;
+ int int_idx;
+
+ if(!class) {
+ BAD_ARG();
+ return 0;
+ }
+
+ int_idx = index;
+
+ if(op == jvm_invokeinterface)
+ int_idx >>= 16;
+
+ /* now we need to determine how many parameters are sitting on the stack */
+ c = cp_entry_by_index(class, int_idx);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index);
+ if(!c) return -1;
+
+ this_desc = cp_null_term_utf8(c->val);
+ if(!this_desc) return -1;
+
+ stackinf = calc_stack(this_desc);
+ if(!stackinf) {
+ free(this_desc);
+ return -1;
+ }
+
+ /* if the opcode is invokespecial, invokevirtual, or invokeinterface then
+ * there is one object reference + parameters on the stack. if this is an
+ * invokestatic instruction, then there's just parameters.
+ */
+
+ stack_increment = stackinf->ret_len;
+
+ free(stackinf);
+ free(this_desc);
+
+ return stack_increment;
+}
+
+/**
+ * Determines the number of bytes that this field access instruction
+ * (getfield, putfield, getstatic, putstatic) leaves on the stack
+ * after execution.
+ *
+ * @param class -- The class containing the constant pool relevant to
+ * this instruction (i.e. the class containing the method containing the
+ * instruction).
+ * @param op -- The instruction opcode.
+ * @param index -- The operand to the instruction.
+ *
+ * @returns The number of bytes left on the stack after execution.
+ */
+
+static int
+get_stack_inc_field_acc(JVM_CLASS *class, JVM_OPCODE op, u4 index)
+{
+ int stack_increment;
+ char *this_desc;
+ CP_NODE *c;
+ int tmpsize;
+
+ if(!class) {
+ BAD_ARG();
+ return 0;
+ }
+
+ c = cp_entry_by_index(class, index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index);
+ if(!c) return -1;
+
+ c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index);
+ if(!c) return -1;
+
+ this_desc = cp_null_term_utf8(c->val);
+ if(!this_desc) return -1;
+
+ if((this_desc[0] == 'D') || (this_desc[0] == 'J'))
+ tmpsize = 2;
+ else
+ tmpsize = 1;
+
+ switch(op) {
+ case jvm_getstatic:
+ stack_increment = tmpsize;
+ break;
+ case jvm_putstatic:
+ stack_increment = 0;
+ break;
+ case jvm_getfield:
+ stack_increment = tmpsize;
+ break;
+ case jvm_putfield:
+ stack_increment = 0;
+ break;
+ default:
+ debug_err("get_stack_increment(): unexpected op type\n");
+ free(this_desc);
+ return -1;
+ }
+
+ free(this_desc);
+
+ return stack_increment;
+}
+
+/**
+ * Given a method descriptor, this function returns the number of arguments
+ * it takes (actually the number returned may differ from the number of args
+ * because doubles and longs take two stack entries per argument). This value
+ * is used to determine how much to decrement the stack after a method
+ * invocation.
+ *
+ * @param d -- The method descriptor to analyze.
+ *
+ * @returns The number of stack entries used for the arguments of the method
+ * with the given descriptor.
+ */
+
+static JVM_STACK_INFO *
+calc_stack(char *d)
+{
+ JVM_STACK_INFO *tmp;
+ int len = strlen(d);
+ char *ptr, *tstr;
+
+ if(!d) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ debug_msg("in calc_stack, the desc = '%s'\n", d);
+
+ tmp = (JVM_STACK_INFO *)malloc(sizeof(JVM_STACK_INFO));
+
+ if(!tmp) return NULL;
+
+ tmp->arg_len = 1;
+ tmp->ret_len = 1;
+
+ /* the shortest possible method descriptor should be 3 characters: ()V
+ * thus, if the given string is < 3 characters, it must be in error.
+ */
+
+ if(len < 3) {
+ debug_err("WARNING: invalid descriptor '%s' (len < 3).\n", d);
+ return tmp;
+ }
+
+ if(d[0] != '(') {
+ debug_err("WARNING: invalid descriptor '%s' (bad 1st char).\n", d);
+ return tmp;
+ }
+
+ ptr = d;
+
+ /* start at -1 because the opening paren will contribute 1 to
+ * the count.
+ */
+ tmp->arg_len = -1;
+
+ while((ptr = bc_next_desc_token(ptr)) != NULL) {
+ tmp->arg_len++;
+
+ /* check if this is a double or long type. if so, increment
+ * again because these data types take up two stack entries.
+ */
+ if( (*ptr == 'D') || (*ptr == 'J') )
+ tmp->arg_len++;
+ }
+
+ tstr = strdup(d);
+ if(!tstr) {
+ debug_err("WARNING: could not dup descriptor.\n");
+ return tmp;
+ }
+
+ strtok(tstr,")");
+ ptr = strtok(NULL,")");
+ if( (*ptr == 'D') || (*ptr == 'J') )
+ tmp->ret_len = 2;
+ else if(*ptr == 'V')
+ tmp->ret_len = 0;
+ else
+ tmp->ret_len = 1;
+
+ free(tstr);
+
+ debug_msg("calc_stack arg_len = %d, ret_len = %d\n",
+ tmp->arg_len, tmp->ret_len);
+
+ return tmp;
+}
+
+/**
+ * Increment the stacksize by the specified amount. If this is the highest
+ * stack value encountered, set max_stack to the current stacksize.
+ *
+ * @param meth -- The method whose stack should be increased.
+ * @param inc -- The amount to increase the stack.
+ */
+
+static void
+inc_stack(JVM_METHOD *meth, int inc)
+{
+ if(!meth) {
+ BAD_ARG();
+ return;
+ }
+
+ meth->stacksize += inc;
+
+ if(meth->stacksize > meth->cur_code->attr.Code->max_stack)
+ meth->cur_code->attr.Code->max_stack = (u2)meth->stacksize;
+}
+
+/**
+ * Decrement the stacksize by the specified amount. *
+ *
+ * @param meth -- The method whose stack should be decreased.
+ * @param dec -- The amount to decrease the stack.
+ */
+
+static void
+dec_stack(JVM_METHOD *meth, int dec) {
+ if(!meth) {
+ BAD_ARG();
+ return;
+ }
+
+ meth->stacksize -= dec;
+
+ if(meth->stacksize < 0)
+ debug_err("WARNING: negative stack! (%s)\n", meth->name);
+}
+
+
+/**
+ * Prepares a tableswitch instruction to be written out. This involves:
+ * -# Calculating the cell padding.
+ * -# Setting up the array of cases.
+ * -# Sorting the switch cases.
+ * -# Filling in missing cases with default information.
+ *
+ * @param val -- The tableswitch instruction node.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+static int
+setup_tableswitch(JVM_CODE_GRAPH_NODE *val)
+{
+ Dlist tmp;
+ int i, n;
+
+ if(!val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ val->op = jvm_tableswitch;
+
+ n = val->switch_info->high - val->switch_info->low + 1;
+
+ val->switch_info->sorted_entries =
+ (JVM_SWITCH_ENTRY **)malloc(sizeof(JVM_SWITCH_ENTRY *) * n);
+ if(!val->switch_info->sorted_entries) return -1;
+
+ val->switch_info->num_entries = n;
+
+ for(i = 0; i < n; i++)
+ val->switch_info->sorted_entries[i] = NULL;
+
+ /* set up the array of branch targets to be sorted */
+
+ dl_traverse(tmp, val->switch_info->offsets) {
+ JVM_SWITCH_ENTRY *entry = (JVM_SWITCH_ENTRY *) tmp->val;
+ int idx;
+
+ idx = entry->case_num - val->switch_info->low;
+ val->switch_info->sorted_entries[idx] = entry;
+ i++;
+ }
+
+ /* fill in any missing cases with the default branch target */
+
+ for(i = 0; i < n; i++) {
+ if(!val->switch_info->sorted_entries[i]) {
+ JVM_SWITCH_ENTRY *new_entry =
+ (JVM_SWITCH_ENTRY *)malloc(sizeof(JVM_SWITCH_ENTRY));
+
+ if(!new_entry) return -1;
+
+ new_entry->instr = val->switch_info->default_case;
+ new_entry->case_num = val->switch_info->low + i;
+
+ val->switch_info->sorted_entries[i] = new_entry;
+ }
+ }
+
+ /* sort the switch cases */
+
+ qsort(val->switch_info->sorted_entries, n, sizeof(JVM_SWITCH_ENTRY *),
+ switch_entry_compare);
+
+ /* need to calculate instruction width */
+
+ val->switch_info->cell_padding = 3-(val->pc%4);
+ val->width = 1 + val->switch_info->cell_padding + 12 + n * 4;
+
+ return 0;
+}
+
+/**
+ * Prepares a lookupswitch instruction to be written out. This involves:
+ * -# Calculating the cell padding.
+ * -# Sorting the switch cases.
+ *
+ * @param val -- The tableswitch instruction node.
+ *
+ * @returns 0 on success, -1 on failure.
+ */
+
+static int
+setup_lookupswitch(JVM_CODE_GRAPH_NODE *val)
+{
+ Dlist tmp;
+ int i, n;
+
+ if(!val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ val->op = jvm_lookupswitch;
+
+ n = val->switch_info->num_entries;
+
+ val->switch_info->sorted_entries =
+ (JVM_SWITCH_ENTRY **)malloc(sizeof(JVM_SWITCH_ENTRY *) * n);
+
+ if(!val->switch_info->sorted_entries) return -1;
+
+ i = 0;
+
+ /* set up the array of branch targets to be sorted */
+
+ dl_traverse(tmp, val->switch_info->offsets) {
+ val->switch_info->sorted_entries[i] = (JVM_SWITCH_ENTRY *) tmp->val;
+ i++;
+ }
+
+ /* sort the switch cases */
+
+ qsort(val->switch_info->sorted_entries, n, sizeof(JVM_SWITCH_ENTRY *),
+ switch_entry_compare);
+
+ /* need to calculate instruction width */
+
+ val->switch_info->cell_padding = 3-(val->pc%4);
+ val->width = 1 + val->switch_info->cell_padding + 8 + n * 8;
+
+ return 0;
+}
+
+/**
+ * Compares two switch entries. This is used as an argument to qsort
+ * when sorting the array of switch cases.
+ *
+ * @param e1 -- Switch entry.
+ * @param e2 -- Switch entry.
+ *
+ * @returns
+ * -# if e1 < e2, return -1
+ * -# if e1 == e2, return 0
+ * -# if e1 > e2, return 1
+ */
+
+static int
+switch_entry_compare(const void *e1, const void *e2)
+{
+ JVM_SWITCH_ENTRY *s1, *s2;
+
+ if(!e1 || !e2) {
+ BAD_ARG();
+ return 0;
+ }
+
+ s1 = *((JVM_SWITCH_ENTRY **)e1);
+ s2 = *((JVM_SWITCH_ENTRY **)e2);
+
+ if(s1->case_num < s2->case_num)
+ return -1;
+
+ if(s1->case_num == s2->case_num)
+ return 0;
+
+ return 1;
+}
+
+
+/**
+ * Given a list and a graph node, this function returns the list node which
+ * contains the graph node.
+ *
+ * @param cgraph -- The code graph (list).
+ * @param n -- The node to find.
+ *
+ * @returns The list node containing the given instruction node.
+ */
+
+static Dlist
+get_list_node(Dlist cgraph, JVM_CODE_GRAPH_NODE *n)
+{
+ Dlist tmp;
+
+ if(!cgraph || !n) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ dl_traverse(tmp,cgraph) {
+ if((JVM_CODE_GRAPH_NODE *) tmp->val == n)
+ return tmp;
+ }
+
+ return NULL;
+}
+
+/**
+ * Checks whether a branch is too far. currently the branch target offset
+ * is a signed 16-bit integer, so the maximum branch is -2^15..2^15-1.
+ *
+ * @param op -- The branching opcode to be checked.
+ * @param dest -- The branch destination address.
+ * @param src -- The current address (i.e. the source of the branch).
+ *
+ * @returns TRUE if the branch is too far away, FALSE otherwise.
+ */
+
+static BOOL
+check_distance(JVM_OPCODE op, int dest, int src)
+{
+ int distance;
+
+ /* if it's a wide goto, then it'll always be ok.. otherwise check */
+ if((op == jvm_goto_w) || (op == jvm_jsr_w))
+ return FALSE;
+
+ distance = dest - src;
+ if((distance > ((int)math_pow( 2.0, 15.0 ) - 1)) ||
+ (distance < ((int)-math_pow( 2.0, 15.0 ))))
+ return TRUE;
+ else
+ return FALSE;
+}
+
+/**
+ * Simple double-precision power function. Just writing this here so that we
+ * dont have to link in the math library.
+ *
+ * @param x -- The base.
+ * @param y -- The exponent.
+ *
+ * @returns x raised to the power of y.
+ */
+
+static double
+math_pow(double x, double y)
+{
+ double result;
+ int i;
+
+ if(y < 0)
+ {
+ debug_err("Warning: got negative exponent in math_pow!\n");
+ return 0.0;
+ }
+
+ if(y == 0)
+ return 1.0;
+
+ if(y == 1)
+ return x;
+
+ result = x;
+
+ for(i=0;i<y-1;i++)
+ result *= x;
+
+ return result;
+}
+
+/**
+ * Gets the proper return opcode for the given method descriptor.
+ *
+ * @param desc -- The complete method descriptor.
+ *
+ * @returns The proper type-specific return opcode (e.g. dreturn)
+ * for the method descriptor.
+ */
+
+static JVM_OPCODE
+get_method_return_op(char *desc) {
+ char *p = desc;
+
+ while( p && (*p != ')') )
+ p++;
+
+ if(!p) {
+ debug_err("get_method_return_type: screwed up descriptor.\n");
+ return jvm_return;
+ }
+
+ /* skip the ')' */
+ p++;
+
+ switch (*p) {
+ case 'B': return jvm_ireturn;
+ case 'C': return jvm_ireturn;
+ case 'D': return jvm_dreturn;
+ case 'F': return jvm_freturn;
+ case 'I':
+ case 'Z': return jvm_ireturn;
+ case 'J': return jvm_lreturn;
+ case 'L':
+ case '[': return jvm_areturn;
+ case 'S': return jvm_ireturn;
+ case 'V': return jvm_return;
+ default:
+ debug_err("get_method_return_type: did not expect to be here.\n");
+ }
+
+ return jvm_return;
+}
+
+/**
+ * Searches a list of Label nodes for the one corresponding to the given
+ * label. From this label node, we can get the PC of the statement
+ * corresponding to this node.
+ *
+ * @param l -- The list of labels in some method.
+ * @param val -- The label string.
+ *
+ * @returns The address of the instruction corresponding to the given
+ * label. If the label is not found, return -1.
+ */
+
+static int
+find_label(Dlist l, const char *val)
+{
+ Dlist tmp;
+ JVM_BRANCH_PC *bp;
+
+ if(!l) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(tmp,l) {
+ bp = (JVM_BRANCH_PC *) tmp->val;
+ if(!strcmp(bp->label, val))
+ return bp->instr->pc;
+ }
+
+ return -1;
+}
diff --git a/libbytecode/class.h b/libbytecode/class.h
new file mode 100644
index 0000000..9546257
--- /dev/null
+++ b/libbytecode/class.h
@@ -0,0 +1,58 @@
+#ifndef _CLASS_H
+#define _CLASS_H
+
+#include<stdio.h>
+#include "bytecode.h"
+
+static BOOL
+ check_distance(JVM_OPCODE, int, int);
+
+static void
+ write_constant_pool(JVM_CLASS *, FILE *),
+ write_interfaces(JVM_CLASS *, FILE *),
+ write_fields(JVM_CLASS *, FILE *),
+ write_methods(JVM_CLASS *, FILE *),
+ write_code(Dlist, FILE *),
+ write_exception_table(struct ExceptionTable *, int, FILE *),
+ write_u1(u1, FILE *),
+ write_u2(u2, FILE *),
+ write_u3(u4, FILE *),
+ write_u4(u4, FILE *),
+ write_tableswitch(JVM_CODE_GRAPH_NODE *, FILE *),
+ write_lookupswitch(JVM_CODE_GRAPH_NODE *, FILE *),
+ dec_stack(JVM_METHOD *, int),
+ inc_stack(JVM_METHOD *, int),
+ calc_offsets(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *);
+
+static int
+ find_label(Dlist, const char *),
+ write_attributes(JVM_CLASS *, Dlist, FILE *),
+ num_empty_switch_cases(JVM_CODE_GRAPH_NODE *),
+ switch_entry_compare(const void *, const void *),
+ setup_tableswitch(JVM_CODE_GRAPH_NODE *),
+ setup_lookupswitch(JVM_CODE_GRAPH_NODE *),
+ finalizeMethod(JVM_METHOD *),
+ get_stack_increment(JVM_METHOD *, JVM_OPCODE, u4),
+ get_stack_decrement(JVM_METHOD *, JVM_OPCODE, u4),
+ get_stack_dec_field_acc(JVM_CLASS *, JVM_OPCODE, u4),
+ get_stack_dec_invocation(JVM_CLASS *, JVM_OPCODE, u4),
+ get_stack_inc_field_acc(JVM_CLASS *, JVM_OPCODE, u4),
+ get_stack_inc_invocation(JVM_CLASS *, JVM_OPCODE, u4),
+ traverse_code(JVM_METHOD *);
+
+static JVM_STACK_INFO
+ *calc_stack(char *);
+
+static Dlist
+ get_list_node(Dlist, JVM_CODE_GRAPH_NODE *);
+
+static double
+ math_pow(double, double);
+
+static JVM_OPCODE
+ get_method_return_op(char *);
+
+static FILE
+ *open_output_classfile(JVM_CLASS *, char *);
+
+#endif
diff --git a/libbytecode/configure b/libbytecode/configure
new file mode 100755
index 0000000..c1c0459
--- /dev/null
+++ b/libbytecode/configure
@@ -0,0 +1,3601 @@
+#! /bin/sh
+# From configure.in Revision: 1.4 .
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.59 for libbytecode 0.8.
+#
+# Report bugs to <f2j at cs.utk.edu>.
+#
+# Copyright (C) 2003 Free Software Foundation, Inc.
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+exec 6>&1
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_config_libobj_dir=.
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
+
+# Identity of this package.
+PACKAGE_NAME='libbytecode'
+PACKAGE_TARNAME='libbytecode'
+PACKAGE_VERSION='0.8'
+PACKAGE_STRING='libbytecode 0.8'
+PACKAGE_BUGREPORT='f2j at cs.utk.edu'
+
+ac_unique_file="api.c"
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT SET_MAKE RANLIB ac_ct_RANLIB AR JAVAC JAVA F2J_INSTALL_PREFIX DOXYGEN LIBOBJS LTLIBOBJS'
+ac_subst_files=''
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+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'
+
+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
+
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+
+ # 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_alias ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build_alias=$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 ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir=$ac_optarg ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) 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 | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host_alias ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host_alias=$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 | -n)
+ 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_alias ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target_alias=$ac_optarg ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
+
+ -with-* | --with-*)
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_$ac_package='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ 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 "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
+ *)
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
+fi
+
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+# 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_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ 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 "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
+ fi
+fi
+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+ { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+ { (exit 1); exit 1; }; }
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # 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 <<_ACEOF
+\`configure' configures libbytecode 0.8 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -n, --no-create do not create output files
+ --srcdir=DIR find the sources in DIR [configure dir or \`..']
+
+_ACEOF
+
+ cat <<_ACEOF
+Installation directories:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
+_ACEOF
+
+ cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+ case $ac_init_help in
+ short | recursive ) echo "Configuration of libbytecode 0.8:";;
+ esac
+ cat <<\_ACEOF
+
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-doxygen=DOXYGEN doxygen binary name
+ --with-debuglevel=num 0=none, 1=only errors default, 2=all debugging output
+
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to <f2j at cs.utk.edu>.
+_ACEOF
+fi
+
+if test "$ac_init_help" = "recursive"; then
+ # If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+ test -d $ac_dir || continue
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+libbytecode configure 0.8
+generated by GNU Autoconf 2.59
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+ exit 0
+fi
+exec 5>config.log
+cat >&5 <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by libbytecode $as_me 0.8, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
+
+/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_sep=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+ for ac_arg
+ do
+ case $ac_arg in
+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ continue ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ case $ac_pass in
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 2)
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ if test $ac_must_keep_next = true; then
+ ac_must_keep_next=false # Got value, back to normal.
+ else
+ case $ac_arg in
+ *=* | --config-cache | -C | -disable-* | --disable-* \
+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ | -with-* | --with-* | -without-* | --without-* | --x)
+ case "$ac_configure_args0 " in
+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ esac
+ ;;
+ -* ) ac_must_keep_next=true ;;
+ esac
+ fi
+ ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ # Get rid of the leading space.
+ ac_sep=" "
+ ;;
+ esac
+ done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log. We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
+ *)
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+}
+ echo
+
+ cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_vars
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+
+ if test -n "$ac_subst_files"; then
+ cat <<\_ASBOX
+## ------------- ##
+## Output files. ##
+## ------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_files
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+ fi
+
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h | sort
+ echo
+ fi
+ test "$ac_signal" != 0 &&
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
+ } >&5
+ rm -f core *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ exit $exit_status
+ ' 0
+for ac_signal in 1 2 13 15; do
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# 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
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# 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 "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+ sed 's/^/| /' "$ac_site_file" >&5
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
+ esac
+ fi
+else
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+ eval ac_old_set=\$ac_cv_env_${ac_var}_set
+ eval ac_new_set=\$ac_env_${ac_var}_set
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
+ case $ac_old_set,$ac_new_set in
+ set,)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # Pass precious variables to config.status.
+ if test "$ac_new_set" = set; then
+ case $ac_new_val in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *) ac_arg=$ac_var=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
+ fi
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ for ac_prog in gcc cc ecc xlc
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in gcc cc ecc xlc
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
+
+fi
+
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5
+echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6
+if test "${ac_cv_c_bigendian+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # See if sys/param.h defines the BYTE_ORDER macro.
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/param.h>
+
+int
+main ()
+{
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/param.h>
+
+int
+main ()
+{
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_bigendian=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_c_bigendian=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+# It does not; compile a test program.
+if test "$cross_compiling" = yes; then
+ # try to guess the endianness by grepping values into an object file
+ ac_cv_c_bigendian=unknown
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
+short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }
+int
+main ()
+{
+ _ascii (); _ebcdic ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
+ ac_cv_c_bigendian=yes
+fi
+if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+ if test "$ac_cv_c_bigendian" = unknown; then
+ ac_cv_c_bigendian=no
+ else
+ # finding both strings is unlikely to happen, but who knows?
+ ac_cv_c_bigendian=unknown
+ fi
+fi
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+int
+main ()
+{
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_bigendian=no
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_c_bigendian=yes
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5
+echo "${ECHO_T}$ac_cv_c_bigendian" >&6
+case $ac_cv_c_bigendian in
+ yes)
+
+cat >>confdefs.h <<\_ACEOF
+#define WORDS_BIGENDIAN 1
+_ACEOF
+ ;;
+ no)
+ ;;
+ *)
+ { { echo "$as_me:$LINENO: error: unknown endianness
+presetting ac_cv_c_bigendian=no (or yes) will help" >&5
+echo "$as_me: error: unknown endianness
+presetting ac_cv_c_bigendian=no (or yes) will help" >&2;}
+ { (exit 1); exit 1; }; } ;;
+esac
+
+
+echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'`
+if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.make <<\_ACEOF
+all:
+ @echo 'ac_maketemp="$(MAKE)"'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftest.make
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ SET_MAKE=
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ echo "$as_me:$LINENO: result: $RANLIB" >&5
+echo "${ECHO_T}$RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":"
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+# Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $AR in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_AR="$AR" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_AR="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+AR=$ac_cv_path_AR
+
+if test -n "$AR"; then
+ echo "$as_me:$LINENO: result: $AR" >&5
+echo "${ECHO_T}$AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+# Extract the first word of "javac", so it can be a program name with args.
+set dummy javac; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_JAVAC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $JAVAC in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_JAVAC="$JAVAC" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_JAVAC="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+JAVAC=$ac_cv_path_JAVAC
+
+if test -n "$JAVAC"; then
+ echo "$as_me:$LINENO: result: $JAVAC" >&5
+echo "${ECHO_T}$JAVAC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+# Extract the first word of "java", so it can be a program name with args.
+set dummy java; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_JAVA+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $JAVA in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_JAVA="$JAVA" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_JAVA="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+JAVA=$ac_cv_path_JAVA
+
+if test -n "$JAVA"; then
+ echo "$as_me:$LINENO: result: $JAVA" >&5
+echo "${ECHO_T}$JAVA" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+
+
+if test "x$prefix" != xNONE; then
+ F2J_INSTALL_PREFIX=${prefix}
+else
+ F2J_INSTALL_PREFIX=`pwd`
+fi
+
+
+
+# Check whether --with-doxygen or --without-doxygen was given.
+if test "${with_doxygen+set}" = set; then
+ withval="$with_doxygen"
+ DOXYGEN="$with_doxygen"
+else
+ DOXYGEN="doxygen"
+fi;
+
+
+# Check whether --with-debuglevel or --without-debuglevel was given.
+if test "${with_debuglevel+set}" = set; then
+ withval="$with_debuglevel"
+ DEBUGLEVEL="$with_debuglevel"
+else
+ DEBUGLEVEL="1"
+fi;
+
+if test "$DEBUGLEVEL" = "1"; then
+ CFLAGS="$CFLAGS -DBC_VIEW"
+fi
+
+if test "$DEBUGLEVEL" = "2"; then
+ CFLAGS="$CFLAGS -DBC_VIEW -DBC_DEBUG"
+fi
+
+
+
+
+
+ ac_config_headers="$ac_config_headers bytecode.h"
+
+
+ ac_config_files="$ac_config_files Makefile make.def"
+cat >confcache <<\_ACEOF
+# 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, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# 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 | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+} |
+ sed '
+ t clear
+ : clear
+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+ t end
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if diff $cache_file confcache >/dev/null 2>&1; then :; else
+ if test -w $cache_file; then
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ cat confcache >$cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
+fi
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+ # 1. Remove the extension, and $U if already installed.
+ ac_i=`echo "$ac_i" |
+ sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+ # 2. Add them.
+ ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+exec 6>&1
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
+This file was extended by libbytecode $as_me 0.8, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_ACEOF
+
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, then exit
+ -q, --quiet do not print progress messages
+ -d, --debug don't remove temporary files
+ --recheck update $as_me by reconfiguring in the same conditions
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+ --header=FILE[:TEMPLATE]
+ instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Report bugs to <bug-autoconf at gnu.org>."
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+libbytecode config.status 0.8
+configured by $0, generated by GNU Autoconf 2.59,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+srcdir=$srcdir
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ ac_shift=:
+ ;;
+ -*)
+ ac_option=$1
+ ac_optarg=$2
+ ac_shift=shift
+ ;;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_option=$1
+ ac_need_defaults=false;;
+ esac
+
+ case $ac_option in
+ # Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ ac_cs_recheck=: ;;
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
+ debug=: ;;
+ --file | --fil | --fi | --f )
+ $ac_shift
+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ $ac_shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ ac_need_defaults=false;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil | --si | --s)
+ ac_cs_silent=: ;;
+
+ # This is an error.
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+if \$ac_cs_recheck; then
+ echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+fi
+
+_ACEOF
+
+
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_config_target in $ac_config_targets
+do
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "make.def" ) CONFIG_FILES="$CONFIG_FILES make.def" ;;
+ "bytecode.h" ) CONFIG_HEADERS="$CONFIG_HEADERS bytecode.h" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used. Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+ test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience. Make it in the build tree
+# simply because there is no reason to put it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+
+# Create a (secure) tmp directory for tmp files.
+
+{
+ tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
+}
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s, at SHELL@,$SHELL,;t t
+s, at PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s, at PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s, at PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s, at PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s, at PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s, at PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s, at exec_prefix@,$exec_prefix,;t t
+s, at prefix@,$prefix,;t t
+s, at program_transform_name@,$program_transform_name,;t t
+s, at bindir@,$bindir,;t t
+s, at sbindir@,$sbindir,;t t
+s, at libexecdir@,$libexecdir,;t t
+s, at datadir@,$datadir,;t t
+s, at sysconfdir@,$sysconfdir,;t t
+s, at sharedstatedir@,$sharedstatedir,;t t
+s, at localstatedir@,$localstatedir,;t t
+s, at libdir@,$libdir,;t t
+s, at includedir@,$includedir,;t t
+s, at oldincludedir@,$oldincludedir,;t t
+s, at infodir@,$infodir,;t t
+s, at mandir@,$mandir,;t t
+s, at build_alias@,$build_alias,;t t
+s, at host_alias@,$host_alias,;t t
+s, at target_alias@,$target_alias,;t t
+s, at DEFS@,$DEFS,;t t
+s, at ECHO_C@,$ECHO_C,;t t
+s, at ECHO_N@,$ECHO_N,;t t
+s, at ECHO_T@,$ECHO_T,;t t
+s, at LIBS@,$LIBS,;t t
+s, at CC@,$CC,;t t
+s, at CFLAGS@,$CFLAGS,;t t
+s, at LDFLAGS@,$LDFLAGS,;t t
+s, at CPPFLAGS@,$CPPFLAGS,;t t
+s, at ac_ct_CC@,$ac_ct_CC,;t t
+s, at EXEEXT@,$EXEEXT,;t t
+s, at OBJEXT@,$OBJEXT,;t t
+s, at SET_MAKE@,$SET_MAKE,;t t
+s, at RANLIB@,$RANLIB,;t t
+s, at ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
+s, at AR@,$AR,;t t
+s, at JAVAC@,$JAVAC,;t t
+s, at JAVA@,$JAVA,;t t
+s, at F2J_INSTALL_PREFIX@,$F2J_INSTALL_PREFIX,;t t
+s, at DOXYGEN@,$DOXYGEN,;t t
+s, at LIBOBJS@,$LIBOBJS,;t t
+s, at LTLIBOBJS@,$LTLIBOBJS,;t t
+CEOF
+
+_ACEOF
+
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # 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_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # 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" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ fi
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+ fi
+fi # test -n "$CONFIG_FILES"
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+
+
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s, at configure_input@,$configure_input,;t t
+s, at srcdir@,$ac_srcdir,;t t
+s, at abs_srcdir@,$ac_abs_srcdir,;t t
+s, at top_srcdir@,$ac_top_srcdir,;t t
+s, at abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s, at builddir@,$ac_builddir,;t t
+s, at abs_builddir@,$ac_abs_builddir,;t t
+s, at top_builddir@,$ac_top_builddir,;t t
+s, at abs_top_builddir@,$ac_abs_top_builddir,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
+
+done
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+#
+# CONFIG_HEADER section.
+#
+
+# 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=' '
+ac_dD=',;t'
+# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_uB='$,\1#\2define\3'
+ac_uC=' '
+ac_uD=',;t'
+
+for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ # Do quote $f, to prevent DOS paths from being IFS'd.
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+ # Remove the trailing spaces.
+ sed 's/[ ]*$//' $ac_file_inputs >$tmp/in
+
+_ACEOF
+
+# Transform confdefs.h into two sed scripts, `conftest.defines' and
+# `conftest.undefs', that substitutes the proper values into
+# config.h.in to produce config.h. The first handles `#define'
+# templates, and the second `#undef' templates.
+# 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.defines conftest.undefs
+# Using a here document instead of a string reduces the quoting nightmare.
+# Putting comments in sed scripts is not portable.
+#
+# `end' is used to avoid that the second main sed command (meant for
+# 0-ary CPP macros) applies to n-ary macro definitions.
+# See the Autoconf documentation for `clear'.
+cat >confdef2sed.sed <<\_ACEOF
+s/[\\&,]/\\&/g
+s,[\\$`],\\&,g
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp
+t end
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp
+: end
+_ACEOF
+# If some macros were called several times there might be several times
+# the same #defines, which is useless. Nevertheless, we may not want to
+# sort them, since we want the *last* AC-DEFINE to be honored.
+uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines
+sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs
+rm -f confdef2sed.sed
+
+# 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.undefs <<\_ACEOF
+s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */,
+_ACEOF
+
+# Break up conftest.defines because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS
+echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS
+echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS
+echo ' :' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.defines >/dev/null
+do
+ # Write a limited-size here document to $tmp/defines.sed.
+ echo ' cat >$tmp/defines.sed <<CEOF' >>$CONFIG_STATUS
+ # Speed up: don't consider the non `#define' lines.
+ echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS
+ # Work around the forget-to-reset-the-flag bug.
+ echo 't clr' >>$CONFIG_STATUS
+ echo ': clr' >>$CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS
+ echo 'CEOF
+ sed -f $tmp/defines.sed $tmp/in >$tmp/out
+ rm -f $tmp/in
+ mv $tmp/out $tmp/in
+' >>$CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail
+ rm -f conftest.defines
+ mv conftest.tail conftest.defines
+done
+rm -f conftest.defines
+echo ' fi # grep' >>$CONFIG_STATUS
+echo >>$CONFIG_STATUS
+
+# Break up conftest.undefs because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo ' # Handle all the #undef templates' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.undefs >/dev/null
+do
+ # Write a limited-size here document to $tmp/undefs.sed.
+ echo ' cat >$tmp/undefs.sed <<CEOF' >>$CONFIG_STATUS
+ # Speed up: don't consider the non `#undef'
+ echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS
+ # Work around the forget-to-reset-the-flag bug.
+ echo 't clr' >>$CONFIG_STATUS
+ echo ': clr' >>$CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS
+ echo 'CEOF
+ sed -f $tmp/undefs.sed $tmp/in >$tmp/out
+ rm -f $tmp/in
+ mv $tmp/out $tmp/in
+' >>$CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail
+ rm -f conftest.undefs
+ mv conftest.tail conftest.undefs
+done
+rm -f conftest.undefs
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ echo "/* Generated by configure. */" >$tmp/config.h
+ else
+ echo "/* $ac_file. Generated by configure. */" >$tmp/config.h
+ fi
+ cat $tmp/in >>$tmp/config.h
+ rm -f $tmp/in
+ if test x"$ac_file" != x-; then
+ if diff $ac_file $tmp/config.h >/dev/null 2>&1; then
+ { echo "$as_me:$LINENO: $ac_file is unchanged" >&5
+echo "$as_me: $ac_file is unchanged" >&6;}
+ else
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ rm -f $ac_file
+ mv $tmp/config.h $ac_file
+ fi
+ else
+ cat $tmp/config.h
+ rm -f $tmp/config.h
+ fi
+done
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ ac_config_status_args=
+ test "$silent" = yes &&
+ ac_config_status_args="$ac_config_status_args --quiet"
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
+
diff --git a/libbytecode/configure.in b/libbytecode/configure.in
new file mode 100644
index 0000000..fd062fd
--- /dev/null
+++ b/libbytecode/configure.in
@@ -0,0 +1,50 @@
+AC_INIT(libbytecode, 0.8.1, [f2j at cs.utk.edu])
+AC_REVISION([$Revision: 1.6 $])
+
+AC_CONFIG_SRCDIR(api.c)
+
+AC_PROG_CC(gcc cc ecc xlc)
+
+AC_C_BIGENDIAN
+
+AC_PROG_MAKE_SET
+AC_PROG_RANLIB
+AC_PATH_PROG(AR, ar)
+AC_SUBST(AR)
+AC_PATH_PROG(JAVAC, javac)
+AC_SUBST(JAVAC)
+AC_PATH_PROG(JAVA, java)
+AC_SUBST(JAVA)
+
+if test "x$prefix" != xNONE; then
+ F2J_INSTALL_PREFIX=${prefix}
+else
+ F2J_INSTALL_PREFIX=`pwd`
+fi
+AC_SUBST(F2J_INSTALL_PREFIX)
+
+AC_ARG_WITH(doxygen,
+ [ --with-doxygen=DOXYGEN doxygen binary name],
+ [DOXYGEN="$with_doxygen"],
+ [DOXYGEN="doxygen"])
+
+AC_ARG_WITH(debuglevel,
+ [ --with-debuglevel=num 0=none, 1=only errors [default], 2=all debugging output],
+ [DEBUGLEVEL="$with_debuglevel"],
+ [DEBUGLEVEL="1"])
+
+if test "$DEBUGLEVEL" = "1"; then
+ CFLAGS="$CFLAGS -DBC_VIEW"
+fi
+
+if test "$DEBUGLEVEL" = "2"; then
+ CFLAGS="$CFLAGS -DBC_VIEW -DBC_DEBUG"
+fi
+
+AC_SUBST(CFLAGS)
+
+AC_SUBST(DOXYGEN)
+
+AC_CONFIG_HEADER(bytecode.h)
+
+AC_OUTPUT(Makefile make.def)
diff --git a/libbytecode/constant_pool.c b/libbytecode/constant_pool.c
new file mode 100644
index 0000000..af333dc
--- /dev/null
+++ b/libbytecode/constant_pool.c
@@ -0,0 +1,1560 @@
+/** @file constant_pool.c
+ * This file contains routines for manipulating the constant pool list.
+ */
+
+#include "constant_pool.h"
+
+/**
+ * Searches for the given node in the specified constant pool list.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the node is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+int
+cp_lookup(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) {
+ int retval;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ switch(tag) {
+ case CONSTANT_Utf8:
+ retval = cp_lookup_utf8(class, value);
+ break;
+ case CONSTANT_Integer:
+ retval = cp_lookup_int(class, value);
+ break;
+ case CONSTANT_Float:
+ retval = cp_lookup_float(class, value);
+ break;
+ case CONSTANT_Long:
+ retval = cp_lookup_long(class, value);
+ break;
+ case CONSTANT_Double:
+ retval = cp_lookup_double(class, value);
+ break;
+ case CONSTANT_Class:
+ retval = cp_lookup_class(class, value);
+ break;
+ case CONSTANT_Fieldref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_Methodref:
+ retval = cp_lookup_ref(class, tag, value);
+ break;
+ case CONSTANT_NameAndType:
+ retval = cp_lookup_nameandtype(class, value);
+ break;
+ case CONSTANT_String:
+ retval = cp_lookup_string(class, value);
+ break;
+ default:
+ debug_err("cp_lookup: WARNING - hit default case!\n");
+ retval = -1;
+ }
+
+ return retval;
+}
+
+/**
+ * Find the constant pool index for the given constant if it exists in
+ * the constant pool. If not, create a new entry and return its index.
+ * This function will not insert constant values for which there exist
+ * shorthand instructions for pushing those values onto the stack. For
+ * example floating point values 0.0, 1.0, and 2.0 can be pushed using
+ * shorthand instructions fconst_0, fconst_1, and fconst_2 respectively.
+ * Similar instructions exist for integer, long, and double. Therefore
+ * these values usually do not need to be inserted into the constant pool.
+ * If you need one of these values inserted, use the cp_manual_insert()
+ * function.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns The constant pool index for the given constant value.
+ * If the value was not inserted because it was a special value
+ * as mentioned above or if an error occurred then -1 is returned.
+ **/
+
+int
+cp_find_or_insert(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) {
+ int temp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ temp = cp_find_function_body(class, tag, value, FALSE);
+
+ if(temp < 0)
+ CP_CHECK_NONZERO("cp_find_or_insert", temp);
+
+ return temp;
+}
+
+/**
+ * Identical to cp_find_or_insert(), except that integer and double precision
+ * constants that would normally be excluded are inserted.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be inserted.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+int
+cp_manual_insert(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) {
+ int temp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ temp = cp_find_function_body(class, tag, value, TRUE);
+
+ if(temp < 0)
+ CP_CHECK_NONZERO("cp_manual_insert", temp);
+
+ return temp;
+}
+
+
+/**
+ * Given an index into the constant pool, return a pointer to
+ * the CP_NODE at that index.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param idx -- The constant pool index to be returned.
+ *
+ * @returns The CP_NODE at the given index. Returns NULL if the
+ * specified index is not found in the constant pool.
+ **/
+
+CP_NODE *
+cp_entry_by_index(JVM_CLASS *class, unsigned int idx)
+{
+ Dlist temp;
+
+ if(!class) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ if( ((CP_NODE*)temp->val)->index == idx )
+ return temp->val;
+ }
+
+ debug_err("cp_entry_by_index() WARNING: looking for non-existent cp index!\n");
+ return NULL;
+}
+
+/**
+ * Dumps a list of the class variables to stdout.
+ *
+ * @param class -- The class containing the constant pool to be printed.
+ **/
+
+void
+cp_fields_dump(JVM_CLASS *class)
+{
+ JVM_FIELD *tmpfield;
+ CP_NODE * tmpfield2;
+ Dlist tmpPtr;
+ int count=1;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->fields) {
+ tmpfield = (JVM_FIELD *) tmpPtr->val;
+
+ printf("Field #%d\n", count++);
+ printf("\taccess flags: %d\n",tmpfield->access_flags);
+
+ tmpfield2 = cp_entry_by_index(class, tmpfield->name_index);
+ printf("\tname idx: %d (%s)\n", tmpfield->name_index,
+ cp_null_term_utf8(tmpfield2->val));
+
+ tmpfield2 = cp_entry_by_index(class, tmpfield->descriptor_index);
+ printf("\tdesc idx: %d (%s)\n", tmpfield->descriptor_index,
+ cp_null_term_utf8(tmpfield2->val));
+ }
+}
+
+/**
+ * Less verbose version of cp_dump(). This function just prints the constant
+ * pool index and the tag.
+ *
+ * @param class -- The class containing the constant pool to be printed.
+ **/
+
+void
+cp_quickdump(JVM_CLASS *class)
+{
+ CP_NODE * tmpconst;
+ Dlist tmpPtr;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->constant_pool) {
+ tmpconst = (CP_NODE *) tmpPtr->val;
+ printf("Constant pool entry %d, ", tmpconst->index);
+ printf("tag: %s\n", jvm_constant_tags[tmpconst->val->tag]);
+ }
+}
+
+/**
+ * Prints the contents of the constant pool to stdout.
+ *
+ * @param class -- The class containing the constant pool to be printed.
+ **/
+
+void
+cp_dump(JVM_CLASS *class)
+{
+ CP_NODE * tmpconst, * tmpconst2;
+ Dlist tmpPtr;
+ double x;
+ float f;
+ u8 l;
+ char *tmp_str;
+
+ if(!class) {
+ BAD_ARG();
+ return;
+ }
+
+ dl_traverse(tmpPtr,class->constant_pool) {
+ tmpconst = (CP_NODE *) tmpPtr->val;
+
+ printf("Constant pool entry %d:\n", tmpconst->index);
+ printf("\ttag: %s\n", jvm_constant_tags[tmpconst->val->tag]);
+ switch(tmpconst->val->tag) {
+ case CONSTANT_Utf8:
+ tmp_str = cp_null_term_utf8(tmpconst->val);
+ printf("\tstring: %s\n",tmp_str);
+
+ free(tmp_str);
+ break;
+ case CONSTANT_Integer:
+ if(isBigEndian())
+ printf("\tint: %d\n",tmpconst->val->cpnode.Integer.bytes);
+ else
+ printf("\tint: %d (conv. to little endian)\n",
+ cp_big_endian_u4(tmpconst->val->cpnode.Integer.bytes));
+ break;
+ case CONSTANT_Float:
+ if(isBigEndian())
+ printf("\tfloat: %f\n",(float)tmpconst->val->cpnode.Float.bytes);
+ else {
+ u4 tmp;
+
+ tmp = cp_big_endian_u4(tmpconst->val->cpnode.Float.bytes);
+ memcpy(&f, &tmp, sizeof(u4));
+
+ printf("\tfloat: %f (conv. to little endian)\n", f);
+ }
+ break;
+ case CONSTANT_Long:
+ if(isBigEndian()) {
+ memcpy(&l,&tmpconst->val->cpnode.Long.high_bytes,sizeof(u4));
+ memcpy((char*)&l+4,&tmpconst->val->cpnode.Long.low_bytes,sizeof(u4));
+ printf("\tlong: %ld (high: %d, low: %d)\n", (long) l,
+ (int)tmpconst->val->cpnode.Long.high_bytes,
+ (int)tmpconst->val->cpnode.Long.low_bytes);
+ }
+ else {
+ u4 t1,t2;
+
+ t1 = cp_big_endian_u4(tmpconst->val->cpnode.Long.high_bytes);
+ t2 = cp_big_endian_u4(tmpconst->val->cpnode.Long.low_bytes);
+
+ memcpy(&l, &t2, sizeof(u4));
+ memcpy((char*)&l+4, &t1, sizeof(u4));
+
+ printf("\tlong: %ld (high: %d, low: %d) (conv to little endian)\n",(long)l,
+ cp_big_endian_u4(tmpconst->val->cpnode.Long.high_bytes),
+ cp_big_endian_u4(tmpconst->val->cpnode.Long.low_bytes));
+ }
+ break;
+ case CONSTANT_Double:
+ if(isBigEndian()) {
+ memcpy(&x,&tmpconst->val->cpnode.Double.high_bytes,sizeof(u4));
+ memcpy((char*)&x+4,&tmpconst->val->cpnode.Double.low_bytes,sizeof(u4));
+ printf("\tdouble: %f (high: %d, low: %d)\n",x,
+ tmpconst->val->cpnode.Double.high_bytes,
+ tmpconst->val->cpnode.Double.low_bytes);
+ }
+ else {
+ u4 t1,t2;
+
+ t1 = cp_big_endian_u4(tmpconst->val->cpnode.Double.high_bytes);
+ t2 = cp_big_endian_u4(tmpconst->val->cpnode.Double.low_bytes);
+
+ memcpy(&x, &t2, sizeof(u4));
+ memcpy((char*)&x+4, &t1, sizeof(u4));
+
+ printf("\tdouble: %f (high: %d, low: %d) (conv to little endian)\n",x,
+ cp_big_endian_u4(tmpconst->val->cpnode.Double.high_bytes),
+ cp_big_endian_u4(tmpconst->val->cpnode.Double.low_bytes));
+ }
+ break;
+ case CONSTANT_Class:
+ tmpconst2 = cp_entry_by_index(class,tmpconst->val->cpnode.Class.name_index);
+ tmp_str = cp_null_term_utf8(tmpconst2->val);
+
+ printf("\tclass index: %d -> %s\n",tmpconst->val->cpnode.Class.name_index,
+ tmp_str);
+
+ free(tmp_str);
+
+ break;
+ case CONSTANT_String:
+ printf("\tstring index: %d\n",tmpconst->val->cpnode.String.string_index);
+ break;
+ case CONSTANT_Fieldref:
+ printf("\tclass index(declaring this field): %d\n",
+ tmpconst->val->cpnode.Methodref.class_index);
+ printf("\tname and type index(of this field): %d\n",
+ tmpconst->val->cpnode.Methodref.name_and_type_index);
+ break;
+ case CONSTANT_Methodref:
+ printf("\tclass index(declaring this method): %d\n",
+ tmpconst->val->cpnode.Methodref.class_index);
+ printf("\tname and type index(of this method): %d\n",
+ tmpconst->val->cpnode.Methodref.name_and_type_index);
+ break;
+ case CONSTANT_InterfaceMethodref:
+ printf("\tclass index(declaring this interface): %d\n",
+ tmpconst->val->cpnode.Methodref.class_index);
+ printf("\tname and type index(of this interface): %d\n",
+ tmpconst->val->cpnode.Methodref.name_and_type_index);
+ break;
+ case CONSTANT_NameAndType:
+ printf("\tname index: %d\n",tmpconst->val->cpnode.NameAndType.name_index);
+ printf("\tdescriptor index: %d\n",
+ tmpconst->val->cpnode.NameAndType.descriptor_index);
+ break;
+ default:
+ debug_err("cp_dump(): Unknown tag!\n");
+ break; /* unnecessary break for ANSI compliance */
+ }
+ }
+}
+
+/**
+ * Creates a null-terminated version of the given utf8 constant pool entry.
+ *
+ * @param val -- The utf8 entry.
+ *
+ * @returns A null-terminated string. On error returns NULL.
+ **/
+
+char *
+cp_null_term_utf8(CP_INFO *val)
+{
+ char * temp;
+
+ if(!val) {
+ BAD_ARG();
+ return NULL;
+ }
+
+ temp = (char *)malloc(val->cpnode.Utf8.length + 1);
+
+ if(!temp) return NULL;
+
+ strncpy(temp,(char *)val->cpnode.Utf8.bytes,val->cpnode.Utf8.length);
+ temp[val->cpnode.Utf8.length] = '\0';
+
+ return temp;
+}
+
+/**
+ * This function converts a u2 (unsigned short) to big endian format. if the
+ * machine is big endian already, we do nothing. otherwise, we reverse the
+ * byte order and return the reversed number.
+ *
+ * @param num -- The unsigned short to be converted.
+ *
+ * @returns Big endian version of the specified number.
+ **/
+
+u2
+cp_big_endian_u2(u2 num)
+{
+ if(isBigEndian())
+ return num;
+ else
+ return (num>>8)+((num&0xFF)<<8);
+}
+
+/**
+ * This function converts a u4 (unsigned int) to big endian format. if the
+ * machine is big endian already, we do nothing. otherwise, we reverse the
+ * byte order and return the reversed number.
+ *
+ * @param num -- The unsigned int to be converted.
+ *
+ * @returns Big endian version of the specified number.
+ **/
+
+u4
+cp_big_endian_u4(u4 num)
+{
+ if(isBigEndian())
+ return num;
+ else
+ return ((num & 0xFF)<<24) +
+ ((num >> 8 & 0xFF)<<16) +
+ ((num >> 16 & 0xFF)<<8) +
+ (num >> 24);
+}
+
+/*****************************************************************************
+ *****************************************************************************
+ ** **
+ ** Functions after this point are not exposed as part of the API. **
+ ** **
+ *****************************************************************************
+ *****************************************************************************/
+
+/**
+ * Inserts the given CP_INFO node into the constant pool list.
+ *
+ * @param class -- The class containing the constant pool into which the
+ * node will be inserted.
+ * @param node -- The node to be inserted.
+ *
+ * @returns The constant pool index of the node after insertion.
+ * Returns -1 on error.
+ **/
+
+static int
+cp_insert(JVM_CLASS *class, CP_INFO *node) {
+ CP_NODE * n;
+ Dlist cp;
+
+ if(!class || !node) {
+ BAD_ARG();
+ return -1;
+ }
+
+ cp = class->constant_pool;
+
+ debug_msg("&& in cp_insert, inserting node w/tag = %s\n",
+ jvm_constant_tags[node->tag]);
+
+ n = (CP_NODE *)malloc(sizeof(CP_NODE));
+
+ if(!n) return -1;
+
+ n->val = node;
+ n->index = dl_empty(cp) ? 1 : ((CP_NODE *) dl_last(cp)->val)->next_idx;
+ n->next_idx = n->index + cp_entry_width[node->tag];
+
+ dl_insert_b(cp, n);
+
+ return n->index;
+}
+
+/**
+ * This function inserts a Constant into the constants_table. We're keeping
+ * track of constants in order to build the constant pool for bytecode
+ * generation.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tok -- The type of constant contained in the 'val' argument.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index of the value after insertion.
+ * Returns -1 on error.
+ **/
+
+static int
+insert_constant(JVM_CLASS *class, int tok, const void *val, BOOL force_insert)
+{
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ switch(tok) {
+ case CP_INTEGER_CONST:
+ return insert_int_constant(class, val, force_insert);
+ case CP_FLOAT_CONST:
+ return insert_float_constant(class, val, force_insert);
+ case CP_LONG_CONST:
+ return insert_long_constant(class, val, force_insert);
+ case CP_EXPONENTIAL_CONST:
+ case CP_DOUBLE_CONST:
+ return insert_double_constant(class, val, force_insert);
+ case CP_TRUE_CONST:
+ case CP_FALSE_CONST:
+ /* boolean literals do not need constant pool entries because
+ * we can use the iconst_1 opcode for TRUE and iconst_0 for FALSE.
+ */
+ return -1;
+ case CP_STRING_CONST:
+ return insert_string_constant(class, val, force_insert);
+ }
+
+ return -1;
+}
+
+/**
+ * This function returns the endianness of the machine we're running on.
+ * Such information is used during bytecode generation since the numerical
+ * constants are always stored in big endian format.
+ *
+ * @returns TRUE if this machine is big endian, FALSE otherwise.
+ **/
+
+static BOOL
+isBigEndian()
+{
+
+#ifdef WORDS_BIGENDIAN
+ return TRUE;
+#else
+ return FALSE;
+#endif
+
+}
+
+/**
+ * Searches the constant pool for a UTF8 string.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The UTF8 constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_utf8(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&&hit utf8 constant\n");
+ debug_msg("&&value = %s\n",(char *)value);
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if(ctemp->tag == CONSTANT_Utf8) {
+ if(strlen((char*)value) == (unsigned int)ctemp->cpnode.Utf8.length)
+ if(!strncmp((char*)ctemp->cpnode.Utf8.bytes, (char*)value,
+ ctemp->cpnode.Utf8.length) )
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for an integer constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_int(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if( ctemp->tag == CONSTANT_Integer) {
+ u4 ival = cp_big_endian_u4( *((u4*)value) );
+
+ if(!memcmp((void *)&ival, (void*)&ctemp->cpnode.Integer.bytes, sizeof(u4)))
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a float constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_float(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if( ctemp->tag == CONSTANT_Float) {
+ u4 fval = cp_big_endian_u4( *((u4*)value) );
+
+ if(!memcmp((void *)&fval, (void*)&ctemp->cpnode.Float.bytes, sizeof(u4)))
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a long constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_long(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if( ctemp->tag == CONSTANT_Long) {
+ u4 hi_bytes, lo_bytes;
+
+ memcpy(&hi_bytes,value,sizeof(u4));
+ memcpy(&lo_bytes,(char*)value+4,sizeof(u4));
+
+ /* convert byte order if necessary, then compare, and return */
+ if(!isBigEndian()) {
+ u4 bytetemp = hi_bytes;
+ hi_bytes = cp_big_endian_u4(lo_bytes);
+ lo_bytes = cp_big_endian_u4(bytetemp);
+ }
+
+ if( !memcmp(&hi_bytes,
+ (void *)&ctemp->cpnode.Long.high_bytes,
+ sizeof(u4))
+ && !memcmp(&lo_bytes,
+ (void *)&ctemp->cpnode.Long.low_bytes,
+ sizeof(u4)))
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a double precision constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_double(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if( ctemp->tag == CONSTANT_Double) {
+ u4 hi_bytes, lo_bytes;
+
+ memcpy(&hi_bytes,value,sizeof(u4));
+ memcpy(&lo_bytes,(char*)value+4,sizeof(u4));
+
+ /* convert byte order if necessary, then compare, and return */
+ if(!isBigEndian()) {
+ u4 bytetemp = hi_bytes;
+ hi_bytes = cp_big_endian_u4(lo_bytes);
+ lo_bytes = cp_big_endian_u4(bytetemp);
+ }
+
+ if( !memcmp(&hi_bytes,
+ (void *)&ctemp->cpnode.Double.high_bytes,
+ sizeof(u4))
+ && !memcmp(&lo_bytes,
+ (void *)&ctemp->cpnode.Double.low_bytes,
+ sizeof(u4)))
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a class constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_class(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+ int this_len;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&&hit class constant\n");
+ debug_msg("&&value = %s\n",(char *)value);
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if(ctemp->tag == CONSTANT_Class) {
+ this_len = cp_entry_by_index(class,
+ ctemp->cpnode.Class.name_index)->val->cpnode.Utf8.length;
+
+ if(!this_len) continue;
+
+ if((unsigned int)this_len == strlen((char*) value)) {
+ CP_NODE *e = cp_entry_by_index(class, ctemp->cpnode.Class.name_index);
+
+ if(!e) continue;
+
+ if(!strncmp( (char *) (e->val->cpnode.Utf8.bytes),
+ (char *)value, strlen((char*)value)))
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a method/field reference.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_ref(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+ JVM_METHODREF *mref = (JVM_METHODREF *)value;
+ CP_NODE *nameref;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+#define err_lookup() \
+ if(tmpC) free(tmpC); \
+ if(tmpM) free(tmpM); \
+ if(tmpM) free(tmpD);
+
+ debug_msg("&&looking up Method/field ref\n");
+ debug_msg("&& mref->classname = '%s'\n",mref->classname);
+ debug_msg("&& mref->methodname = '%s'\n",mref->methodname);
+ debug_msg("&& mref->descriptor = '%s'\n",mref->descriptor);
+
+ /* for the methodref to match, we need to check that the class, method,
+ * and descriptor strings all match.
+ */
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if(ctemp->tag == tag) {
+ char *tmpC, *tmpM, *tmpD;
+
+ tmpC = tmpM = tmpD = NULL;
+
+ nameref = cp_entry_by_index(class,ctemp->cpnode.Methodref.class_index);
+ if(!nameref) continue;
+
+ nameref = cp_entry_by_index(class,nameref->val->cpnode.Class.name_index);
+ if(!nameref) continue;
+
+ tmpC = cp_null_term_utf8(nameref->val);
+ if(!tmpC) continue;
+
+ debug_msg("&& name_nad_type_index = %d\n",
+ ctemp->cpnode.Methodref.name_and_type_index);
+
+ nameref = cp_entry_by_index(class,
+ ctemp->cpnode.Methodref.name_and_type_index);
+ if(!nameref) {
+ err_lookup();
+ continue;
+ }
+
+ debug_msg("&& name index = %d\n",
+ nameref->val->cpnode.NameAndType.name_index);
+
+ nameref = cp_entry_by_index(class,
+ nameref->val->cpnode.NameAndType.name_index);
+ if(!nameref) {
+ err_lookup();
+ continue;
+ }
+
+ debug_msg("&& ok, nodetype of nameref is %s\n",
+ jvm_constant_tags[nameref->val->tag]);
+ debug_msg("&& name[0] = %c\n",nameref->val->cpnode.Utf8.bytes[0]);
+
+ tmpM = cp_null_term_utf8(nameref->val);
+ if(!tmpM) {
+ err_lookup();
+ continue;
+ }
+
+ nameref = cp_entry_by_index(class,
+ ctemp->cpnode.Methodref.name_and_type_index);
+ if(!nameref) {
+ err_lookup();
+ continue;
+ }
+
+ nameref = cp_entry_by_index(class,
+ nameref->val->cpnode.NameAndType.descriptor_index);
+ if(!nameref) {
+ err_lookup();
+ continue;
+ }
+
+ tmpD = cp_null_term_utf8(nameref->val);
+ if(!tmpD) {
+ err_lookup();
+ continue;
+ }
+
+ if( !strcmp(tmpC, mref->classname)
+ && !strcmp(tmpM, mref->methodname)
+ && !strcmp(tmpD, mref->descriptor) )
+ {
+ err_lookup();
+
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ else {
+ err_lookup();
+ }
+ }
+ }
+
+#undef err_lookup
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a name and type reference.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_nameandtype(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+ JVM_METHODREF *mref = (JVM_METHODREF *)value;
+ CP_NODE *nref, *dref;
+ char *tmpM, *tmpD;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&& up NameAndType\n");
+ debug_msg("&& mref->classname = '%s'\n",mref->classname);
+ debug_msg("&& mref->methodname = '%s'\n",mref->methodname);
+ debug_msg("&& mref->descriptor = '%s'\n",mref->descriptor);
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if(ctemp->tag == CONSTANT_NameAndType) {
+ nref = cp_entry_by_index(class,ctemp->cpnode.NameAndType.name_index);
+ if(!nref) continue;
+
+ dref = cp_entry_by_index(class,ctemp->cpnode.NameAndType.descriptor_index);
+ if(!dref) continue;
+
+ tmpM = cp_null_term_utf8(nref->val);
+ if(!tmpM) continue;
+
+ tmpD = cp_null_term_utf8(dref->val);
+ if(!tmpD) {
+ free(tmpM);
+ continue;
+ }
+
+ if( !strcmp(tmpM, mref->methodname)
+ && !strcmp(tmpD, mref->descriptor))
+ {
+ free(tmpM);
+ free(tmpD);
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ else {
+ free(tmpM);
+ free(tmpD);
+ }
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Searches the constant pool for a String constant.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be searched for.
+ *
+ * @returns If the value is found, return its constant pool index.
+ * Return -1 otherwise.
+ **/
+
+static int
+cp_lookup_string(JVM_CLASS *class, const void *value) {
+ Dlist temp;
+ CP_INFO * ctemp;
+ CP_NODE *sref;
+ char *tmpS;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ dl_traverse(temp,class->constant_pool) {
+ ctemp = ((CP_NODE *)(temp->val))->val;
+
+ if(ctemp->tag == CONSTANT_String) {
+ sref = cp_entry_by_index(class,ctemp->cpnode.String.string_index);
+ if(!sref) continue;
+
+ tmpS = cp_null_term_utf8(sref->val);
+ if(!tmpS) continue;
+
+ if(!strcmp(tmpS,(char *)value)) {
+ free(tmpS);
+ return ((CP_NODE *)(temp->val))->index;
+ }
+ else
+ free(tmpS);
+ }
+ }
+
+ return -1;
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be inserted.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_class(JVM_CLASS *class, const void *value) {
+ CP_INFO *newnode;
+ int temp;
+ char *t;
+ int i;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&& find/insert Class %s...\n",(char*)value);
+
+ t = strdup((char *)value);
+ if(!t) return -1;
+
+ for(i=0;i<strlen(t);i++)
+ if(t[i]=='.') t[i]='/';
+
+ temp = cp_find_or_insert(class, CONSTANT_Utf8, t);
+
+ free(t);
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+
+ if(!newnode || (temp < 0)) return -1;
+
+ newnode->tag = CONSTANT_Class;
+ newnode->cpnode.Class.name_index = temp;
+
+ /* now return the CP_NODE pointer created by cp_insert */
+ return cp_insert(class,newnode);
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be inserted.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_ref(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) {
+ JVM_METHODREF *mref = (JVM_METHODREF *)value;
+ CP_INFO *newnode;
+ int temp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&& ok.. going to find/insert a method reference...\n");
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = (u1) tag;
+
+ debug_msg("&& first find/insert %s...\n",mref->classname);
+
+ temp = cp_find_or_insert(class,CONSTANT_Class,mref->classname);
+ if(temp < 0) {
+ free(newnode);
+ return -1;
+ }
+
+ newnode->cpnode.Methodref.class_index = temp;
+
+ debug_msg("&& then find/insert the name_and_type...\n");
+
+ temp = cp_find_or_insert(class,CONSTANT_NameAndType,mref);
+ if(temp < 0) {
+ free(newnode);
+ return -1;
+ }
+
+ newnode->cpnode.Methodref.name_and_type_index = temp;
+
+ return cp_insert(class,newnode);
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be inserted.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_nameandtype(JVM_CLASS *class, const void *value) {
+ JVM_METHODREF *mref = (JVM_METHODREF *)value;
+ CP_INFO *newnode;
+ int temp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&& find/insert NameAndType...\n");
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_NameAndType;
+
+ temp = cp_find_or_insert(class,CONSTANT_Utf8,mref->methodname);
+ if(temp < 0) {
+ free(newnode);
+ return -1;
+ }
+
+ newnode->cpnode.NameAndType.name_index = temp;
+
+ temp = cp_find_or_insert(class,CONSTANT_Utf8,mref->descriptor);
+ if(temp < 0) {
+ free(newnode);
+ return -1;
+ }
+
+ newnode->cpnode.NameAndType.descriptor_index = temp;
+
+ return cp_insert(class,newnode);
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param value -- The constant value to be inserted.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_utf8(JVM_CLASS *class, const void *value) {
+ CP_INFO *newnode;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Utf8;
+ newnode->cpnode.Utf8.length = strlen(value);
+ newnode->cpnode.Utf8.bytes = (u1 *) malloc(newnode->cpnode.Utf8.length);
+ if(!newnode->cpnode.Utf8.bytes) {
+ free(newnode);
+ return -1;
+ }
+
+ strncpy((char*)newnode->cpnode.Utf8.bytes,value,newnode->cpnode.Utf8.length);
+
+ return cp_insert(class, newnode);
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_int_constant(JVM_CLASS *class, const void *val, BOOL force_insert) {
+ CP_INFO * newnode;
+ int intVal;
+
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ intVal = *((int*)val);
+
+ /* if integer value is between JVM_SHORT_MIN and JVM_SHORT_MAX,
+ * then we do not need to use the ldc opcode. Thus, there's no
+ * need to create a constant pool entry.
+ */
+
+ if(( (cp_lookup(class, CONSTANT_Integer, (void *)&intVal) < 0)
+ && (intVal < JVM_SHORT_MIN || intVal > JVM_SHORT_MAX) )
+ || force_insert)
+ {
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Integer;
+ newnode->cpnode.Integer.bytes = cp_big_endian_u4((u4)intVal);
+
+ return cp_insert(class, newnode);
+ }
+
+ return -1;
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_float_constant(JVM_CLASS *class, const void *val, BOOL force_insert) {
+ CP_INFO * newnode;
+ float floatVal;
+
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ floatVal = *((float *)val);
+
+ /* if float value is 0.0, 1.0, or 2.0 then we can use
+ * the fconst_<i> opcode. Thus, there's no
+ * need to create a constant pool entry.
+ */
+
+ if(( (cp_lookup(class, CONSTANT_Float, (void *)&floatVal) < 0)
+ && ( floatVal != 0.0 && floatVal != 1.0 && floatVal != 2.0) )
+ || force_insert)
+ {
+ u4 tmp;
+ memcpy(&tmp,&floatVal,sizeof(tmp));
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Float;
+ newnode->cpnode.Float.bytes = cp_big_endian_u4(tmp);
+
+ return cp_insert(class, newnode);
+ }
+
+ return -1;
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_long_constant(JVM_CLASS *class, const void *val, BOOL force_insert) {
+ CP_INFO * newnode;
+ u4 tmp1, tmp2;
+ u8 longVal;
+
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ longVal = *((u8 *)val);
+
+ /* if long value is 0 or 1, then we can use
+ * the lconst_<i> opcode. Thus, there's no
+ * need to create a constant pool entry.
+ */
+
+ if(( (cp_lookup(class, CONSTANT_Long, (void *)&longVal) < 0)
+ && ( longVal != 0 && longVal != 1 ) )
+ || force_insert)
+ {
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Long;
+ memcpy(&tmp1,&longVal,sizeof(tmp1));
+ memcpy(&tmp2,(char*)&longVal+4,sizeof(tmp2));
+ if(isBigEndian()) {
+ newnode->cpnode.Long.high_bytes = tmp1;
+ newnode->cpnode.Long.low_bytes = tmp2;
+ }
+ else {
+ newnode->cpnode.Long.high_bytes = cp_big_endian_u4(tmp2);
+ newnode->cpnode.Long.low_bytes = cp_big_endian_u4(tmp1);
+ }
+
+ return cp_insert(class, newnode);
+ }
+
+ return -1;
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_double_constant(JVM_CLASS *class, const void *val, BOOL force_insert) {
+ unsigned int tmp1, tmp2;
+ CP_INFO * newnode;
+ double doubleVal;
+
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ doubleVal = *((double *)val);
+
+ /* if double value is 0.0 or 1.0, then we can use
+ * the dconst_<i> opcode. Thus, there's no
+ * need to create a constant pool entry.
+ */
+
+ if(( (cp_lookup(class, CONSTANT_Double, (void *)&doubleVal) < 0)
+ && ( doubleVal != 0.0 && doubleVal != 1.0 ) )
+ || force_insert)
+ {
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Double;
+ memcpy(&tmp1,&doubleVal,sizeof(tmp1));
+ memcpy(&tmp2,(char*)&doubleVal+4,sizeof(tmp2));
+ if(isBigEndian()) {
+ newnode->cpnode.Double.high_bytes = tmp1;
+ newnode->cpnode.Double.low_bytes = tmp2;
+ }
+ else {
+ newnode->cpnode.Double.high_bytes = cp_big_endian_u4(tmp2);
+ newnode->cpnode.Double.low_bytes = cp_big_endian_u4(tmp1);
+ }
+
+ return cp_insert(class, newnode);
+ }
+
+ return -1;
+}
+
+/**
+ * Inserts a class constant into the constant pool.
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param val -- The constant value to be inserted.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * On error, returns -1.
+ **/
+
+static int
+insert_string_constant(JVM_CLASS *class, const void *val, BOOL force_insert) {
+ CP_INFO * newnode;
+ int idx;
+
+ if(!class || !val) {
+ BAD_ARG();
+ return -1;
+ }
+
+ /* unique string literals always go into the constant pool.
+ * first, we have to create a CONSTANT_Utf8 entry for the
+ * string itself. then we create a CONSTANT_String entry
+ * whose string_index points to the Utf8 string.
+ *
+ * Note that we only malloc enough for the string itself
+ * since the Utf8 string should not be null-terminated.
+ */
+
+ debug_msg("inserting a string... '%s'\n",(char *)val);
+
+ idx = cp_lookup(class, CONSTANT_Utf8, val);
+
+ if(idx < 0)
+ {
+
+ debug_msg("&& in insert_constant, inserting '%s'\n",(char *)val);
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_Utf8;
+ newnode->cpnode.Utf8.length = strlen(val);
+ newnode->cpnode.Utf8.bytes = (u1 *) malloc(newnode->cpnode.Utf8.length);
+ if(!newnode->cpnode.Utf8.bytes) {
+ free(newnode);
+ return -1;
+ }
+
+ strncpy((char *)newnode->cpnode.Utf8.bytes, val,
+ newnode->cpnode.Utf8.length);
+
+ idx = cp_insert(class, newnode);
+ }
+ else if(idx == 0) {
+ debug_err("WARNING insert_constant(): idx is 0\n");
+ }
+
+ newnode = (CP_INFO *)malloc(sizeof(CP_INFO));
+ if(!newnode) return -1;
+
+ newnode->tag = CONSTANT_String;
+ newnode->cpnode.String.string_index = (u2)idx;
+
+ return cp_insert(class, newnode);
+}
+
+/**
+ * Find the constant pool index for the given constant if it exists in
+ * the constant pool. If not, create a new entry and return its index.
+ * See cp_find_or_insert().
+ *
+ * @param class -- The class containing the constant pool to be searched.
+ * @param tag -- The type of constant contained in the 'value' argument.
+ * @param value -- The constant value to be searched for.
+ * @param force_insert -- If FALSE, certain constants will be excluded
+ * depending on the data type/value (see cp_find_or_insert()). If TRUE,
+ * the constant will be inserted regardless of its value.
+ *
+ * @returns The constant pool index for the given constant value.
+ * If the value was not inserted because it was a special value
+ * as mentioned above or if an error occurred then -1 is returned.
+ **/
+
+static int
+cp_find_function_body(JVM_CLASS *class, JVM_CONSTANT tag, const void *value,
+ BOOL force_insert)
+{
+ int temp;
+
+ if(!class || !value) {
+ BAD_ARG();
+ return -1;
+ }
+
+ debug_msg("&& cp_find_or_insert\n");
+
+ /* First, check to see if it's already in the list. */
+
+ if( (temp = cp_lookup(class,tag,value)) >= 0 ) {
+
+ debug_msg("&& found entry, returning\n");
+
+ return temp;
+ }
+
+ debug_msg("&& entry not found, continuing...\n");
+
+ /* It's not in the list, so we insert it and return a pointer to
+ * the new node
+ */
+ switch(tag) {
+ case CONSTANT_Class:
+ return insert_class(class, value);
+ case CONSTANT_Fieldref:
+ case CONSTANT_InterfaceMethodref:
+ case CONSTANT_Methodref:
+ return insert_ref(class, tag, value);
+ case CONSTANT_NameAndType:
+ return insert_nameandtype(class, value);
+ case CONSTANT_Utf8:
+ return insert_utf8(class, value);
+ case CONSTANT_Integer:
+ return insert_constant(class, CP_INTEGER_CONST, value, force_insert);
+ case CONSTANT_Float:
+ return insert_constant(class, CP_FLOAT_CONST, value, force_insert);
+ case CONSTANT_Long:
+ return insert_constant(class, CP_LONG_CONST, value, force_insert);
+ case CONSTANT_Double:
+ return insert_constant(class, CP_DOUBLE_CONST, value, force_insert);
+ case CONSTANT_String:
+ return insert_constant(class, CP_STRING_CONST, value, force_insert);
+ default:
+ debug_err("cp_find_or_insert: WARNING - tag not yet implemented!\n");
+ return -1;
+ }
+
+ /* should never hit this return stmt once this function is fully-implemented.
+ * still might return NULL from elsewhere if insert_constant returns NULL,
+ * though (e.g. if trying to insert integer 0, etc).
+ */
+
+ return -1;
+}
+
diff --git a/libbytecode/constant_pool.h b/libbytecode/constant_pool.h
new file mode 100644
index 0000000..72e6b1f
--- /dev/null
+++ b/libbytecode/constant_pool.h
@@ -0,0 +1,49 @@
+#ifndef _CONSTANT_POOL_H
+#define _CONSTANT_POOL_H
+
+#include <string.h>
+#include "bytecode.h"
+
+static int
+ cp_find_function_body(JVM_CLASS *, JVM_CONSTANT, const void *, BOOL),
+ cp_lookup_utf8(JVM_CLASS *, const void *),
+ cp_lookup_int(JVM_CLASS *, const void *),
+ cp_lookup_float(JVM_CLASS *, const void *),
+ cp_lookup_long(JVM_CLASS *, const void *),
+ cp_lookup_double(JVM_CLASS *, const void *),
+ cp_lookup_class(JVM_CLASS *, const void *),
+ cp_lookup_ref(JVM_CLASS *, JVM_CONSTANT, const void *),
+ cp_lookup_nameandtype(JVM_CLASS *, const void *),
+ cp_lookup_string(JVM_CLASS *, const void *),
+ cp_insert(JVM_CLASS *, CP_INFO *),
+ insert_class(JVM_CLASS *, const void *),
+ insert_ref(JVM_CLASS *, JVM_CONSTANT, const void *),
+ insert_nameandtype(JVM_CLASS *, const void *),
+ insert_utf8(JVM_CLASS *, const void *),
+ insert_int_constant(JVM_CLASS *, const void *, BOOL),
+ insert_float_constant(JVM_CLASS *, const void *, BOOL),
+ insert_long_constant(JVM_CLASS *, const void *, BOOL),
+ insert_double_constant(JVM_CLASS *, const void *, BOOL),
+ insert_string_constant(JVM_CLASS *, const void *, BOOL),
+ insert_constant(JVM_CLASS *, int, const void *, BOOL);
+
+static BOOL
+ isBigEndian();
+
+const char * jvm_constant_tags[] = {
+ "Unknown CONSTANT",
+ "CONSTANT_Utf8",
+ "Unknown CONSTANT",
+ "CONSTANT_Integer",
+ "CONSTANT_Float",
+ "CONSTANT_Long",
+ "CONSTANT_Double",
+ "CONSTANT_Class",
+ "CONSTANT_String",
+ "CONSTANT_Fieldref",
+ "CONSTANT_Methodref",
+ "CONSTANT_InterfaceMethodref",
+ "CONSTANT_NameAndType"
+};
+
+#endif
diff --git a/libbytecode/dlist.c b/libbytecode/dlist.c
new file mode 100644
index 0000000..ae1365e
--- /dev/null
+++ b/libbytecode/dlist.c
@@ -0,0 +1,117 @@
+/* Jim Plank's dlist routines. Contact plank at cs.utk.edu */
+
+#include <stdio.h> /* Basic includes and definitions */
+#include <stdlib.h>
+#include "dlist.h"
+
+/*---------------------------------------------------------------------*
+ * PROCEDURES FOR MANIPULATING DOUBLY LINKED LISTS
+ * Each list contains a sentinal node, so that
+ * the first item in list l is l->flink. If l is
+ * empty, then l->flink = l->blink = l.
+ *---------------------------------------------------------------------*/
+
+Dlist make_dl()
+{
+ Dlist d;
+
+ d = (Dlist) malloc (sizeof(struct dlist));
+
+ if(!d) return NULL;
+
+ d->flink = d;
+ d->blink = d;
+ d->val = (void *) 0;
+ return d;
+}
+
+void
+dl_insert_b(node, val) /* Inserts to the end of a list */
+Dlist node;
+void *val;
+{
+ Dlist last_node, new;
+
+ new = (Dlist) malloc (sizeof(struct dlist));
+ new->val = val;
+
+ last_node = node->blink;
+
+ node->blink = new;
+ last_node->flink = new;
+ new->blink = last_node;
+ new->flink = node;
+}
+
+void
+dl_insert_list_b(Dlist node, Dlist list_to_insert)
+{
+ Dlist last_node, f, l;
+
+ if (dl_empty(list_to_insert)) {
+ free(list_to_insert);
+ return;
+ }
+ f = list_to_insert->flink;
+ l = list_to_insert->blink;
+ last_node = node->blink;
+
+ node->blink = l;
+ last_node->flink = f;
+ f->blink = last_node;
+ l->flink = node;
+ free(list_to_insert);
+}
+
+void
+dl_delete_node(item) /* Deletes an arbitrary iterm */
+Dlist item;
+{
+ item->flink->blink = item->blink;
+ item->blink->flink = item->flink;
+ free(item);
+}
+
+void
+dl_delete_list(l)
+Dlist l;
+{
+ Dlist d, next_node;
+
+ if(l == NULL)
+ return;
+
+ d = l->flink;
+ while(d != l) {
+ next_node = d->flink;
+ free(d);
+ d = next_node;
+ }
+ free(d);
+}
+
+void *
+dl_val(l)
+Dlist l;
+{
+ return l->val;
+}
+
+void*
+dl_pop(li)
+Dlist li;
+{
+ Dlist item = dl_last(li);
+ void *tmp;
+
+ if(item == NULL)
+ return NULL;
+
+ item->flink->blink = item->blink;
+ item->blink->flink = item->flink;
+
+ tmp = dl_val(item);
+ free(item);
+
+ return tmp;
+}
diff --git a/libbytecode/dlist.h b/libbytecode/dlist.h
new file mode 100644
index 0000000..869c7b6
--- /dev/null
+++ b/libbytecode/dlist.h
@@ -0,0 +1,50 @@
+/* Jim Plank's dlist routines. Contact plank at cs.utk.edu */
+
+#ifndef _DLIST_H
+#define _DLIST_H
+
+typedef struct dlist {
+ struct dlist *flink;
+ struct dlist *blink;
+ void *val;
+} *Dlist;
+
+/* Nil, first, next, and prev are macro expansions for list traversal
+ * primitives. */
+
+#define dl_nil(l) (l)
+
+#define dl_first(l) (l->flink)
+
+#define dl_last(l) (l->blink)
+
+#define dl_next(n) (n->flink)
+
+#define dl_prev(n) (n->blink)
+
+/* These are the routines for manipluating lists */
+
+extern Dlist make_dl(void);
+extern void dl_insert_b(Dlist, void *); /* Makes a new node, and inserts it before
+ the given node -- if that node is the
+ head of the list, the new node is
+ inserted at the end of the list */
+#define dl_insert_a(n, val) dl_insert_b(n->flink, val)
+
+extern void dl_delete_node(Dlist); /* Deletes and free's a node */
+
+extern void dl_delete_list(Dlist); /* Deletes the entire list from
+ existance */
+extern void *dl_val(Dlist); /* Returns node->val (used to shut lint up) */
+extern void *dl_pop(Dlist); /* returns the first node and removes
+ it from the list */
+
+extern void dl_insert_list_b(Dlist, Dlist);
+
+#define dl_traverse(ptr, list) \
+ for (ptr = dl_first(list); ptr != dl_nil(list); ptr = dl_next(ptr))
+#define dl_traverse_b(ptr, list) \
+ for (ptr = dl_last(list); ptr != dl_nil(list); ptr = dl_prev(ptr))
+#define dl_empty(list) (list->flink == list)
+
+#endif
diff --git a/libbytecode/globals.c b/libbytecode/globals.c
new file mode 100644
index 0000000..899c47a
--- /dev/null
+++ b/libbytecode/globals.c
@@ -0,0 +1,438 @@
+/** @file globals.c
+ * Contains global variables for the library.
+ */
+
+#include "bytecode.h"
+
+/**
+ * This table stores the number of constant pool entries required
+ * by each of the constant pool data types.
+ */
+
+const int cp_entry_width[] =
+{
+ 1, /* no tag 0 */
+ 1, /* CONSTANT_Utf8 */
+ 1, /* tag 2 intentionally missing */
+ 1, /* CONSTANT_Integer */
+ 1, /* CONSTANT_Float, */
+ 2, /* CONSTANT_Long, */
+ 2, /* CONSTANT_Double, */
+ 1, /* CONSTANT_Class, */
+ 1, /* CONSTANT_String, */
+ 1, /* CONSTANT_Fieldref, */
+ 1, /* CONSTANT_Methodref, */
+ 1, /* CONSTANT_InterfaceMethodref, */
+ 1, /* CONSTANT_NameAndType */
+};
+
+/**
+ * This table stores the number of local variable entries
+ * required by each of the JVM data types.
+ */
+
+const int jvm_localvar_width[] = {
+ 1, /* jvm_Byte */
+ 1, /* jvm_Short */
+ 1, /* jvm_Int */
+ 2, /* jvm_Long */
+ 1, /* jvm_Char */
+ 1, /* jvm_Float */
+ 2, /* jvm_Double */
+ 1 /* jvm_Object */
+};
+
+/**
+ * This table stores the operands for the newarray instruction.
+ */
+
+const int jvm_newarray_type[] = {
+ JVM_T_BYTE, /* jvm_Byte */
+ JVM_T_SHORT, /* jvm_Short */
+ JVM_T_INT, /* jvm_Int */
+ JVM_T_LONG, /* jvm_Long */
+ JVM_T_CHAR, /* jvm_Char */
+ JVM_T_FLOAT, /* jvm_Float */
+ JVM_T_DOUBLE, /* jvm_Double */
+ JVM_T_UNUSED /* jvm_Object */
+};
+
+/**
+ * Shorthand opcodes for loading integer constants -1 through 5.
+ */
+
+const JVM_OPCODE jvm_iconst_op[7] =
+{
+ jvm_iconst_m1,
+ jvm_iconst_0,
+ jvm_iconst_1,
+ jvm_iconst_2,
+ jvm_iconst_3,
+ jvm_iconst_4,
+ jvm_iconst_5
+};
+
+/**
+ * Opcodes to load local variables.
+ */
+
+const JVM_OPCODE jvm_load_op[JVM_MAX_RETURNS+1] =
+{
+ jvm_iload,
+ jvm_iload,
+ jvm_iload,
+ jvm_lload,
+ jvm_iload,
+ jvm_fload,
+ jvm_dload,
+ jvm_aload
+};
+
+/**
+ * Opcodes to load from arrays.
+ */
+
+const JVM_OPCODE jvm_array_load_op[JVM_MAX_RETURNS+1] =
+{
+ jvm_baload,
+ jvm_saload,
+ jvm_iaload,
+ jvm_laload,
+ jvm_caload,
+ jvm_faload,
+ jvm_daload,
+ jvm_aaload
+};
+
+/**
+ * Opcodes to store local variables.
+ */
+
+const JVM_OPCODE jvm_store_op[JVM_MAX_RETURNS+1] =
+{
+ jvm_istore,
+ jvm_istore,
+ jvm_istore,
+ jvm_lstore,
+ jvm_istore,
+ jvm_fstore,
+ jvm_dstore,
+ jvm_astore
+};
+
+/**
+ * Opcodes to store into arrays.
+ */
+
+const JVM_OPCODE jvm_array_store_op[JVM_MAX_RETURNS+1] =
+{
+ jvm_bastore,
+ jvm_sastore,
+ jvm_iastore,
+ jvm_lastore,
+ jvm_castore,
+ jvm_fastore,
+ jvm_dastore,
+ jvm_aastore
+};
+
+/**
+ * Shorthand opcodes for storing local variables 0 through 3.
+ */
+
+const JVM_OPCODE jvm_short_store_op[JVM_MAX_RETURNS+1][4] =
+{
+ {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3},
+ {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3},
+ {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3},
+ {jvm_lstore_0, jvm_lstore_1, jvm_lstore_2, jvm_lstore_3},
+ {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3},
+ {jvm_fstore_0, jvm_fstore_1, jvm_fstore_2, jvm_fstore_3},
+ {jvm_dstore_0, jvm_dstore_1, jvm_dstore_2, jvm_dstore_3},
+ {jvm_astore_0, jvm_astore_1, jvm_astore_2, jvm_astore_3}
+};
+
+/**
+ * Shorthand opcodes for loading local variables 0 through 3.
+ */
+
+const JVM_OPCODE jvm_short_load_op[JVM_MAX_RETURNS+1][4] =
+{
+ {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3},
+ {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3},
+ {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3},
+ {jvm_lload_0, jvm_lload_1, jvm_lload_2, jvm_lload_3},
+ {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3},
+ {jvm_fload_0, jvm_fload_1, jvm_fload_2, jvm_fload_3},
+ {jvm_dload_0, jvm_dload_1, jvm_dload_2, jvm_dload_3},
+ {jvm_aload_0, jvm_aload_1, jvm_aload_2, jvm_aload_3}
+};
+
+/**
+ * This table stores information about all the JVM instructions.
+ * Each entry has four parts:
+ *
+ * -# opcode - string representation of the opcode
+ * -# width - total width of the instruction plus operands
+ * -# pre-stack - number of stack items popped before issuing the instruction
+ * -# post-stack - number of stack items pushed after issuing the instruction
+ */
+
+const JVM_OP_INFO jvm_opcode[] = {
+ {"nop", 1, 0, 0},
+ {"aconst_null", 1, 0, 1},
+ {"iconst_m1", 1, 0, 1},
+ {"iconst_0", 1, 0, 1},
+ {"iconst_1", 1, 0, 1},
+ {"iconst_2", 1, 0, 1},
+ {"iconst_3", 1, 0, 1},
+ {"iconst_4", 1, 0, 1},
+ {"iconst_5", 1, 0, 1},
+ {"lconst_0", 1, 0, 2},
+ {"lconst_1", 1, 0, 2},
+ {"fconst_0", 1, 0, 1},
+ {"fconst_1", 1, 0, 1},
+ {"fconst_2", 1, 0, 1},
+ {"dconst_0", 1, 0, 2},
+ {"dconst_1", 1, 0, 2},
+ {"bipush", 2, 0, 1},
+ {"sipush", 3, 0, 1},
+ {"ldc", 2, 0, 1},
+ {"ldc_w", 3, 0, 1},
+ {"ldc2_w", 3, 0, 2},
+ {"iload", 2, 0, 1},
+ {"lload", 2, 0, 2},
+ {"fload", 2, 0, 1},
+ {"dload", 2, 0, 2},
+ {"aload", 2, 0, 1},
+ {"iload_0", 1, 0, 1},
+ {"iload_1", 1, 0, 1},
+ {"iload_2", 1, 0, 1},
+ {"iload_3", 1, 0, 1},
+ {"lload_0", 1, 0, 2},
+ {"lload_1", 1, 0, 2},
+ {"lload_2", 1, 0, 2},
+ {"lload_3", 1, 0, 2},
+ {"fload_0", 1, 0, 1},
+ {"fload_1", 1, 0, 1},
+ {"fload_2", 1, 0, 1},
+ {"fload_3", 1, 0, 1},
+ {"dload_0", 1, 0, 2},
+ {"dload_1", 1, 0, 2},
+ {"dload_2", 1, 0, 2},
+ {"dload_3", 1, 0, 2},
+ {"aload_0", 1, 0, 1},
+ {"aload_1", 1, 0, 1},
+ {"aload_2", 1, 0, 1},
+ {"aload_3", 1, 0, 1},
+ {"iaload", 1, 2, 1},
+ {"laload", 1, 2, 2},
+ {"faload", 1, 2, 1},
+ {"daload", 1, 2, 2},
+ {"aaload", 1, 2, 1},
+ {"baload", 1, 2, 1},
+ {"caload", 1, 2, 1},
+ {"saload", 1, 2, 1},
+ {"istore", 2, 1, 0},
+ {"lstore", 2, 2, 0},
+ {"fstore", 2, 1, 0},
+ {"dstore", 2, 2, 0},
+ {"astore", 2, 1, 0},
+ {"istore_0", 1, 1, 0},
+ {"istore_1", 1, 1, 0},
+ {"istore_2", 1, 1, 0},
+ {"istore_3", 1, 1, 0},
+ {"lstore_0", 1, 2, 0},
+ {"lstore_1", 1, 2, 0},
+ {"lstore_2", 1, 2, 0},
+ {"lstore_3", 1, 2, 0},
+ {"fstore_0", 1, 1, 0},
+ {"fstore_1", 1, 1, 0},
+ {"fstore_2", 1, 1, 0},
+ {"fstore_3", 1, 1, 0},
+ {"dstore_0", 1, 2, 0},
+ {"dstore_1", 1, 2, 0},
+ {"dstore_2", 1, 2, 0},
+ {"dstore_3", 1, 2, 0},
+ {"astore_0", 1, 1, 0},
+ {"astore_1", 1, 1, 0},
+ {"astore_2", 1, 1, 0},
+ {"astore_3", 1, 1, 0},
+ {"iastore", 1, 3, 0},
+ {"lastore", 1, 4, 0},
+ {"fastore", 1, 3, 0},
+ {"dastore", 1, 4, 0},
+ {"aastore", 1, 3, 0},
+ {"bastore", 1, 3, 0},
+ {"castore", 1, 3, 0},
+ {"sastore", 1, 3, 0},
+ {"pop", 1, 1, 0},
+ {"pop2", 1, 2, 0},
+ {"dup", 1, 1, 2},
+ {"dup_x1", 1, 2, 3},
+ {"dup_x2", 1, 3, 4},
+ {"dup2", 1, 2, 4},
+ {"dup2_x1", 1, 3, 5},
+ {"dup2_x2", 1, 4, 6},
+ {"swap", 1, 2, 2},
+ {"iadd", 1, 2, 1},
+ {"ladd", 1, 4, 2},
+ {"fadd", 1, 2, 1},
+ {"dadd", 1, 4, 2},
+ {"isub", 1, 2, 1},
+ {"lsub", 1, 4, 2},
+ {"fsub", 1, 2, 1},
+ {"dsub", 1, 4, 2},
+ {"imul", 1, 2, 1},
+ {"lmul", 1, 4, 2},
+ {"fmul", 1, 2, 1},
+ {"dmul", 1, 4, 2},
+ {"idiv", 1, 2, 1},
+ {"ldiv", 1, 4, 2},
+ {"fdiv", 1, 2, 1},
+ {"ddiv", 1, 4, 2},
+ {"irem", 1, 2, 1},
+ {"lrem", 1, 4, 2},
+ {"frem", 1, 2, 1},
+ {"drem", 1, 4, 2},
+ {"ineg", 1, 1, 1},
+ {"lneg", 1, 2, 2},
+ {"fneg", 1, 1, 1},
+ {"dneg", 1, 2, 2},
+ {"ishl", 1, 2, 1},
+ {"lshl", 1, 3, 2},
+ {"ishr", 1, 2, 1},
+ {"lshr", 1, 3, 2},
+ {"iushr", 1, 2, 1},
+ {"lushr", 1, 3, 2},
+ {"iand", 1, 2, 1},
+ {"land", 1, 4, 2},
+ {"ior", 1, 2, 1},
+ {"lor", 1, 4, 2},
+ {"ixor", 1, 2, 1},
+ {"lxor", 1, 4, 2},
+ {"iinc", 3, 0, 0},
+ {"i2l", 1, 1, 2},
+ {"i2f", 1, 1, 1},
+ {"i2d", 1, 1, 2},
+ {"l2i", 1, 2, 1},
+ {"l2f", 1, 2, 1},
+ {"l2d", 1, 2, 2},
+ {"f2i", 1, 1, 1},
+ {"f2l", 1, 1, 2},
+ {"f2d", 1, 1, 2},
+ {"d2i", 1, 2, 1},
+ {"d2l", 1, 2, 2},
+ {"d2f", 1, 2, 1},
+ {"i2b", 1, 1, 1},
+ {"i2c", 1, 1, 1},
+ {"i2s", 1, 1, 1},
+ {"lcmp", 1, 4, 1},
+ {"fcmpl", 1, 2, 1},
+ {"fcmpg", 1, 2, 1},
+ {"dcmpl", 1, 4, 1},
+ {"dcmpg", 1, 4, 1},
+ {"ifeq", 3, 1, 0},
+ {"ifne", 3, 1, 0},
+ {"iflt", 3, 1, 0},
+ {"ifge", 3, 1, 0},
+ {"ifgt", 3, 1, 0},
+ {"ifle", 3, 1, 0},
+ {"if_icmpeq", 3, 2, 0},
+ {"if_icmpne", 3, 2, 0},
+ {"if_icmplt", 3, 2, 0},
+ {"if_icmpge", 3, 2, 0},
+ {"if_icmpgt", 3, 2, 0},
+ {"if_icmple", 3, 2, 0},
+ {"if_acmpeq", 3, 2, 0},
+ {"if_acmpne", 3, 2, 0},
+ {"goto", 3, 0, 0},
+ {"jsr", 3, 0, 1},
+ {"ret", 2, 0, 0},
+ {"tableswitch", 13, 1, 0},
+ {"lookupswitch", 9, 1, 0},
+ {"ireturn", 1, 1, 0},
+ {"lreturn", 1, 2, 0},
+ {"freturn", 1, 1, 0},
+ {"dreturn", 1, 2, 0},
+ {"areturn", 1, 1, 0},
+ {"return", 1, 0, 0},
+ {"getstatic", 3, 0, 1},
+ {"putstatic", 3, 1, 0},
+ {"getfield", 3, 1, 9},
+ {"putfield", 3, 9, 0},
+ {"invokevirtual", 3, 9, 0},
+ {"invokespecial", 3, 9, 0},
+ {"invokestatic", 3, 9, 0},
+ {"invokeinterface",5, 9, 0},
+ {"UNUSED", 1, 0, 0},
+ {"new", 3, 0, 1},
+ {"newarray", 2, 1, 1},
+ {"anewarray", 3, 1, 1},
+ {"arraylength", 1, 1, 1},
+ {"athrow", 1, 1, 0},
+ {"checkcast", 3, 1, 1},
+ {"instanceof", 3, 1, 1},
+ {"monitorenter", 1, 1, 0},
+ {"monitorexit", 1, 1, 0},
+ {"wide", 1, 0, 0},
+ {"multianewarray", 4, 9, 1},
+ {"ifnull", 3, 1, 0},
+ {"ifnonnull", 3, 1, 0},
+ {"goto_w", 5, 0, 0},
+ {"jsr_w", 5, 0, 1},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0},
+ {"UNUSED", 1, 0, 0}
+};
diff --git a/libbytecode/make.def.in b/libbytecode/make.def.in
new file mode 100644
index 0000000..b570a5a
--- /dev/null
+++ b/libbytecode/make.def.in
@@ -0,0 +1,8 @@
+CC=@CC@
+CFLAGS=-g -Wall @CFLAGS@
+AR=@AR@
+DOXYGEN=@DOXYGEN@
+JAVA=@JAVA@
+JAVAC=@JAVAC@
+
+F2J_LIBDIR=@F2J_INSTALL_PREFIX@/lib
diff --git a/src/LICENSE b/src/LICENSE
new file mode 100644
index 0000000..4205b4a
--- /dev/null
+++ b/src/LICENSE
@@ -0,0 +1,273 @@
+
+LICENSE
+
+The license covering the f2j source code is basically GPL with the addition
+of the BSD advertising clause.
+
+ GNU GENERAL PUBLIC LICENSE
+
+ Version 2, June 1991
+
+Copyright (C) 1989, 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.
+
+ 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.
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..f5d0ae1
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,80 @@
+# $Author: keithseymour $
+# $Date: 2007/02/01 01:06:37 $
+# $Source: /cvsroot/f2j/f2j/src/Makefile,v $
+# Revision:$
+
+.PHONY: clean
+
+include make.def
+
+OBJS=y.tab.o f2jlex.o f2jmain.o symtab.o \
+ codegen.o vcg_emitter.o dlist.o typecheck.o \
+ optimize.o globals.o f2jmem.o
+F2J_LIBS= -L$(BYTE_DIR) -lbytecode $(LIBS)
+
+.c.o:
+ $(CC) $(CFLAGS) $(INCLUDES) -c $<
+
+# The main executable.
+f2java: f2j.h f2jparse.y $(OBJS) $(BYTE_DIR)/libbytecode.a
+ $(CC) $(CFLAGS) $(INCLUDES) -o $@ $(OBJS) $(F2J_LIBS)
+
+# The purify version...
+puref2j: f2j.h f2jparse.y $(OBJS) $(JAVAB)
+ $(PURIFY) $(PFLAGS) $(CC) $(CFLAGS) $(INCLUDES) -o $@ $(OBJS) $(F2J_LIBS)
+
+install: f2java
+ install -d -m 755 $(F2J_BINDIR)
+ install -m 755 f2java $(F2J_BINDIR)
+
+lexdebug: f2jlex.c
+ $(CC) $(CFLAGS) $(INCLUDES) -o lexdebug -DSTANDALONE f2jlex.c
+
+lint:
+ lint codegen.c dlist.c f2jlex.c\
+ f2jmain.c f2jmem.c y.tab.c globals.c optimize.c\
+ symtab.c typecheck.c vcg_emitter.c
+
+y.tab.c y.tab.h: f2jparse.y
+ $(YACC) $(YFLAGS) f2jparse.y
+
+y.tab.o: y.tab.c f2j.h symtab.h dlist.h \
+ opcodes.h f2jmem.h
+
+f2jlex.o: f2jlex.c initialize.h f2j.h symtab.h dlist.h \
+ opcodes.h y.tab.h f2jmem.h
+
+f2jmain.o: f2jmain.c f2j.h symtab.h dlist.h opcodes.h \
+ y.tab.h f2jmem.h
+
+symtab.o: symtab.c f2j.h symtab.h dlist.h opcodes.h \
+ f2jmem.h
+
+codegen.o: codegen.c codegen.h f2j.h symtab.h dlist.h \
+ opcodes.h y.tab.h f2jmem.h
+
+vcg_emitter.o: vcg_emitter.c f2j.h symtab.h dlist.h \
+ opcodes.h y.tab.h
+
+dlist.o: dlist.c dlist.h f2j.h symtab.h opcodes.h \
+ f2jmem.h
+
+typecheck.o: typecheck.c f2j.h symtab.h dlist.h \
+ opcodes.h y.tab.h f2jmem.h
+
+optimize.o: optimize.c f2j.h symtab.h dlist.h \
+ opcodes.h codegen.h y.tab.h f2jmem.h
+
+globals.o: globals.c f2j.h symtab.h dlist.h opcodes.h \
+ codegen.h y.tab.h
+
+f2jmem.o: f2jmem.c f2jmem.h f2j.h symtab.h dlist.h \
+ opcodes.h
+
+clean:
+ rm -f *.o *.class f2jparse.c y.tab.c y.tab.h \
+ tmp f2j f2java core a.out *.output *~ *.vcg
+ cd test; $(MAKE) clean
+
+realclean: clean
+ rm -f ../bin/f2java ../bin/puref2j
diff --git a/src/codegen.c b/src/codegen.c
new file mode 100644
index 0000000..680b2c4
--- /dev/null
+++ b/src/codegen.c
@@ -0,0 +1,13218 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/codegen.c,v $
+ * $Revision: 1.286 $
+ * $Date: 2007/12/14 20:56:39 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * codegen.c *
+ * *
+ * Generates Java source code from the AST representation of a Fortran *
+ * program. *
+ * *
+ *****************************************************************************/
+
+#include"codegen.h"
+#include"f2j_externs.h"
+
+/*****************************************************************************
+ * Global variables, a necessary evil when working with yacc. *
+ *****************************************************************************/
+
+int
+ gendebug = FALSE; /* set to TRUE to generate debugging output */
+
+char
+ *unit_name, /* name of this function/subroutine */
+ *returnname, /* return type of this prog. unit */
+ *cur_filename, /* name of the class file currently writing */
+ **funcname=input_func;/* input functions, EOF-detecting or non-detecting */
+
+Dlist
+ cur_assign_list = NULL, /* list of labels used in ASSIGN TO statements */
+ dummy_nodes = NULL, /* list of dummy graph nodes to free later */
+ doloop = NULL, /* stack of do loop labels */
+ while_list = NULL, /* stack of while loop labels */
+ adapter_list = NULL, /* list of adapter functions (see tech report) */
+ methcall_list = NULL; /* list of methods to be called by reflection */
+
+SUBSTITUTION
+ global_sub={NULL,0}; /* substitution used for implied loops */
+
+FILE
+ *javafp, /* the class file currently generating */
+ *curfp, /* the file currently being written to */
+ *savefp; /* temp var for saving the current file pointer */
+
+SYMTABLE /* Symbol tables containing... */
+ *cur_type_table, /* type information */
+ *cur_external_table, /* external functions */
+ *cur_intrinsic_table, /* intrinsic functions */
+ *cur_args_table, /* variables which are arguments */
+ *cur_array_table, /* variables which are arrays */
+ *cur_format_table, /* format statements */
+ *cur_data_table, /* variables contained in DATA stmts */
+ *cur_save_table, /* variables contained in SAVE stmts */
+ *cur_common_table, /* variables contained in COMMON stmts */
+ *cur_param_table, /* variables which are parameters */
+ *cur_equiv_table; /* variables which are equivalenced */
+
+JVM_CLASS
+ *cur_class_file; /* class file for the current program unit */
+
+AST
+ *cur_equivList, /* list of equivalences */
+ *cur_unit, /* program unit currently being translated. */
+ *local_list; /* saved pointer to list of local vars. */
+
+BOOL
+ import_reflection, /* does this class need to import reflection */
+ import_blas, /* does it need to import the BLAS library */
+ bytecode_gen=TRUE, /* is bytecode generation currently enabled */
+ save_all_locals; /* should all locals be declared static? */
+
+unsigned int
+ stdin_lvar = -1, /* local var number of the EasyIn object */
+ iovec_lvar = -1; /* local var number of the input/output Vector */
+
+JVM_METHOD
+ *main_method, /* the primary method for this fortran program unit */
+ *cur_method;
+
+JVM_EXCEPTION_TABLE_ENTRY
+ * reflect_entry, /* exception table entry for reflection exceptions. */
+ * access_entry; /* exception table entry for access exceptions. */
+
+extern METHODTAB
+ intrinsic_toks[]; /* Fortran intrinsic function names. */
+
+extern FILE *devnull; /* file pointer to /dev/null, opened in f2jmain.c */
+
+/*****************************************************************************
+ * *
+ * emit *
+ * *
+ * This is the main code generation function. We traverse the *
+ * AST and recursively call emit() on each node. This *
+ * function figures out what kind of node it's looking at and *
+ * calls the appropriate function to handle the code generation. *
+ * *
+ *****************************************************************************/
+
+void
+emit (AST * root)
+{
+ int c;
+ int locals;
+
+ switch (root->nodetype)
+ {
+ case 0:
+ if (gendebug)
+ fprintf (stderr,"Bad node\n");
+
+ emit (root->nextstmt);
+ break;
+ case Progunit:
+ {
+ JVM_METHOD *clinit_method;
+ HASHNODE *hashtemp;
+ char *tmp_method_desc;
+ char *methodname;
+ char *classname;
+ char *tmpname;
+
+ if (gendebug)
+ printf ("Source.\n");
+
+ save_all_locals = root->astnode.source.save_all;
+
+ tmpname = root->astnode.source.progtype->
+ astnode.source.name->astnode.ident.name;
+
+ classname = strdup(tmpname);
+ lowercase(classname);
+
+ /* check if this program unit is a PROGRAM. if so, the
+ * method name is "main".
+ */
+
+ if(root->astnode.source.progtype->nodetype == Program) {
+ /* dup constant "main" so that we can free() later & won't
+ * be trying to free non-heap memory
+ */
+ methodname = strdup("main");
+ }
+ else
+ methodname = strdup(classname);
+
+ classname[0] = toupper(classname[0]);
+
+ cur_filename = bc_get_full_classname(classname, package_name);
+
+ /* First set up the local hash tables. */
+
+ cur_type_table = root->astnode.source.type_table;
+ cur_external_table = root->astnode.source.external_table;
+ cur_intrinsic_table = root->astnode.source.intrinsic_table;
+ cur_args_table = root->astnode.source.args_table;
+ cur_array_table = root->astnode.source.array_table;
+ cur_format_table = root->astnode.source.format_table;
+ cur_data_table = root->astnode.source.data_table;
+ cur_save_table = root->astnode.source.save_table;
+ cur_common_table = root->astnode.source.common_table;
+ cur_param_table = root->astnode.source.parameter_table;
+ cur_equiv_table = root->astnode.source.equivalence_table;
+ cur_equivList = root->astnode.source.equivalences;
+ cur_assign_list = root->astnode.source.stmt_assign_list;
+ cur_class_file = root->astnode.source.class =
+ bc_new_class(classname,inputfilename, "java.lang.Object",
+ package_name, F2J_CLASS_ACC);
+
+ bc_add_default_constructor(cur_class_file, F2J_INIT_ACC);
+
+ if(gendebug)
+ print_equivalences(cur_equivList);
+
+ initialize_lists();
+
+ clinit_method = bc_new_method(cur_class_file, "<clinit>", "()V",
+ strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC);
+ cur_method = clinit_method;
+
+ locals = assign_varnums_to_arguments(
+ root->astnode.source.progtype->astnode.source.args);
+
+ /* needs_reflection is determined during typecheck */
+
+ if(root->astnode.source.progtype->astnode.source.needs_reflection)
+ import_reflection = TRUE;
+ else
+ import_reflection = FALSE;
+
+ /* needs_blas is also determined during typecheck */
+
+ if(root->astnode.source.progtype->astnode.source.needs_blas &&
+ !type_lookup(blas_routine_table,tmpname))
+ import_blas = TRUE;
+ else
+ import_blas = FALSE;
+
+ prepare_comments(root);
+
+ open_output_file(root->astnode.source.progtype, classname);
+
+ savefp = curfp;
+ set_bytecode_status(cur_method, JAVA_AND_JVM);
+
+ if(root->astnode.source.prologComments != NULL)
+ emit_prolog_comments(root);
+
+ if((hashtemp=type_lookup(function_table, tmpname)) != NULL)
+ tmp_method_desc = hashtemp->variable->astnode.source.descriptor;
+ else
+ tmp_method_desc = MAIN_DESCRIPTOR;
+
+ main_method = bc_new_method(cur_class_file, methodname,
+ tmp_method_desc, strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC);
+
+ if(!save_all_override)
+ assign_varnums_to_locals(main_method,
+ root->astnode.source.typedecs);
+
+ insert_fields(root);
+
+ /* as part of creating a new classfile structure, we have
+ * already created an <init> method, the default constructor.
+ * the class may also need a <clinit> method, the class
+ * initializer. the <clinit> method initializes any static
+ * fields, DATA stmts, Strings which require new objects to
+ * be created, etc. here we create an empty CodeAttribute
+ * structure and then emit the typedecs. afterwards, we
+ * check to see if any code was generated for <clinit>.
+ * if so, we must create a method structure and add
+ * that to the current classfile structure. if not, we do
+ * nothing.
+ */
+
+ /* save pointer for local vars in local_emit */
+ local_list = root->astnode.source.typedecs;
+
+ emit (root->astnode.source.typedecs);
+ emit (root->astnode.source.progtype);
+
+ /* check whether any class initialization code was generated.
+ * if so, finish initializing the method and insert it into this
+ * class.
+ */
+
+ if(bc_get_code_length(cur_method) > 0) {
+ bc_append(cur_method, jvm_return);
+ fprintf(indexfp,"%s:%s:%s\n",cur_filename, "<clinit>", "()V");
+ }
+ else {
+ bc_remove_method(cur_method);
+ bc_free_method(cur_method);
+ }
+
+ /* if this program unit is a function, then assign a local
+ * variable number to the implicit return variable.
+ */
+
+ if(root->astnode.source.progtype->nodetype == Function) {
+ hashtemp=type_lookup(cur_type_table, unit_name);
+ if(hashtemp)
+ hashtemp->variable->astnode.ident.localvnum =
+ bc_get_next_local(main_method,
+ jvm_data_types[root->astnode.source.progtype->astnode.source.returns]);
+ }
+
+ cur_method = main_method;
+
+ /* return stuff */
+ if(!save_all_override)
+ local_emit(cur_method, root->astnode.source.typedecs);
+
+ /* If this program unit does any reading, we declare an instance of
+ * the EasyIn class. grab a local var for this, but dont worry
+ * about releasing it, since we might need it throughout the life
+ * of the method.
+ */
+
+ if(root->astnode.source.progtype->astnode.source.needs_input) {
+ fprintf(curfp," EasyIn %s = new EasyIn();\n", F2J_STDIN);
+ stdin_lvar = bc_get_next_local(cur_method, jvm_Object);
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, EASYIN_CLASS);
+ bc_append(cur_method, jvm_new,c);
+ bc_append(cur_method, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "<init>",
+ EASYIN_DESC);
+ bc_append(cur_method, jvm_invokespecial, c);
+ bc_gen_store_op(cur_method, stdin_lvar, jvm_Object);
+ }
+
+ /* Initialize a vector to be used for storing arguments to the
+ * formatted write routine (f77write).
+ */
+ if(root->astnode.source.progtype->astnode.source.needs_output) {
+ fprintf(curfp," java.util.Vector %s = new java.util.Vector();\n", F2J_IO_VEC);
+ iovec_lvar = bc_get_next_local(cur_method, jvm_Object);
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, VECTOR_CLASS);
+ bc_append(cur_method, jvm_new,c);
+ bc_append(cur_method, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "<init>",
+ VECTOR_DESC);
+ bc_append(cur_method, jvm_invokespecial, c);
+ bc_gen_store_op(cur_method, iovec_lvar, jvm_Object);
+ }
+
+ if((type_lookup(cur_external_table, "etime") != NULL)
+ || type_lookup(cur_external_table, "second") != NULL)
+ {
+ fprintf(curfp, " Etime.etime();\n");
+
+ c = bc_new_methodref(cur_class_file, ETIME_CLASS,
+ "etime", ETIME_DESC);
+
+ bc_append(cur_method, jvm_invokestatic, c);
+ }
+
+ /* if one of the arguments is a function, we must use the
+ * reflection mechanism to perform the method call.
+ */
+
+ if(import_reflection) {
+ reflect_declarations_emit(cur_method,
+ root->astnode.source.progtype->astnode.source.args);
+
+ /* The 'catch' corresponding to the following try is generated
+ * in case End.
+ */
+
+ fprintf(curfp,"try {\n");
+
+ /* start the exception handler from the next opcode */
+ reflect_entry = (JVM_EXCEPTION_TABLE_ENTRY *)
+ f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY));
+ reflect_entry->from = bc_append(cur_method, jvm_xxxunusedxxx);
+
+ access_entry = (JVM_EXCEPTION_TABLE_ENTRY *)
+ f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY));
+ access_entry->from = reflect_entry->from;
+ }
+
+ emit(root->astnode.source.statements);
+
+ /* check if code was generated for this program unit's method.
+ * if so, finish initializing the method and insert it into this
+ * class.
+ */
+
+ if(bc_get_code_length(cur_method) > 0)
+ fprintf(indexfp,"%s:%s:%s\n",cur_filename, methodname,
+ tmp_method_desc);
+
+ f2jfree(methodname, strlen(methodname)+1);
+
+ emit_invocations();
+
+ emit_adapters();
+
+ fprintf(curfp,"} // End class.\n");
+ fclose(curfp);
+
+ bc_write_class(cur_class_file, output_dir);
+
+ if(gendebug)
+ cp_dump(cur_class_file);
+
+ bc_free_class(cur_class_file);
+
+ free_lists();
+
+ f2jfree(classname, strlen(classname)+1);
+ f2jfree(cur_filename, strlen(cur_filename)+1);
+
+ break;
+ }
+ case Subroutine:
+ if (gendebug)
+ printf ("Subroutine.\n");
+
+ returnname = NULL; /* Subroutines return void. */
+ cur_unit = root;
+ unit_name = root->astnode.source.name->astnode.ident.name;
+
+ if(gendebug)
+ printf ("Subroutine name: %s\n", unit_name);
+
+ constructor (root);
+ break;
+ case Function:
+ if (gendebug)
+ printf ("Function.\n");
+
+ returnname = root->astnode.source.name->astnode.ident.name;
+ cur_unit = root;
+ unit_name = root->astnode.source.name->astnode.ident.name;
+
+ if(gendebug)
+ printf ("Function name: %s\n", unit_name);
+
+ constructor (root);
+ break;
+ case Program:
+ if (gendebug)
+ printf ("Program.\n");
+
+ returnname = NULL; /* programs return void. */
+ cur_unit = root;
+ unit_name = root->astnode.source.name->astnode.ident.name;
+
+ if (gendebug)
+ printf ("Program name: %s\n", unit_name);
+
+ constructor(root);
+ break;
+ case Typedec:
+ if (gendebug)
+ printf ("Typedec.\n");
+
+ if(save_all_override)
+ typedec_emit_all_static (cur_method, root);
+ else
+ typedec_emit (cur_method, root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case DataList:
+ if (gendebug)
+ printf ("Data.\n");
+
+ data_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of data list. */
+ emit (root->nextstmt);
+ break;
+ case Specification:
+ if (gendebug)
+ printf ("Specification.\n");
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Equivalence:
+ if (gendebug)
+ printf ("Equivalence.\n");
+
+ equiv_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Statement:
+ if (gendebug)
+ printf ("Statement.\n");
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Assignment:
+ if (gendebug)
+ printf ("Assignment.\n");
+
+ assign_emit (cur_method, root);
+ fprintf (curfp, ";\n");
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case StmtLabelAssign:
+ if (gendebug)
+ printf ("StmtLabelAssign.\n");
+
+ assign_emit (cur_method, root);
+ fprintf (curfp, ";\n");
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Call:
+ if (gendebug)
+ printf ("Call.\n");
+
+ call_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Forloop:
+ if (gendebug)
+ printf ("Forloop.\n");
+
+ forloop_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Blockif:
+ if (gendebug)
+ printf ("Blockif.\n");
+
+ blockif_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Elseif:
+ if (gendebug)
+ printf ("Elseif.\n");
+
+ elseif_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Else:
+ if (gendebug)
+ printf ("Else.\n");
+
+ else_emit (root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Logicalif:
+ if (gendebug)
+ printf ("Logicalif.\n");
+
+ logicalif_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Arithmeticif:
+ if (gendebug)
+ printf ("Arithmeticif.\n");
+
+ arithmeticif_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Return:
+ if(gendebug)
+ printf("Return: %s.\n", returnname != NULL ? returnname : "void");
+
+ /*
+ * According to the f77 spec, labels cannot contain more
+ * than five digits, so we use six nines as the label
+ * for the final return statement to avoid conflicts with
+ * labels that already exist in the program.
+ */
+
+ fprintf(curfp,"Dummy.go_to(\"%s\",999999);\n",cur_filename);
+
+ return_emit(cur_method);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Goto:
+ if (gendebug)
+ printf ("Goto.\n");
+
+ goto_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case ComputedGoto:
+ if (gendebug)
+ printf ("Computed Goto.\n");
+
+ computed_goto_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case AssignedGoto:
+ if (gendebug)
+ printf ("Assigned Goto.\n");
+
+ assigned_goto_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Label:
+ if (gendebug)
+ printf ("Label.\n");
+
+ label_emit (cur_method, root);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit (root->nextstmt);
+ break;
+ case Write:
+ if (gendebug)
+ printf ("Write statement.\n");
+
+ write_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Read:
+ if (gendebug)
+ printf ("Read statement.\n");
+
+ read_emit (cur_method, root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Format:
+ if (gendebug)
+ printf("skipping format statement\n");
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Stop:
+ if (gendebug)
+ printf ("Stop.\n");
+
+ stop_emit(cur_method, root);
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Pause:
+ if (gendebug)
+ printf ("Pause.\n");
+
+ pause_emit(cur_method, root);
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case End:
+ if (gendebug)
+ printf ("End.\n");
+ end_emit(cur_method);
+ break;
+ case Save:
+ if (gendebug)
+ printf ("Save (ignoring).\n");
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Common:
+ fprintf(stderr,"Warning: hit case Common in emit()\n");
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case CommonList:
+ if (gendebug)
+ printf ("Common.\n");
+
+ common_emit(root);
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case MainComment:
+ while(root->nextstmt != NULL && root->nextstmt->nodetype == Comment)
+ root = root->nextstmt;
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Comment:
+ if (gendebug)
+ printf ("Comment.\n");
+
+ if(curfp != NULL)
+ fprintf(curfp,"// %s", root->astnode.ident.name);
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Dimension:
+ if(gendebug)
+ printf("Dimension\n");
+
+ /* ignore */
+
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Unimplemented:
+ fprintf (curfp,
+ " ; // WARNING: Unimplemented statement in Fortran source.\n");
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ case Constant:
+ default:
+ fprintf(stderr,"emit(): Error, bad nodetype (%s)\n",
+ print_nodetype(root));
+ if (root->nextstmt != NULL)
+ emit (root->nextstmt);
+ break;
+ } /* switch on nodetype. */
+
+}
+
+/*****************************************************************************
+ * *
+ * prepare_comments *
+ * *
+ * Here we check whether there was a block of prologue comment statements. *
+ * If that block is longer than the current javadoc comment block (or if *
+ * there is no javadoc comment block) then use the prologue instead. *
+ * *
+ *****************************************************************************/
+
+void
+prepare_comments(AST *root)
+{
+ AST *pc, *jc;
+
+ if(genJavadoc) {
+ pc = root->astnode.source.prologComments;
+ jc = root->astnode.source.progtype->astnode.source.javadocComments;
+
+ if(pc) {
+ if(jc) {
+ if(pc->astnode.ident.len > jc->astnode.ident.len) {
+ jc->nodetype = Comment;
+ pc->nodetype = MainComment;
+ root->astnode.source.progtype->astnode.source.javadocComments = pc;
+ root->astnode.source.prologComments = NULL;
+ }
+ }
+ else {
+ pc->nodetype = MainComment;
+ root->astnode.source.progtype->astnode.source.javadocComments = pc;
+ root->astnode.source.prologComments = NULL;
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * initialize_lists *
+ * *
+ * initializes new list instances for the current program unit. *
+ * *
+ *****************************************************************************/
+
+void
+initialize_lists()
+{
+
+ /* Initialize the lists. */
+
+ dummy_nodes = make_dl();
+ while_list = make_dl();
+ doloop = make_dl();
+ adapter_list = make_dl();
+ methcall_list = make_dl();
+}
+
+/*****************************************************************************
+ * *
+ * free_lists *
+ * *
+ * frees memory associated with the global lists. *
+ * *
+ *****************************************************************************/
+
+void
+free_lists(JVM_METHOD *meth)
+{
+ Dlist tmp;
+
+ /* free memory from previous program units. */
+
+ if(dummy_nodes) {
+ dl_traverse(tmp, dummy_nodes)
+ f2jfree(dl_val(tmp), sizeof(JVM_CODE_GRAPH_NODE));
+ dl_delete_list(dummy_nodes);
+ }
+
+ if(while_list) {
+ dl_traverse(tmp, while_list)
+ f2jfree(dl_val(tmp), sizeof(int));
+ dl_delete_list(while_list);
+ }
+
+ dl_delete_list(doloop);
+ dl_delete_list(adapter_list);
+
+ if(methcall_list) {
+ dl_traverse(tmp, methcall_list)
+ dl_delete_list((Dlist)dl_val(tmp));
+ dl_delete_list(methcall_list);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * set_bytecode_status *
+ * *
+ * allow temporarily suspending generation of bytecode for situations where *
+ * the code generation ordering is very different between Java source and *
+ * JVM bytecode. this way, f2java may suspend bytecode, generate the java *
+ * source, then generate the JVM bytecode differently. *
+ * *
+ *****************************************************************************/
+
+void
+set_bytecode_status(JVM_METHOD *meth, int mode)
+{
+ switch(mode) {
+ case JVM_ONLY:
+ bc_set_gen_status(meth, TRUE);
+ savefp = curfp;
+ curfp = devnull;
+ break;
+ case JAVA_ONLY:
+ bc_set_gen_status(meth, FALSE);
+ curfp = savefp;
+ break;
+ case JAVA_AND_JVM:
+ default:
+ bc_set_gen_status(meth, TRUE);
+ bytecode_gen=TRUE;
+ curfp = savefp;
+ break;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * reflect_declarations_emit *
+ * *
+ * this function emits declarations for each function passed in as an arg. *
+ * the arg type is Object, so we call Object.getClass().getDeclaredMethods() *
+ * to get the Method array of that object. then we assign the first method *
+ * to the next available local variable. *
+ * *
+ *****************************************************************************/
+
+void
+reflect_declarations_emit(JVM_METHOD *meth, AST *root)
+{
+ HASHNODE *hashtemp, *ht2;
+ AST *tempnode;
+ int c;
+ int meth_var_num = 0;
+
+ for(tempnode = root; tempnode != NULL; tempnode = tempnode->nextstmt)
+ {
+ hashtemp = type_lookup(cur_external_table, tempnode->astnode.ident.name);
+ if(hashtemp)
+ {
+ hashtemp->variable->astnode.ident.localvnum =
+ bc_get_next_local(meth, jvm_Object);
+
+ fprintf(curfp," java.lang.reflect.Method _%s_meth ",
+ tempnode->astnode.ident.name);
+ fprintf(curfp," = %s.getClass().getDeclaredMethods()[0];\n",
+ tempnode->astnode.ident.name);
+
+ ht2 = type_lookup(cur_type_table, tempnode->astnode.ident.name);
+
+ if(ht2) {
+ meth_var_num = ht2->variable->astnode.ident.localvnum;
+
+ if(gendebug)
+ printf("found '%s' in type table, using localvnum = %d\n",
+ tempnode->astnode.ident.name, meth_var_num);
+ }
+ else {
+ ht2 = type_lookup(cur_args_table, tempnode->astnode.ident.name);
+
+ if(ht2) {
+ meth_var_num = ht2->variable->astnode.ident.localvnum;
+ if(gendebug)
+ printf("found '%s' in args table, using localvnum = %d\n",
+ tempnode->astnode.ident.name, meth_var_num);
+ }
+ else {
+ fprintf(stderr,"(1)Error: expected to find %s in symbol table.\n",
+ tempnode->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+ }
+
+ bc_gen_load_op(meth, meth_var_num, jvm_Object);
+
+ c = bc_new_methodref(cur_class_file, JL_OBJECT, "getClass",
+ GETCLASS_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ c = bc_new_methodref(cur_class_file, JL_CLASS, "getDeclaredMethods",
+ GETMETHODS_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ bc_push_int_const(meth, 0);
+ bc_append(meth, jvm_aaload);
+ bc_gen_store_op(meth, hashtemp->variable->astnode.ident.localvnum,
+ jvm_Object);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * invocation_exception_handler_emit *
+ * *
+ * this function emits the bytecode for the two exception handlers that are *
+ * generated when the program unit invokes a method on a passed-in function. *
+ * *
+ *****************************************************************************/
+
+void
+invocation_exception_handler_emit(JVM_CLASS *cclass,
+ JVM_METHOD *meth, JVM_EXCEPTION_TABLE_ENTRY *et)
+{
+ int c;
+ unsigned int vnum;
+
+ vnum = bc_get_next_local(meth, jvm_Object);
+
+ /* emit handler for InvocationTargetException */
+ et->target = bc_gen_store_op(meth, vnum, jvm_Object);
+
+ c = bc_new_fieldref(cclass, JL_SYSTEM, "err", OUT_DESC);
+ bc_append(meth, jvm_getstatic, c);
+
+ c = cp_find_or_insert(cclass, CONSTANT_Class, STRINGBUFFER);
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ bc_push_string_const(meth, "Error Calling Method: ");
+
+ c = bc_new_methodref(cclass, STRINGBUFFER, "<init>", STRBUF_DESC);
+ bc_append(meth, jvm_invokespecial, c);
+
+ bc_gen_load_op(meth, vnum,jvm_Object);
+
+ c = bc_new_methodref(cclass, THROWABLE_CLASS, "getMessage", GETMSG_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ c = bc_new_methodref(cclass, STRINGBUFFER, "append",
+ append_descriptor[String]);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ c = bc_new_methodref(cclass, STRINGBUFFER, "toString", TOSTRING_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ c = bc_new_methodref(cclass, PRINTSTREAM, "println",
+ println_descriptor[String]);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ /* artificially set stack depth at beginning of exception
+ * handler to 1.
+ */
+ bc_set_stack_depth(et->target, 1);
+
+ bc_release_local(meth, jvm_Object);
+}
+
+/*****************************************************************************
+ * *
+ * pause_emit *
+ * *
+ * Generate the code for a PAUSE statement. If the statement has an *
+ * argument, print it to stderr before querying the user about continuing. *
+ * The PAUSE statement pauses the program and asks the user whether or not *
+ * to continue. *
+ * *
+ *****************************************************************************/
+
+void
+pause_emit(JVM_METHOD *meth, AST *root)
+{
+ int c;
+
+ if(root->astnode.constant.number[0] != 0) {
+ fprintf(curfp,"org.netlib.util.Util.pause(\"%s\");\n",
+ escape_double_quotes(root->astnode.constant.number));
+
+ bc_push_string_const(meth, root->astnode.constant.number);
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "pause", PAUSE_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+ }
+ else {
+ fprintf(curfp,"org.netlib.util.Util.pause();\n");
+
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "pause",
+ PAUSE_NOARG_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * stop_emit *
+ * *
+ * Generate the code for a STOP statement. If the statement has an argument *
+ * print it to stderr before exiting. *
+ * *
+ *****************************************************************************/
+
+void
+stop_emit(JVM_METHOD *meth, AST *root)
+{
+ int c;
+
+ if(root->astnode.constant.number[0] != 0) {
+ char *stop_msg;
+
+ stop_msg = (char *)malloc(strlen(root->astnode.constant.number) + 7);
+
+ if(!stop_msg) {
+ fprintf(stderr, "malloc failed in stop_emit()\n");
+ exit(EXIT_FAILURE);
+ }
+
+ strcpy(stop_msg, "STOP: ");
+ strncat(stop_msg, root->astnode.constant.number, MAX_CONST_LEN);
+
+ c = bc_new_fieldref(cur_class_file, JL_SYSTEM, "err", OUT_DESC);
+ bc_append(meth, jvm_getstatic, c);
+
+ bc_push_string_const(meth, stop_msg);
+ c = bc_new_methodref(cur_class_file, PRINTSTREAM, "println",
+ println_descriptor[String]);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ fprintf(curfp, "System.err.println(\"STOP: %s\");\n",
+ escape_double_quotes(root->astnode.constant.number));
+
+ free(stop_msg);
+ }
+
+ fprintf (curfp, "System.exit(0);\n");
+ bc_append(meth, jvm_iconst_0);
+ c = bc_new_methodref(cur_class_file, JL_SYSTEM, "exit",
+ EXIT_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+}
+
+/*****************************************************************************
+ * *
+ * end_emit *
+ * *
+ * We only generate one real return statement. The other return statements *
+ * are emitted as gotos to the end of the code. See the tech report for the *
+ * reasoning behind this decision. Anyway, here at the end, we emit the *
+ * real return statement. We use six nines as the label to avoid conflicts *
+ * with other labels. See comment above in the Return case. *
+ * *
+ *****************************************************************************/
+
+void
+end_emit(JVM_METHOD *meth)
+{
+ JVM_CODE_GRAPH_NODE *goto_node, *goto_node2;
+ int c;
+
+ if(import_reflection) {
+ /* this goto skips the execption handlers under normal execution */
+ goto_node = bc_append(meth, jvm_goto);
+
+ /* set the end point for the exception handlers. */
+ reflect_entry->to = goto_node;
+ access_entry->to = goto_node;
+
+ invocation_exception_handler_emit(cur_class_file, meth, reflect_entry);
+ goto_node2 = bc_append(meth, jvm_goto);
+ invocation_exception_handler_emit(cur_class_file, meth, access_entry);
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, INVOKE_EXCEPTION);
+ reflect_entry->catch_type = c;
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ACCESS_EXCEPTION);
+ access_entry->catch_type = c;
+
+ bc_add_exception_handler(meth, reflect_entry);
+ bc_add_exception_handler(meth, access_entry);
+
+ bc_set_branch_target(goto_node, bc_append(meth, jvm_xxxunusedxxx));
+ bc_set_branch_target(goto_node2, bc_append(meth, jvm_xxxunusedxxx));
+
+ fprintf(curfp, "%s%s%s%s%s%s%s",
+ "} catch (java.lang.reflect.InvocationTargetException _e) {\n",
+ " System.err.println(\"Error calling method.",
+ " \"+ _e.getMessage());\n",
+ "} catch (java.lang.IllegalAccessException _e2) {\n",
+ " System.err.println(\"Error calling method.",
+ " \"+ _e2.getMessage());\n",
+ "}\n");
+ }
+
+ fprintf(curfp,"Dummy.label(\"%s\",999999);\n",cur_filename);
+
+ if (returnname != NULL) {
+ if(omitWrappers && !cgPassByRef(returnname))
+ fprintf (curfp, "return %s;\n", returnname);
+ else
+ fprintf (curfp, "return %s.val;\n", returnname);
+ }
+ else
+ fprintf (curfp, "return;\n");
+
+ fprintf (curfp, " }\n");
+
+ /* in Fortran if the program unit is a PROGRAM, it has no explicit
+ * return statement. however, Java bytecode requires an explicit return
+ * instruction even if the method returns void. also, if I remember
+ * correctly from the F77 spec, FUNCTIONs and SUBROUTINEs do not
+ * require an explicit return statement, but the END statement acts
+ * as an implicit return in these cases. here we must generate a
+ * return statement however we want to avoid generating two return
+ * statements because then the bytecode verifier will reject the class.
+ * to avoid duplicates, check whether the last opcode generated was
+ * a return. if so, do not generate another one here.
+ */
+ switch(bc_get_last_opcode(meth)) {
+ case jvm_ireturn:
+ case jvm_lreturn:
+ case jvm_freturn:
+ case jvm_dreturn:
+ case jvm_areturn:
+ case jvm_return:
+ /* do nothing */
+ break;
+ default:
+ return_emit(meth);
+ break; /* ansi compliance */
+ }
+}
+
+/*****************************************************************************
+ * *
+ * return_emit *
+ * *
+ * This function generates code to return from a method. Fortran program *
+ * units PROGRAM and SUBROUTINE both return void, while FUNCTIONs return *
+ * the Java type corresponding to their original Fortran declaration. *
+ * *
+ *****************************************************************************/
+
+void
+return_emit(JVM_METHOD *meth)
+{
+ /* for bytecode, check if the current program unit is a
+ * Function. if so, we push the implicit return value
+ * on the stack and return. otherwise, just return void.
+ */
+
+ if(returnname) {
+ HASHNODE *ht;
+ int rlv=0;
+
+ ht = type_lookup(cur_type_table, returnname);
+ if(!ht) {
+ fprintf(stderr,"Bad news: can't find return name '%s' in symtab.\n",
+ returnname);
+ rlv = 0;
+ }
+ else
+ rlv = ht->variable->astnode.ident.localvnum;
+
+ if(omitWrappers && !cgPassByRef(returnname))
+ pushVar(cur_class_file, meth, cur_unit->vartype, FALSE, cur_filename,
+ returnname, field_descriptor[cur_unit->vartype][0],
+ rlv, FALSE);
+ else
+ pushVar(cur_class_file, meth, cur_unit->vartype, FALSE, cur_filename,
+ returnname, wrapped_field_descriptor[cur_unit->vartype][0],
+ rlv, TRUE);
+ bc_append(meth, return_opcodes[cur_unit->vartype]);
+ }
+ else
+ bc_append(meth, jvm_return);
+}
+
+/*****************************************************************************
+ * *
+ * field_emit *
+ * *
+ * This function is called by insert_fields to create a new field_info *
+ * structure for the given variable. *
+ * *
+ *****************************************************************************/
+
+void
+field_emit(AST *root)
+{
+ char * desc, * name;
+ HASHNODE *ht;
+
+ if(!type_lookup(cur_type_table, root->astnode.ident.name))
+ return;
+
+ /* check whether this is a local var. if so, then it does not need to
+ * be emitted as a static field of this class, so just return now.
+ */
+
+ if(gendebug){
+ printf("field_emit: %s localvnum=%d\n", root->astnode.ident.name,
+ root->astnode.ident.localvnum);
+ }
+ if(root->astnode.ident.localvnum != -1){
+ return;
+ }
+
+ /* check if this variable has a merged name. if so,
+ * use that name instead.
+ */
+ ht = type_lookup(cur_equiv_table,root->astnode.ident.name);
+
+ if(ht && ht->variable->astnode.ident.merged_name)
+ name = ht->variable->astnode.ident.merged_name;
+ else {
+ ht = type_lookup(cur_type_table,root->astnode.ident.name);
+
+ if(ht && ht->variable->astnode.ident.merged_name)
+ name = ht->variable->astnode.ident.merged_name;
+ else
+ name = root->astnode.ident.name;
+ }
+
+ desc = getVarDescriptor(root);
+
+ if(ht)
+ ht->variable->astnode.ident.descriptor = desc;
+ else {
+ if((ht = type_lookup(cur_type_table,root->astnode.ident.name)) != NULL)
+ ht->variable->astnode.ident.descriptor = desc;
+ else
+ fprintf(stderr,"WARNING: can't find ident to set descriptor\n");
+ }
+
+ if(gendebug) {
+ printf("going to emit field %s\n",name);
+ printf("\ttype: %s (%d)\n",returnstring[root->vartype], root->vartype);
+ printf("\t dim: %d\n",root->astnode.ident.dim);
+ printf("\tdesc: %s\n",desc);
+ }
+
+ bc_add_field(cur_class_file, name, desc, F2J_NORMAL_ACC);
+}
+
+/*****************************************************************************
+ * *
+ * insert_fields *
+ * *
+ * Each variable in the program unit is generated as a static field in the *
+ * current class. Loop through all the type declarations, inserting each *
+ * variable into the list of fields. ignore all specification statements *
+ * except for actual type declarations. also ignore arguments to this *
+ * program unit since they will be declared as local variables, not fields. *
+ * we will go back later and generate code to initialize everything, but *
+ * first we need to get all the field names in the constant pool. *
+ * *
+ *****************************************************************************/
+
+void
+insert_fields(AST *root)
+{
+ AST *temp, *dec, *etmp;
+ HASHNODE *hashtemp;
+
+ /* for every spec statement */
+ for(temp = root->astnode.source.typedecs; temp; temp = temp->nextstmt) {
+ if(temp->nodetype == Typedec) {
+ /* for every variable in this specification stmt */
+ for(dec = temp->astnode.typeunit.declist; dec; dec = dec->nextstmt) {
+ if( ! type_lookup (cur_external_table, dec->astnode.ident.name)
+ && ! type_lookup (cur_intrinsic_table, dec->astnode.ident.name)
+ && ! type_lookup (cur_args_table, dec->astnode.ident.name)
+ && ! type_lookup (cur_param_table, dec->astnode.ident.name)
+ && ! type_lookup (cur_equiv_table, dec->astnode.ident.name)
+ && ! type_lookup (cur_common_table, dec->astnode.ident.name))
+ {
+ if(gendebug){
+ printf("calling field_emit from insert_fields\n");
+ }
+ field_emit(dec);
+ }
+ }
+ }
+ else if(temp->nodetype == Equivalence) {
+ /* for each group of equivalenced variables... */
+
+ for(etmp = temp->astnode.equiv.nlist;etmp != NULL;etmp = etmp->nextstmt)
+ {
+ /* only generate a field entry for the first node. */
+
+ if(etmp->astnode.equiv.clist != NULL) {
+ hashtemp = type_lookup(cur_type_table,
+ etmp->astnode.equiv.clist->astnode.ident.name);
+
+ if(hashtemp)
+ field_emit(hashtemp->variable);
+ else
+ fprintf(stderr,"insert_fields(): can't find data type for %s\n" ,
+ etmp->astnode.equiv.clist->astnode.ident.name);
+ }
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * print_equivalences *
+ * *
+ * Print the variables that are equivalenced. *
+ * This routine is used only for debugging *
+ * *
+ *****************************************************************************/
+
+void
+print_equivalences(AST *root)
+{
+ AST *temp;
+
+ printf("M_EQV Equivalences:\n");
+
+ for(temp=root; temp != NULL; temp = temp->nextstmt) {
+ printf("M_EQV (%d)", temp->token);
+ print_eqv_list(temp,stdout);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * print_eqv_list *
+ * *
+ * This function prints the equivalence list to the file *
+ * pointed to by fptr. *
+ * *
+ *****************************************************************************/
+
+void
+print_eqv_list(AST *root, FILE *fptr)
+{
+ AST *temp;
+
+ for(temp = root->astnode.equiv.clist;temp!=NULL;temp=temp->nextstmt)
+ fprintf(fptr," %s, ", temp->astnode.ident.name);
+ fprintf(fptr,"\n");
+}
+
+/*****************************************************************************
+ * *
+ * emit_prolog_comments *
+ * *
+ * 'Prolog' refers to those comments found before the *
+ * function/subroutine declaration. Here we emit those *
+ * comments. *
+ * *
+ *****************************************************************************/
+
+void
+emit_prolog_comments(AST *root)
+{
+ AST *temp;
+
+ temp = root->astnode.source.prologComments;
+
+ if(temp == NULL)
+ return;
+
+ while( (temp != NULL) && (temp->nodetype == Comment))
+ {
+ fprintf(curfp,"// %s",temp->astnode.ident.name);
+ temp = temp->nextstmt;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * emit_javadoc_comments *
+ * *
+ * generate comments in javadoc format. *
+ * *
+ *****************************************************************************/
+
+void
+emit_javadoc_comments(AST *root)
+{
+ AST *temp;
+
+ temp = root->astnode.source.javadocComments;
+
+ if(temp == NULL)
+ return;
+
+ fprintf(curfp,"/**\n");
+ fprintf(curfp,"*<pre>\n");
+ fprintf(curfp,"*Following is the description from the original\n");
+ fprintf(curfp,"*Fortran source. For each array argument, the Java\n");
+ fprintf(curfp,"*version will include an integer offset parameter, so\n");
+ fprintf(curfp,"*the arguments may not match the description exactly.\n");
+ fprintf(curfp,"*Contact <a href=\"mailto:seymour at cs.utk.edu\">");
+ fprintf(curfp,"seymour at cs.utk.edu</a> with any");
+ fprintf(curfp," questions.\n");
+ fprintf(curfp,"*<p>\n");
+ fprintf(curfp,"*\n");
+ while( (temp != NULL) && (temp->nodetype == MainComment ||
+ temp->nodetype == Comment))
+ {
+ fprintf(curfp,"* %s",temp->astnode.ident.name);
+ temp = temp->nextstmt;
+ }
+ fprintf(curfp,"*</pre>\n");
+ fprintf(curfp,"**/\n");
+}
+
+/*****************************************************************************
+ * *
+ * equiv_emit *
+ * *
+ * Generate declarations for equivalenced variables. This handles *
+ * only a very restricted set of equivalences. Scalars can be *
+ * equivalenced and arrays can be equivalenced, but only if the *
+ * starting points are the same. *
+ * *
+ * To translate equivalences, we just merge the equivalenced names *
+ * into one name and generate one Java declaration. *
+ * *
+ *****************************************************************************/
+
+
+void
+equiv_emit (JVM_METHOD *meth, AST *root)
+{
+ HASHNODE *ht;
+ AST *temp;
+ enum returntype curType;
+
+ /* for each group of equivalenced variables... */
+
+ for(temp = root->astnode.equiv.nlist; temp != NULL; temp = temp->nextstmt)
+ {
+
+ /* just check the first variable since we're only going to emit
+ * one declaration.
+ */
+
+ if(temp->astnode.equiv.clist != NULL) {
+ ht = type_lookup(cur_type_table,
+ temp->astnode.equiv.clist->astnode.ident.name);
+
+ if(ht) {
+ curType = ht->variable->vartype;
+
+ if(gendebug)
+ if(ht->variable->astnode.ident.arraylist != NULL)
+ printf("EQV looks like %s is an array\n",
+ ht->variable->astnode.ident.name);
+ }
+ else {
+ fprintf(stderr,"equiv_emit(): can't find data type for %s\n" ,
+ temp->astnode.equiv.clist->astnode.ident.name);
+ curType = 0;
+ }
+
+ /* now emit the declaration as with any other variable. */
+
+ if(temp->astnode.equiv.clist->astnode.ident.merged_name != NULL)
+ vardec_emit(meth, ht->variable, curType, "public static ");
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * find_commonblock *
+ * *
+ * finds a common block entry in the .f2j file. *
+ * *
+ *****************************************************************************/
+
+JVM_METHODREF *
+find_commonblock(char *cblk_name, Dlist dt)
+{
+ char *temp_commonblockname;
+ JVM_METHODREF *mtmp;
+
+ temp_commonblockname = (char *) f2jalloc(strlen(cblk_name) +
+ strlen(CB_PREFIX) + 1);
+
+ sprintf(temp_commonblockname, "%s%s", CB_PREFIX, cblk_name);
+
+ if(gendebug)
+ printf("#@#@ looking for temp_commonblockname = '%s'\n",
+ temp_commonblockname);
+
+ mtmp = find_method(temp_commonblockname, dt);
+
+ f2jfree(temp_commonblockname, strlen(temp_commonblockname)+1);
+
+ return mtmp;
+}
+
+/*****************************************************************************
+ * *
+ * skipCommonVarEntry *
+ * *
+ * This function returns a pointer to the next common block variable in *
+ * the common block entry of an .f2j file. *
+ * *
+ *****************************************************************************/
+
+char *
+skipCommonVarEntry(char *p)
+{
+ if(!p || (*p == '\0')) return NULL;
+
+ p++; /* skip over CB_DELIMITER */
+
+ while(*p != CB_DELIMITER)
+ if(*p == '\0')
+ return NULL;
+ else
+ p++;
+
+ return p;
+}
+
+/*****************************************************************************
+ * *
+ * getVarDescFromCommonEntry *
+ * *
+ * This function returns the descriptor from a common block entry obtained *
+ * an .f2j file. *
+ * *
+ *****************************************************************************/
+
+char *
+getVarDescFromCommonEntry(const char *p)
+{
+ char *newdesc = (char *) f2jalloc(strlen(p) + 1); /* upper bound on len */
+ char *np = newdesc;
+
+ p++; /* skip over CB_DELIMITER */
+
+ while((*p != '\0') && (*p != CB_SEPARATOR))
+ *np++ = *p++;
+
+ *np = '\0';
+
+ return newdesc;
+}
+
+/*****************************************************************************
+ * *
+ * getVarNameFromCommonEntry *
+ * *
+ * This function returns the name from a common block entry obtained from *
+ * an .f2j file. *
+ * *
+ *****************************************************************************/
+
+char *
+getVarNameFromCommonEntry(const char *p)
+{
+ char *newdesc = (char *) f2jalloc(strlen(p) + 1); /* upper bound on len */
+ char *np = newdesc;
+
+ while((*p != '\0') && (*p++ != CB_SEPARATOR))
+ /* spin */ ;
+
+ while((*p != '\0') && (*p != CB_DELIMITER))
+ *np++ = *p++;
+
+ *np = '\0';
+
+ return newdesc;
+}
+
+/*****************************************************************************
+ * *
+ * assign_merged_names *
+ * *
+ * This function loops through all the variables in a given COMMON block *
+ * declaration and assigns the 'merged_name' and 'descriptor' fields to *
+ * the values found in the .f2j files. This allows having a COMMON block *
+ * split across multiple Java packages. Our current need for this feature *
+ * stems from the fact that to allow for a user-specifiable XERBLA error *
+ * reporting routine, we had to put it in another package. Since the *
+ * LAPACK testers use their own XERBLA which contains a COMMON block that *
+ * is shared with the rest of the tester source, we needed this feature *
+ * in order to run the "error-exits" tests. 3/14/01 --keith *
+ * *
+ *****************************************************************************/
+
+void
+assign_merged_names(AST *Ctemp, JVM_METHODREF *mtmp)
+{
+ HASHNODE *hashtemp;
+ AST *Ntemp;
+ char *dp;
+
+ dp = mtmp->descriptor;
+
+ if(!dp) return;
+
+ for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt)
+ {
+ if((hashtemp=type_lookup(cur_type_table,Ntemp->astnode.ident.name))==NULL)
+ {
+ if(gendebug)
+ printf("assign_merged_names: Var Not Found\n");
+ continue;
+ }
+
+ hashtemp->variable->astnode.ident.merged_name =
+ getVarNameFromCommonEntry(dp);
+ hashtemp->variable->astnode.ident.descriptor =
+ getVarDescFromCommonEntry(dp);
+
+ dp = skipCommonVarEntry(dp);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * common_emit *
+ * *
+ * This function emits common blocks as a static class containing *
+ * the variables specified in the COMMON statement. Currently, *
+ * each COMMON statement must specify the same variable names for *
+ * the translation to work reliably. 10/9/97 --Keith *
+ * *
+ * Now COMMON statements may use different variable names and *
+ * f2java attempts to merge the names into one. --Keith *
+ * *
+ *****************************************************************************/
+
+void
+common_emit(AST *root)
+{
+ JVM_METHOD *clinit_method;
+ HASHNODE *hashtemp;
+ JVM_METHODREF *mtmp;
+ AST *Ctemp, *Ntemp, *temp;
+ char *common_classname=NULL, *filename=NULL;
+ FILE *commonfp;
+ char * prefix = strtok(strdup(inputfilename),".");
+ JVM_CLASS *save_class_file;
+ char *save_filename;
+
+ /* save the current global variables pointing to the class file. this is
+ * necessary because we're in the middle of generating the class file
+ * for the current fortran program unit, but now we need to generate some
+ * classes to hold COMMON blocks and we dont want to alter the pc, stack,
+ * etc for the current class.
+ */
+ save_class_file = cur_class_file;
+ save_filename = cur_filename;
+
+ /* set cur_filename to NULL in case we decide not to reset it here and
+ * end up trying to free it later. then we don't blow away the
+ * original memory.
+ */
+ cur_filename = NULL;
+
+ /*
+ * Ctemp loops through each common block name specified
+ * in the COMMON statement and Ntemp loops through each
+ * variable in each common block.
+ */
+
+ for(Ctemp=root->astnode.common.nlist;Ctemp!=NULL;Ctemp=Ctemp->nextstmt)
+ {
+ if(Ctemp->astnode.common.name != NULL)
+ {
+ if(gendebug)
+ printf("common_emit.2: lookin for common block '%s'\n",
+ Ctemp->astnode.common.name);
+
+ mtmp = find_commonblock(Ctemp->astnode.common.name, descriptor_table);
+ if(mtmp) {
+ if(gendebug)
+ printf("common_emit.3: %s,%s,%s\n", mtmp->classname,
+ mtmp->methodname, mtmp->descriptor);
+
+ assign_merged_names(Ctemp, mtmp);
+ continue;
+ }else{
+ if(gendebug)
+ printf("common name not found in descriptor table\n");
+ }
+
+ /* common block filename will be a concatenation of
+ * the original input filename and the name of this
+ * common block.
+ */
+ common_classname = (char *)f2jrealloc(common_classname,
+ strlen(prefix) + strlen(Ctemp->astnode.common.name) + 2);
+ sprintf(common_classname,"%s_%s",prefix,Ctemp->astnode.common.name);
+
+ if(gendebug)
+ printf("emitting common block '%s'\n",common_classname);
+
+ cur_filename = bc_get_full_classname(common_classname, package_name);
+
+ filename = (char *)f2jrealloc(filename,
+ strlen(cur_filename) + 6);
+ sprintf(filename,"%s.java", cur_filename);
+
+ cur_class_file = bc_new_class(common_classname,inputfilename,
+ "java.lang.Object", package_name, F2J_CLASS_ACC);
+
+ bc_add_default_constructor(cur_class_file, F2J_INIT_ACC);
+
+ clinit_method = bc_new_method(cur_class_file, "<clinit>", "()V",
+ strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC);
+
+ if(gendebug)
+ printf("## going to open file: '%s'\n", filename);
+
+ if((commonfp = bc_fopen_fullpath(filename,"w", output_dir))==NULL)
+ {
+ fprintf(stderr,"Cannot open output file '%s'.\n",filename);
+ perror("Reason");
+ exit(EXIT_FAILURE);
+ }
+
+ curfp = commonfp;
+
+ if(package_name != NULL)
+ fprintf(curfp,"package %s;\n",package_name);
+
+ /* import util package for object wrapper classes */
+
+ fprintf(curfp,"import org.netlib.util.*;\n\n");
+
+ if(Ctemp->astnode.common.name != NULL)
+ fprintf(curfp,"public class %s_%s\n{\n",prefix,
+ Ctemp->astnode.common.name);
+
+ fprintf(indexfp,"%s:common_block/%s:",cur_filename,
+ Ctemp->astnode.common.name);
+
+ for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt)
+ {
+ if(gendebug)
+ {
+ printf("Common block %s -- %s\n",Ctemp->astnode.common.name,
+ Ntemp->astnode.ident.name);
+ printf("Looking up %s in the type table\n",
+ Ntemp->astnode.ident.name);
+ }
+
+ /* each variable in the common block should have a type
+ * declaration associated with it.
+ */
+
+ if((hashtemp=type_lookup(cur_type_table,Ntemp->astnode.ident.name))
+ == NULL)
+ {
+ fprintf(stderr,"Error: can't find type for common %s\n",
+ Ntemp->astnode.ident.name);
+ if(gendebug)
+ printf("Not Found\n");
+ continue;
+ }
+
+ if(gendebug)
+ printf("Found\n");
+
+ temp = hashtemp->variable;
+
+ if(gendebug)printf("drew field_emit: %c%s, %s (parent=%p)\n", CB_DELIMITER,
+ getVarDescriptor(temp), getCommonVarName(Ntemp), (void *)temp->parent);
+ fprintf(indexfp,"%c%s,%s",CB_DELIMITER, getVarDescriptor(temp),
+ getCommonVarName(Ntemp));
+
+ field_emit(temp);
+
+ /* now emit the variable declaration as with any
+ * other variable.
+ */
+
+ vardec_emit(clinit_method, temp, temp->vartype, "public static ");
+ }
+ fprintf(indexfp,"\n");
+
+ if(Ctemp->astnode.common.name != NULL)
+ fprintf(curfp,"}\n");
+
+ fclose(curfp);
+
+ /* check whether any class initialization code was generated.
+ * if so, finish initializing the method and insert it into this
+ * class.
+ */
+ if(bc_get_code_length(clinit_method) > 0) {
+ bc_append(clinit_method, jvm_return);
+ fprintf(indexfp,"%s:%s:%s\n",cur_filename, "<clinit>", "()V");
+ }
+ else {
+ bc_remove_method(clinit_method);
+ bc_free_method(clinit_method);
+ }
+
+ bc_write_class(cur_class_file, output_dir);
+ bc_free_class(cur_class_file);
+ }
+ }
+
+ curfp = javafp;
+
+ if(prefix) f2jfree(prefix,strlen(prefix)+1);
+ if(common_classname) f2jfree(common_classname,strlen(common_classname)+1);
+ if(filename) f2jfree(filename,strlen(filename)+1);
+ if(cur_filename) f2jfree(cur_filename,strlen(cur_filename)+1);
+
+ /* restore previously saved globals */
+ cur_class_file = save_class_file;
+ cur_filename = save_filename;
+}
+
+/*****************************************************************************
+ * *
+ * getNameFromCommonDesc *
+ * *
+ * given a common block 'descriptor' (as found in the .f2j file), we return *
+ * the variable name corresponding to the Nth variable in the common block. *
+ * *
+ *****************************************************************************/
+
+char *
+getNameFromCommonDesc(char *desc, int idx)
+{
+ int len = 0, del_count = 0;
+ char *p, *name;
+
+ /* skip initial delimiter */
+ p = desc + 1;
+
+ while(del_count < idx) {
+ p = bc_next_desc_token(p); /* skip the descriptor */
+ p++; /* skip the comma */
+
+ /* skip until next descriptor */
+ while((*p != CB_DELIMITER) && (*p != '\0'))
+ p++;
+
+ del_count++;
+ p++; /* skip the delimiter */
+ }
+
+ if(p == '\0')
+ return NULL;
+
+ p = bc_next_desc_token(p);
+ p++;
+
+ while((*(p+len) != CB_DELIMITER) && (*(p+len) != '\0'))
+ len++;
+
+ name = (char *) f2jalloc(len+2);
+ strncpy(name, p, len+1);
+ name[len] = '\0';
+
+ return name;
+}
+
+/*****************************************************************************
+ * *
+ * getFieldDescFromCommonDesc *
+ * *
+ * given a common block 'descriptor' (as found in the .f2j file), we return *
+ * the descriptor corresponding to the Nth variable in the common block. *
+ * *
+ *****************************************************************************/
+
+char *
+getFieldDescFromCommonDesc(char *desc, int idx)
+{
+ int len = 0, del_count = 0;
+ char *p, *name;
+
+ /* skip initial delimiter */
+ p = desc + 1;
+
+ while(del_count < idx) {
+ /* skip until next descriptor */
+ while((*p != CB_DELIMITER) && (*p != '\0'))
+ p++;
+
+ del_count++;
+ p++; /* skip the delimiter */
+ }
+
+ if(p == '\0')
+ return NULL;
+
+ while((*(p+len) != CB_SEPARATOR) && (*(p+len) != '\0'))
+ len++;
+
+ name = (char *) f2jalloc(len+2);
+ strncpy(name, p, len+1);
+ name[len] = '\0';
+
+ return name;
+}
+
+/*****************************************************************************
+ * *
+ * getCommonVarName *
+ * *
+ * Given a node, this function returns the merged name of this variable in *
+ * the common block. if the variable is not in a common block or if we *
+ * can't find the variable in the symbol table, return "unknown". *
+ * *
+ *****************************************************************************/
+
+char *
+getCommonVarName(AST *root)
+{
+ HASHNODE *ht2;
+
+ if(type_lookup(cur_common_table,root->astnode.ident.name) != NULL) {
+ ht2 = type_lookup(cur_type_table,root->astnode.ident.name);
+
+ return ht2->variable->astnode.ident.merged_name;
+ }
+
+ return "Unknown";
+}
+
+/*****************************************************************************
+ * *
+ * typedec_emit *
+ * *
+ * this procedure only emits static variables, data and save. (drew) *
+ * *
+ *****************************************************************************/
+
+void
+typedec_emit (JVM_METHOD *meth, AST * root)
+{
+ AST *temp;
+ HASHNODE *ht;
+ enum returntype returns;
+
+ returns = root->astnode.typeunit.returns;
+
+ for(temp=root->astnode.typeunit.declist; temp != NULL; temp = temp->nextstmt)
+ {
+
+ if(omitWrappers) {
+ if(gendebug)
+ printf("vardec %s\n", temp->astnode.ident.name);
+ if((ht= type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL)
+ {
+ if(gendebug)
+ printf("%s should be %s\n", temp->astnode.ident.name,
+ ht->variable->astnode.ident.passByRef ? "WRAPPED" : "PRIMITIVE");
+ }
+ else {
+ char *tempname;
+
+ /* if this is an intrinsic then don't emit any warning since we
+ * didn't want to emit a real declaration for this anyway.
+ */
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(methodscan(intrinsic_toks, tempname)) {
+ free(tempname);
+ continue;
+ }
+
+ fprintf(stderr,"could not find %s\n", temp->astnode.ident.name);
+
+ free(tempname);
+ }
+ }
+
+ if(is_static(temp))
+ vardec_emit(meth, temp, returns, "public static ");
+ }
+} /* Close typedec_emit(). */
+
+/*****************************************************************************
+ * *
+ * is_static *
+ * *
+ * this functions returns true if the stmt is a data or save and has not *
+ * been declared.(drew) *
+ * *
+ *****************************************************************************/
+
+BOOL
+is_static(AST *root)
+{
+ AST *temp;
+ HASHNODE *ht;
+
+ temp = root;
+
+ if(type_lookup(cur_args_table,temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ is_static(): %s: not static (is arg)\n",
+ temp->astnode.ident.name);
+ return FALSE;
+ }
+ else if(type_lookup(cur_data_table,temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ Variable %s: Found corresponding data stmt\n",
+ temp->astnode.ident.name);
+
+ ht = type_lookup(cur_type_table,temp->astnode.ident.name);
+
+ if(ht == NULL)
+ return FALSE;
+
+ if(!ht->variable->astnode.ident.needs_declaration) {
+ if(gendebug)
+ printf("is_static: declared data statement\n");
+ return FALSE;
+ }
+
+ if(gendebug)
+ printf("is_static: undeclared data statement\n");
+
+ return TRUE;
+ }
+ else if(type_lookup(cur_save_table,temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ Variable %s: Found corresponding SAVE stmt\n",
+ temp->astnode.ident.name);
+ return TRUE;
+ }
+ else if(type_lookup (cur_external_table, temp->astnode.ident.name)
+ || type_lookup (cur_intrinsic_table, temp->astnode.ident.name)
+ || type_lookup (cur_args_table, temp->astnode.ident.name)
+ || type_lookup (cur_param_table, temp->astnode.ident.name)
+ || type_lookup (cur_equiv_table, temp->astnode.ident.name)
+ || type_lookup (cur_common_table, temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ is_static %s: no, it's a spec stmt\n",
+ temp->astnode.ident.name);
+ return FALSE;
+ }
+ else if(save_all_locals) {
+ if(gendebug)
+ printf("@@ Save Variable %s: SAVE all\n",
+ temp->astnode.ident.name);
+ return TRUE;
+ }
+ else{
+ if(gendebug)
+ printf("@@ Variable %s: Corresponding data stmt not found\n",
+ temp->astnode.ident.name);
+
+ if(type_lookup (cur_array_table, temp->astnode.ident.name)
+ && f2j_arrays_static)
+ return TRUE;
+ else
+ return FALSE;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * is_local *
+ * *
+ * this function checks to see if the varibles are local and returns *
+ * true if they are. (drew) *
+ * *
+ *****************************************************************************/
+
+BOOL
+is_local(AST *root){
+
+ AST *temp;
+ HASHNODE *hashtemp;
+ char *tempname;
+ BOOL isarg;
+
+ temp = root;
+ hashtemp = type_lookup (cur_args_table, temp->astnode.ident.name);
+ isarg = hashtemp != NULL;
+
+ if(f2j_arrays_static) {
+ if(type_lookup (cur_array_table, temp->astnode.ident.name)
+ && !type_lookup (cur_args_table, temp->astnode.ident.name)) {
+
+ return FALSE;
+ }
+ }
+
+ if(type_lookup(cur_data_table,temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ Variable %s: Found corresponding data stmt\n",
+ temp->astnode.ident.name);
+
+ return FALSE;
+ }
+
+ hashtemp = type_lookup(cur_equiv_table,temp->astnode.ident.name);
+ if(hashtemp) {
+ if(type_lookup(cur_common_table,temp->astnode.ident.name)) {
+ fprintf(stderr,"Please dont mix COMMON and EQUIVALENCE. ");
+ fprintf(stderr,"I dont like it. It scares me.\n");
+ }else {
+ fprintf(curfp," // %s equivalenced to %s\n",
+ temp->astnode.ident.name,
+ hashtemp->variable->astnode.ident.merged_name);
+ }
+ return FALSE;
+ }
+
+ if(type_lookup(cur_save_table,temp->astnode.ident.name))
+ return FALSE;
+
+ if(type_lookup(cur_common_table,temp->astnode.ident.name))
+ return FALSE;
+
+ /*
+ * Dont emit anything for intrinsic functions.
+ */
+
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(( methodscan (intrinsic_toks, tempname) != NULL)
+ && (type_lookup(cur_intrinsic_table,temp->astnode.ident.name) != NULL))
+ {
+ f2jfree(tempname,strlen(tempname)+1);
+ return FALSE;
+ }
+
+ f2jfree(tempname,strlen(tempname)+1);
+
+ /*
+ * Let's do the argument lookup first. No need to retype variables
+ * that are already declared in the argument list, or declared
+ * as externals. So if it is already declared, loop again.
+ */
+
+ if (isarg)
+ {
+ if(gendebug)
+ printf("### %s is in the args_table, so I'm skipping it.\n",
+ temp->astnode.ident.name);
+ return FALSE;
+ }
+
+ if(type_lookup(cur_external_table, temp->astnode.ident.name) != NULL)
+ {
+ /* skip externals */
+ return FALSE;
+ }
+
+ if(save_all_locals && !isarg)
+ return FALSE;
+
+ if(gendebug)
+ printf("Returning TRUE from is_local\n");
+
+ return TRUE;
+}
+
+/*****************************************************************************
+ * *
+ * local_emit *
+ * *
+ * This function calls vardec_emit on local variables (drew) *
+ * *
+ *****************************************************************************/
+
+void
+local_emit(JVM_METHOD *meth, AST *root)
+{
+ AST *temp, *temp2;
+ HASHNODE *ht;
+ enum returntype returns;
+
+ if(gendebug)printf("in local_emit\n");
+
+ temp2 = root;
+
+ while(temp2 != NULL) {
+ if(temp2->nodetype != Typedec) {
+ temp2 = temp2->nextstmt;
+ continue;
+ }
+
+ returns = temp2->astnode.typeunit.returns;
+ if(gendebug)printf("in local_emit, returns=%s\n", returnstring[returns]);
+
+ for(temp=temp2->astnode.typeunit.declist;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(is_local(temp)==TRUE) {
+ /* emit if it is local variable */
+ if(gendebug)
+ printf("local variable found\n");
+
+ ht = type_lookup(cur_type_table,temp->astnode.ident.name);
+ if(!ht) {
+ char *tempname;
+
+ /* if this is an intrinsic then don't emit any warning since we
+ * didn't want to emit a real declaration for this anyway.
+ */
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(!methodscan(intrinsic_toks, tempname)) {
+ fprintf(stderr,"Warning: local_emit() could not find '%s'\n",
+ temp->astnode.ident.name);
+ fprintf(stderr,"vartype is: %s\n",returnstring[temp->vartype]);
+ }
+
+ free(tempname);
+ continue;
+ }
+
+ if(gendebug)
+ printf("Emitting local variable %s\n", temp->astnode.ident.name);
+ vardec_emit(meth, temp, returns, "");
+ }
+ }
+
+ temp2=temp2->nextstmt;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * assign_varnums_to_locals *
+ * *
+ * This routine assigns a local variable (aka register) number to every *
+ * variable that should not be static. *
+ * *
+ *****************************************************************************/
+
+void
+assign_varnums_to_locals(JVM_METHOD *meth, AST *root)
+{
+ AST *temp, *temp2;
+ HASHNODE *ht;
+
+ temp2 = root;
+
+ while(temp2 != NULL) {
+ if(temp2->nodetype != Typedec) {
+ temp2 = temp2->nextstmt;
+ continue;
+ }
+
+ for(temp=temp2->astnode.typeunit.declist;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(is_local(temp)==TRUE) {
+ ht = type_lookup(cur_type_table,temp->astnode.ident.name);
+ if(!ht) {
+ char *tempname;
+
+ /* if this is an intrinsic then don't emit any warning since we
+ * didn't want to emit a real declaration for this anyway.
+ */
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(!methodscan(intrinsic_toks, tempname)) {
+ fprintf(stderr,"assign_varnums_to_locals() could not find '%s'\n",
+ temp->astnode.ident.name);
+ fprintf(stderr,"vartype is: %s\n",returnstring[temp->vartype]);
+ }
+
+ free(tempname);
+ continue;
+ }
+
+ /* might want to check whether it's a double precision array & only
+ * grab one register in that case... kgs
+ */
+ ht->variable->astnode.ident.localvnum =
+ bc_get_next_local(meth, jvm_data_types[temp->vartype]);
+ temp->astnode.ident.localvnum = ht->variable->astnode.ident.localvnum;
+
+ if(gendebug)
+ printf("assign_varnums_to_locals: %s -> slot %d %d\n",
+ temp->astnode.ident.name, ht->variable->astnode.ident.localvnum,
+ temp->astnode.ident.localvnum);
+ }
+ }
+
+ temp2=temp2->nextstmt;
+ }
+
+}
+
+/*****************************************************************************
+ * *
+ * typedec_emit *
+ * *
+ * Emit all the type declarations. This procedure checks *
+ * whether variables are typed in the argument list, and *
+ * does not redeclare those arguments. *
+ * *
+ *****************************************************************************/
+
+void
+typedec_emit_all_static (JVM_METHOD *meth, AST * root)
+{
+ AST *temp;
+ HASHNODE *hashtemp, *ht;
+ enum returntype returns;
+ char *tempname;
+
+ /*
+ * This may have to be moved into the looop also. Could be
+ * why I have had problems with this stuff.
+ *
+ * commented out 3/6/98 -- keith
+ *
+ * hashtemp = type_lookup (cur_external_table, temp->astnode.ident.name);
+ * if (hashtemp)
+ * return;
+ */
+
+ returns = root->astnode.typeunit.returns;
+
+ /*
+ * Somewhere in here I need to do a table lookup
+ * to see whether the variable is in the argument
+ * list for the method. If so, it takes the type
+ * in the argument list and is not retyped here.
+ */
+
+ for(temp=root->astnode.typeunit.declist;temp != NULL;temp = temp->nextstmt)
+ {
+
+ if(omitWrappers) {
+ if(gendebug)
+ printf("vardec %s\n", temp->astnode.ident.name);
+ if((ht= type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL)
+ {
+ if(gendebug)
+ printf("%s should be %s\n", temp->astnode.ident.name,
+ ht->variable->astnode.ident.passByRef ? "WRAPPED" : "PRIMITIVE");
+ }
+ else {
+ char *tempname;
+
+ /* if this is an intrinsic then don't emit any warning since we
+ * didn't want to emit a real declaration for this anyway.
+ */
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(methodscan(intrinsic_toks, tempname)) {
+ free(tempname);
+ continue;
+ }
+
+ free(tempname);
+
+ fprintf(stderr,"could not find %s\n", temp->astnode.ident.name);
+ }
+ }
+
+ /*
+ * If there is a corresponding data statement for this
+ * variable, don't emit anything here. Just wait and
+ * let the whole thing get emitted when we come across
+ * the DATA node. --9/22/97, Keith
+ */
+
+ if(type_lookup(cur_data_table,temp->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ Variable %s: Found corresponding data stmt\n",
+ temp->astnode.ident.name);
+
+ ht = type_lookup(cur_type_table,temp->astnode.ident.name);
+
+ if(ht == NULL)
+ continue;
+
+ if( ! ht->variable->astnode.ident.needs_declaration)
+ continue;
+ }
+ else
+ if(gendebug)
+ printf("@@ Variable %s: Corresponding data stmt not found\n",
+ temp->astnode.ident.name);
+
+ /*
+ * dont worry about checking the save table now since we're
+ * going to emit everything as static variables. --keith
+ *
+ * if(type_lookup(cur_save_table,temp->astnode.ident.name))
+ * continue;
+ */
+
+
+ /*
+ * check to se if this variable is equivalenced with some
+ * other variable(s). if so, do not emit a variable
+ * declaration here.
+ */
+
+ hashtemp = type_lookup(cur_equiv_table,temp->astnode.ident.name);
+ if(hashtemp) {
+ if(type_lookup(cur_common_table,temp->astnode.ident.name)) {
+ fprintf(stderr,"Please dont mix COMMON and EQUIVALENCE. ");
+ fprintf(stderr,"I dont like it. It scares me.\n");
+ } else {
+ fprintf(curfp," // %s equivalenced to %s\n",
+ temp->astnode.ident.name,
+ hashtemp->variable->astnode.ident.merged_name);
+ }
+ continue;
+ }
+
+ /*
+ * also do not try to redefine a 'common' variable since
+ * they are placed in their own classes. 10-8-97 -- Keith
+ */
+
+ if(type_lookup(cur_common_table,temp->astnode.ident.name))
+ continue;
+
+ /*
+ * Dont emit anything for intrinsic functions.
+ */
+
+ tempname = strdup(temp->astnode.ident.name);
+ uppercase(tempname);
+
+ if(( methodscan (intrinsic_toks, tempname) != NULL)
+ && (type_lookup(cur_intrinsic_table,temp->astnode.ident.name) != NULL))
+ {
+ f2jfree(tempname,strlen(tempname)+1);
+ continue;
+ }
+
+ f2jfree(tempname,strlen(tempname)+1);
+
+ /*
+ * Let's do the argument lookup first. No need to retype variables
+ * that are already declared in the argument list, or declared
+ * as externals. So if it is already declared, loop again.
+ */
+
+ hashtemp = type_lookup (cur_args_table, temp->astnode.ident.name);
+ if (hashtemp)
+ {
+ if(gendebug)
+ printf("### %s is in the args_table, so I'm skipping it.\n",
+ temp->astnode.ident.name);
+ continue;
+ }
+
+ if(type_lookup(cur_external_table, temp->astnode.ident.name) != NULL)
+ {
+ /* skip externals */
+ continue;
+ }
+
+ if(gendebug)
+ printf("### calling vardec_emit on %s\n",temp->astnode.ident.name);
+
+ vardec_emit(meth, temp, returns, "public static ");
+ }
+} /* Close typedec_emit(). */
+
+/*****************************************************************************
+ * *
+ * newarray_emit *
+ * *
+ * this function emits the newarray instruction appropriate to the data type *
+ * of the given node. *
+ * *
+ *****************************************************************************/
+
+void
+newarray_emit(JVM_METHOD *meth, enum returntype vtype)
+{
+ int c;
+
+ switch(vtype) {
+ case String:
+ case Character:
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, "java/lang/String");
+ bc_append(meth, jvm_anewarray, c);
+ break;
+ case Complex:
+ case Double:
+ case Float:
+ case Integer:
+ case Logical:
+ bc_append(meth, jvm_newarray, jvm_array_type[vtype]);
+ break;
+ default:
+ fprintf(stderr,"WARNING: newarray_emit() unknown vartype\n");
+ }
+}
+
+/*****************************************************************************
+ * *
+ * getMergedName *
+ * *
+ * given an ident, return the merged name. *
+ * *
+ *****************************************************************************/
+
+char *
+getMergedName(AST *root)
+{
+ HASHNODE *ht, *ht2;
+ char *name;
+
+ if(type_lookup(cur_common_table,root->astnode.ident.name) != NULL) {
+ ht2 = type_lookup(cur_type_table,root->astnode.ident.name);
+
+ name = ht2->variable->astnode.ident.merged_name;
+ }
+ else if((ht=type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL)
+ name = ht->variable->astnode.ident.merged_name;
+ else
+ name = root->astnode.ident.name;
+
+ return name;
+}
+
+/*****************************************************************************
+ * *
+ * getMergedDescriptor *
+ * *
+ * given an ident, return the descriptor. *
+ * *
+ *****************************************************************************/
+
+char *
+getMergedDescriptor(AST *root, enum returntype returns)
+{
+ HASHNODE *ht, *ht2;
+ char *desc;
+
+ if(gendebug){
+ printf("@@## looking for '%s' in common table\n",
+ root->astnode.ident.name);
+ }
+
+ if(type_lookup(cur_common_table,root->astnode.ident.name)!=NULL) {
+ if(gendebug){
+ printf("@@## found! in common table\n");
+ }
+ ht2 = type_lookup(cur_type_table,root->astnode.ident.name);
+
+ if(gendebug)printf("@@## ht2 is '%s'\n", ht2 ? "non-null": "NULL");
+ desc = ht2->variable->astnode.ident.descriptor;
+ if(gendebug)printf("@@## desc is '%s'\n", desc ? desc: "NULL");
+ }
+ else if((ht=type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL) {
+ desc = ht->variable->astnode.ident.descriptor;
+ }
+ else {
+ ht2 = type_lookup(cur_type_table,root->astnode.ident.name);
+
+ if(ht2 && ht2->variable->astnode.ident.descriptor)
+ desc = ht2->variable->astnode.ident.descriptor;
+ else {
+ desc = field_descriptor[returns][(root->astnode.ident.dim > 0)];
+ }
+ }
+
+ return desc;
+}
+
+/*****************************************************************************
+ * *
+ * vardec_emit *
+ * *
+ * the body of this function used to be in typedec_emit, but *
+ * I moved it so that I could use the same code to emit static *
+ * or nonstatic variables. 10/3/97 -- Keith *
+ * *
+ * This could probably be simplified somewhat now that all *
+ * variables are emitted 'static'. 1/27/98 -- Keith *
+ * ...done 3/26/98 -- Keith *
+ * *
+ *****************************************************************************/
+
+void
+vardec_emit(JVM_METHOD *meth, AST *root, enum returntype returns,
+ char *prefix)
+{
+ char *name, *desc;
+ HASHNODE *hashtemp;
+ int count;
+ AST *temp2;
+ int c;
+ struct var_info *ainf;
+
+ if(type_lookup(cur_external_table, root->astnode.ident.name))
+ return;
+
+ ainf = get_var_info(root);
+
+ if(gendebug) {
+ printf("vardec emit %s\n", root->astnode.ident.name);
+ printf("ident = %s, prefix = %s\n",root->astnode.ident.name,prefix);
+ }
+
+ /* the top of the stack now contains the array we just created.
+ * now issue the store instruction to store the array reference
+ * into the static variable. if this ident is equivalenced, we
+ * need to get the name/descriptor from the merged variable.
+ */
+
+ name = getMergedName(root);
+ desc = getMergedDescriptor(root, returns);
+ if(gendebug) {
+ if(!name) printf("!name\n");
+ if(!desc) printf("!desc\n");
+ }
+ /*
+ * check to see if this is an array declaration or not.
+ * if so, we must generate the appropriate "new" statement.
+ * otherwise, just declare & initialize in one statement. --keith
+ */
+
+ if(root->astnode.ident.arraylist != NULL) {
+ fprintf (curfp, "%s%s [] ",prefix, returnstring[returns]);
+
+ if (gendebug)
+ printf ("found array %s, calling name_emit\n", returnstring[returns]);
+ name_emit (meth, root);
+
+ if (returns == Integer)
+ fprintf (curfp, "= new int[");
+ else if (returns == Float)
+ fprintf (curfp, "= new float[");
+ else if (returns == Double)
+ fprintf (curfp, "= new double[");
+ else if (returns == Logical)
+ fprintf (curfp, "= new boolean[");
+ else if ((returns == String) || (returns == Character))
+ fprintf (curfp, "= new String[");
+ else
+ fprintf(stderr,"vardec_emit(): Unknown type (%d)!\n",returns);
+
+ /* make sure this variable is in the array table */
+
+ hashtemp = type_lookup(cur_array_table,root->astnode.ident.name);
+ if(hashtemp != NULL)
+ {
+ /* loop through each dimension of the array */
+
+ temp2=root->astnode.ident.arraylist;
+ for(count=0 ; temp2!=NULL ; temp2=temp2->nextstmt, count++)
+ {
+ if(temp2 != root->astnode.ident.arraylist)
+ fprintf(curfp, " * "); /* if not the first iteration */
+
+ fprintf(curfp,"(");
+
+ if(temp2->nodetype == ArrayIdxRange)
+ {
+ /* if we have a range of indices (e.g. integer a(0:12))
+ * then we must allocate (end - start + 1) elements.
+ */
+
+ expr_emit(meth, temp2->astnode.expression.rhs);
+ fprintf(curfp," - ");
+ expr_emit(meth, temp2->astnode.expression.lhs);
+ fprintf(curfp," + 1");
+
+ /* at this point, we've pushed the end and start onto the
+ * stack, so now we just subtract start from end and increment
+ * by one as described above.
+ */
+ bc_append(meth, jvm_isub);
+ bc_append(meth, jvm_iconst_1);
+ bc_append(meth, jvm_iadd);
+ }
+ else
+ expr_emit(meth, temp2);
+
+ /* if this isn't the first iteration, then we must multiply
+ * the dimensions to get the total size of the array.
+ */
+ if(temp2 != root->astnode.ident.arraylist)
+ bc_append(meth, jvm_imul);
+
+ fprintf(curfp,")");
+ }
+ }
+ else
+ fprintf(stderr,"vardec_emit: Can't find %s in array table!\n",
+ root->astnode.ident.name);
+
+ fprintf (curfp, "];\n");
+
+ /* now the stack contains the number of elements for this
+ * array, so now we issue a newarray instruction to create the
+ * new array. we have to distinguish between arrays of
+ * primitives and arrays of references because there are
+ * different opcodes for creating these arrays.
+ */
+
+ newarray_emit(meth, root->vartype);
+
+ storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+ } else { /* this is not an array declaration */
+
+ if(!type_lookup(cur_param_table, root->astnode.ident.name))
+ {
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name))
+ fprintf (curfp, "%s%s ", prefix, returnstring[returns]);
+ else
+ fprintf (curfp, "%s%s ", prefix, wrapper_returns[returns]);
+
+ if (gendebug)
+ printf ("%s\n", returnstring[returns]);
+
+ name_emit (meth, root);
+
+ /* this variable is not declared as a parameter, so
+ * initialize it with an initial value depending on
+ * its data type.
+ */
+
+ if ((returns == String) || (returns == Character))
+ {
+ print_string_initializer(meth, root);
+ fprintf(curfp,";\n");
+
+ if(gendebug) {
+ printf("new fieldref:\n");
+ printf("\tclass: %s\n", cur_filename);
+ printf("\tname: %s\n", name);
+ printf("\tdesc: %s\n", desc ? desc : "NULL");
+ }
+
+ storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+ }
+ else {
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) {
+ fprintf(curfp,"= %s;\n", init_vals[returns]);
+ bc_append(meth, init_opcodes[returns]);
+ storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+ }
+ else
+ {
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ full_wrappername[returns]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ bc_append(meth, init_opcodes[returns]);
+
+ c = bc_new_methodref(cur_class_file,full_wrappername[returns],
+ "<init>", wrapper_descriptor[returns]);
+
+ bc_append(meth, jvm_invokespecial, c);
+
+ storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+
+ fprintf(curfp,"= new %s(%s);\n",wrapper_returns[returns],
+ init_vals[returns]);
+ }
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * print_string_initializer *
+ * *
+ * This function prints the initialization code for a *
+ * String object. If we know how long the string is supposed to *
+ * be, then we can generate a blank string of that length. Thus *
+ * any length operations on the 'uninitialized' string would be *
+ * correct. *
+ * *
+ *****************************************************************************/
+
+void
+print_string_initializer(JVM_METHOD *meth, AST *root)
+{
+ char *src_initializer, *bytecode_initializer;
+ AST *tempnode;
+ HASHNODE *ht;
+
+ if(gendebug)
+ printf("in print_string_initializer()\n");
+
+ ht = type_lookup(cur_type_table,root->astnode.ident.name);
+ if(ht == NULL)
+ {
+ fprintf(stderr,"Weird...can't find '%s' in type_table\n",
+ root->astnode.ident.name);
+
+ /* We can't find this variable in the hash table,
+ * so just initialize the string to the standard initial
+ * value found in init_vals. dup this constant string
+ * so that we can always free() later regardless of
+ * whether we hit this case or the latter case.
+ */
+
+ src_initializer = strdup(init_vals[String]);
+ }
+ else
+ {
+ /* check if this is a Fortran character array. it will have been
+ * allocated as a Java String, so don't treat it as an array.
+ */
+
+ if((ht->variable->astnode.ident.len == 1) &&
+ (ht->variable->astnode.ident.dim == 0) &&
+ (ht->variable->astnode.ident.arraylist == NULL) &&
+ (ht->variable->astnode.ident.startDim[2] != NULL))
+ {
+ AST *temp_node, *save_parent;
+ int c;
+
+ temp_node = addnode();
+ if(!temp_node) {
+ fprintf(stderr, "Internal error: Failed to alloc temporary node.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ save_parent = ht->variable->astnode.ident.startDim[2]->parent;
+
+ ht->variable->astnode.ident.startDim[2]->parent = temp_node;
+
+ temp_node->astnode.expression.rhs = ht->variable->astnode.ident.startDim[2];
+ temp_node->astnode.expression.lhs = NULL;
+ temp_node->astnode.expression.minus = '+';
+ temp_node->nodetype = Unaryop;
+ temp_node->vartype = ht->variable->astnode.ident.startDim[2]->vartype;
+
+ fprintf(curfp, "= new String(new char[");
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, JL_STRING);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+ expr_emit (meth, ht->variable->astnode.ident.startDim[2]);
+ bc_append(meth, jvm_newarray, JVM_T_CHAR);
+
+ c = bc_new_methodref(cur_class_file, JL_STRING, "<init>", CHAR_ARRAY_DESC);
+
+ bc_append(meth, jvm_invokespecial, c);
+
+ fprintf(curfp, "])");
+
+ ht->variable->astnode.ident.startDim[2]->parent = save_parent;
+
+ f2jfree(temp_node, sizeof(AST));
+
+ return;
+ }
+
+ /* We know how long this string is supposed to be, so we
+ * allocate a blank string with that many characters. For
+ * example, CHARACTER*5 blah is translated to:
+ * String blah = new String(" ");
+ * assuming it has not been declared with a DATA statement.
+ */
+
+ if(ht->variable->astnode.ident.len < 0) {
+ src_initializer = (char *)f2jalloc(5);
+
+ sprintf(src_initializer,"\" \"");
+ }
+ else {
+ src_initializer = (char *)f2jalloc(ht->variable->astnode.ident.len+3);
+
+ sprintf(src_initializer,"\"%*s\"",ht->variable->astnode.ident.len," ");
+ }
+
+ }
+
+ /* we've created the initializer for java source code generation,
+ * but for JVM opcode, we do not need the quotes within the string.
+ * here we remove them and create a bytecode initializer.
+ */
+
+ bytecode_initializer = (char *)f2jalloc(strlen(src_initializer) - 1);
+ strncpy(bytecode_initializer,src_initializer+1,strlen(src_initializer)-2);
+ bytecode_initializer[strlen(src_initializer) - 2] = '\0';
+
+ tempnode = addnode();
+ tempnode->token = STRING;
+ tempnode->astnode.constant.number = strdup(bytecode_initializer);
+
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) {
+ fprintf(curfp,"= new String(%s)", src_initializer);
+ invoke_constructor(meth, JL_STRING, tempnode, STR_CONST_DESC);
+ }
+ else {
+ fprintf(curfp,"= new StringW(%s)", src_initializer);
+ invoke_constructor(meth, full_wrappername[String], tempnode,
+ wrapper_descriptor[String]);
+ }
+
+ f2jfree(bytecode_initializer, strlen(bytecode_initializer)+1);
+ f2jfree(src_initializer, strlen(src_initializer)+1);
+ f2jfree(tempnode, sizeof(AST));
+}
+
+/*****************************************************************************
+ * *
+ * data_emit *
+ * *
+ * This function handles emitting DATA statements, which consist of a *
+ * list of names and a list of data items. We start with the first name *
+ * and assign as many data items from the list as the size allows. for *
+ * example if the first name is a 5 element array, we assign the first 5 *
+ * data items to the first name. then we go to the second name, third *
+ * name, etc. and assign values in the same way. 10/3/97 --Keith *
+ * *
+ *****************************************************************************/
+
+void
+data_emit(JVM_METHOD *meth, AST *root)
+{
+ AST * Dtemp, *Ntemp, *Ctemp;
+ HASHNODE *hashtemp;
+
+ /* foreach Data spec... */
+ for(Dtemp = root->astnode.label.stmt;Dtemp != NULL;Dtemp = Dtemp->prevstmt)
+ {
+ Ctemp = Dtemp->astnode.data.clist;
+
+ /* foreach variable... */
+ for(Ntemp = Dtemp->astnode.data.nlist;Ntemp != NULL;Ntemp=Ntemp->nextstmt)
+ {
+ /* check to see if we're looking at an implied do loop */
+
+ if(Ntemp->nodetype == DataImpliedLoop)
+ {
+ data_implied_loop_emit(meth, Ntemp, Ctemp);
+ continue;
+ }
+
+ /* This variable should have a type declaration associated with it */
+
+ hashtemp = type_lookup(cur_type_table,Ntemp->astnode.ident.name);
+
+ if(hashtemp == NULL)
+ {
+ fprintf(stderr,"No typedec associated with this DATA variable: %s\n",
+ Ntemp->astnode.ident.name);
+ continue;
+ }
+
+ if(hashtemp->variable == NULL)
+ {
+ fprintf(stderr,"Wow, hashtemp->variable is NULL!\n");
+ continue;
+ }
+
+ /* check to see if this variable is also part of a common block */
+
+ if(type_lookup(cur_common_table, Ntemp->astnode.ident.name))
+ {
+ fprintf(stderr,"Warning: can't handle COMMON varables");
+ fprintf(stderr," w/DATA statements.\n");
+ continue;
+ }
+
+ if((hashtemp->variable->vartype == String) &&
+ (hashtemp->variable->astnode.ident.len == 1) &&
+ (hashtemp->variable->astnode.ident.dim == 0) &&
+ (hashtemp->variable->astnode.ident.arraylist == NULL) &&
+ (hashtemp->variable->astnode.ident.startDim[2] != NULL))
+ {
+ int i, length;
+
+ /* this is a Fortran character array generated as a Java String.
+ * copy the original dimension info to the arraylist field and
+ * call determine_var_length(), then set it back to NULL before
+ * emitting the string initializer.
+ */
+ hashtemp->variable->astnode.ident.arraylist =
+ hashtemp->variable->astnode.ident.startDim[2];
+ length = determine_var_length(hashtemp);
+ hashtemp->variable->astnode.ident.arraylist = NULL;
+
+ Ctemp = data_var_emit(meth, Ntemp, Ctemp, hashtemp, length);
+
+ if(Ntemp->astnode.ident.arraylist) {
+ /*
+ * if Ntemp is a single element of a character array, e.g.:
+ * DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', 'l'/
+ * then the whole thing would have been emitted above in the call
+ * to data_var_emit(). So, here we skip the remaining single
+ * element references so that we don't try to emit them again.
+ */
+ for(i=0;i<length-1;i++)
+ Ntemp = Ntemp->nextstmt;
+ }
+ }
+ else
+ Ctemp = data_var_emit(meth, Ntemp, Ctemp, hashtemp, -1);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * data_implied_loop_emit *
+ * *
+ * This function generates the code for implied do loops in DATA *
+ * statements. The initialization is done in Java within a static *
+ * block. For example, the following fortran statements: *
+ * *
+ * integer x *
+ * data (x(j),j=1,4)/5,6,7,8/ *
+ * *
+ * would be emitted in Java as: *
+ * *
+ * static int [] x= new int[(4)]; *
+ * static { *
+ * x[( 1 )- 1] = 5; *
+ * x[( 2 )- 1] = 6; *
+ * x[( 3 )- 1] = 7; *
+ * x[( 4 )- 1] = 8; *
+ * } *
+ * *
+ *****************************************************************************/
+
+AST *
+data_implied_loop_emit(JVM_METHOD *meth, AST * root, AST *Clist)
+{
+ AST * loop_var, * lhs;
+ int start, stop, incr, i;
+ HASHNODE *ht;
+
+
+ if(gendebug) {
+ printf("/* \n");
+ printf("* looking at an implied data loop...\n");
+ printf("*\n");
+ }
+
+ start = atoi(root->astnode.forloop.start->astnode.constant.number);
+
+ if(gendebug)
+ printf("* the start is: %d\n",start);
+
+ stop = atoi(root->astnode.forloop.stop->astnode.constant.number);
+
+ if(gendebug)
+ printf("* the stop is: %d\n",stop);
+
+ if(root->astnode.forloop.incr != NULL)
+ incr = atoi(root->astnode.forloop.incr->astnode.constant.number);
+ else
+ incr = 1;
+
+ if(gendebug)
+ printf("* the increment is: %d\n",incr);
+
+ loop_var = root->astnode.forloop.counter;
+
+ if(gendebug)
+ printf("* the name for the loop var is: %s\n",
+ loop_var->astnode.ident.name);
+
+ lhs = root->astnode.forloop.Label;
+
+ if(gendebug)
+ {
+ AST *temp;
+
+ printf("* the Lhs for this data stmt is: %s\n",
+ lhs->astnode.ident.name);
+
+ printf("* lets see whats in Clist\n");
+ for(temp=Clist;temp!=NULL;temp=temp->nextstmt)
+ printf("* temp: %s\n", temp->astnode.constant.number);
+ }
+
+ ht = type_lookup(cur_type_table,lhs->astnode.ident.name);
+ if(ht)
+ lhs->vartype = ht->variable->vartype;
+ else
+ fprintf(stderr,"WARNING: [DATA] couldn't get vartype of '%s'\n",
+ lhs->astnode.ident.name);
+
+ global_sub.name = loop_var->astnode.ident.name;
+
+ /* emit the static initialization block */
+
+ fprintf(curfp,"static {\n");
+ for(i = start; i <= stop; i += incr)
+ {
+ global_sub.val = i;
+ name_emit(meth, lhs);
+ fprintf(curfp, " = ");
+ expr_emit(meth, Clist);
+ fprintf(curfp, ";\n");
+ Clist = Clist->nextstmt;
+ bc_gen_array_store_op(meth, jvm_data_types[ht->variable->vartype]);
+ }
+ fprintf(curfp,"}\n");
+
+ if(gendebug)
+ printf("*/ \n");
+
+ global_sub.name = NULL;
+
+ return Clist;
+}
+
+/*****************************************************************************
+ * *
+ * data_var_emit *
+ * *
+ * This function emits variable declarations for those variables *
+ * originally contained in DATA statements in the fortran source. *
+ * *
+ *****************************************************************************/
+
+AST *
+data_var_emit(JVM_METHOD *meth, AST *Ntemp, AST *Ctemp, HASHNODE *hashtemp,
+ int java_str_len)
+{
+ int length, is_array, needs_dec;
+
+ if(gendebug)
+ printf("VAR here we are emitting data for %s\n",
+ Ntemp->astnode.ident.name);
+
+ /* check to see whether we're going to be assigning to
+ * an array element. If so, the declaration for the array
+ * would have already been emitted, so we dont need a
+ * declaration here - just assign the value. Otherwise,
+ * we do need a declaration.
+ * (my gut feeling is that for bytecode generation, needs_dec
+ * is irrelevant. we shall see.)
+ */
+
+ if(Ntemp->astnode.ident.arraylist == NULL)
+ needs_dec = FALSE;
+ else
+ needs_dec = TRUE;
+
+ /* here we determine whether this variable was declared as
+ * an array or not. hashtemp points to the symtable info.
+ */
+ if((hashtemp->variable->astnode.ident.arraylist != NULL ) && !needs_dec)
+ is_array = TRUE;
+ else
+ is_array = FALSE;
+
+ if(java_str_len >= 0)
+ {
+ fprintf(curfp,"public static %s ",
+ returnstring[ hashtemp->variable->vartype]);
+
+ if(gendebug)
+ printf("VAR STRING going to data_string_emit\n");
+
+ Ctemp = data_string_emit(meth, java_str_len, Ctemp, Ntemp);
+
+ return Ctemp;
+ }
+
+ if( hashtemp->variable->astnode.ident.leaddim != NULL )
+ {
+ if(gendebug)
+ printf("VAR leaddim not NULL\n");
+
+ /* Check for attempts to initialize dummy argument. we can't
+ * determine the number of elements in a dummy arg.
+ */
+ if(hashtemp->variable->astnode.ident.leaddim[0] == '*')
+ {
+ fprintf(stderr,"Attempt to initialize dummy argument: %s\n",
+ hashtemp->variable->astnode.ident.name);
+ return Ctemp;
+ }
+ else if (type_lookup(cur_args_table,Ntemp->astnode.ident.name))
+ {
+ fprintf(stderr,"Attempt to initialize argument: %s\n",
+ hashtemp->variable->astnode.ident.name);
+ return Ctemp;
+ }
+ }
+
+ if(is_array)
+ {
+ /* determine how many elements are in this array so that
+ * we know how many items from the DATA statement to assign
+ * to this variable.
+ */
+
+ length = determine_var_length(hashtemp);
+
+ if(gendebug)
+ printf("VAR length = %d\n",length);
+
+ fprintf(curfp,"public static %s ", returnstring[ hashtemp->variable->vartype]);
+
+ if(gendebug)
+ printf("VAR going to data_array_emit\n");
+
+ Ctemp = data_array_emit(meth, length, Ctemp, Ntemp);
+ }
+ else
+ {
+ if(!needs_dec)
+ {
+ if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name))
+ fprintf(curfp,"public static %s ", returnstring[ hashtemp->variable->vartype]);
+ else
+ fprintf(curfp,"public static %s ", wrapper_returns[ hashtemp->variable->vartype]);
+
+ data_scalar_emit(meth, hashtemp->variable->vartype, Ctemp, Ntemp, needs_dec);
+ }
+ else
+ {
+ fprintf(curfp,"static {\n");
+ data_scalar_emit(meth, hashtemp->variable->vartype, Ctemp, Ntemp, needs_dec);
+ fprintf(curfp,"}\n");
+ }
+
+ Ctemp = Ctemp->nextstmt;
+ }
+
+ return Ctemp;
+}
+
+/*****************************************************************************
+ * determine_var_length *
+ * *
+ * Determine the number of elements in this array variable. *
+ * *
+ *****************************************************************************/
+
+int
+determine_var_length(HASHNODE *var)
+{
+ AST *temp2;
+ int length = 1;
+ int dims = var->variable->astnode.ident.dim;
+
+ if(gendebug) {
+ printf("determining length of %s\n", var->variable->astnode.ident.name);
+ printf("dim = %d\n", dims);
+ }
+
+ /* loop through each dimension of the array and evaluate it.
+ * multiply the length of each dimension as we go.
+ */
+
+ temp2=var->variable->astnode.ident.arraylist;
+ for( ; temp2 != NULL ; temp2=temp2->nextstmt ) {
+
+ if(temp2->nodetype == ArrayIdxRange) {
+
+ if(idxNeedsDecr(temp2))
+ length *= (int)eval_const_expr(temp2->astnode.expression.rhs);
+ else
+ length *= (int)eval_const_expr(temp2->astnode.expression.rhs) + 1;
+
+ if(gendebug)
+ printf("VAR now length = %d\n", length);
+ }
+ else if(temp2->nodetype != Constant) {
+
+ length = -1;
+ break;
+ }
+ else {
+ length *= atoi(temp2->astnode.constant.number);
+ }
+ }
+
+ if(gendebug)
+ printf("VAR returning length = %d\n", length);
+
+ return length;
+}
+
+/*****************************************************************************
+ * *
+ * data_string_emit *
+ * *
+ * This function generates data statements that are used to initialize *
+ * character arrays, e.g.: *
+ * *
+ * CHARACTER TRANSS( NTRAN ) *
+ * DATA TRANSS / 'N', 'T', 'C' / *
+ * *
+ * This is a horrible hack and probably won't work well for most things. *
+ * I think the character handling needs to be totally rewritten. *
+ * *
+ *****************************************************************************/
+
+AST *
+data_string_emit(JVM_METHOD *meth, int length, AST *Ctemp, AST *Ntemp)
+{
+ unsigned int count, size = 0;
+ HASHNODE *ht;
+ int i, str_idx;
+ struct var_info *ainf;
+ char *init_string;
+
+ ainf = get_var_info(Ntemp);
+
+ if(gendebug)
+ printf("VAR here we are in data_string_emit, length = %d\n",length);
+
+ ht=type_lookup(cur_type_table, Ntemp->astnode.ident.name);
+ if(!ht) {
+ fprintf(stderr,"type table may be screwed. Can't find '%s'.",
+ Ntemp->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ fprintf(curfp,"%s = \"",Ntemp->astnode.ident.name);
+
+ /* for bytecode, we have to determine the number of elements
+ * prior to emitting the elements themselves because we must
+ * push the array size on the stack first. if the length is
+ * not known, we count the number of actual data items.
+ * otherwise, we set the array size equal to the given length.
+ */
+ if(length == -1) {
+ AST *tmp;
+ for(tmp = Ctemp;tmp != NULL;tmp=tmp->nextstmt)
+ size++;
+ }
+ else
+ size = length;
+
+ init_string = (char *)f2jalloc(size+1);
+
+ str_idx = 0;
+ init_string[str_idx] = 0;
+
+ for(i=0,count=0;(length==-1)?(Ctemp != NULL):(i< length);i++) {
+
+ if(Ctemp->nodetype == Binaryop) {
+ fprintf(stderr, "repeated characters in data stmts not supported\n");
+ exit(EXIT_FAILURE);
+ }
+ else {
+
+ if(Ctemp->token == STRING) {
+ init_string[str_idx] = Ctemp->astnode.constant.number[0];
+ }
+ else {
+ init_string[str_idx] = '?';
+ fprintf(stderr, "expected a string constant in data statement\n");
+ }
+
+ str_idx++;
+ }
+
+ if((Ctemp = Ctemp->nextstmt) == NULL)
+ break;
+ }
+
+ init_string[str_idx] = 0;
+
+ fprintf(curfp,"%s\";\n", escape_double_quotes(init_string));
+
+ bc_push_string_const(meth, init_string);
+
+ storeVar(cur_class_file, meth, Ntemp->vartype, ainf->is_arg, ainf->class,
+ ainf->name, "Ljava/lang/String;", ainf->localvar, FALSE);
+
+ return Ctemp;
+}
+
+/*****************************************************************************
+ * *
+ * data_array_emit *
+ * *
+ * This function generates array declarations which are contained in *
+ * DATA statements. *
+ * *
+ *****************************************************************************/
+
+AST *
+data_array_emit(JVM_METHOD *meth, int length, AST *Ctemp, AST *Ntemp)
+{
+ unsigned int count, size = 0;
+ HASHNODE *ht;
+ int i;
+ struct var_info *ainf;
+
+ ainf = get_var_info(Ntemp);
+
+ if(gendebug)
+ printf("VAR here we are in data_array_emit, length = %d\n",length);
+
+ ht=type_lookup(cur_type_table, Ntemp->astnode.ident.name);
+ if(!ht) {
+ fprintf(stderr,"type table may be screwed. Can't find '%s'.",
+ Ntemp->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ fprintf(curfp,"[] ");
+
+ /*
+ * if this variable is static, we can't declare it here
+ * because it has been declared already as a class variable.
+ * so we use the "_temp_" prefix and emit the initialization.
+ * later we assign the temp variable to the class variable.
+ * 10/3/97 --Keith
+ *
+ * i think the above comment is out of date. there is really
+ * no distinction between static/nonstatic anymore. --kgs 5/15/00
+ */
+
+ fprintf(curfp,"%s = {\n",Ntemp->astnode.ident.name);
+
+ /* for bytecode, we have to determine the number of elements
+ * prior to emitting the elements themselves because we must
+ * push the array size on the stack first. if the length is
+ * not known, we count the number of actual data items.
+ * otherwise, we set the array size equal to the given length.
+ */
+ if(length == -1) {
+ AST *tmp;
+ for(tmp = Ctemp;tmp != NULL;tmp=tmp->nextstmt)
+ size++;
+ }
+ else
+ size = length;
+
+ bc_push_int_const(meth, size);
+ newarray_emit(meth, ht->variable->vartype);
+
+ for(i=0,count=0;(length==-1)?(Ctemp != NULL):(i< length);i++) {
+
+ if(Ctemp->nodetype == Binaryop)
+ count = data_repeat_emit(meth, Ctemp, Ntemp, count);
+ else {
+ bc_append(meth, jvm_dup);
+ bc_push_int_const(meth, count++);
+
+ if(Ctemp->token == STRING) {
+ fprintf(curfp,"\"%s\" ",
+ escape_double_quotes(Ctemp->astnode.constant.number));
+ invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC);
+ }
+ else {
+ fprintf(curfp,"%s ", Ctemp->astnode.constant.number);
+ pushConst(meth, Ctemp);
+ }
+
+ bc_gen_array_store_op(meth, jvm_data_types[ht->variable->vartype]);
+
+ /*
+ * Every now and then, emit a newline for readability.
+ * I have run across some lines that end up so long that
+ * they screw up 'vi'. 9/30/97 --Keith
+ */
+ if( (count+1) % 5 == 0 )
+ fprintf(curfp,"\n");
+ }
+
+ if( (Ctemp = Ctemp->nextstmt) == NULL )
+ break;
+ else {
+ if(length == -1)
+ {
+ if (Ctemp != NULL)
+ fprintf(curfp,", ");
+ }
+ else
+ if(i != length -1 )
+ fprintf(curfp,", ");
+ }
+ }
+
+ fprintf(curfp,"};\n");
+
+ storeVar(cur_class_file, meth, Ntemp->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+
+ return Ctemp;
+}
+
+/*****************************************************************************
+ * *
+ * data_repeat_emit *
+ * *
+ * This function generates repeated DATA specifications, for example: *
+ * INTEGER x(30) *
+ * DATA x/30*1/ *
+ * *
+ * For bytecode generation, we must keep track of which index we're emitting *
+ * so we return the int value of the next array index to emit. *
+ * *
+ *****************************************************************************/
+
+int
+data_repeat_emit(JVM_METHOD *meth, AST *root, AST *Ntemp, unsigned int idx)
+{
+ int j, repeat;
+ char *ditem;
+ BOOL keep_going = FALSE;
+
+ if((root->astnode.expression.lhs == NULL) ||
+ (root->astnode.expression.rhs == NULL))
+ {
+ fprintf(stderr,"Bad data statement!\n");
+ exit(EXIT_FAILURE);
+ }
+
+ if((root->astnode.expression.lhs->nodetype != Constant) ||
+ (root->astnode.expression.rhs->nodetype != Constant))
+ {
+ fprintf(stderr,"Error: Data items must be constants.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ repeat = atoi(root->astnode.expression.lhs->astnode.constant.number);
+ ditem = root->astnode.expression.rhs->astnode.constant.number;
+
+ /* emit the all but the last with a comma.. the last one without */
+ for(j=0;j<repeat-1;j++) {
+ /* This code checks to see if the value we are putting in the array
+ * index matches the type of the array. If the values don't match
+ * we must cast the array.
+ */
+
+ if((Ntemp->vartype != root->astnode.expression.rhs->vartype)||(keep_going)) {
+ root->astnode.expression.rhs->token = cast_data_stmt(Ntemp,
+ root->astnode.expression.rhs->token);
+ root->astnode.expression.rhs->vartype = Ntemp->vartype;
+ keep_going = TRUE; /* Used because the vartype is the same now */
+ }
+
+ fprintf(curfp,"%s, ", ditem);
+ bc_append(meth, jvm_dup);
+ bc_push_int_const(meth, idx++);
+ pushConst(meth, root->astnode.expression.rhs);
+ bc_gen_array_store_op(meth, jvm_data_types[root->astnode.expression.rhs->vartype]);
+ }
+
+ if((Ntemp->vartype != root->astnode.expression.rhs->vartype)||(keep_going)) {
+ root->astnode.expression.rhs->token = cast_data_stmt(Ntemp,
+ root->astnode.expression.rhs->token);
+ root->astnode.expression.rhs->vartype = Ntemp->vartype;
+ }
+
+ fprintf(curfp,"%s ", ditem);
+ bc_append(meth, jvm_dup);
+ bc_push_int_const(meth, idx++);
+ pushConst(meth, root->astnode.expression.rhs);
+ bc_gen_array_store_op(meth, jvm_data_types[root->astnode.expression.rhs->vartype]);
+
+ return idx;
+}
+
+/*****************************************************************************
+ * *
+ * data_scalar_emit *
+ * *
+ * This function generates declarations of scalar items which are *
+ * contained in DATA statements. *
+ * *
+ *****************************************************************************/
+
+void
+data_scalar_emit(JVM_METHOD *meth, enum returntype type, AST *Ctemp, AST *Ntemp,
+ int needs_dec)
+{
+ int c;
+
+ if(Ctemp->nodetype == Binaryop)
+ {
+ fprintf(stderr,"Attempt to assign more than one value to a scalar.\n");
+ return;
+ }
+
+ if(Ctemp->token == STRING)
+ {
+ HASHNODE *ht;
+ int len;
+
+ /* find this string in the symbol table */
+ ht = type_lookup(cur_type_table,Ntemp->astnode.ident.name);
+
+ /* determine the length of the string (as declared in the fortran src) */
+ if(ht == NULL)
+ len = 1;
+ else {
+ if(Ntemp->astnode.ident.len < 0)
+ len = 1;
+ else
+ len = Ntemp->astnode.ident.len;
+ }
+
+ /* now initialize the string to all blanks. but we try to keep the length
+ * of the string constant, otherwise some subscript operations get screwed
+ * up. so we initialize the string to n blanks, where n is the original
+ * string length.
+ * ..i dont think this code is working as described above. however, it
+ * doesn't seem to be hurting anything currently. --kgs
+ */
+
+ if(!needs_dec)
+ {
+ /* assigning to a scalar element. call invoke_constructor() to push
+ * the new string object onto the stack and then emit a putstatic
+ * instruction to store it into the scalar variable. we can safely
+ * assume that it is not an argument to this program unit because
+ * you cannot use the DATA statement to initialize an argument.
+ */
+
+ if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name)) {
+ fprintf(curfp,"%s = new String(\"%*s\");\n",
+ Ntemp->astnode.ident.name, len,
+ escape_double_quotes(Ctemp->astnode.constant.number));
+
+ invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC);
+ c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name,
+ field_descriptor[String][0]);
+ }
+ else {
+ fprintf(curfp,"%s = new StringW(\"%*s\");\n",
+ Ntemp->astnode.ident.name, len,
+ escape_double_quotes(Ctemp->astnode.constant.number));
+
+ invoke_constructor(meth, full_wrappername[type], Ctemp, STR_CONST_DESC);
+ c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name,
+ wrapped_field_descriptor[String][0]);
+ }
+
+ bc_append(meth, jvm_putstatic, c);
+ }
+ else
+ {
+ /* assigning to an array element. first, call expr_emit() which will
+ * push a reference to the array & the array index onto the stack.
+ * then call invoke_constructor() to push a new string object onto
+ * the stack. finally, emit an array store instruction to store the
+ * string into the array element.
+ */
+
+ expr_emit(meth, Ntemp);
+ fprintf(curfp," = \"%*s\";\n", len,
+ escape_double_quotes(Ctemp->astnode.constant.number));
+
+ invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC);
+
+ bc_gen_array_store_op(meth, jvm_data_types[Ntemp->vartype]);
+ }
+ }
+ else
+ {
+ /* this is not a string, so the declaration/initialization is
+ * pretty straightforward.
+ */
+
+ if(!needs_dec)
+ {
+ /* as above in the string case, we are assigning to a scalar
+ * variable, which we may safely assume is not an argument.
+ * if it does not need to be wrapped, just push the constant
+ * onto the stack. otherwise, call invoke_constructor() to
+ * create the appropriate wrapper object.
+ */
+ if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name)) {
+ fprintf(curfp, "%s = ", Ntemp->astnode.ident.name);
+ if(Ntemp->vartype != Ctemp->vartype){
+ Ctemp->token = cast_data_stmt(Ntemp, Ctemp->token);
+ Ctemp->vartype = Ntemp->vartype;
+ }
+ fprintf(curfp, "%s;\n", Ctemp->astnode.constant.number);
+ pushConst(meth, Ctemp);
+ c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name,
+ field_descriptor[type][0]);
+ }
+ else {
+ fprintf(curfp,"%s = new %s(%s);\n",Ntemp->astnode.ident.name,
+ wrapper_returns[ type],
+ Ctemp->astnode.constant.number);
+ invoke_constructor(meth, full_wrappername[type], Ctemp,
+ wrapper_descriptor[type]);
+ c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name,
+ wrapped_field_descriptor[type][0]);
+ }
+
+ bc_append(meth, jvm_putstatic, c);
+ }
+ else
+ {
+ /* as above in string case, we are assigning to an array element.
+ * the individual elements of an array are never wrapped, so we
+ * just push the constant onto the stack and issue an array store
+ * instruction.
+ */
+ expr_emit(meth, Ntemp);
+ fprintf(curfp, " = ");
+ if(Ntemp->vartype != Ctemp->vartype){
+ Ctemp->token = cast_data_stmt(Ntemp, Ctemp->token);
+ Ctemp->vartype = Ntemp->vartype;
+ }
+ fprintf(curfp,"%s;\n", Ctemp->astnode.constant.number);
+ pushConst(meth, Ctemp);
+ bc_gen_array_store_op(meth, jvm_data_types[type]);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * invoke_constructor *
+ * *
+ * invokes the <init> method of the given class constructor. used for the *
+ * numeric & string classes (one-arg constructors). the AST node 'constant' *
+ * should represent a constant value of course (i.e. dont pass idents). *
+ * *
+ *****************************************************************************/
+
+void
+invoke_constructor(JVM_METHOD *meth, char *classname, AST *constant, char *desc)
+{
+ int c;
+
+ if(gendebug)
+ printf("invoke_constructor(): classname = %s, constant = '%s'\n",
+ classname, constant->astnode.constant.number);
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, classname);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+ pushConst(meth, constant);
+
+ c = bc_new_methodref(cur_class_file, classname, "<init>", desc);
+
+ bc_append(meth, jvm_invokespecial, c);
+}
+
+/*****************************************************************************
+ * *
+ * name_emit *
+ * *
+ * A name will either fly solo or lead off *
+ * a named array. So far, this code will emit *
+ * a name or an array with integer indices. The *
+ * procedure also needs to check all relevant tables *
+ * to determine whether the name is an array or *
+ * a procedure (i.e. Class.method) call, and whether *
+ * the name is a STRING, CHAR, etc. Frankly, this is *
+ * a hideous procedure and really needs to *
+ * be rewritten. *
+ * *
+ * ...and it's getting worse by the day --Keith *
+ * *
+ * Heh... gotta love it... -dmd 9/26/97 *
+ * *
+ * Started cleaning up name_emit 10/10/97 --Keith *
+ * *
+ *****************************************************************************/
+
+
+void
+name_emit (JVM_METHOD *meth, AST * root)
+{
+ HASHNODE *hashtemp;
+ char * tempname;
+
+ if(gendebug)
+ printf("entering name_emit\n");
+
+ /*
+ * Check to see whether name is in external table. Names are
+ * loaded into the external table from the parser.
+ */
+
+ if(root->nodetype == Identifier)
+ if(root->token == STRING)
+ fprintf(stderr,"** string literal (this case should NOT be reached)\n");
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ if(gendebug)
+ if(type_lookup(cur_equiv_table, root->astnode.ident.name))
+ printf("EQV %s is equivalenced\n",root->astnode.ident.name);
+
+ /*
+ * If this is not a substring operation and the name is in the
+ * external table, then check to see if it is an intrinsic function
+ * instead (e.g. SQRT, ABS, etc).
+ */
+
+ if(root->nodetype != Substring) {
+ hashtemp = type_lookup (cur_array_table, root->astnode.ident.name);
+ if((root->astnode.ident.arraylist == NULL)
+ && (!type_lookup(cur_external_table, root->astnode.ident.name))) {
+ scalar_emit(meth, root, hashtemp);
+ return;
+ }
+ else if(hashtemp || (!hashtemp && (root->astnode.ident.arraylist != NULL)
+ && (root->vartype == String))) {
+ array_emit(meth, root);
+ return;
+ }
+ }
+
+ /*
+ * If the name is in the external table, then check to see if
+ * it is an intrinsic function instead (e.g. SQRT, ABS, etc).
+ */
+
+ if(type_lookup(cur_external_table, root->astnode.ident.name)
+ || type_lookup(function_table, root->astnode.ident.name)
+ || find_method(root->astnode.ident.name, descriptor_table))
+ {
+ hashtemp = type_lookup(cur_type_table, root->astnode.ident.name);
+ if(hashtemp)
+ root->vartype = hashtemp->variable->vartype;
+ external_emit(meth, root);
+ }
+ else if((type_lookup(function_table, root->astnode.ident.name) == NULL)
+ && (find_method(root->astnode.ident.name, descriptor_table) == NULL)
+ && (type_lookup(cur_type_table, root->astnode.ident.name) == NULL)
+ && (methodscan(intrinsic_toks, tempname) != NULL))
+ {
+ if(gendebug)
+ printf("calling intrinsic emit %s\n", root->astnode.ident.name);
+ intrinsic_emit(meth, root);
+ }
+ else
+ switch (root->token)
+ {
+ /*
+ * I think the first case (STRING/CHAR) is obsolete now since string
+ * and char constants were moved to the Constant production.
+ * 9/23/97, Keith
+ */
+
+ case STRING:
+ case CHAR:
+ if(gendebug) {
+ printf("** emit String/char literal!");
+ printf(" (should this case be reached?)\n");
+ }
+
+ fprintf (curfp, "\"%s\"",
+ escape_double_quotes(root->astnode.constant.number));
+ break;
+ case INTRINSIC:
+ break;
+ case NAME:
+ default:
+ if (root->nodetype == Substring)
+ substring_emit(meth, root);
+ else{
+ subcall_emit(meth, root);
+ }
+ break;
+ }
+
+ f2jfree(tempname,strlen(tempname)+1);
+
+ if(gendebug)
+ printf("leaving name_emit\n");
+}
+
+/*****************************************************************************
+ * *
+ * substring_emit *
+ * *
+ * This function emits substring operations. *
+ * *
+ *****************************************************************************/
+
+void
+substring_emit(JVM_METHOD *meth, AST *root)
+{
+ HASHNODE *hashtemp;
+
+ hashtemp = type_lookup (cur_array_table, root->astnode.ident.name);
+
+ if(hashtemp)
+ fprintf(stderr,"WARNING: substring on array element not supported.\n");
+
+ scalar_emit(meth, root, hashtemp);
+
+ if((root->parent->nodetype == Assignment) &&
+ (root->parent->astnode.assignment.lhs == root))
+ {
+ /* in this case we are assigning TO a substring, so we
+ * do not want to generate the calls to substring() because
+ * we will create a new string and assign it to this variable.
+ */
+
+ return;
+ }
+
+ if(root->astnode.ident.startDim[0] || root->astnode.ident.endDim[0])
+ fprintf(curfp,".substring(");
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * subcall_emit *
+ * *
+ * This function emits a function call. I think this function *
+ * is only called in cases where the function or subroutine is *
+ * not declared external or intrinsic and we dont know what *
+ * else to do with it. *
+ * *
+ *****************************************************************************/
+
+void
+subcall_emit(JVM_METHOD *meth, AST *root)
+{
+ JVM_METHODREF *mref;
+ AST *temp;
+ char *tempstr, *t;
+ char *desc;
+ HASHNODE *ht;
+ int c;
+
+ fprintf(stderr,"WARNING: undeclared function call: %s",
+ root->astnode.ident.name);
+ fprintf(stderr," (likely to be emitted wrong)\n");
+
+ if(gendebug) {
+ printf("@##@ in subcall_emit, %s\n",root->astnode.ident.name);
+
+ if(type_lookup(cur_args_table, root->astnode.ident.name))
+ printf("@@ calling passed-in func %s\n",root->astnode.ident.name);
+ }
+
+ /* captialize the first letter of the subroutine name to get the
+ * class name.
+ */
+
+ tempstr = strdup (root->astnode.ident.name);
+ *tempstr = toupper (*tempstr);
+
+ mref = get_method_name(root, FALSE);
+
+ /* mref should always be non-null, though i guess it's
+ * possible that the elements may be null.
+ */
+
+ if((mref->classname != NULL) && (strlen(mref->classname) > 0)) {
+ t = char_substitution(mref->classname, '/', '.');
+ fprintf (curfp, "%s.%s", t, root->astnode.ident.name);
+ f2jfree(t, strlen(t)+1);
+ }
+ else
+ fprintf (curfp, "%s.%s", tempstr, root->astnode.ident.name);
+
+ temp = root->astnode.ident.arraylist;
+ desc = get_desc_from_arglist(temp);
+ ht = type_lookup(cur_type_table, root->astnode.ident.name);
+
+ if(gendebug){
+ printf("codegen: function return type: %s\n",
+ returnstring[ht->variable->vartype]);
+ }
+
+ /* Loop through the argument list and emit each one. */
+
+ fprintf (curfp, "(");
+ if(temp->nodetype != EmptyArgList)
+ for (; temp != NULL; temp = temp->nextstmt)
+ {
+ if(temp != root->astnode.ident.arraylist)
+ fprintf (curfp, ","); /* if not first iteration */
+
+ if (*temp->astnode.ident.name != '*')
+ expr_emit (meth, temp);
+ }
+
+ c = bc_new_methodref(cur_class_file,
+ bc_get_full_classname(tempstr, package_name),
+ root->astnode.ident.name, desc);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ fprintf (curfp, ")");
+
+ bc_free_fieldref(mref);
+}
+
+/*****************************************************************************
+ * *
+ * idxNeedsDecr *
+ * *
+ * This function returns a boolean value depending on whether *
+ * the array pointed to by alist needs to have its index (dims) *
+ * decremented by one or not. This allows arrays to start *
+ * indexing at an arbitrary point. If we recognize that the *
+ * indexing starts at 0 then we dont have to decrement and we *
+ * return FALSE. If indexing begins at 1 (the default in Fortran), *
+ * then we must decrement since Java indexing begins at 0. *
+ * *
+ *****************************************************************************/
+
+int
+idxNeedsDecr(AST *alist)
+{
+ AST *startIdx;
+ int eval;
+
+ if( (alist != NULL) && (alist->nodetype == ArrayIdxRange))
+ {
+ if((startIdx = alist->astnode.expression.lhs) != NULL)
+ {
+ /* evaluate the start index. we dont really care about the
+ * end index at this point.
+ */
+
+ eval = (int)eval_const_expr(startIdx);
+
+ if(gendebug)
+ printf("VAR eval returns %d\n",eval);
+
+ if(eval == 0)
+ return FALSE;
+ else if(eval == 1)
+ return TRUE;
+ else
+ fprintf(stderr,"Can't handle array starting at arbitrary index\n");
+ }
+ else
+ fprintf(stderr,"NULL lhs in array dec!\n");
+ }
+ return TRUE;
+}
+
+/*****************************************************************************
+ * *
+ * func_array_emit *
+ * *
+ * This function emits the index to an array. The boolean argument *
+ * is_arg represents whether the array is an argument to the current *
+ * function or subroutine and the boolean is_ext represents whether *
+ * the array is being passed to an external function. *
+ * *
+ *****************************************************************************/
+
+void
+func_array_emit(JVM_METHOD *meth, AST *root, char *arrayname, int is_arg,
+ int is_ext)
+{
+ int needs_cast;
+
+ HASHNODE *ht;
+
+ if(is_ext)
+ fprintf (curfp, ",");
+ else
+ fprintf (curfp, "[");
+
+ /* if the index is not an integer value, then it needs a cast to int. for
+ * bytecode generation, we cast the indices as we emit them, so a final
+ * cast should not be necessary.
+ */
+
+ needs_cast = root->vartype != Integer;
+
+ if(needs_cast)
+ fprintf(curfp,"(int)(");
+
+ if(gendebug)
+ printf("~looking up %s in the array table\n", arrayname);
+
+ /* find this variable in the array table */
+ ht = type_lookup(cur_array_table, arrayname);
+
+ if(ht == NULL)
+ {
+ if(gendebug)
+ printf("~Could not find!\n");
+ }
+ else
+ {
+ AST *tmp;
+ int i,j;
+
+ /* hack alert! what i'm doing here is changing the
+ * nodetype of the array dimension expression's parent.
+ * the reason being that when we emit the start and
+ * end dimensions, if the parent nodetype is ArrayDec
+ * then nothing will be emitted for bytecode. --keith
+ * p.s. note that we only need to set this for one
+ * dimension since they all share the same parent node.
+ */
+
+ if(ht->variable->astnode.ident.endDim[0])
+ ht->variable->astnode.ident.endDim[0]->parent->nodetype = Identifier;
+
+ tmp = root;
+ for(i=0;i<ht->variable->astnode.ident.dim;i++) {
+ AST *start, *end;
+
+ if(tmp != root)
+ fprintf(curfp,"+");
+
+ fprintf(curfp,"(");
+ expr_emit(meth, tmp);
+ if(tmp->vartype != Integer)
+ bc_append(meth, typeconv_matrix[tmp->vartype][Integer]);
+ fprintf(curfp,"-(");
+
+ start = ht->variable->astnode.ident.startDim[i];
+
+ if(start != NULL) {
+ expr_emit(meth, start);
+ if(start->vartype != Integer)
+ bc_append(meth, typeconv_matrix[start->vartype][Integer]);
+ }
+ else {
+ fprintf(curfp,"1");
+ bc_push_int_const(meth, 1);
+ }
+ fprintf(curfp,"))");
+ bc_append(meth, jvm_isub);
+
+ for(j=i-1;j>=0;j--) {
+ fprintf(curfp," * ");
+ fprintf(curfp,"(");
+
+ start = ht->variable->astnode.ident.startDim[j];
+ end = ht->variable->astnode.ident.endDim[j];
+
+ if(start != NULL) {
+ expr_emit(meth, end);
+ if(end->vartype != Integer)
+ bc_append(meth, typeconv_matrix[end->vartype][Integer]);
+ fprintf(curfp," - ");
+ expr_emit(meth, start);
+ if(start->vartype != Integer)
+ bc_append(meth, typeconv_matrix[start->vartype][Integer]);
+ bc_append(meth, jvm_isub);
+ fprintf(curfp," + 1");
+ bc_push_int_const(meth, 1);
+ bc_append(meth, jvm_iadd);
+ }
+ else {
+ expr_emit(meth, end);
+ if(end->vartype != Integer)
+ bc_append(meth, typeconv_matrix[end->vartype][Integer]);
+ }
+ fprintf(curfp,")");
+ bc_append(meth, jvm_imul);
+ }
+
+ if(tmp != root)
+ bc_append(meth, jvm_iadd);
+ tmp = tmp->nextstmt;
+ }
+ }
+
+ if(is_arg) {
+ int varnum;
+
+ fprintf(curfp, "+ _%s_offset",arrayname);
+
+ /* locate the array's symtable entry and assign the varnum
+ * of the offset arg to be one greater than the array's varnum.
+ */
+ ht = type_lookup(cur_type_table, arrayname);
+ if(!ht) {
+ fprintf(stderr,"WARNING: type table screwed.");
+ fprintf(stderr," looking for localvarnum for '_%s_offset'\n",
+ arrayname);
+ varnum = 1;
+ }
+ else
+ varnum = ht->variable->astnode.ident.localvnum + 1;
+
+ pushVar(cur_class_file, meth, Integer,is_arg,cur_filename,
+ "dummy string...is this significant?",
+ "I", varnum , FALSE);
+ bc_append(meth, jvm_iadd);
+ }
+
+ if(needs_cast)
+ fprintf(curfp,")");
+
+ if(!is_ext) {
+ fprintf(curfp, "]");
+ }
+}
+
+/*****************************************************************************
+ * *
+ * cgPassByRef *
+ * *
+ * wrapper around isPassByRef() for codegen routines. this is just to *
+ * make the code a bit more compact. we could have used a #define but they *
+ * can be annoying sometimes. *
+ * *
+ *****************************************************************************/
+
+int
+cgPassByRef(char *name)
+{
+ return isPassByRef(name, cur_type_table, cur_common_table,
+ cur_external_table);
+}
+
+/*****************************************************************************
+ * *
+ * isPassByRef *
+ * *
+ * Given the name of a variable, this function returns *
+ * TRUE if the variable is passed by reference, FALSE *
+ * otherwise. Generally, being passed by reference *
+ * means that the variable will be wrapped in an object. *
+ * *
+ *****************************************************************************/
+
+int
+isPassByRef(char *name, SYMTABLE *ttable, SYMTABLE *ctable, SYMTABLE *etable)
+{
+ HASHNODE *ht, *ht2, *ht3;
+ char *blockName;
+ int pos, i;
+ AST *temp;
+
+ /* First look up the variable name in the main hash table. */
+
+ ht = type_lookup(ttable,name);
+ if(ht) {
+
+ if(gendebug)
+ printf("isPassByRef(): found '%s' in type table\n", name);
+
+ if(ht->variable->nodetype != Identifier) {
+ fprintf(stderr,"isPassByRef(): non-ident node found (%s).\n", name);
+ fprintf(stderr, " node type is: %s\n", print_nodetype(ht->variable));
+ return FALSE;
+ }
+
+ if(ht->variable->astnode.ident.passByRef)
+ {
+ /* simple case. if the variable is tagged as pass-by-reference
+ * in the hash table, then return TRUE.
+ */
+ if(gendebug)
+ printf("isPassByRef(): '%s' is tagged pass-by-ref\n", name);
+
+ return TRUE;
+ }
+ else {
+ JVM_METHODREF * mtmp;
+
+ /* otherwise, we look up the variable name in the table of
+ * COMMON variables.
+ */
+ if(gendebug)
+ printf("isPassByRef(): '%s' is not tagged pass-by-ref\n", name);
+
+ ht2 = type_lookup(ctable,name);
+ if(ht2) {
+
+ /* since different declarations of the same common block
+ * may use different variable names for the members, we
+ * use the position of the variable in the common block
+ * to look up the actual variable.
+ */
+
+ pos = ht2->variable->astnode.ident.position;
+ blockName = ht2->variable->astnode.ident.commonBlockName;
+
+ ht3 = type_lookup(global_common_table, blockName);
+ if(ht3) {
+
+ /* after getting a pointer to the common block, we loop
+ * through the entries until we get to the Nth entry, where
+ * N = pos, or until the pointer is NULL.
+ */
+
+ i = 0;
+ temp = ht3->variable->astnode.common.nlist;
+
+ while((i < pos) && (temp != NULL)) {
+ i++;
+ temp = temp->nextstmt;
+ }
+
+ if(temp != NULL)
+ return temp->astnode.ident.passByRef;
+ else
+ fprintf(stderr,"isPassByRef(): mismatch in common block size\n");
+ }
+ else
+ fprintf(stderr, "isPassByRef(): cant find common block %s\n",
+ blockName);
+
+ return TRUE;
+ }
+ else if((mtmp=find_commonblock(name, descriptor_table)) != NULL) {
+ char * temp_desc;
+
+ /** TODO: 'pos' was being used here uninitialized, but I can't
+ * remember the circumstances that would drop us into this
+ * case anyway. it seems common block variables are always
+ * tagged pass-by-ref, so this is never executed (at least
+ * compiling all blas, lapack, testers, etc never result in
+ * this case being executed).
+ *
+ * For now, just set pos to 0 and figure it out later.
+ **/
+
+ pos = 0;
+
+ temp_desc = getFieldDescFromCommonDesc(mtmp->descriptor, pos);
+
+ return isPassByRef_desc(temp_desc);
+ }
+ else {
+ return FALSE;
+ }
+ }
+ }
+ else if(type_lookup(etable, name)) {
+ if(gendebug) {
+ printf("isPassByRef(): '%s' not found in type table,", name);
+ printf(" but found in external table\n");
+ }
+
+ return FALSE;
+ }
+ else {
+ fprintf(stderr,"isPassByRef(): variable %s not found (unit: %s)\n",
+ name, unit_name);
+
+ return TRUE;
+ }
+
+ /* should not reach this point */
+}
+
+/*****************************************************************************
+ * *
+ * array_emit *
+ * *
+ * Here we emit array variables. actually we first determine *
+ * the context in which the array access is found and then call *
+ * func_array_emit() to emit the array index. *
+ * 10/10/97 --Keith *
+ * *
+ *****************************************************************************/
+
+void
+array_emit(JVM_METHOD *meth, AST *root)
+{
+ AST *temp;
+ struct var_info *arrayinf;
+
+ if(gendebug)
+ printf ("Array... %s, My node type is %s\n", root->astnode.ident.name,
+ print_nodetype(root));
+
+ temp = root->astnode.ident.arraylist;
+
+ if((root->vartype == String) && temp && !temp->nextstmt &&
+ !type_lookup(cur_array_table, root->astnode.ident.name))
+ {
+ int c, charat_ref;
+
+ /* special handling for single dimension string array reference */
+
+ fprintf(curfp, "String.valueOf(");
+ arrayinf = push_array_var(meth, root);
+
+ fprintf(curfp, ".charAt((");
+
+ c = bc_new_methodref(cur_class_file, "java/lang/String",
+ "valueOf", "(C)Ljava/lang/String;");
+
+ expr_emit(meth, temp);
+ bc_append(meth, jvm_iconst_1);
+ bc_append(meth, jvm_isub);
+
+ charat_ref = bc_new_methodref(cur_class_file,JL_STRING,
+ "charAt", CHARAT_DESC);
+ bc_append(meth, jvm_invokevirtual, charat_ref);
+
+ bc_append(cur_method, jvm_invokestatic, c);
+
+ fprintf(curfp, ")-1))");
+
+ return;
+ }
+
+ arrayinf = push_array_var(meth, root);
+
+ if(root->parent == NULL) {
+
+ /* Under normal circumstances, I dont think this should
+ * be reached.
+ */
+
+ fprintf (stderr,"Array... %s, NO PARENT - ", arrayinf->name);
+ fprintf (stderr,"This is not good!\n");
+ } else {
+ if(gendebug)
+ printf ("Array... %s, Parent node type... %s\n",
+ arrayinf->name, print_nodetype(root->parent));
+
+ if((root->parent->nodetype == Call))
+ {
+ if(type_lookup(cur_external_table, root->parent->astnode.ident.name)
+ && !type_lookup(cur_args_table,root->parent->astnode.ident.name) )
+ {
+ func_array_emit(meth, temp, root->astnode.ident.name,
+ arrayinf->is_arg, TRUE);
+ }
+ else {
+ func_array_emit(meth, temp, root->astnode.ident.name,
+ arrayinf->is_arg, FALSE);
+ bc_gen_array_load_op(meth, jvm_data_types[root->vartype]);
+ }
+ }
+ else if(((root->parent->nodetype == Assignment) &&
+ (root->parent->astnode.assignment.lhs == root)) ||
+ (root->parent->nodetype == DataStmt) ||
+ (root->parent->nodetype == DataImpliedLoop))
+ {
+ func_array_emit(meth, temp, root->astnode.ident.name,
+ arrayinf->is_arg, FALSE);
+ }
+ else if((root->parent->nodetype == Typedec))
+ {
+ /* Just a declaration, don't emit index. */
+ if(gendebug)
+ printf("I guess this is just an array declaration\n");
+ }
+ else {
+ func_array_emit(meth, temp, root->astnode.ident.name,
+ arrayinf->is_arg, FALSE);
+ bc_gen_array_load_op(meth, jvm_data_types[root->vartype]);
+ }
+ }
+
+ free_var_info(arrayinf);
+}
+
+/*****************************************************************************
+ * *
+ * push_array_var *
+ * *
+ * this function pushes a reference to the array variable onto the stack. *
+ * *
+ *****************************************************************************/
+
+struct var_info *
+push_array_var(JVM_METHOD *meth, AST *root)
+{
+ struct var_info *ainf;
+
+ ainf = get_var_info(root);
+
+ /*
+ * Now, what needs to happen here is the context of the
+ * array needs to be determined. If the array is being
+ * passed as a parameter to a method, then the array index
+ * needs to be passed separately and the array passed as
+ * itself. If not, then an array value is being set,
+ * so dereference with index arithmetic.
+ */
+
+ /* for typedec, generate no bytecode */
+ if((root->parent != NULL) && (root->parent->nodetype == Typedec))
+ fprintf (curfp, "%s", ainf->name);
+ else {
+ char *com_prefix;
+
+ com_prefix = get_common_prefix(root->astnode.ident.name);
+
+ fprintf (curfp, "%s%s", com_prefix, ainf->name);
+ pushVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+
+ f2jfree(com_prefix, strlen(com_prefix)+1);
+ }
+
+ if(gendebug)
+ printf("push_array_var(%s) - '%s' -> %d\n", cur_filename,
+ root->astnode.ident.name, ainf->localvar);
+
+ return ainf;
+}
+
+/*****************************************************************************
+ * *
+ * get_var_info *
+ * *
+ * this function returns information about an identifier (name, desc, etc). *
+ * *
+ *****************************************************************************/
+
+struct var_info *
+get_var_info(AST *root)
+{
+ int is_arg;
+ unsigned int varnum=0;
+ char *com_prefix;
+ char *name, *tmpclass, *desc;
+ HASHNODE *ht;
+ struct var_info *new_array_inf;
+
+ new_array_inf = (struct var_info *)f2jalloc(sizeof(struct var_info));
+
+ /* find the descriptor & local var number (if applicable) for this var */
+
+ if((ht = type_lookup(cur_type_table, root->astnode.ident.name)) != NULL) {
+ desc = getVarDescriptor(ht->variable);
+ varnum = ht->variable->astnode.ident.localvnum;
+ }
+ else {
+ fprintf(stderr,"WARNING: get_var_info() '%s' not in hash table!\n",
+ root->astnode.ident.name);
+ desc = "asdfjkl";
+ }
+
+ /* If this is a COMMON variable, get the prefix for the common
+ * class name.
+ */
+
+ com_prefix = get_common_prefix(root->astnode.ident.name);
+ name = root->astnode.ident.name;
+
+ if(com_prefix[0] != '\0')
+ {
+ char *idx;
+
+ /* if this is a COMMON variable, find out the merged
+ * name, if any, that we should use instead. Names are
+ * merged when different declarations of a common
+ * block use different variable names.
+ */
+
+ ht = type_lookup(cur_type_table,root->astnode.ident.name);
+ if (ht == NULL)
+ fprintf(stderr,"get_var_info:Cant find %s in type_table\n",
+ root->astnode.ident.name);
+
+ if(ht->variable->astnode.ident.merged_name != NULL)
+ name = ht->variable->astnode.ident.merged_name;
+
+ tmpclass = strdup(com_prefix);
+ while( (idx = strchr(tmpclass, '.')) != NULL )
+ *idx = '/';
+ tmpclass[strlen(tmpclass)-1] = '\0';
+ }
+ else
+ tmpclass = strdup(cur_filename);
+
+ /* if this is an equivalenced variable, find out the merged
+ * name that we should use instead. Equivalenced names are
+ * always merged.
+ */
+
+ if((ht = type_lookup(cur_equiv_table,root->astnode.ident.name)) != NULL)
+ name = ht->variable->astnode.ident.merged_name;
+
+ if (name == NULL)
+ {
+ fprintf(stderr,"get_var_info: setting name to NULL!\n");
+ name = root->astnode.ident.name;
+ }
+
+ if(gendebug)
+ printf("### #in get_var_info, setting name = %s\n",name);
+
+ /* Determine whether this variable is an argument to the current
+ * program unit.
+ */
+
+ if( type_lookup(cur_args_table,root->astnode.ident.name) != NULL )
+ is_arg = TRUE;
+ else
+ is_arg = FALSE;
+
+ new_array_inf->name = strdup(name);
+ new_array_inf->desc = strdup(desc);
+ new_array_inf->localvar = varnum;
+ new_array_inf->is_arg = is_arg;
+ new_array_inf->class = strdup(tmpclass);
+
+ f2jfree(com_prefix, strlen(com_prefix)+1);
+ f2jfree(tmpclass, strlen(tmpclass)+1);
+ return new_array_inf;
+}
+
+/*****************************************************************************
+ * *
+ * get_common_prefix *
+ * *
+ * If the variable is in a common block, this function returns the name of *
+ * the class file in which it is declared. Otherwise, it returns a blank *
+ * string. *
+ * *
+ *****************************************************************************/
+
+
+char *
+get_common_prefix(char *varname)
+{
+ HASHNODE *ht;
+ char * inf = strdup(inputfilename);
+ char * prefix = strtok(inf,".");
+ static char * cprefix;
+ JVM_METHODREF *mtmp;
+ char * idx;
+
+ /* Look up this variable name in the table of COMMON variables */
+
+ ht = type_lookup(cur_common_table, varname);
+
+ if(gendebug)
+ printf("in get_common_prefix, name = '%s'\n",varname);
+
+ if(ht) {
+ if(gendebug)
+ printf("commonblockname = '%s'\n",
+ ht->variable->astnode.ident.commonBlockName);
+
+ if((mtmp = find_commonblock(ht->variable->astnode.ident.commonBlockName,
+ descriptor_table)) != NULL)
+ {
+ cprefix = (char *) f2jalloc( strlen(mtmp->classname) + 3);
+
+ sprintf(cprefix,"%s.", mtmp->classname);
+ }
+ else {
+ char * full_prefix = bc_get_full_classname(prefix, package_name);
+
+ cprefix = (char *) f2jalloc(
+ strlen(ht->variable->astnode.ident.commonBlockName) +
+ strlen(full_prefix) + 3);
+
+ sprintf(cprefix,"%s_%s.", full_prefix,
+ ht->variable->astnode.ident.commonBlockName);
+ }
+ }
+ else
+ cprefix = strdup(""); /* dup so we can free() later */
+
+ /* convert fully-qualified class name to dotted notation */
+ while( (idx = strchr(cprefix, '/')) != NULL )
+ *idx = '.';
+
+ if(gendebug)
+ if(cprefix && strlen(cprefix) > 0)
+ printf("get_common_prefix returning '%s'\n", cprefix);
+
+ f2jfree(inf, strlen(inf)+1);
+ return(cprefix);
+}
+
+/*****************************************************************************
+ * *
+ * getVarDescriptor *
+ * *
+ * Returns the descriptor for this variable. *
+ * *
+ *****************************************************************************/
+
+char *
+getVarDescriptor(AST *root)
+{
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name))
+ return field_descriptor[root->vartype][(root->astnode.ident.dim > 0)];
+ else
+ return wrapped_field_descriptor[root->vartype]
+ [(root->astnode.ident.dim > 0)];
+}
+
+/*****************************************************************************
+ * *
+ * pushConst *
+ * *
+ * this function pushes the constant value pointed to by root onto the *
+ * jvm stack. *
+ * *
+ *****************************************************************************/
+
+void
+pushConst(JVM_METHOD *meth, AST *root) {
+ switch(root->token) {
+ case INTEGER:
+ bc_push_int_const(meth, atoi(root->astnode.constant.number));
+ break;
+ case E_EXPONENTIAL:
+ case FLOAT:
+ bc_push_float_const(meth, atof(root->astnode.constant.number));
+ break;
+ case D_EXPONENTIAL:
+ case DOUBLE:
+ bc_push_double_const(meth, atof(root->astnode.constant.number));
+ break;
+ case TrUE: /* dont expect to find booleans anyway, so dont try */
+ bc_append(meth, jvm_iconst_1);
+ break;
+ case FaLSE:
+ bc_append(meth, jvm_iconst_0);
+ break;
+ case STRING:
+ bc_push_string_const(meth, root->astnode.constant.number);
+ break;
+ default:
+ break;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * scalar_emit *
+ * *
+ * This function emits a scalar variable. The first thing that needs *
+ * to be checked here is whether the variable is part of a common block. *
+ * If so, we need to emit the common block name followed by a dot and *
+ * the variable name. Otherwise, just emit the variable name. If using *
+ * object wrappers, the nodetype of the parent node must be checked. If the *
+ * parent node is a 'call' to an external function then the variables must *
+ * be passed as objects. Otherwise, the value from the wrapper should be *
+ * obtained by appending .val to the variable name. 10/10/97 -- Keith *
+ * *
+ * (note: this function also emits array variables which do not have *
+ * indices since they look like scalars to the parser) *
+ * *
+ *****************************************************************************/
+
+void
+scalar_emit(JVM_METHOD *meth, AST *root, HASHNODE *hashtemp)
+{
+ char *com_prefix, *desc, *name, *scalar_class;
+ HASHNODE *ht, *isArg, *typenode;
+
+ /* determine descriptor */
+ if((typenode = type_lookup(cur_type_table,root->astnode.ident.name))!=NULL)
+ desc = getVarDescriptor(typenode->variable);
+ else {
+ fprintf(stderr,"ERROR: can't find '%s' in hash table\n",
+ root->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ if(gendebug)
+ printf("in scalar_emit, name = %s, desc = %s\n",
+ root->astnode.ident.name, desc);
+
+ /* get the name of the common block class file, if applicable */
+
+ com_prefix = get_common_prefix(root->astnode.ident.name);
+
+ name = root->astnode.ident.name;
+
+ isArg = type_lookup(cur_args_table,name);
+
+ if(com_prefix[0] != '\0')
+ {
+ char *idx;
+
+ /* if this is a COMMON variable, find out the merged
+ * name, if any, that we should use instead. Names are
+ * merged when different declarations of a common
+ * block use different variable names.
+ */
+
+ ht = type_lookup(cur_type_table,root->astnode.ident.name);
+ if (ht == NULL)
+ fprintf(stderr,"scalar_emit:Cant find %s in type_table\n",
+ root->astnode.ident.name);
+ else if(ht->variable->astnode.ident.merged_name != NULL)
+ name = ht->variable->astnode.ident.merged_name;
+
+ scalar_class = strdup(com_prefix);
+ while( (idx = strchr(scalar_class, '.')) != NULL )
+ *idx = '/';
+ scalar_class[strlen(scalar_class)-1] = '\0';
+ }
+ else
+ scalar_class = strdup(cur_filename);
+
+ if(gendebug)
+ printf("scalar_emit: scalar_class is '%s'\n",scalar_class);
+
+ /* if this is an equivalenced variable, find out the merged
+ * name that we should use instead. Equivalenced names are
+ * always merged.
+ */
+
+ if((ht = type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL) {
+ name = ht->variable->astnode.ident.merged_name;
+
+ if(gendebug)
+ printf("%s -> %s\n",root->astnode.ident.name,name);
+ }
+
+ if (name == NULL)
+ {
+ fprintf(stderr,"scalar_emit: name was NULL!\n");
+ name = root->astnode.ident.name;
+ }
+
+ if(hashtemp == NULL) {
+ /* if hashtemp is NULL, then this variable is not in the
+ * array table (i.e. it is not an array).
+ */
+
+ if(gendebug) {
+ printf("here we are emitting a scalar: %s, len = %d, ",
+ root->astnode.ident.name, root->astnode.ident.len);
+ printf("The parent node is : %s\n",print_nodetype(root->parent));
+ }
+
+ if(gendebug)
+ printf("### #in scalar_emit, setting name = %s\n",name);
+
+ if(root->parent == NULL) {
+ /* not good. */
+ fprintf(stderr,"scalar_emit(): NO PARENT! (%s)\n", name);
+ } else {
+ if (root->parent->nodetype == Call) {
+ JVM_METHODREF *user_method;
+ char *tempname;
+
+ if(gendebug)
+ printf("in scalar_emit CALL, '%s' <- '%s'\n",
+ root->parent->astnode.ident.name,
+ name);
+
+ user_method = find_method(root->parent->astnode.ident.name, descriptor_table);
+
+ tempname = strdup(root->parent->astnode.ident.name);
+ uppercase(tempname);
+
+ /* Determine whether the parent (a call) is an intrinsic or an
+ * array access. If neither, we pass the scalar as is - wrapped
+ * in an object if necessary. This provides the ability to simulate
+ * pass by reference in Java. If the parent is either an intrinsic
+ * function call or an array access, we must pass the actual value.
+ * Fortran intrinsics are implemented using functions from the core
+ * Java API which only take primitive types as arguments. And arrays
+ * must always be indexed using primitive integers. Therefore, in
+ * those two cases, we must emit the primitive value, in some cases
+ * obtained by appending ".val" to the wrapper object.
+ */
+
+ if(((methodscan(intrinsic_toks, tempname) == NULL) || user_method) &&
+ (type_lookup(cur_array_table,
+ root->parent->astnode.ident.name) == NULL))
+ {
+ /* parent is not a call to an intrinsic and not an array access */
+
+ if(gendebug)
+ printf("did not find %s in intrinsics table\n",
+ root->parent->astnode.ident.name);
+
+ fprintf (curfp, "%s%s", com_prefix, name);
+
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ else
+ {
+ if(gendebug)
+ printf("found %s in intrinsics or array table\n",
+ root->parent->astnode.ident.name);
+
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) {
+ fprintf (curfp, "%s%s", com_prefix,name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ else {
+ fprintf (curfp, "%s%s.val", com_prefix,name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, TRUE);
+ }
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+ }
+ else if(root->parent->nodetype == Typedec) {
+
+ /* Parent is a type declaration - just emit the name itself.
+ *
+ * For bytecode generation, nothing needs to be done here
+ * because insert_fields() handles all typedecs.
+ */
+
+ if(gendebug)
+ printf("Emitting typedec name: %s\n", name);
+ fprintf (curfp, "%s", name);
+ }
+ else if(root->parent->nodetype == Equivalence) {
+
+ /* Parent is an EQUIVALENCE statement. This is handled the
+ * same as a type declaration, except we emit the merged name.
+ *
+ * Nothing needs to be done here for bytecode generation.
+ */
+
+ if(gendebug)
+ printf("Emitting equivalenced name: %s\n",
+ root->astnode.ident.merged_name);
+ fprintf (curfp, "%s", root->astnode.ident.merged_name);
+ }
+ else if(root->parent->nodetype == ArrayDec) {
+
+ /* Parent is an array declaration, but we know that the
+ * variable we're emitting is not an array, so this must
+ * be the size of the array.
+ *
+ * Nothing needs to be done here for bytecode generation.
+ */
+
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name))
+ fprintf (curfp, "%s%s", com_prefix, name);
+ else
+ fprintf (curfp, "%s%s.val", com_prefix, name);
+ }
+ else if(((root->parent->nodetype == Assignment) ||
+ (root->parent->nodetype == StmtLabelAssign))
+ && (root->parent->astnode.assignment.lhs == root)) {
+ /* this is the LHS of some assignment. this is only an
+ * issue for bytecode generation since we don't want to
+ * generate a load instruction for the LHS of an assignment.
+ * for Java source, generate as usual.
+ */
+
+ if((global_sub.name != NULL) &&
+ !strcmp(global_sub.name, name))
+ fprintf (curfp, " %d ", global_sub.val);
+ else {
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name))
+ fprintf (curfp, "%s%s", com_prefix, name);
+ else {
+ fprintf (curfp, "%s%s.val", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ }
+ }
+ else {
+
+ /* General case - just generate the name, with the
+ * .val suffix if applicable. the global_sub stuff is
+ * for implied DO loops in data statements. in that
+ * case, we dont want to actually emit a variable name,
+ * so we substitute its corresponding number.
+ */
+
+ if((global_sub.name != NULL) &&
+ !strcmp(global_sub.name, name))
+ {
+ fprintf (curfp, " %d ", global_sub.val);
+
+ bc_push_int_const(meth, global_sub.val);
+ }
+ else {
+ if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) {
+ fprintf (curfp, "%s%s", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ else {
+ fprintf (curfp, "%s%s.val", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, TRUE);
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ /*
+ * if we reach this case, we are emitting an array, but there
+ * is no index specified. Normally, we would just emit the variable
+ * name, but we must also check the parent nodetype. If it is a
+ * call to an external function, then we have to emit the variable
+ * name followed by ",0" to signify that the offset into this array
+ * is 0. 10/10/97 --Keith
+ */
+
+ if(root->parent == NULL)
+ {
+ fprintf(stderr,"scalar_emit(): NO PARENT!\n");
+ }
+ else
+ {
+ if(gendebug) {
+ printf("here we are emitting a scalar: %s,",name);
+ printf("The parent node is : %s\n",print_nodetype(root->parent));
+ }
+
+ if(root->parent->nodetype == Call)
+ {
+ if(type_lookup(cur_args_table, root->parent->astnode.ident.name) &&
+ !type_lookup(cur_type_table, root->parent->astnode.ident.name)) {
+ /* if the parent is a subroutine passed as an arg to this function,
+ * then we do not append the offset.
+ */
+ fprintf (curfp, "%s%s", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ else if(type_lookup(cur_args_table,root->astnode.ident.name)) {
+ fprintf (curfp, "%s%s,_%s_offset", com_prefix, name, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ bc_gen_load_op(meth, typenode->variable->astnode.ident.localvnum+1, jvm_Int);
+ }
+ else {
+ fprintf (curfp, "%s%s,0", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ bc_append(meth, jvm_iconst_0);
+ }
+ }
+ else if(root->parent->nodetype == Write) {
+ if(type_lookup(cur_args_table,root->astnode.ident.name)) {
+ fprintf (curfp, "%s%s,_%s_offset", com_prefix, name, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ bc_gen_load_op(meth, typenode->variable->astnode.ident.localvnum+1, jvm_Int);
+ }
+ else {
+ fprintf (curfp, "%s%s,0", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ bc_append(meth, jvm_iconst_0);
+ }
+ }
+ else if(((root->parent->nodetype == Assignment) ||
+ (root->parent->nodetype == StmtLabelAssign))
+ && (root->parent->astnode.assignment.lhs == root)) {
+ /* LHS of assignment. do not generate any bytecode. */
+ fprintf (curfp, "%s%s", com_prefix, name);
+ }
+ else {
+ fprintf (curfp, "%s%s", com_prefix, name);
+ pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc,
+ typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ }
+ }
+
+ f2jfree(scalar_class, strlen(scalar_class)+1);
+ f2jfree(com_prefix, strlen(com_prefix)+1);
+}
+
+/*****************************************************************************
+ * *
+ * external_emit *
+ * *
+ * This function translates calls to external functions. First, *
+ * check whether we are translating a call to ETIME or SECOND. *
+ * We have implemented java versions of these pseduo intrinsics. *
+ * If we're not translating a call to ETIME or SECOND, use the *
+ * function call_emit(). --Keith *
+ * *
+ *****************************************************************************/
+
+void
+external_emit(JVM_METHOD *meth, AST *root)
+{
+ char *tempname, *javaname;
+ METHODTAB *entry;
+ AST *temp;
+ int c;
+
+ if(gendebug) {
+ printf("here we are in external_emit (%s)\n", root->astnode.ident.name);
+ printf("nodetype = %s, parent nodetype = %s\n",
+ print_nodetype(root),print_nodetype(root->parent));
+ }
+
+ /*
+ * If we encounter this external variable within a
+ * function/subroutine call, but the name itself is not
+ * being used as a call, then we know that the function
+ * is being passed as a parameter.
+ */
+
+ if( (root->parent->nodetype == Call) &&
+ (root->astnode.ident.arraylist == NULL))
+ {
+ HASHNODE *ht;
+
+ if(gendebug)
+ printf("unit %s: EXTERNAL has parent CALL\n", unit_name);
+
+ tempname = strdup(root->astnode.ident.name);
+ *tempname = toupper(*tempname);
+
+ /* if this external function is also an argument to the
+ * current unit, we already have an Object reference to
+ * it, so just pass that. If not, we create a new
+ * instance of whatever class we want to pass.
+ */
+
+ if(type_lookup(cur_args_table,root->astnode.ident.name)) {
+
+ ht=type_lookup(cur_type_table,root->astnode.ident.name);
+
+ if(ht)
+ bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object);
+ else
+ bc_gen_load_op(meth, 0, jvm_Object);
+
+ fprintf(curfp,"%s", root->astnode.ident.name);
+ }
+ else {
+ int c;
+ char *fc;
+
+ fprintf(curfp," new %s() ",tempname);
+
+ fc = bc_get_full_classname(tempname, package_name);
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class, fc);
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,fc, "<init>", "()V");
+ bc_append(meth, jvm_invokespecial, c);
+ }
+
+ return;
+ }
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ entry = methodscan (intrinsic_toks, tempname);
+
+ /*
+ * This block of code is only called if the identifier
+ * absolutely does not have an entry in any table,
+ * and corresponds to a method invocation of
+ * something in the blas or lapack packages.
+ */
+
+ if (entry == NULL)
+ {
+ if (root->astnode.ident.arraylist != NULL)
+ call_emit (meth, root);
+ f2jfree(tempname, strlen(tempname)+1);
+ return;
+ }
+
+ javaname = entry->java_method;
+
+ if(gendebug)
+ {
+ printf("javaname = %s\n",javaname);
+ printf("args = %p\n", (void*)root->astnode.ident.arraylist);
+ }
+
+ /* Ensure that the call has arguments */
+
+ if (root->astnode.ident.arraylist != NULL)
+ {
+ temp = root->astnode.ident.arraylist;
+
+ if(!strcmp(tempname, "ETIME")) {
+ /* first, make sure there are enough args to work with */
+ if(temp == NULL) {
+ fprintf(stderr,"No args to ETIME\n");
+ f2jfree(tempname, strlen(tempname)+1);
+ return;
+ }
+
+ if(gendebug)
+ printf("emitting ETIME...\n");
+
+ fprintf (curfp, "Etime.etime(");
+ expr_emit(meth, temp);
+ fprintf (curfp, ")");
+
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+ }
+ else if(!strcmp(tempname, "SECOND")) {
+ if(gendebug)
+ printf("emitting SECOND...\n");
+
+ fprintf(curfp, "Second.second()");
+
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+ }
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+}
+
+/*****************************************************************************
+ * *
+ * intrinsic_emit *
+ * *
+ * This function generates calls to intrinsic functions. Basically we just *
+ * map fortran intrinsics to equivalent functions in the core Java API. *
+ * It might be a good idea to write separate handlers for each intrinsic. *
+ * Many intrinsics can be handled with a generic handler, so we could have *
+ * a generic one-argument handler, a generic two-argument handler, etc. *
+ * Intrinsics that need more specialized handling, such as LOG10, would need *
+ * their own handler. Because of the need for specialized handlers, the *
+ * commented-out loop below may not ever really work. *
+ * (6/2000 removed loop - kgs). *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic_emit(JVM_METHOD *meth, AST *root)
+{
+ AST *temp;
+ HASHNODE *ht;
+ int c;
+ METHODTAB *entry;
+ char *tempname, *javaname;
+ enum _intrinsics id;
+
+ if(gendebug)
+ printf("entering intrinsic_emit\n");
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ entry = methodscan (intrinsic_toks, tempname);
+
+ if(!entry) {
+ fprintf(stderr,"Error: not expecting null entry at this point.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ /* if strict floating-point is enabled and the intrinsic has a
+ * strict version, then use it for generating the call.
+ */
+
+ if(strictMath && entry->strict_java_method)
+ javaname = entry->strict_java_method;
+ else
+ javaname = entry->java_method;
+
+ id = entry->intrinsic;
+
+ switch(id) {
+ /* numeric type conversion intrinsics. */
+ case ifunc_INT:
+ case ifunc_IFIX:
+ case ifunc_IDINT:
+ case ifunc_REAL:
+ case ifunc_FLOAT:
+ case ifunc_SNGL:
+ case ifunc_DBLE:
+ case ifunc_CMPLX:
+ temp = root->astnode.ident.arraylist;
+
+ /* for Java source, we just emit a cast. */
+ fprintf (curfp, "%s(", javaname);
+ expr_emit (meth, temp);
+ fprintf (curfp, ")");
+
+ /* for bytecode, we emit the appropriate conversion opcode. */
+ if(temp->vartype != root->vartype)
+ bc_append(meth, typeconv_matrix[temp->vartype][root->vartype]);
+
+ break;
+
+ /* conversion to integer */
+ case ifunc_ICHAR:
+ temp = root->astnode.ident.arraylist;
+ fprintf (curfp, "%s(", javaname);
+ expr_emit (meth, temp);
+ fprintf (curfp, ".charAt(0))");
+
+ bc_append(meth, jvm_iconst_0);
+ c = bc_new_methodref(cur_class_file,JL_STRING,
+ "charAt", CHARAT_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ break;
+
+ /* conversion to character */
+ case ifunc_CHAR:
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ JL_CHAR);
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ temp = root->astnode.ident.arraylist;
+ fprintf (curfp, "new Character( %s(", javaname);
+ expr_emit (meth, temp);
+ fprintf (curfp, ") ).toString()");
+
+ c = bc_new_methodref(cur_class_file,JL_CHAR,
+ "<init>", "(C)V");
+ bc_append(meth, jvm_invokespecial, c);
+ c = bc_new_methodref(cur_class_file, JL_CHAR, "toString",
+ TOSTRING_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ break;
+
+ /* truncation */
+ case ifunc_AINT:
+ case ifunc_DINT:
+ if((root->astnode.ident.arraylist->vartype == Float) &&
+ (id==ifunc_AINT))
+ aint_intrinsic_emit(meth, root, entry);
+ else
+ dint_intrinsic_emit(meth, root, entry);
+ break;
+
+ /* nearest whole number */
+ case ifunc_ANINT:
+ case ifunc_DNINT:
+ if(root->astnode.ident.arraylist->vartype == Double) {
+ entry = &intrinsic_toks[ifunc_DNINT];
+
+ if(strictMath && entry->strict_java_method)
+ javaname = entry->strict_java_method;
+ else
+ javaname = entry->java_method;
+
+ fprintf (curfp, "(double)%s(", javaname);
+ }
+ else
+ fprintf (curfp, "(float)%s(", javaname);
+
+ expr_emit (meth, root->astnode.ident.arraylist);
+ fprintf (curfp, ")");
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file, entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(root->astnode.ident.arraylist->vartype == Double)
+ bc_append(meth, jvm_i2d);
+ else
+ bc_append(meth, jvm_i2f);
+
+ break;
+
+ /* nearest integer */
+ case ifunc_NINT:
+ case ifunc_IDNINT:
+ if(root->astnode.ident.arraylist->vartype == Double)
+ entry = &intrinsic_toks[ifunc_IDNINT];
+
+ if(strictMath && entry->strict_java_method)
+ javaname = entry->strict_java_method;
+ else
+ javaname = entry->java_method;
+
+ fprintf (curfp, "%s(", javaname);
+ expr_emit (meth, root->astnode.ident.arraylist);
+ fprintf (curfp, ")");
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file, entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ break;
+
+ /* absolute value */
+ case ifunc_ABS:
+ if(root->astnode.ident.arraylist->vartype == Integer)
+ entry = &intrinsic_toks[ifunc_IABS];
+ else if(root->astnode.ident.arraylist->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DABS];
+ else if(root->astnode.ident.arraylist->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CABS];
+ case ifunc_DABS:
+ case ifunc_IABS:
+ case ifunc_CABS:
+ if(strictMath && entry->strict_java_method)
+ javaname = entry->strict_java_method;
+ else
+ javaname = entry->java_method;
+
+ temp = root->astnode.ident.arraylist;
+
+ fprintf (curfp, "%s(", javaname);
+ expr_emit (meth, temp);
+ fprintf (curfp, ")");
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file, entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+ break;
+
+ /* remainder */
+ case ifunc_MOD:
+ case ifunc_AMOD:
+ case ifunc_DMOD:
+ temp = root->astnode.ident.arraylist;
+ fprintf(curfp,"(");
+ expr_emit (meth, temp);
+ fprintf(curfp,")%%(");
+
+ if(temp->vartype > root->vartype)
+ bc_append(meth,
+ typeconv_matrix[temp->vartype][root->vartype]);
+
+ expr_emit (meth, temp->nextstmt);
+ fprintf(curfp,")");
+
+ if(temp->nextstmt->vartype > root->vartype)
+ bc_append(meth,
+ typeconv_matrix[temp->nextstmt->vartype][root->vartype]);
+
+ if(root->vartype == Float)
+ bc_append(meth, jvm_frem);
+ else if(root->vartype == Integer)
+ bc_append(meth, jvm_irem);
+ else
+ bc_append(meth, jvm_drem);
+
+ break;
+
+ /* transfer of sign */
+ case ifunc_SIGN:
+ if(root->vartype == Integer)
+ entry = &intrinsic_toks[ifunc_ISIGN];
+ else if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DSIGN];
+ case ifunc_ISIGN:
+ case ifunc_DSIGN:
+ intrinsic2_call_emit(meth, root,entry, root->vartype);
+ break;
+
+ /* positive difference */
+ case ifunc_DIM:
+ if(root->vartype == Integer)
+ entry = &intrinsic_toks[ifunc_IDIM];
+ else if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DDIM];
+ case ifunc_IDIM:
+ case ifunc_DDIM:
+ intrinsic2_call_emit(meth, root,entry, root->vartype);
+ break;
+
+ /* double precision product of two reals */
+ case ifunc_DPROD:
+ temp = root->astnode.ident.arraylist;
+
+ fprintf(curfp, "((double)(");
+ expr_emit (meth, temp);
+ bc_append(meth, jvm_f2d);
+ fprintf(curfp, ") * (double)(");
+ expr_emit (meth, temp->nextstmt);
+ bc_append(meth, jvm_f2d);
+ fprintf(curfp, "))");
+ bc_append(meth, jvm_dmul);
+ break;
+
+ /* real AMAX0(integer) */
+ case ifunc_AMAX0:
+ max_intrinsic_emit(meth, root, entry);
+ break;
+
+ /* integer MAX1(real) */
+ case ifunc_MAX1:
+ fprintf(curfp,"(int)(");
+ max_intrinsic_emit(meth, root, entry);
+ fprintf(curfp,")");
+ bc_append(meth, typeconv_matrix[Float][Integer]);
+ break;
+
+ /* generic maximum or MAX that returns same type as args */
+ case ifunc_MAX:
+ case ifunc_MAX0:
+ case ifunc_AMAX1:
+ case ifunc_DMAX1:
+ max_intrinsic_emit(meth, root, entry);
+ break;
+
+ /* real AMIN0(integer) */
+ case ifunc_AMIN0:
+ min_intrinsic_emit(meth, root, entry);
+ break;
+
+ /* integer MIN1(real) */
+ case ifunc_MIN1:
+ fprintf(curfp,"(int)(");
+ min_intrinsic_emit(meth, root, entry);
+ fprintf(curfp,")");
+ bc_append(meth, typeconv_matrix[Float][Integer]);
+ break;
+
+ /* generic minimum or MIN that returns same type as args */
+ case ifunc_MIN:
+ case ifunc_MIN0:
+ case ifunc_AMIN1:
+ case ifunc_DMIN1:
+ min_intrinsic_emit(meth, root, entry);
+ break;
+
+ /* length of a character entity */
+ case ifunc_LEN:
+ temp = root->astnode.ident.arraylist;
+
+ /* the handling of the LEN intrinsic here is really a hack..
+ * LEN(x) should return the declared length of x, but if x
+ * was passed in as an argument, we may not know the declared
+ * length of x at compile-time. In this case, we just use
+ * the length() method at run-time. That's pretty bad, but
+ * the alternative is to create some sort of fortran string
+ * class that keeps track of the declared length - definitely
+ * a hassle to implement and also makes the API nastier by
+ * not allowing the user to pass String constants.. -keith
+ */
+
+ if(temp != NULL) {
+ if( (ht=type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL)
+ {
+ if(ht->variable->astnode.ident.len > 0) {
+ fprintf (curfp, " %d ", ht->variable->astnode.ident.len);
+
+ bc_push_int_const(meth, ht->variable->astnode.ident.len);
+
+ if(gendebug)
+ printf("LEN(%s) = %d\n",temp->astnode.ident.name,
+ ht->variable->astnode.ident.len);
+ }
+ else {
+ int c;
+
+ expr_emit(meth, temp);
+ fprintf(curfp,".length()");
+
+ c = bc_new_methodref(cur_class_file,JL_STRING,
+ "length", STRLEN_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ }
+ else
+ {
+ fprintf (curfp, " 1 ");
+
+ bc_append(meth, jvm_iconst_1);
+
+ if(gendebug)
+ printf("LEN(%s) = 1\n",temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ /* Index of substring */
+ case ifunc_INDEX:
+ case ifunc_AIMAG:
+ case ifunc_CONJG:
+ /* Unimplemented!
+ *
+ * INDEX returns the location of a substring within another
+ * string. however fortran and java treat strings quite differently
+ * so implementing INDEX properly isn't as straightforward as it seems
+ * at first. at this point, it's not that important, so I'll leave
+ * it for later. --kgs 6/14/00
+ *
+ * AIMAG and CONJG operate on complex numbers, which are not yet
+ * supported.
+ */
+ fprintf(stderr,"WARNING: intrinsic %s not yet implemented!\n",
+ entry->fortran_name);
+ break;
+
+ /* square root */
+ case ifunc_SQRT:
+ /* the java sqrt only supports double, so use that entry for
+ * either double or float .
+ */
+ if((root->vartype == Double) || (root->vartype == Float))
+ entry = &intrinsic_toks[ifunc_DSQRT];
+ else if(root->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CSQRT];
+ case ifunc_DSQRT:
+ case ifunc_CSQRT:
+ intrinsic_call_emit(meth, root,entry,Double);
+ break;
+
+ /* exponential */
+ case ifunc_EXP:
+ /* the java exp only supports double, so use that entry for
+ * either double or float .
+ */
+ if((root->vartype == Double) || (root->vartype == Float))
+ entry = &intrinsic_toks[ifunc_DEXP];
+ else if(root->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CEXP];
+ case ifunc_DEXP:
+ case ifunc_CEXP:
+ intrinsic_call_emit(meth, root,entry,Double);
+ break;
+
+ /* natural logarithm */
+ case ifunc_LOG:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DLOG];
+ else if(root->vartype == Float)
+ entry = &intrinsic_toks[ifunc_ALOG];
+ else if(root->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CLOG];
+ case ifunc_ALOG:
+ case ifunc_DLOG:
+ case ifunc_CLOG:
+ intrinsic_call_emit(meth, root,entry,Double);
+ break;
+
+ /* common logarithm */
+ case ifunc_LOG10:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DLOG10];
+ else if(root->vartype == Float)
+ entry = &intrinsic_toks[ifunc_ALOG10];
+ case ifunc_ALOG10:
+ case ifunc_DLOG10:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* sine */
+ case ifunc_SIN:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DSIN];
+ else if(root->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CSIN];
+ case ifunc_DSIN:
+ case ifunc_CSIN:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* cosine */
+ case ifunc_COS:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DCOS];
+ else if(root->vartype == Complex)
+ entry = &intrinsic_toks[ifunc_CCOS];
+ case ifunc_DCOS:
+ case ifunc_CCOS:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* tangent */
+ case ifunc_TAN:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DTAN];
+ case ifunc_DTAN:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* arcsine */
+ case ifunc_ASIN:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DASIN];
+ case ifunc_DASIN:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* arccosine */
+ case ifunc_ACOS:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DACOS];
+ case ifunc_DACOS:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* arctangent */
+ case ifunc_ATAN:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DATAN];
+ case ifunc_DATAN:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* arctangent (2 arg) */
+ case ifunc_ATAN2:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DATAN2];
+ case ifunc_DATAN2:
+ intrinsic2_call_emit(meth, root, entry, Double);
+ break;
+
+ /* Hyperbolic sine */
+ case ifunc_SINH:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DSINH];
+ case ifunc_DSINH:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* Hyperbolic cosine */
+ case ifunc_COSH:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DCOSH];
+ case ifunc_DCOSH:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ /* Hyperbolic tangent */
+ case ifunc_TANH:
+ if(root->vartype == Double)
+ entry = &intrinsic_toks[ifunc_DTANH];
+ case ifunc_DTANH:
+ intrinsic_call_emit(meth, root, entry, Double);
+ break;
+
+ case ifunc_LGE: /* lexically greater than/equal */
+ case ifunc_LGT: /* lexically greater than */
+ case ifunc_LLE: /* lexically less than/equal */
+ case ifunc_LLT: /* lexically less than */
+ intrinsic_lexical_compare_emit(meth, root, entry);
+ break;
+
+ default:
+ fprintf(stderr,"WARNING: codegen() unimplemented intrinsic: '%s'\n",
+ tempname);
+ break; /* ansi c */
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+
+ if(gendebug)
+ printf("leaving intrinsic_emit\n");
+}
+
+
+/*****************************************************************************
+ * *
+ * intrinsic_lexical_compare_emit *
+ * *
+ * generates code for LGE, LGT, LLE, adn LLT intrinsics. these intrinsics *
+ * perform lexical comparison of strings. *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic_lexical_compare_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry)
+{
+ JVM_CODE_GRAPH_NODE *goto_node, *if_node = NULL;
+ AST *temp;
+ int c;
+
+ temp = root->astnode.ident.arraylist;
+ fprintf(curfp,"((");
+ expr_emit(meth, temp);
+ fprintf(curfp,").compareTo(");
+ expr_emit(meth, temp->nextstmt);
+
+ c = bc_new_methodref(cur_class_file, JL_STRING, "compareTo", COMPARE_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ if(entry->intrinsic == ifunc_LGE) {
+ fprintf(curfp,") >= 0 ? true : false)");
+ if_node = bc_append(meth, jvm_ifge);
+ }
+ else if(entry->intrinsic == ifunc_LGT) {
+ fprintf(curfp,") > 0 ? true : false)");
+ if_node = bc_append(meth, jvm_ifgt);
+ }
+ else if(entry->intrinsic == ifunc_LLE) {
+ fprintf(curfp,") <= 0 ? true : false)");
+ if_node = bc_append(meth, jvm_ifle);
+ }
+ else if(entry->intrinsic == ifunc_LLT) {
+ fprintf(curfp,") < 0 ? true : false)");
+ if_node = bc_append(meth, jvm_iflt);
+ }
+ else
+ fprintf(stderr,"intrinsic_lexical_compare_emit(): bad tag!\n");
+
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_branch_target(if_node, bc_append(meth, jvm_iconst_1));
+
+ /* create a dummy instruction node following the stmts so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ bc_set_branch_target(goto_node, bc_append(meth, jvm_xxxunusedxxx));
+}
+
+
+/*****************************************************************************
+ * *
+ * intrinsic0_call_emit *
+ * *
+ * generates a call to an intrinsic which has no args. *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic0_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry)
+{
+ int c;
+
+ if(entry->ret != root->vartype)
+ fprintf(curfp, "(%s)", returnstring[root->vartype]);
+
+ if(strictMath && entry->strict_java_method)
+ fprintf (curfp, "%s()", entry->strict_java_method);
+ else
+ fprintf (curfp, "%s()", entry->java_method);
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file, entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(entry->ret != root->vartype)
+ bc_append(meth, typeconv_matrix[entry->ret][root->vartype]);
+}
+
+/*****************************************************************************
+ * *
+ * intrinsic_call_emit *
+ * *
+ * generates a call to a single-arg intrinsic. *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry,
+ enum returntype argtype)
+{
+ int c;
+
+ /* entry->ret should represent the return type of the equivalent JAva
+ * function, while root->vartype should represent the return type of
+ * the fortran intrinsic. e.g. fortan's EXP may return Real but JAva's
+ * Math.exp() always returns double. in these cases we must cast.
+ */
+ if(entry->ret != root->vartype)
+ fprintf(curfp, "(%s)", returnstring[root->vartype]);
+
+ if(strictMath && entry->strict_java_method)
+ fprintf (curfp, "%s(", entry->strict_java_method);
+ else
+ fprintf (curfp, "%s(", entry->java_method);
+
+ intrinsic_arg_emit(meth, root->astnode.ident.arraylist, argtype);
+ fprintf (curfp, ")");
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file,entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file,entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(entry->ret != root->vartype)
+ bc_append(meth, typeconv_matrix[entry->ret][root->vartype]);
+}
+
+/*****************************************************************************
+ * *
+ * intrinsic2_call_emit *
+ * *
+ * generates a call to a two-arg intrinsic. *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic2_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry,
+ enum returntype argtype)
+{
+ AST * temp = root->astnode.ident.arraylist;
+ int c;
+
+ /* entry->ret should represent the return type of the equivalent JAva
+ * function, while root->vartype should represent the return type of
+ * the fortran intrinsic. e.g. fortan's EXP may return Real but JAva's
+ * Math.exp() always returns double. in these cases we must cast.
+ */
+
+ if(entry->ret != root->vartype)
+ fprintf(curfp, "(%s)", returnstring[root->vartype]);
+
+ if(strictMath && entry->strict_java_method)
+ fprintf (curfp, "%s(", entry->strict_java_method);
+ else
+ fprintf (curfp, "%s(", entry->java_method);
+ intrinsic_arg_emit (meth, temp, argtype);
+ fprintf (curfp, ",");
+ intrinsic_arg_emit (meth, temp->nextstmt, argtype);
+ fprintf (curfp, ")");
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file, entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file, entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(entry->ret != root->vartype)
+ bc_append(meth, typeconv_matrix[entry->ret][root->vartype]);
+}
+
+/*****************************************************************************
+ * *
+ * aint_intrinsic_emit *
+ * *
+ * this function handles calls to the AINT intrinsic function. AINT returns *
+ * the floor of a single precision floating point number. *
+ * *
+ *****************************************************************************/
+
+void
+aint_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB * entry)
+{
+ if(strictMath && entry->strict_java_method)
+ fprintf(curfp,"(float)(%s(",entry->strict_java_method);
+ else
+ fprintf(curfp,"(float)(%s(",entry->java_method);
+
+ expr_emit(meth, root->astnode.ident.arraylist);
+
+ fprintf(curfp,"))");
+
+ /* convert to integer to truncate, then back to float */
+ bc_append(meth, jvm_f2i);
+ bc_append(meth, jvm_i2f);
+}
+
+/*****************************************************************************
+ * *
+ * dint_intrinsic_emit *
+ * *
+ * this function handles calls to the DINT intrinsic function. DINT returns *
+ * the floor of a double precision floating point number. *
+ * *
+ *****************************************************************************/
+
+void
+dint_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry)
+{
+ if(strictMath && entry->strict_java_method)
+ fprintf(curfp,"(double)(%s(",entry->strict_java_method);
+ else
+ fprintf(curfp,"(double)(%s(",entry->java_method);
+ expr_emit(meth, root->astnode.ident.arraylist);
+ fprintf(curfp,"))");
+
+ /* convert to integer to truncate, then back to double */
+ bc_append(meth, jvm_d2i);
+ bc_append(meth, jvm_i2d);
+}
+
+/*****************************************************************************
+ * *
+ * intrinsic_arg_emit *
+ * *
+ * this function emits the arg to an intrinsic function, making type casts *
+ * as necessary. *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic_arg_emit(JVM_METHOD *meth, AST *node, enum returntype this_type)
+{
+
+ if(gendebug){
+ printf("intrinsic_arg_emit, node type = %s, this type = %s\n",
+ returnstring[node->vartype], returnstring[this_type]);
+ }
+
+ if(node->vartype > this_type) {
+ fprintf(curfp," (%s)",returnstring[this_type]);
+ expr_emit (meth, node);
+ bc_append(meth, typeconv_matrix[node->vartype][this_type]);
+ }
+ else
+ expr_emit(meth, node);
+}
+
+/*****************************************************************************
+ * *
+ * max_intrinsic_emit *
+ * *
+ * This function handles calls to the MAX intrinsic function. here we just *
+ * check if the generic form is used and then call maxmin_intrinsic_emit(). *
+ * *
+ *****************************************************************************/
+
+void
+max_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry)
+{
+ METHODTAB *tmpentry = entry;
+ char *desc = "(DDD)D", *f;
+
+ if(entry->intrinsic == ifunc_MAX) {
+ switch(root->vartype) {
+ case Integer:
+ tmpentry = &intrinsic_toks[ifunc_MAX0];
+ desc = "(III)I";
+ break;
+ case Float:
+ tmpentry = &intrinsic_toks[ifunc_AMAX1];
+ desc = "(FFF)F";
+ break;
+ case Double:
+ tmpentry = &intrinsic_toks[ifunc_DMAX1];
+ desc = "(DDD)D";
+ break;
+ default:
+ fprintf(stderr,"WARNING: generic MAX used, but data type is bad!\n");
+ break;
+ }
+ }
+ else if(entry->intrinsic==ifunc_MAX0)
+ desc = "(III)I";
+ else if((entry->intrinsic==ifunc_AMAX1) || (entry->intrinsic==ifunc_MAX1))
+ desc = "(FFF)F";
+ else if(entry->intrinsic==ifunc_AMAX0)
+ desc = "(FFF)F";
+ else if(entry->intrinsic==ifunc_DMAX1)
+ desc = "(DDD)D";
+ else
+ fprintf(stderr,"WARNING: bad intrinsic tag in max_intrinsic_emit()\n");
+
+ f = strictMath ? THREEARG_MAX_FUNC_STRICT : THREEARG_MAX_FUNC;
+
+ maxmin_intrinsic_emit(meth, root, tmpentry, f, desc);
+}
+
+/*****************************************************************************
+ * *
+ * min_intrinsic_emit *
+ * *
+ * This function handles calls to the MIN intrinsic function. here we just *
+ * check if the generic form is used and then call maxmin_intrinsic_emit(). *
+ * *
+ *****************************************************************************/
+
+void
+min_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry)
+{
+ METHODTAB *tmpentry = entry;
+ char *desc = "(DDD)D", *f;
+
+ if(entry->intrinsic == ifunc_MIN) {
+ switch(root->vartype) {
+ case Integer:
+ tmpentry = &intrinsic_toks[ifunc_MIN0];
+ desc = "(III)I";
+ break;
+ case Float:
+ tmpentry = &intrinsic_toks[ifunc_AMIN1];
+ desc = "(FFF)F";
+ break;
+ case Double:
+ tmpentry = &intrinsic_toks[ifunc_DMIN1];
+ desc = "(DDD)D";
+ break;
+ default:
+ fprintf(stderr,"WARNING: generic MIN used, but data type is bad!\n");
+ break; /* ansi c */
+ }
+ }
+ else if(entry->intrinsic==ifunc_MIN0)
+ desc = "(III)I";
+ else if((entry->intrinsic==ifunc_AMIN1) || (entry->intrinsic==ifunc_MIN1))
+ desc = "(FFF)F";
+ else if(entry->intrinsic==ifunc_AMIN0)
+ desc = "(FFF)F";
+ else if(entry->intrinsic==ifunc_DMIN1)
+ desc = "(DDD)D";
+ else
+ fprintf(stderr,"WARNING: bad intrinsic tag in min_intrinsic_emit()\n");
+
+ if(gendebug)
+ printf("MIN vartype = %s, %s %s %s\n", returnstring[root->vartype],
+ entry->class_name, entry->method_name, entry->descriptor);
+
+ f = strictMath ? THREEARG_MIN_FUNC_STRICT : THREEARG_MIN_FUNC;
+
+ maxmin_intrinsic_emit(meth, root, tmpentry, f, desc);
+}
+
+/*****************************************************************************
+ * *
+ * maxmin_intrinsic_emit *
+ * *
+ * This function handles calls to the MAX and MIN intrinsic functions. these *
+ * functions take a variable number of arguments, which is not easily *
+ * accomplished in Java, so we generate multiple calls to Math.max/Math.min *
+ * in case there are more than 2 args. *
+ * *
+ *****************************************************************************/
+
+void
+maxmin_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry,
+ char *threearg, char *three_desc)
+{
+ int ii, arg_count = 0;
+ char *javaname, *method, *util_class;
+ int c;
+ AST *temp;
+
+ if(strictMath && entry->strict_java_method)
+ javaname = entry->strict_java_method;
+ else
+ javaname = entry->java_method;
+
+ util_class = strictMath ? STRICT_UTIL_CLASS : UTIL_CLASS;
+
+ /* figure out how many args we need to handle */
+ for(temp = root->astnode.ident.arraylist;temp!=NULL;temp = temp->nextstmt)
+ arg_count++;
+
+ /* If we only have one arg, just emit that expression. This should not
+ * happen since it's invalid to call MAX with only one arg.
+ */
+
+ if(arg_count == 1) {
+ temp = root->astnode.ident.arraylist;
+
+ fprintf (curfp, "(");
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ fprintf (curfp, ")");
+ }
+
+ /* typical situation, two args */
+
+ else if(arg_count == 2) {
+ temp = root->astnode.ident.arraylist;
+ fprintf(curfp, "%s(", javaname);
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ fprintf (curfp, ", ");
+ intrinsic_arg_emit(meth, temp->nextstmt, entry->ret);
+ fprintf (curfp, ")");
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file,entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file,entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+ }
+
+ /* special handling of situation in which MAX or MIN has three args */
+
+ else if(arg_count == 3) {
+ char *ta_tmp;
+
+ temp = root->astnode.ident.arraylist;
+ fprintf(curfp, "%s(", threearg);
+ intrinsic_arg_emit(meth, temp,entry->ret);
+ fprintf (curfp, ", ");
+ intrinsic_arg_emit(meth, temp->nextstmt,entry->ret);
+ fprintf (curfp, ", ");
+ intrinsic_arg_emit(meth, temp->nextstmt->nextstmt,entry->ret);
+ fprintf (curfp, ")");
+
+ ta_tmp = strdup(threearg);
+
+ strtok(ta_tmp,".");
+ method = strtok(NULL,".");
+ c = bc_new_methodref(cur_class_file, util_class, method, three_desc);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ f2jfree(ta_tmp, strlen(ta_tmp)+1);
+ }
+
+ /*
+ * For cases in which MAX or MIN has more than three args, we generate n-1
+ * method calls, where n is the number of args. For example, MAX(a,b,c,d,e)
+ * would be translated to:
+ * Math.max(Math.max(Math.max(Math.max(a,b),c),d),e)
+ * I dont think this situation is very common (in LAPACK/BLAS at least).
+ *
+ * changed this slightly to make the inner call a three-arg Util.max call.
+ * e.g. Math.max(Math.max(Util.max(a,b,c),d),e)
+ * --kgs 6/13/00
+ */
+
+ else {
+ char *ta_tmp;
+
+ for(ii=0;ii<arg_count -3;ii++)
+ fprintf(curfp,"%s(", javaname);
+ fprintf(curfp,"%s(", threearg);
+
+ temp = root->astnode.ident.arraylist;
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ fprintf (curfp, ", ");
+ temp = temp->nextstmt;
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ fprintf (curfp, ", ");
+ temp = temp->nextstmt;
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ fprintf (curfp, "), ");
+
+ ta_tmp = strdup(threearg);
+
+ strtok(ta_tmp,".");
+ method = strtok(NULL,".");
+ c = bc_new_methodref(cur_class_file, util_class, method, three_desc);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(strictMath && entry->strict_class_name)
+ c = bc_new_methodref(cur_class_file,entry->strict_class_name,
+ entry->method_name, entry->descriptor);
+ else
+ c = bc_new_methodref(cur_class_file,entry->class_name,
+ entry->method_name, entry->descriptor);
+
+ for(temp = temp->nextstmt; temp != NULL; temp = temp->nextstmt) {
+ intrinsic_arg_emit(meth, temp, entry->ret);
+ if(temp->nextstmt != NULL)
+ fprintf (curfp, "), ");
+ else
+ fprintf (curfp, ") ");
+ bc_append(meth, jvm_invokestatic, c);
+ }
+
+ f2jfree(ta_tmp, strlen(ta_tmp)+1);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * get_type *
+ * *
+ * This function tries to guess the type of a value contained *
+ * in a string. If we find a '.' in the string, we guess that *
+ * it's a floating point number. If the string contains 'true' *
+ * or 'false', we guess that it's a boolean value. Otherwise *
+ * we guess that it's an integer value. Not very sophisticated, *
+ * but it works most of the time. *
+ * *
+ *****************************************************************************/
+
+enum returntype
+get_type(char *num)
+{
+ unsigned int idx;
+ int contains_dot = FALSE, contains_f = FALSE;
+
+ for(idx = 0;idx < strlen(num);idx++)
+ if(num[idx] == '.')
+ contains_dot = TRUE;
+ else if(num[idx] == 'f')
+ contains_f = TRUE;
+
+ if(contains_dot && contains_f)
+ return Float;
+
+ if(contains_dot && !contains_f)
+ return Double;
+
+ if( !strcmp(num,"false") || !strcmp(num,"true"))
+ return Logical;
+
+ return Integer;
+}
+
+/*****************************************************************************
+ * *
+ * expr_emit *
+ * *
+ * This function traverses an expression subtree and emits code for simple *
+ * operations. For more complex operations, we call the appropriate code *
+ * generation routine. *
+ * *
+ *****************************************************************************/
+
+void
+expr_emit (JVM_METHOD *meth, AST * root)
+{
+ if(root == NULL)
+ {
+ /* We should not have a NULL expression */
+ fprintf(stderr,"Warning: NULL root in expr_emit (%s)\n", cur_filename);
+ return;
+ }
+
+ if(gendebug) {
+ printf("expr_emit(): nodetype = %s\n", print_nodetype(root));
+ printf("%s\n", root->astnode.ident.name);
+ if(root->nodetype == Binaryop)
+ printf("\toptype = %c\n",root->astnode.expression.optype);
+ }
+
+ switch (root->nodetype)
+ {
+ case Identifier:
+ name_emit (meth, root);
+ break;
+ case Expression:
+ parenthesized_expr_emit(meth, root);
+ break;
+ case Power:
+ fprintf (curfp, "(");
+ power_emit(meth, root);
+ fprintf (curfp, ")");
+ break;
+ case Binaryop:
+ fprintf (curfp, "(");
+ binaryop_emit(meth, root);
+ fprintf (curfp, ")");
+ break;
+ case Unaryop:
+ fprintf (curfp, "(");
+ unaryop_emit(meth, root);
+ fprintf (curfp, ")");
+ break;
+ case Constant:
+ constant_expr_emit(meth, root);
+ break;
+ case Logicalop:
+ fprintf (curfp, "(");
+ logicalop_emit(meth, root);
+ fprintf (curfp, ")");
+ break;
+ case Relationalop:
+ fprintf (curfp, "(");
+ relationalop_emit(meth, root);
+ fprintf (curfp, ")");
+ break;
+ case Substring:
+ substring_expr_emit(meth, root);
+ break;
+ default:
+ fprintf(stderr,"Warning: Unknown nodetype in expr_emit(): %s\n",
+ print_nodetype(root));
+ }
+
+ if(gendebug)printf("leaving-expr emit\n");
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * parenthesized_expr_emit *
+ * *
+ * This function handles any expression surrounded by parens - really no *
+ * need to do anything here, just call expr_emit() to emit the expression. *
+ * *
+ *****************************************************************************/
+
+void
+parenthesized_expr_emit(JVM_METHOD *meth, AST *root)
+{
+ if (root->astnode.expression.parens)
+ fprintf (curfp, "(");
+
+ /* is expression.lhs ever really non-null? i dont think so.
+ * in any case, for bytecode generation, we are not concerned
+ * with parens, so it should be ok to just call expr_emit. (kgs)
+ */
+
+ if (root->astnode.expression.lhs != NULL)
+ expr_emit (meth, root->astnode.expression.lhs);
+
+ expr_emit (meth, root->astnode.expression.rhs);
+
+ if (root->astnode.expression.parens)
+ fprintf (curfp, ")");
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * power_emit *
+ * *
+ * This function generates code for exponential expressions (e.g. x**y). *
+ * We use java.lang.Math.pow(). *
+ * *
+ *****************************************************************************/
+
+void
+power_emit(JVM_METHOD *meth, AST *root)
+{
+ int ct;
+
+ /* hack alert: determine whether this expression is used as the size
+ * in an array declaration. if so, it must be integer, but java's
+ * pow() method returns double. so we add a cast. it would probably
+ * be better to detect this elsewhere (e.g. in the code that emits
+ * array declarations).
+ */
+ BOOL gencast = (root->parent != NULL)
+ && (root->parent->nodetype == ArrayDec);
+ char pow_cast[32];
+
+ if(gencast)
+ sprintf(pow_cast, "(int)");
+ else if(root->vartype != Double)
+ sprintf(pow_cast, "(%s)", returnstring[root->vartype]);
+ else
+ sprintf(pow_cast, " ");
+
+ if(strictMath)
+ fprintf(curfp, "%sStrictMath.pow(", pow_cast);
+ else
+ fprintf(curfp, "%sMath.pow(", pow_cast);
+
+ /* the args to pow must be doubles, so cast if necessary */
+
+ expr_emit(meth, root->astnode.expression.lhs);
+
+ if(root->astnode.expression.lhs->vartype != Double)
+ bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][Double]);
+ fprintf(curfp, ", ");
+ expr_emit(meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype != Double)
+ bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][Double]);
+ fprintf(curfp, ")");
+
+ if(strictMath)
+ ct = bc_new_methodref(cur_class_file, "java/lang/StrictMath", "pow", "(DD)D");
+ else
+ ct = bc_new_methodref(cur_class_file, "java/lang/Math", "pow", "(DD)D");
+
+ bc_append(meth, jvm_invokestatic, ct);
+
+ if(gencast)
+ bc_append(meth, jvm_d2i);
+ else if(root->vartype != Double)
+ bc_append(meth, typeconv_matrix[Double][root->vartype]);
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * binaryop_emit *
+ * *
+ * This function generates code for binary operations (mul, add, etc). *
+ * *
+ *****************************************************************************/
+
+void
+binaryop_emit(JVM_METHOD *meth, AST *root)
+{
+ int ct;
+
+ /* handle special case for string concatenation in bytecode.. we
+ * must create a new StringBuffer which contains the LHS and append
+ * the RHS to the STringBuffer.
+ */
+ if(root->token == CAT)
+ {
+ ct = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ STRINGBUFFER);
+
+ bc_append(meth, jvm_new,ct);
+ bc_append(meth, jvm_dup);
+ expr_emit (meth, root->astnode.expression.lhs);
+ if((root->astnode.expression.lhs->vartype != String) &&
+ (root->astnode.expression.lhs->vartype != Character) )
+ {
+ fprintf(stderr,"ERROR:str cat with non-string types unsupported\n");
+ }
+ ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "<init>", STRBUF_DESC);
+
+ fprintf (curfp, "%c", root->astnode.expression.optype);
+
+ bc_append(meth, jvm_invokespecial, ct);
+ expr_emit (meth, root->astnode.expression.rhs);
+ if((root->astnode.expression.rhs->vartype != String) &&
+ (root->astnode.expression.rhs->vartype != Character) )
+ {
+ fprintf(stderr,"ERROR:str cat with non-string types unsupported\n");
+ }
+ ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "append",
+ append_descriptor[String]);
+ bc_append(meth, jvm_invokevirtual, ct);
+ ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "toString",
+ TOSTRING_DESC);
+ bc_append(meth, jvm_invokevirtual, ct);
+ }
+ else {
+ expr_emit (meth, root->astnode.expression.lhs);
+
+ if(root->astnode.expression.lhs->vartype > root->vartype)
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype]
+ [root->vartype]);
+
+ fprintf (curfp, "%c", root->astnode.expression.optype);
+ expr_emit (meth, root->astnode.expression.rhs);
+
+ if(root->astnode.expression.rhs->vartype > root->vartype)
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype]
+ [root->vartype]);
+
+ switch(root->astnode.expression.optype) {
+ case '+':
+ bc_append(meth, add_opcode[root->vartype]);
+ break;
+ case '-':
+ bc_append(meth, sub_opcode[root->vartype]);
+ break;
+ case '/':
+ bc_append(meth, div_opcode[root->vartype]);
+ break;
+ case '*':
+ bc_append(meth, mul_opcode[root->vartype]);
+ break;
+ default:
+ fprintf(stderr,"WARNING: unsupported optype\n");
+ break; /* for ANSI C compliance */
+ }
+ }
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * unaryop_emit *
+ * *
+ * This function emits the code for a unary expression. I think the only *
+ * unary op we handle here is unary minus. Unary negation gets handled in *
+ * logicalop_emit(). *
+ * *
+ *****************************************************************************/
+
+void
+unaryop_emit(JVM_METHOD *meth, AST *root)
+{
+ fprintf (curfp, "%c(", root->astnode.expression.minus);
+ expr_emit (meth, root->astnode.expression.rhs);
+ fprintf (curfp, ")");
+
+ if(root->astnode.expression.minus == '-')
+ bc_append(meth, neg_opcode[root->vartype]);
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * constant_expr_emit *
+ * *
+ * This function emits the code for a constant expression. *
+ * *
+ *****************************************************************************/
+
+void
+constant_expr_emit(JVM_METHOD *meth, AST *root)
+{
+ char *tempname = NULL;
+
+ if(root->parent != NULL)
+ {
+ tempname = strdup(root->parent->astnode.ident.name);
+ uppercase(tempname);
+ }
+
+ /*
+ * here we need to determine if this is a parameter to a function
+ * or subroutine. if so, and we are using wrappers, then we need
+ * to create a temporary wrapper and pass that in instead of the
+ * constant. 10/9/97 -- Keith
+ */
+
+ if( (root->parent != NULL) &&
+ (root->parent->nodetype == Call) &&
+ (type_lookup(cur_array_table,root->parent->astnode.ident.name)
+ == NULL) &&
+ (methodscan(intrinsic_toks, tempname) == NULL))
+ {
+ if(root->token == STRING) {
+ if(omitWrappers) {
+
+ pushConst(meth, root);
+
+ fprintf (curfp, "\"%s\"",
+ escape_double_quotes(root->astnode.constant.number));
+ }
+ else
+ {
+ invoke_constructor(meth, full_wrappername[root->vartype], root,
+ wrapper_descriptor[root->vartype]);
+
+ fprintf (curfp, "new StringW(\"%s\")",
+ escape_double_quotes(root->astnode.constant.number));
+ }
+ }
+ else { /* non-string constant argument to a function call */
+ if(omitWrappers) {
+ pushConst(meth, root);
+
+ fprintf (curfp, "%s", root->astnode.constant.number);
+ }
+ else
+ {
+ invoke_constructor(meth, full_wrappername[root->vartype], root,
+ wrapper_descriptor[root->vartype]);
+
+ fprintf (curfp, "new %s(%s)",
+ wrapper_returns[get_type(root->astnode.constant.number)],
+ root->astnode.constant.number);
+ }
+ }
+ }
+ else /* this constant is not an argument to a function call */
+ {
+
+ pushConst(meth, root);
+
+ if(root->token == STRING)
+ fprintf (curfp, "\"%s\"",
+ escape_double_quotes(root->astnode.constant.number));
+ else
+ fprintf (curfp, "%s", root->astnode.constant.number);
+ }
+
+ if(tempname != NULL)
+ f2jfree(tempname, strlen(tempname)+1);
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * logicalop_emit *
+ * *
+ * This function emits the code for a logical expression (i.e. boolean). *
+ * *
+ *****************************************************************************/
+
+void
+logicalop_emit(JVM_METHOD *meth, AST *root)
+{
+ JVM_CODE_GRAPH_NODE *if_node1, *if_node2, *goto_node, *next_node;
+
+ switch(root->token) {
+ case NOT:
+ fprintf (curfp, "!");
+ expr_emit (meth, root->astnode.expression.rhs);
+
+ bc_append(meth, jvm_iconst_1);
+ bc_append(meth, jvm_ixor);
+ break;
+ case AND:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if_node1 = bc_append(meth, jvm_ifeq);
+
+ fprintf (curfp, " && ");
+
+ expr_emit (meth, root->astnode.expression.rhs);
+ if_node2 = bc_append(meth, jvm_ifeq);
+
+ bc_append(meth, jvm_iconst_1);
+ goto_node = bc_append(meth, jvm_goto);
+ next_node = bc_append(meth, jvm_iconst_0);
+
+ bc_set_branch_target(if_node1, next_node);
+ bc_set_branch_target(if_node2, next_node);
+
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+
+ bc_set_branch_target(goto_node, next_node);
+
+ break;
+ case OR:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if_node1 = bc_append(meth, jvm_ifne);
+
+ fprintf (curfp, " || ");
+
+ expr_emit (meth, root->astnode.expression.rhs);
+ if_node2 = bc_append(meth, jvm_ifne);
+
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ next_node = bc_append(meth, jvm_iconst_1);
+
+ bc_set_branch_target(if_node1, next_node);
+ bc_set_branch_target(if_node2, next_node);
+
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+
+ bc_set_branch_target(goto_node, next_node);
+
+ break;
+ }
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * relationalop_emit *
+ * *
+ * This function emits the code for a relational expression (e.g. .lt., .gt. *
+ * etc). *
+ * *
+ *****************************************************************************/
+
+void
+relationalop_emit(JVM_METHOD *meth, AST *root)
+{
+ int cur_vt;
+
+ cur_vt = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+
+ if(((root->astnode.expression.lhs->vartype == String) ||
+ (root->astnode.expression.lhs->vartype == Character)) &&
+ ((root->astnode.expression.rhs->vartype == String) ||
+ (root->astnode.expression.rhs->vartype == Character)))
+ {
+ int c;
+ int len;
+
+ if((root->token != rel_eq) && (root->token != rel_ne)) {
+ fprintf(stderr,"ERR: didn't expect this relop on a STring type!\n");
+ return;
+ }
+
+ c = bc_new_methodref(cur_class_file,JL_STRING,
+ "regionMatches", REGIONMATCHES_DESC);
+
+ if(root->token == rel_ne)
+ fprintf(curfp,"!");
+
+ expr_emit (meth, root->astnode.expression.lhs);
+
+ bc_append(meth, jvm_iconst_0);
+ fprintf(curfp,".regionMatches(0, ");
+
+ expr_emit (meth, root->astnode.expression.rhs);
+ bc_append(meth, jvm_iconst_0);
+
+ len = 1;
+
+ if(root->astnode.expression.lhs->nodetype == Constant) {
+ len = strlen(root->astnode.expression.lhs->astnode.constant.number);
+ }
+ else if(root->astnode.expression.lhs->nodetype == Identifier) {
+ HASHNODE *h;
+
+ h = type_lookup(cur_type_table,
+ root->astnode.expression.lhs->astnode.ident.name);
+
+ if(h) {
+ if(h->variable->astnode.ident.len < 0)
+ len = 1;
+ else
+ len = h->variable->astnode.ident.len;
+ }
+ }
+
+ if(root->astnode.expression.rhs->nodetype == Constant) {
+ int rlen;
+
+ rlen = strlen(root->astnode.expression.rhs->astnode.constant.number);
+
+ if(rlen < len)
+ len = rlen;
+ }
+ else if(root->astnode.expression.rhs->nodetype == Identifier) {
+ HASHNODE *h;
+
+ h = type_lookup(cur_type_table,
+ root->astnode.expression.rhs->astnode.ident.name);
+
+ if(h)
+ if((h->variable->astnode.ident.len < len) &&
+ (h->variable->astnode.ident.len > 0))
+ len = h->variable->astnode.ident.len;
+ }
+
+ /* bc_append(jvm_iconst_1); */
+ bc_push_int_const(meth, len);
+
+ fprintf(curfp,", 0, %d) ",len);
+
+ bc_append(meth, jvm_invokevirtual, c); /* call regionMatches() */
+
+ /* now check the op type & reverse if .NE. */
+ if(root->token == rel_ne) {
+ bc_append(meth, jvm_iconst_1);
+ bc_append(meth, jvm_ixor);
+ }
+
+ return; /* nothing more to do for strings here. */
+ }
+
+ switch (root->token)
+ {
+ case rel_eq:
+
+ if(gendebug) {
+ if(root->astnode.expression.lhs->nodetype == Identifier)
+ printf("##@@ lhs ident %s has type %s\n",
+ root->astnode.expression.lhs->astnode.ident.name,
+ returnstring[root->astnode.expression.lhs->vartype]);
+
+ if(root->astnode.expression.rhs->nodetype == Identifier)
+ printf("##@@ rhs ident %s has type %s\n",
+ root->astnode.expression.rhs->astnode.ident.name,
+ returnstring[root->astnode.expression.rhs->vartype]);
+ }
+
+ expr_emit (meth, root->astnode.expression.lhs);
+
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+
+ fprintf (curfp, " == ");
+
+ expr_emit (meth, root->astnode.expression.rhs);
+
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+
+ break;
+ case rel_ne:
+
+ expr_emit (meth, root->astnode.expression.lhs);
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+ fprintf (curfp, " != ");
+ expr_emit (meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+ break;
+ case rel_lt:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+ fprintf (curfp, " < ");
+ expr_emit (meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+ break;
+ case rel_le:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+ fprintf (curfp, " <= ");
+ expr_emit (meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+ break;
+ case rel_gt:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+ fprintf (curfp, " > ");
+ expr_emit (meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+ break;
+ case rel_ge:
+ expr_emit (meth, root->astnode.expression.lhs);
+ if(root->astnode.expression.lhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]);
+ }
+ fprintf (curfp, " >= ");
+ expr_emit (meth, root->astnode.expression.rhs);
+ if(root->astnode.expression.rhs->vartype > cur_vt) {
+ bc_append(meth,
+ typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]);
+ }
+ break;
+ }
+
+ switch(cur_vt) {
+ case String:
+ case Character:
+ /* we dont need to do anything here because strings were handled
+ * above already.
+ */
+ break;
+ case Complex:
+ fprintf(stderr,"WARNING: complex relop not supported yet!\n");
+ break;
+ case Logical:
+ fprintf(stderr,"WARNING: relop not supported on logicals!\n");
+ break;
+ case Float:
+ {
+ JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node;
+
+ /* the only difference between fcmpg and fcmpl is the handling
+ * of the NaN value. for .lt. and .le. we use fcmpg, otherwise
+ * use fcmpl. this mirrors the behavior of javac.
+ */
+ if((root->token == rel_lt) || (root->token == rel_le))
+ bc_append(meth, jvm_fcmpg);
+ else
+ bc_append(meth, jvm_fcmpl);
+
+ cmp_node = bc_append(meth, dcmp_opcode[root->token]);
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_1);
+ bc_set_branch_target(cmp_node, iconst_node);
+
+ /* create a dummy instruction node following the iconst so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(goto_node, next_node);
+ }
+ break;
+ case Double:
+ {
+ JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node;
+
+ /* the only difference between dcmpg and dcmpl is the handling
+ * of the NaN value. for .lt. and .le. we use dcmpg, otherwise
+ * use dcmpl. this mirrors the behavior of javac.
+ */
+ if((root->token == rel_lt) || (root->token == rel_le))
+ bc_append(meth, jvm_dcmpg);
+ else
+ bc_append(meth, jvm_dcmpl);
+
+ cmp_node = bc_append(meth, dcmp_opcode[root->token]);
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_1);
+ bc_set_branch_target(cmp_node, iconst_node);
+
+ /* create a dummy instruction node following the iconst so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(goto_node, next_node);
+ }
+ break;
+ case Integer:
+ {
+ JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node;
+
+ cmp_node = bc_append(meth, icmp_opcode[root->token]);
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_1);
+ bc_set_branch_target(cmp_node, iconst_node);
+
+ /* create a dummy instruction node following the iconst so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(goto_node, next_node);
+ }
+ break;
+ default:
+ fprintf(stderr,"WARNING: hit default, relop .eq.\n");
+ break;
+ }
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * emit_default_substring_start *
+ * *
+ * This handles substring operations with an unspecified starting index. *
+ * For example, "str(:10)". The implicit starting index is 1. *
+ * *
+ *****************************************************************************/
+
+void
+emit_default_substring_start(JVM_METHOD *meth, AST *root)
+{
+ fprintf(curfp, "1");
+ bc_append(meth, jvm_iconst_1);
+}
+
+/*****************************************************************************
+ * *
+ * emit_default_substring_end *
+ * *
+ * This handles substring operations with an unspecified ending index. *
+ * For example, "str(5:)". The implicit ending index is the last character *
+ * of the string. *
+ * *
+ *****************************************************************************/
+
+void
+emit_default_substring_end(JVM_METHOD *meth, AST *root)
+{
+ int c;
+ AST *tmp_parent, *tmp_node;
+
+ /* For a substring operation of the form "str(5:)", here we are trying to
+ * emit the implicit end index expression, which would be "str.length()".
+ * The problem is that when we pass the root node to scalar_emit() to emit
+ * the instruction to load "str" (necessary before the method can be
+ * invoked), it can get confused since the parent node type could be
+ * something like 'Assignment', so it's thinking that we're looking at the
+ * LHS of an assignment and therefore it erroneously omits the load
+ * instruction.
+ *
+ * To get around that, we just fudge things a bit here and duplicate the
+ * root node, make a dummy parent node of type 'Write', and set it as the
+ * new node's parent.
+ */
+
+ tmp_node = clone_ident(root);
+
+ tmp_parent = addnode();
+ tmp_parent->nodetype = Write;
+ tmp_parent->astnode.io_stmt.arg_list = tmp_node;
+
+ tmp_node->parent = tmp_parent;
+
+ scalar_emit(meth, tmp_node, NULL);
+
+ fprintf(curfp, ".length()");
+ c = bc_new_methodref(cur_class_file, JL_STRING,
+ "length", STRLEN_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ f2jfree(tmp_node, sizeof(AST));
+ f2jfree(tmp_parent, sizeof(AST));
+}
+
+/*****************************************************************************
+ * *
+ * substring_expr_emit *
+ * *
+ * This function emits the code for a substring expression. I think this *
+ * only handles RHS substring expressions. Use java.lang.String.substring() *
+ * *
+ *****************************************************************************/
+
+void
+substring_expr_emit(JVM_METHOD *meth, AST *root)
+{
+ int c;
+
+ /* Check if this is a single character substring */
+ if((root->astnode.ident.startDim[0] == NULL) &&
+ (root->astnode.ident.endDim[0] == NULL) &&
+ (root->astnode.ident.startDim[1] != NULL))
+ {
+ fprintf(curfp, "Util.strCharAt(");
+ name_emit(meth, root);
+ fprintf(curfp,",");
+ expr_emit(meth, root->astnode.ident.startDim[1]);
+ fprintf(curfp,")");
+
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS,
+ "strCharAt", STRCHARAT_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+
+ return;
+ }
+
+ /* Substring operations are handled with java.lang.String.substring */
+
+ name_emit(meth, root);
+
+ fprintf(curfp,"(");
+ if(root->astnode.ident.startDim[0])
+ expr_emit(meth, root->astnode.ident.startDim[0]);
+ else
+ emit_default_substring_start(meth, root);
+ fprintf(curfp,")-1,");
+
+ bc_append(meth, jvm_iconst_m1); /* decrement start idx by one */
+ bc_append(meth, jvm_iadd);
+
+ if(root->astnode.ident.endDim[0])
+ expr_emit(meth, root->astnode.ident.endDim[0]);
+ else
+ emit_default_substring_end(meth, root);
+ fprintf(curfp,")");
+
+ c = bc_new_methodref(cur_class_file,JL_STRING,
+ "substring", SUBSTR_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * open_output_file *
+ * *
+ * This function attempts to open the output file and write the *
+ * header. *
+ * *
+ *****************************************************************************/
+
+void
+open_output_file(AST *root, char *classname)
+{
+ char * filename;
+ char import_stmt[60];
+
+ filename = (char *) f2jalloc(strlen(cur_filename) + 6);
+ strcpy(filename, cur_filename);
+ strcat(filename,".java");
+
+#ifdef _WIN32
+ filename = char_substitution(filename, '/', '\\');
+#endif
+
+ if(gendebug)
+ printf("filename is %s\n",filename);
+
+ if(gendebug)
+ printf("## going to open file: '%s'\n", filename);
+
+ if((javafp = bc_fopen_fullpath(filename,"w", output_dir))==NULL) {
+ fprintf(stderr,"Cannot open output file '%s'.\n",filename);
+ perror("Reason");
+ exit(EXIT_FAILURE);
+ }
+
+ curfp = javafp; /* set global pointer to output file */
+
+ /* add import statements if necessary */
+
+ import_stmt[0] = '\0';
+
+ if(import_reflection)
+ strcat(import_stmt,"import java.lang.reflect.*;\n");
+
+ javaheader(javafp,import_stmt);
+
+ if(genJavadoc)
+ emit_javadoc_comments(root);
+
+ if(strictFp)
+ fprintf(javafp,"public strictfp class %s {\n\n", classname);
+ else
+ fprintf(javafp,"public class %s {\n\n", classname);
+
+ f2jfree(filename, strlen(cur_filename) + 6);
+}
+
+/*****************************************************************************
+ * *
+ * constructor *
+ * *
+ * This function generates the method header for the current *
+ * function or subroutine. *
+ * *
+ *****************************************************************************/
+
+void
+constructor (AST * root)
+{
+ enum returntype returns;
+ AST *tempnode;
+ char *tempstring;
+ HASHNODE *hashtemp;
+
+ if (root->nodetype == Function)
+ {
+ char *name;
+
+ returns = root->astnode.source.returns;
+ name = root->astnode.source.name->astnode.ident.name;
+
+ /* Define the constructor for the class. */
+
+ fprintf (curfp, "\npublic static %s %s (",
+ returnstring[returns], name);
+
+ if(genInterfaces)
+ emit_interface(root);
+ }
+ /* Else we have a subroutine, which returns void. */
+ else if(root->nodetype == Subroutine)
+ {
+ fprintf (curfp, "\npublic static void %s (",
+ root->astnode.source.name->astnode.ident.name);
+
+ if(genInterfaces)
+ emit_interface(root);
+ }
+ else /* Else we have a program, create a main() function */
+ {
+ fprintf (curfp, "\npublic static void main (String [] args");
+ }
+
+ /*
+ * Now traverse the list of constructor arguments for either
+ * functions or subroutines. This is where I will
+ * have to check what the variable type is in the
+ * symbol table.
+ */
+
+ tempnode = root->astnode.source.args;
+
+ for (; tempnode != NULL; tempnode = tempnode->nextstmt)
+ {
+ hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name);
+ if (hashtemp == NULL)
+ {
+ if( type_lookup (cur_external_table, tempnode->astnode.ident.name) ) {
+ fprintf (curfp, "Object %s", tempnode->astnode.ident.name);
+
+ if (tempnode->nextstmt)
+ fprintf (curfp, ",\n");
+ continue;
+ }
+ else {
+ fprintf (stderr,"Type table is screwed (codegen.c).\n");
+ fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+ }
+
+ /* If this variable is declared external and it is an argument to
+ * this program unit, it must be declared as Object in Java.
+ */
+
+ if(type_lookup(cur_external_table, tempnode->astnode.ident.name) != NULL)
+ returns = OBJECT_TYPE;
+ else{
+ returns = hashtemp->variable->vartype;
+ }
+
+ /*
+ * Check the numerical value returns. It should not
+ * exceed the value of the enum returntypes.
+ */
+
+ if (returns > MAX_RETURNS)
+ fprintf (stderr,"Bad return value, check types.\n");
+
+ if(omitWrappers) {
+ if((hashtemp->variable->astnode.ident.arraylist == NULL) &&
+ cgPassByRef(tempnode->astnode.ident.name))
+ tempstring = wrapper_returns[returns];
+ else
+ tempstring = returnstring[returns];
+ }
+ else
+ {
+ if (hashtemp->variable->astnode.ident.arraylist == NULL)
+ tempstring = wrapper_returns[returns];
+ else
+ tempstring = returnstring[returns];
+ }
+
+ /*
+ * I haven't yet decided how the pass-by-reference
+ * pass-by-value problem will be resolved. It may
+ * not be an issue at all in a java calling java
+ * situation. The next line, when used, will list
+ * all the arguments to the method as references.
+ * This means that primitives such as int and
+ * double are wrapped as objects.
+ *
+ * *tempstring = toupper (*tempstring);
+ *
+ * To save storage space, I'm wrapping the primitives with
+ * special-purpose wrappers (intW, doubleW, etc.).
+ * 10/8/97 --Keith
+ */
+
+ fprintf (curfp, "%s ", tempstring);
+
+ if (hashtemp->variable->astnode.ident.arraylist == NULL)
+ fprintf (curfp, "%s", tempnode->astnode.ident.name);
+ else {
+ /* Declare as array variables. */
+ char *temp2;
+ fprintf (curfp, "[]");
+ fprintf (curfp, " %s", tempnode->astnode.ident.name);
+
+ /*
+ * for arrays, add a parameter representing the base
+ * index. -- Keith
+ */
+
+ temp2 = (char *)f2jalloc(strlen(tempnode->astnode.ident.name) + 9);
+ strcpy( temp2, "_");
+ strcat( temp2, tempnode->astnode.ident.name);
+ strcat( temp2, "_offset");
+ fprintf(curfp, ", int %s",temp2);
+ f2jfree(temp2, strlen(temp2)+1);
+ }
+
+ /* Don't emit a comma on the last iteration. */
+ if (tempnode->nextstmt)
+ fprintf (curfp, ",\n");
+ }
+
+ fprintf (curfp, ") {\n\n");
+
+} /* Close constructor(). */
+
+/*****************************************************************************
+ * *
+ * emit_interface *
+ * *
+ * This function generates a simplified interface to the underlying *
+ * numerical routine. This simplification includes: *
+ * . accepting Java row-major 2D arrays *
+ * . omitting leading dimension parameters *
+ * . omitting offset parameters *
+ * The interface will have the same name as the numerical routine, but *
+ * it will be in all caps. *
+ * *
+ *****************************************************************************/
+
+void
+emit_interface(AST *root)
+{
+ enum returntype returns;
+ AST *tempnode, *prev;
+ char *tempstring;
+ HASHNODE *hashtemp;
+ FILE *intfp;
+ char *intfilename;
+ char *classname;
+ Dlist decs, rest, tmp;
+ int i;
+ /* BOOL skipped; */
+
+ decs = make_dl();
+ rest = make_dl();
+
+ classname = strdup(root->astnode.source.name->astnode.ident.name);
+ uppercase(classname);
+
+ tempstring = bc_get_full_classname(classname, package_name);
+ intfilename = f2jalloc( strlen(tempstring) + 6 );
+ strcpy(intfilename, tempstring);
+ strcat(intfilename,".java");
+
+ intfp = bc_fopen_fullpath(intfilename,"w", output_dir);
+ if(!intfp) {
+ perror("Unable to open file");
+ exit(EXIT_FAILURE);
+ }
+
+ javaheader(intfp, "");
+
+ if(genJavadoc) {
+ fprintf(intfp,"/**\n");
+ fprintf(intfp,"*<pre>\n");
+ fprintf(intfp,"*<b>%s</b> is a simplified interface to the JLAPACK",
+ classname);
+ fprintf(intfp," routine <b>%s</b>.\n",
+ root->astnode.source.name->astnode.ident.name);
+ fprintf(intfp,"*This interface converts Java-style 2D row-major arrays");
+ fprintf(intfp," into\n*the 1D column-major linearized arrays expected by");
+ fprintf(intfp," the lower\n*level JLAPACK routines. Using this interface");
+ fprintf(intfp," also allows you\n*to omit offset and leading dimension");
+ fprintf(intfp," arguments. However, because\n*of these conversions,");
+ fprintf(intfp," these routines will be slower than the low\n*level ones.");
+ fprintf(intfp," Following is the description from the original ");
+ fprintf(intfp,"Fortran\n*source. Contact ");
+ fprintf(intfp,"<a href=\"mailto:seymour at cs.utk.edu\">");
+ fprintf(intfp,"seymour at cs.utk.edu</a> with any questions.\n");
+ fprintf(intfp,"*<p>\n");
+ tempnode = root->astnode.source.javadocComments;
+ while( (tempnode != NULL) && (tempnode->nodetype == MainComment ||
+ tempnode->nodetype == Comment))
+ {
+ fprintf(intfp,"* %s",tempnode->astnode.ident.name);
+ tempnode = tempnode->nextstmt;
+ }
+ fprintf(intfp,"*</pre>\n");
+ fprintf(intfp,"**/\n");
+ }
+
+ fprintf(intfp,"public class %s {\n\n", classname);
+
+ if (root->nodetype == Function)
+ fprintf (intfp, "\npublic static %s %s (",
+ returnstring[root->astnode.source.returns], classname);
+ else if(root->nodetype == Subroutine)
+ fprintf (intfp, "\npublic static void %s (", classname);
+ else
+ fprintf (stderr, "emit_interface called with bad nodetype.");
+
+ prev = NULL;
+ tempnode = root->astnode.source.args;
+
+ for (; tempnode != NULL; tempnode = tempnode->nextstmt)
+ {
+ /* skipped = FALSE; */
+
+ hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name);
+ if (hashtemp == NULL)
+ {
+ fprintf (stderr,"Type table is screwed (codegen.c).\n");
+ fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ if(type_lookup(cur_external_table, tempnode->astnode.ident.name) != NULL)
+ returns = OBJECT_TYPE;
+ else
+ returns = hashtemp->variable->vartype;
+
+ /*
+ * Check the numerical value returns. It should not
+ * exceed the value of the enum returntypes.
+ */
+
+ if (returns > MAX_RETURNS)
+ fprintf (stderr,"Bad return value, check types.\n");
+
+ if(omitWrappers) {
+ if((hashtemp->variable->astnode.ident.arraylist == NULL) &&
+ cgPassByRef(tempnode->astnode.ident.name))
+ tempstring = wrapper_returns[returns];
+ else
+ tempstring = returnstring[returns];
+ }
+ else
+ {
+ if (hashtemp->variable->astnode.ident.arraylist == NULL)
+ tempstring = wrapper_returns[returns];
+ else
+ tempstring = returnstring[returns];
+ }
+
+ if (hashtemp->variable->astnode.ident.arraylist == NULL) {
+ if((prev != NULL) && (prev->astnode.ident.dim > 1) &&
+ !strcmp(tempnode->astnode.ident.name,prev->astnode.ident.leaddim))
+ {
+ /* skipped = TRUE; */
+ }
+ else
+ {
+ if(prev != NULL)
+ fprintf (intfp, ",\n");
+ fprintf (intfp, "%s %s", tempstring, tempnode->astnode.ident.name);
+ }
+ }
+ else {
+ char *decstr;
+
+ if(prev != NULL)
+ fprintf (intfp, ",\n");
+
+ /* allocate enough room for: */
+ /* */
+ /* the data type ('double' etc.) strlen(tempstring) */
+ /* plus a space 1 */
+ /* two for the brackets: "[]" 2 */
+ /* plus a space 1 */
+ /* one for the leading "_" 1 */
+ /* plus the var name strlen(name) */
+ /* five for the "_copy" 5 */
+ /* plus a space 1 */
+ /* the equals sign 1 */
+ /* plus a space 1 */
+ /* plus the "TwoDtoOneD" call 28 */
+ /* open paren 1 */
+ /* argument name strlen(name) */
+ /* close paren 1 */
+ /* semicolon 1 */
+ /* NULL termination 1 */
+ /* ---------------------------------------------------------------- */
+ /* Total 45 + (2 * strlen(name)) + strlen(tempstring) */
+
+ if(hashtemp->variable->astnode.ident.dim > 1) {
+ decstr = (char *) f2jalloc(45 + (2 *
+ strlen(tempnode->astnode.ident.name)) + strlen(tempstring));
+ sprintf(decstr,"%s [] _%s_copy = MatConv.%sTwoDtoOneD(%s);",
+ tempstring, tempnode->astnode.ident.name,
+ returnstring[returns], tempnode->astnode.ident.name);
+
+ dl_insert_b(decs, (void *) strdup(decstr));
+
+ /* decstr should already have enough storage for the
+ * following string.
+ */
+
+ sprintf(decstr,"MatConv.copyOneDintoTwoD(%s,_%s_copy);",
+ tempnode->astnode.ident.name, tempnode->astnode.ident.name);
+
+ dl_insert_b(rest, (void *) strdup(decstr));
+ }
+
+ if(hashtemp->variable->astnode.ident.dim > 2)
+ fprintf(stderr,
+ "Cant correctly generate interface with array over 2 dimensions\n");
+
+ fprintf (intfp, "%s ", tempstring);
+
+ for(i = 0; i < hashtemp->variable->astnode.ident.dim; i++ )
+ fprintf(intfp,"[]");
+
+ fprintf(intfp, " %s", tempnode->astnode.ident.name);
+
+ if(!noOffset && (hashtemp->variable->astnode.ident.dim == 1)) {
+ char * temp2 = (char *) f2jalloc(
+ strlen(tempnode->astnode.ident.name) + 9);
+
+ strcpy( temp2, "_");
+ strcat( temp2, tempnode->astnode.ident.name);
+ strcat( temp2, "_offset");
+ fprintf(intfp, ", int %s",temp2);
+ }
+ }
+
+ prev = hashtemp->variable;
+ }
+
+ fprintf (intfp, ") {\n\n");
+
+ if (root->nodetype == Function)
+ fprintf (intfp, "\n%s _retval;\n",
+ returnstring[root->astnode.source.returns]);
+
+ /* Emit all the 2D -> 1D conversion method calls */
+
+ dl_traverse (tmp, decs)
+ fprintf(intfp,"%s\n", (char *) dl_val(tmp));
+
+ emit_methcall(intfp,root);
+
+ /* Now emit all the 1D -> 2D conversion method calls */
+
+ dl_traverse (tmp, rest)
+ fprintf(intfp,"%s\n", (char *) dl_val(tmp));
+
+ if (root->nodetype == Function)
+ fprintf (intfp, "\nreturn _retval;\n");
+
+ fprintf (intfp, "}\n");
+ fprintf (intfp, "}\n");
+
+ fclose(intfp);
+}
+
+/*****************************************************************************
+ * *
+ * emit_methcall *
+ * *
+ * This routine generates the call to a 'raw' numerical routine. *
+ * Normally this is written to the file containing the simplified *
+ * interface for that routine. *
+ * *
+ *****************************************************************************/
+
+void
+emit_methcall(FILE *intfp, AST *root)
+{
+ AST *tempnode, *prev;
+ char *tempstring;
+ HASHNODE *hashtemp;
+ /* BOOL skipped; */
+
+ if (root->nodetype == Function)
+ fprintf (intfp, "_retval = ");
+
+ tempstring = strdup(root->astnode.source.name->astnode.ident.name);
+ *tempstring = toupper(*tempstring);
+
+ fprintf(intfp,"%s.%s( ", tempstring,
+ root->astnode.source.name->astnode.ident.name);
+
+ prev = NULL;
+ tempnode = root->astnode.source.args;
+
+ /* for each argument */
+ for (; tempnode != NULL; tempnode = tempnode->nextstmt)
+ {
+ /* skipped = FALSE; */
+
+ hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name);
+ if (hashtemp == NULL)
+ {
+ fprintf (stderr,"Type table is screwed (codegen.c).\n");
+ fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ if (hashtemp->variable->astnode.ident.arraylist == NULL) {
+ if((prev != NULL) && (prev->astnode.ident.dim > 1) &&
+ !strcmp(tempnode->astnode.ident.name,prev->astnode.ident.leaddim))
+ {
+ /* If this arg follows a 2D array, pass the array's .length as the
+ * leading dimension to the numerical routine.
+ */
+
+ /* skipped = TRUE; */
+ fprintf(intfp, "%s.length" , prev->astnode.ident.name);
+ }
+ else
+ {
+ fprintf (intfp, "%s", tempnode->astnode.ident.name);
+ }
+ }
+ else {
+
+ if(hashtemp->variable->astnode.ident.dim > 2)
+ fprintf(stderr,
+ "Cant correctly generate interface with array over 2 dimensions\n");
+
+ if(hashtemp->variable->astnode.ident.dim == 1)
+ fprintf(intfp, " %s", tempnode->astnode.ident.name);
+ else if(hashtemp->variable->astnode.ident.dim == 2)
+ fprintf(intfp, " _%s_copy", tempnode->astnode.ident.name);
+
+ if(!noOffset && (hashtemp->variable->astnode.ident.dim == 1)) {
+ char * temp2 = (char *) f2jalloc(
+ strlen(tempnode->astnode.ident.name) + 9);
+
+ strcpy( temp2, "_");
+ strcat( temp2, tempnode->astnode.ident.name);
+ strcat( temp2, "_offset");
+ fprintf(intfp, ", %s",temp2);
+ }
+ else
+ fprintf(intfp, ", 0");
+ }
+
+ prev = hashtemp->variable;
+
+ /* Don't emit a comma on the last iteration. */
+ if(tempnode->nextstmt)
+ fprintf (intfp, ", ");
+ }
+
+ fprintf (intfp, ");\n\n");
+}
+
+/*****************************************************************************
+ * *
+ * forloop_emit *
+ * *
+ * This function generates code to implement the fortran DO loop. *
+ * naturally, we use Java's 'for' loop for this purpose. *
+ * *
+ * We also keep track of the nesting of for loops so that if we *
+ * encounter a goto statement within a loop, we can generate a *
+ * java 'break' or 'continue' statement. *
+ * *
+ * We should change the generation of for loops to match the Fortran77 *
+ * spec. For instance, the spec calls for computing the number of *
+ * iterations before the loop with the following formula: *
+ * MAX( INT( (stop - start + increment)/increment), 0) *
+ * that would simplify the code in this routine a lot. kgs 4/4/00 *
+ * *
+ *****************************************************************************/
+
+void
+forloop_emit (JVM_METHOD *meth, AST * root)
+{
+ char *indexname;
+
+ forloop_bytecode_emit(meth, root);
+
+ /* push this do loop's AST node on the stack */
+ dl_insert_b(doloop, root);
+
+ set_bytecode_status(meth, JAVA_ONLY);
+
+ /*
+ * Some point I will need to test whether this is really a name
+ * because it will crash if not.
+ */
+ indexname =
+ root->astnode.forloop.start->astnode.assignment.lhs->astnode.ident.name;
+
+ fprintf(curfp, "{\n");
+
+ if(root->astnode.forloop.incr != NULL)
+ {
+ fprintf(curfp,"int _%s_inc = ", indexname);
+ expr_emit (meth, root->astnode.forloop.incr);
+ fprintf(curfp, ";\n");
+ }
+
+ /* print out a label for this for loop */
+
+ /* commented out the forloop label since it is not used anymore.
+ * see the comment in goto_emit(). --keith
+ *
+ * fprintf(curfp, "forloop%s:\n",
+ * root->astnode.forloop.Label->astnode.constant.number);
+ */
+
+ /* This block writes out the loop parameters. */
+
+ fprintf (curfp, "for (");
+
+ assign_emit (meth, root->astnode.forloop.start);
+
+ fprintf(curfp, "; ");
+
+ if(root->astnode.forloop.incr == NULL)
+ {
+
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+
+ fprintf(curfp, " <= ");
+ if(gendebug)printf("forloop stop\n");
+ expr_emit (meth, root->astnode.forloop.stop);
+
+ fprintf (curfp, "; ");
+
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+
+ fprintf (curfp, "++");
+ }
+ else
+ {
+ /* if there is an increment the code should use >= if the
+ * increment is negative and <= if the increment is positive.
+ * If we determine that the increment is a constant, then
+ * we can simplify the code a little by generating the correct
+ * operator now.
+ */
+
+ if(root->astnode.forloop.incr->nodetype == Constant)
+ {
+ int increment=atoi(root->astnode.forloop.incr->astnode.constant.number);
+
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+ if(increment > 0)
+ fprintf(curfp," <= ");
+ else if(increment < 0)
+ fprintf(curfp," >= ");
+ else {
+ fprintf(stderr,"WARNING: Zero increment in do loop\n");
+ fprintf(curfp," /* ERR:zero increment..next op incorrect */ <= ");
+ }
+
+ if(gendebug)printf("forloop stop\n");
+ expr_emit (meth, root->astnode.forloop.stop);
+
+ fprintf (curfp, "; ");
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+ fprintf (curfp, " += _%s_inc",indexname);
+ }
+ else {
+ fprintf(curfp,"(_%s_inc < 0) ? ",indexname);
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+ fprintf(curfp," >= ");
+ if(gendebug)printf("forloop stop\n");
+ expr_emit (meth, root->astnode.forloop.stop);
+ fprintf(curfp," : ");
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+ fprintf(curfp," <= ");
+ expr_emit (meth, root->astnode.forloop.stop);
+ fprintf (curfp, "; ");
+
+ name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs);
+ fprintf (curfp, " += _%s_inc",indexname);
+ }
+ }
+
+ fprintf (curfp, ") {\n");
+
+ set_bytecode_status(meth, JAVA_AND_JVM);
+ /* Done with loop parameters. */
+}
+
+/*****************************************************************************
+ * *
+ * forloop_bytecode_emit *
+ * *
+ * this function emits the bytecode to begin a for loop. here we only *
+ * generate the initial code that comes before the body of the loop: *
+ * - initialization of loop variable *
+ * - calculation of increment count *
+ * - goto (branch to end of loop to test for loop completion) *
+ * *
+ *****************************************************************************/
+
+void
+forloop_bytecode_emit(JVM_METHOD *meth, AST *root)
+{
+ set_bytecode_status(meth, JVM_ONLY);
+
+ /* emit the initialization assignment for the loop variable */
+ assign_emit(meth, root->astnode.forloop.start);
+
+ /* now emit the expression to calculate the number of
+ * iterations that this loop should make and store the result
+ * into the next available local variable.
+ */
+ expr_emit(meth, root->astnode.forloop.iter_expr);
+ root->astnode.forloop.localvar = bc_get_next_local(meth, jvm_Int);
+ bc_gen_store_op(meth, root->astnode.forloop.localvar, jvm_Int);
+
+ /* goto the end of the loop where we test for completion */
+ root->astnode.forloop.goto_node = bc_append(meth, jvm_goto);
+
+ set_bytecode_status(meth, JAVA_AND_JVM);
+}
+
+/*****************************************************************************
+ * *
+ * goto_emit *
+ * *
+ * Since gotos aren't supported by java, we can't just emit a goto here. *
+ * labeled continues and breaks are supported in java, but only in certain *
+ * cases. so, if we are within a loop, and we are trying to goto the *
+ * CONTINUE statement of an enclosing loop, then we can just emit a labeled *
+ * continue statement. --Keith *
+ * *
+ * I think I fixed a previous problem emitting gotos within nested *
+ * simulated while loops by keeping track of all if statements rather than *
+ * just the ones identified as while statements. 10/3/97 -- Keith *
+ * *
+ *****************************************************************************/
+
+void
+goto_emit (JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *goto_node;
+
+ /* for bytecode, maintain a list of the gotos so that we can come back
+ * later and resolve the branch targets.
+ */
+ goto_node = bc_append(meth, jvm_goto);
+
+ bc_set_integer_branch_label(goto_node, root->astnode.go_to.label);
+
+ if(gendebug)
+ printf("## setting branch_label of this node to %d\n",
+ root->astnode.go_to.label);
+
+ if(label_search(doloop, root->astnode.go_to.label) != NULL)
+ {
+ /*
+ * we are inside a do loop and we are looking at a goto
+ * statement to the 'continue' statement of an enclosing loop.
+ * what we want to do here is just emit a 'labeled continue'
+ */
+
+ /*
+ * fprintf(curfp,"continue forloop%d;\n",root->astnode.go_to.label);
+ */
+
+ /* well... in order to allow the continuation statement of the DO loop
+ * to be any arbitrary statement, we cannot translate this to a labeled
+ * continue because the statement must be executed before continuing
+ * the loop (and JAva's continue statement will not do that for us).
+ */
+ fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename,
+ root->astnode.go_to.label);
+ }
+ else if((!dl_empty(while_list)) &&
+ (dl_int_examine(while_list) == root->astnode.go_to.label ))
+ {
+ /*
+ * we are inside a simulated while loop and we are looking at
+ * a goto statement to the 'beginning' statement of the most
+ * enclosing if statment. Since we are translating this to an
+ * actual while loop, we ignore this goto statement
+ */
+
+ fprintf(curfp,"// goto %d (end while)\n",root->astnode.go_to.label);
+ }
+ else
+ {
+ /*
+ * otherwise, not quite sure what to do with this one, so
+ * we'll just emit a dummy goto
+ */
+
+ fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename,
+ root->astnode.go_to.label);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * computed_goto_emit *
+ * *
+ * This function generates code to implement fortran's computed *
+ * GOTO statement. we simply use a series of if-else statements *
+ * to implement the computed goto. *
+ * *
+ *****************************************************************************/
+
+void
+computed_goto_emit(JVM_METHOD *meth, AST *root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *goto_node;
+ AST *temp;
+ unsigned int lvar, count = 1;
+
+ lvar = bc_get_next_local(meth, jvm_Int);
+
+ fprintf(curfp,"{\n");
+ fprintf(curfp," int _cg_tmp = ");
+
+ if(root->astnode.computed_goto.name->vartype != Integer) {
+ fprintf(curfp,"(int)( ");
+ expr_emit(meth, root->astnode.computed_goto.name);
+ bc_append(meth, typeconv_matrix[root->astnode.computed_goto.name->vartype]
+ [Integer]);
+ fprintf(curfp,")");
+ }
+ else
+ expr_emit(meth, root->astnode.computed_goto.name);
+
+ bc_gen_store_op(meth, lvar, jvm_Int);
+ fprintf(curfp,";\n");
+
+ for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(temp != root->astnode.computed_goto.intlist)
+ fprintf(curfp,"else ");
+ fprintf(curfp,"if (_cg_tmp == %d) \n", count);
+ fprintf(curfp," Dummy.go_to(\"%s\",%s);\n", cur_filename,
+ temp->astnode.constant.number);
+ bc_gen_load_op(meth, lvar, jvm_Int);
+ bc_push_int_const(meth, count);
+ if_node = bc_append(meth, jvm_if_icmpne);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_branch_label(goto_node, temp->astnode.constant.number);
+
+ bc_set_branch_target(if_node, bc_append(meth, jvm_xxxunusedxxx));
+
+ count++;
+ }
+ fprintf(curfp,"}\n");
+
+ bc_release_local(meth, jvm_Int);
+}
+
+/*****************************************************************************
+ * *
+ * assigned_goto_emit *
+ * *
+ * This function generates code to implement fortran's assigned *
+ * GOTO statement. we simply use a series of if-else statements *
+ * to implement the assigned goto. *
+ * *
+ *****************************************************************************/
+
+void
+assigned_goto_emit(JVM_METHOD *meth, AST *root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *goto_node;
+ AST *temp;
+ unsigned int lvar;
+ int i, count;
+ char **labels;
+ Dlist tmp;
+
+ count = 0;
+
+ /* if this assigned goto has an integer list of possible targets, e.g.:
+ * GOTO x (10, 20, 30)
+ * then root->astnode.computed_goto.intlist should be non-null and will
+ * contain a list of AST nodes.
+ *
+ * if there is no list of targets, e.g.:
+ * GOTO x
+ * then we fall back on the list of all possible targets created during
+ * parsing.
+ *
+ * Since these lists are stored in different data structures, we will
+ * just convert them to an array of strings here so that we can just
+ * write one loop to do the code generation.
+ */
+
+ if(root->astnode.computed_goto.intlist) {
+ for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt)
+ count++;
+ }
+ else {
+ dl_traverse (tmp, cur_assign_list)
+ count++;
+ }
+
+ if(count == 0) {
+ fprintf(stderr, "Warning: didn't expect empty list of statement labels\n");
+ return;
+ }
+
+ labels = (char **) f2jalloc(count * sizeof(char *));
+
+ i = 0;
+
+ if(root->astnode.computed_goto.intlist) {
+ for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt)
+ labels[i++] = temp->astnode.constant.number;
+ }
+ else {
+ dl_traverse (tmp, cur_assign_list)
+ labels[i++] = ((AST *)dl_val(tmp))->astnode.constant.number;
+ }
+
+ /* Now the array of integer targets has been built. */
+
+ lvar = bc_get_next_local(meth, jvm_Int);
+
+ fprintf(curfp,"{\n");
+ fprintf(curfp," int _cg_tmp = ");
+
+ expr_emit(meth, root->astnode.computed_goto.name);
+
+ bc_gen_store_op(meth, lvar, jvm_Int);
+ fprintf(curfp,";\n");
+
+ for(i=0;i<count;i++)
+ {
+ if(i != 0)
+ fprintf(curfp,"else ");
+ fprintf(curfp,"if (_cg_tmp == %s) \n", labels[i]);
+ fprintf(curfp," Dummy.go_to(\"%s\",%s);\n", cur_filename, labels[i]);
+ bc_gen_load_op(meth, lvar, jvm_Int);
+ bc_push_int_const(meth, atoi(labels[i]));
+ if_node = bc_append(meth, jvm_if_icmpne);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_branch_label(goto_node, labels[i]);
+
+ bc_set_branch_target(if_node, bc_append(meth, jvm_xxxunusedxxx));
+ }
+ fprintf(curfp,"}\n");
+
+ bc_release_local(meth, jvm_Int);
+}
+
+/*****************************************************************************
+ * *
+ * logicalif_emit *
+ * *
+ * This function generates code for IF statements. Java and Fortran have *
+ * pretty similar if statements, so this one is simple. *
+ * *
+ *****************************************************************************/
+
+void
+logicalif_emit(JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *next_node;
+
+ fprintf (curfp, "if (");
+
+ if (root->astnode.logicalif.conds != NULL)
+ expr_emit (meth, root->astnode.logicalif.conds);
+
+ if_node = bc_append(meth, jvm_ifeq);
+
+ fprintf (curfp, ") {\n ");
+
+ emit (root->astnode.logicalif.stmts);
+
+ fprintf (curfp, "}\n ");
+
+ /* create a dummy instruction node following the stmts so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(if_node, next_node);
+}
+
+/*****************************************************************************
+ * *
+ * arithmeticif_emit *
+ * *
+ * This function generates code for arithmetic IF statements. *
+ * *
+ *****************************************************************************/
+
+void
+arithmeticif_emit (JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *goto_node;
+ unsigned int lvar;
+
+ lvar = bc_get_next_local(meth,
+ jvm_data_types[root->astnode.arithmeticif.cond->vartype]);
+
+ fprintf (curfp, "{\n");
+ fprintf (curfp, " %s _arif_tmp = ",
+ returnstring[root->astnode.arithmeticif.cond->vartype]);
+ expr_emit(meth, root->astnode.arithmeticif.cond);
+ bc_gen_store_op(meth, lvar,
+ jvm_data_types[root->astnode.arithmeticif.cond->vartype]);
+
+ fprintf (curfp, ";\n");
+
+ fprintf (curfp, "if (_arif_tmp < 0) \n ");
+ fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename,
+ root->astnode.arithmeticif.neg_label);
+ fprintf (curfp, "else if (_arif_tmp == 0) \n ");
+ fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename,
+ root->astnode.arithmeticif.zero_label);
+ fprintf (curfp, "else ");
+ fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename,
+ root->astnode.arithmeticif.pos_label);
+
+ fprintf (curfp, "}\n");
+
+ /* arithmetic ifs may have an integer,real,or double expression.
+ * since the conditionals are handled differently for integer,
+ * we split the cases into integer and non-integer.
+ */
+ if(root->astnode.arithmeticif.cond->vartype == Integer) {
+ bc_gen_load_op(meth, lvar, jvm_Int);
+ if_node = bc_append(meth, jvm_ifge);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node,
+ root->astnode.arithmeticif.neg_label);
+
+ bc_set_branch_target(if_node, bc_gen_load_op(meth, lvar, jvm_Int));
+ }
+ else {
+ bc_gen_load_op(meth, lvar, jvm_data_types[root->astnode.arithmeticif.cond->vartype]);
+ bc_append(meth, init_opcodes[root->astnode.arithmeticif.cond->vartype]);
+ bc_append(meth, cmpg_opcode[root->astnode.arithmeticif.cond->vartype]);
+ if_node = bc_append(meth, jvm_ifge);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node,
+ root->astnode.arithmeticif.neg_label);
+
+ bc_set_branch_target(if_node,
+ bc_gen_load_op(meth, lvar, jvm_data_types[root->astnode.arithmeticif.cond->vartype]));
+ bc_append(meth, init_opcodes[root->astnode.arithmeticif.cond->vartype]);
+ bc_append(meth, cmpg_opcode[root->astnode.arithmeticif.cond->vartype]);
+ }
+
+ if_node = bc_append(meth, jvm_ifne);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node,root->astnode.arithmeticif.zero_label);
+
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node, root->astnode.arithmeticif.pos_label);
+
+ bc_set_branch_target(if_node, goto_node);
+
+ bc_release_local(meth, jvm_data_types[root->astnode.arithmeticif.cond->vartype]);
+}
+
+/*****************************************************************************
+ * *
+ * label_emit *
+ * *
+ * This function generates labels. We generate both a java label *
+ * and a call to the Dummy.label() method for goto translation. *
+ * *
+ *****************************************************************************/
+
+void
+label_emit (JVM_METHOD *meth, AST * root)
+{
+ AST *loop;
+ int num;
+
+ num = root->astnode.label.number;
+
+ if(gendebug)
+ printf("looking at label %d\n", num);
+
+ root->astnode.label.instr = bc_append(meth, jvm_xxxunusedxxx);
+
+ /* if this continue statement corresponds with the most
+ * recent DO loop, then this is the end of the loop - pop
+ * the label off the doloop list.
+ */
+ loop = dl_astnode_examine(doloop);
+
+ if((loop != NULL) &&
+ (atoi(loop->astnode.forloop.Label->astnode.constant.number) == num))
+ {
+ do {
+ /*
+ * finally pop this loop's label number off the stack and
+ * emit the label (for experimental goto resolution)
+ */
+
+ fprintf(curfp,"Dummy.label(\"%s\",%d);\n",cur_filename,num);
+
+ dl_pop(doloop);
+
+ if((root->astnode.label.stmt != NULL) &&
+ (root->astnode.label.stmt->nodetype != Format))
+ emit (root->astnode.label.stmt);
+
+ fprintf(curfp, "} // Close for() loop. \n");
+ fprintf(curfp, "}\n");
+
+ forloop_end_bytecode(meth, loop);
+
+ loop = dl_astnode_examine(doloop);
+ } while((loop != NULL) &&
+ (atoi(loop->astnode.forloop.Label->astnode.constant.number) == num));
+ }
+ else {
+ /* this labeled statement is not associated with a DO loop */
+
+ fprintf (curfp, "label%d:\n ", num);
+ fprintf(curfp,"Dummy.label(\"%s\",%d);\n",cur_filename, num);
+
+ if((root->astnode.label.stmt != NULL) &&
+ (root->astnode.label.stmt->nodetype != Format))
+ {
+ emit (root->astnode.label.stmt);
+ }
+ }
+
+ bc_associate_integer_branch_label(meth, root->astnode.label.instr,
+ root->astnode.label.number);
+}
+
+/*****************************************************************************
+ * *
+ * forloop_end_bytecode *
+ * *
+ * bytecode-only generation of the final components of a DO loop: *
+ * - increment loop variable *
+ * - decrement and check the iteration count *
+ * *
+ *****************************************************************************/
+
+void
+forloop_end_bytecode(JVM_METHOD *meth, AST *root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *iload_node;
+ unsigned int icount;
+
+ icount = root->astnode.forloop.localvar;
+
+ set_bytecode_status(meth, JVM_ONLY);
+
+ /* increment loop variable */
+ assign_emit(meth, root->astnode.forloop.incr_expr);
+
+ /* decrement iteration count */
+ bc_gen_iinc(meth, icount, -1);
+
+ iload_node = bc_gen_load_op(meth, icount, jvm_Int);
+
+ bc_set_branch_target(root->astnode.forloop.goto_node, iload_node);
+
+ if_node = bc_append(meth, jvm_ifgt);
+ bc_set_branch_target(if_node,
+ bc_get_next_instr(root->astnode.forloop.goto_node));
+
+ bc_release_local(meth, jvm_Int);
+
+ set_bytecode_status(meth, JAVA_AND_JVM);
+}
+
+/*****************************************************************************
+ * *
+ * read_emit *
+ * *
+ * Emit a READ statement. Calls formatted_read_emit() or *
+ * unformatted_read_emit(), depending on whether there is a *
+ * corresponding FORMAT statement. *
+ * *
+ *****************************************************************************/
+
+void
+read_emit (JVM_METHOD *meth, AST * root)
+{
+ char *fmt_str, tmp[100];
+ HASHNODE *hnode;
+
+ /* look for a format statement */
+ sprintf(tmp,"%d", root->astnode.io_stmt.format_num);
+ if(gendebug)
+ printf("***Looking for format statement number: %s\n",tmp);
+
+ hnode = format_lookup(cur_format_table,tmp);
+
+ if(hnode)
+ fmt_str = format2str(hnode->variable->astnode.label.stmt);
+ else if(root->astnode.io_stmt.fmt_list != NULL)
+ fmt_str = strdup(root->astnode.io_stmt.fmt_list->astnode.constant.number);
+ else
+ fmt_str = NULL;
+
+ if(fmt_str)
+ formatted_read_emit(meth, root, fmt_str);
+ else
+ unformatted_read_emit(meth, root);
+}
+
+/*****************************************************************************
+ * *
+ * unformatted_read_emit *
+ * *
+ * This function generates unformatted READ statements. We generate calls *
+ * to a Java class called EasyIn to perform the I/O. Also emit a try-catch *
+ * to trap IOExceptions. *
+ * *
+ *****************************************************************************/
+
+void
+unformatted_read_emit(JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *goto_node1, *goto_node2, *try_start, *pop_node;
+ JVM_EXCEPTION_TABLE_ENTRY *et_entry;
+ AST *assign_temp;
+ AST *temp;
+ int c;
+
+ try_start = NULL;
+
+ /* if the READ statement has no args, just read a line and
+ * ignore it.
+ */
+
+ if(root->astnode.io_stmt.arg_list == NULL) {
+ fprintf(curfp,"%s.readString(); // skip a line\n", F2J_STDIN);
+ bc_gen_load_op(meth, stdin_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "readString",
+ "()Ljava/lang/String;");
+ bc_append(meth, jvm_invokevirtual, c);
+ return;
+ }
+
+ /* if the READ statement includes an END label, then we
+ * use a try block to determine EOF. the catch block, emitted
+ * below, just contains the GOTO.
+ */
+
+ if(root->astnode.io_stmt.end_num > 0 )
+ {
+ fprintf(curfp,"try {\n");
+ funcname = input_func_eof;
+ try_start = bc_append(meth, jvm_xxxunusedxxx);
+ }
+ else
+ funcname = input_func;
+
+ assign_temp = addnode();
+ assign_temp->nodetype = Assignment;
+
+ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(temp->nodetype == IoImpliedLoop)
+ implied_loop_emit(meth, temp, read_implied_loop_bytecode_emit,
+ read_implied_loop_sourcecode_emit);
+ else if(temp->nodetype == Identifier)
+ {
+ temp->parent = assign_temp;
+ assign_temp->astnode.assignment.lhs = temp;
+
+ name_emit(meth, assign_temp->astnode.assignment.lhs);
+
+ bc_gen_load_op(meth, stdin_lvar, jvm_Object);
+ if( (temp->vartype == Character) || (temp->vartype == String) ) {
+ int len;
+
+ len = temp->astnode.ident.len < 0 ? 1 : temp->astnode.ident.len;
+
+ fprintf(curfp," = %s.%s(%d);\n", F2J_STDIN, funcname[temp->vartype],
+ len);
+ bc_push_int_const(meth, len);
+ }
+ else {
+ fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[temp->vartype]);
+ }
+
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, funcname[temp->vartype],
+ input_descriptors[temp->vartype]);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ LHS_bytecode_emit(meth, assign_temp);
+ }
+ else
+ {
+ fprintf(stderr,"Read list must consist of idents or implied loops\n");
+ fprintf(stderr," nodetype is %s\n", print_nodetype(temp));
+ continue;
+ }
+ }
+
+ free_ast_node(assign_temp);
+
+ fprintf(curfp,"%s.skipRemaining();\n", F2J_STDIN);
+ bc_gen_load_op(meth, stdin_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "skipRemaining", "()V");
+ bc_append(meth, jvm_invokevirtual, c);
+
+ /* Emit the catch block for when we hit EOF. We only care if
+ * the READ statement has an END label.
+ */
+
+ if(root->astnode.io_stmt.end_num > 0)
+ {
+ fprintf(curfp,"} catch (java.io.IOException e) {\n");
+ fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename,
+ root->astnode.io_stmt.end_num);
+ fprintf(curfp,"}\n");
+
+ goto_node1 = bc_append(meth, jvm_goto); /* skip the exception handler */
+
+ /* following is the exception handler for IOException. this
+ * implements Fortrans END specifier (eg READ(*,*,END=100)).
+ * the exception handler just consists of a pop to get the stack
+ * back to normal and a goto to branch to the label specified
+ * in the END spec.
+ */
+ pop_node = bc_append(meth, jvm_pop);
+
+ /* artificially set stack depth at beginning of exception
+ * handler to 1.
+ */
+ bc_set_stack_depth(pop_node, 1);
+
+ goto_node2 = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node2, root->astnode.io_stmt.end_num);
+
+ bc_set_branch_target(goto_node1, bc_append(meth, jvm_xxxunusedxxx));
+
+ et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY));
+ et_entry->from = try_start;
+ et_entry->to = pop_node;
+ et_entry->target = pop_node;
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class, IOEXCEPTION);
+ et_entry->catch_type = c;
+
+ bc_add_exception_handler(meth, et_entry);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * formatted_read_assign_emit *
+ * *
+ * Emits the assignment statement of an implied loop in a READ statement. *
+ * If emit_source is TRUE, emits both bytecode and source code. *
+ * *
+ *****************************************************************************/
+
+void
+formatted_read_assign_emit(JVM_METHOD *meth, AST *temp,
+ int emit_source, int idx)
+{
+ AST *assign_temp, *idx_temp = NULL;
+ int c;
+
+ assign_temp = addnode();
+ assign_temp->nodetype = Assignment;
+
+ if(idx >= 0) {
+ idx_temp = addnode();
+ idx_temp->token = INTEGER;
+ idx_temp->nodetype = Constant;
+ idx_temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ if(!idx_temp->astnode.constant.number) {
+ fprintf(stderr, "malloc failed in formatted_read_assign_emit()\n");
+ exit(EXIT_FAILURE);
+ }
+
+ sprintf(idx_temp->astnode.constant.number, "%d", idx);
+ idx_temp->vartype = Integer;
+ idx_temp->nextstmt = NULL;
+ temp->astnode.ident.arraylist = idx_temp;
+ }
+
+ temp->parent = assign_temp;
+ assign_temp->astnode.assignment.lhs = temp;
+
+ name_emit(meth, assign_temp->astnode.assignment.lhs);
+
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ bc_append(meth, jvm_iconst_0);
+
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "remove",
+ VEC_REMOVE_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ if((temp->vartype == Character) || (temp->vartype == String)) {
+ /* special case for string since we don't need to call any method
+ * to get the value as with other primitive types (e.g. intValue,
+ * doubleValue, etc).
+ */
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class,
+ numeric_wrapper[temp->vartype]);
+ bc_append(meth, jvm_checkcast, c);
+
+ if(emit_source)
+ fprintf(curfp," = (%s) %s.remove(0);\n", java_wrapper[temp->vartype],
+ F2J_IO_VEC);
+ }
+ else if(temp->vartype == Logical) {
+ /* special case for boolean since java.lang.Boolean can't be cast
+ * to java.lang.Number.
+ */
+
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class,
+ numeric_wrapper[temp->vartype]);
+ bc_append(meth, jvm_checkcast, c);
+
+ if(emit_source)
+ fprintf(curfp," = ((Boolean) %s.remove(0)).booleanValue();\n",
+ F2J_IO_VEC);
+ c = bc_new_methodref(cur_class_file, numeric_wrapper[temp->vartype],
+ numericValue_method[temp->vartype],
+ numericValue_descriptor[temp->vartype]);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ else {
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, JL_NUMBER);
+ bc_append(meth, jvm_checkcast, c);
+
+ if(emit_source)
+ fprintf(curfp," = ((Number) %s.remove(0)).%s();\n",
+ F2J_IO_VEC, numericValue_method[temp->vartype]);
+ c = bc_new_methodref(cur_class_file, JL_NUMBER,
+ numericValue_method[temp->vartype],
+ numericValue_descriptor[temp->vartype]);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+
+ LHS_bytecode_emit(meth, assign_temp);
+
+ free_ast_node(assign_temp);
+ if(idx_temp) {
+ free_ast_node(idx_temp);
+ temp->astnode.ident.arraylist = NULL;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * read_emit *
+ * *
+ * This function generates formatted READ statements. J.Paine's formatter *
+ * is used behind the scenes. *
+ * *
+ *****************************************************************************/
+
+void
+formatted_read_emit(JVM_METHOD *meth, AST *root, char *fmt_str)
+{
+ AST *temp;
+ int c;
+
+ /* if the READ statement has no args, just read a line and
+ * ignore it.
+ */
+
+ if(root->astnode.io_stmt.arg_list == NULL) {
+ fprintf(curfp,"%s.readString(); // skip a line\n", F2J_STDIN);
+ bc_gen_load_op(meth, stdin_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "readString",
+ "()Ljava/lang/String;");
+ bc_append(meth, jvm_invokevirtual, c);
+ return;
+ }
+
+ gen_clear_io_vec(meth);
+
+ bc_push_string_const(meth, fmt_str);
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "f77read", F77_READ_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(root->astnode.io_stmt.end_num > 0 )
+ {
+ JVM_CODE_GRAPH_NODE *if_node, *goto_node;
+
+ /* the READ statement includes an END label, so we
+ * test the return value to determine EOF.
+ */
+ fprintf(curfp, "if(Util.f77read(\"%s\", %s) <= 0)\n", fmt_str, F2J_IO_VEC);
+ fprintf(curfp," Dummy.go_to(\"%s\",%d);\n",cur_filename,
+ root->astnode.io_stmt.end_num);
+
+ if_node = bc_append(meth, jvm_ifgt);
+ goto_node = bc_append(meth, jvm_goto);
+ bc_set_integer_branch_label(goto_node, root->astnode.io_stmt.end_num);
+ bc_set_branch_target(if_node, bc_append(meth, jvm_xxxunusedxxx));
+ }
+ else {
+ fprintf(curfp, "Util.f77read(\"%s\", %s);\n", fmt_str, F2J_IO_VEC);
+ /* return value is unused, so pop it off the stack */
+ bc_append(meth, jvm_pop);
+ }
+
+ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ {
+ HASHNODE *ht;
+
+ if(temp->nodetype == IoImpliedLoop)
+ implied_loop_emit(meth, temp, formatted_read_implied_loop_bytecode_emit,
+ formatted_read_implied_loop_sourcecode_emit);
+ else if((temp->nodetype == Identifier) &&
+ (ht=type_lookup(cur_array_table, temp->astnode.ident.name)) &&
+ (temp->astnode.ident.arraylist == NULL))
+ {
+ if(ht->variable->astnode.ident.array_len == -1) {
+ fprintf(stderr, "Warning: passing implied size array to formatted read.\n");
+ fprintf(stderr, " this won't work properly.\n");
+
+ formatted_read_assign_emit(meth, temp, TRUE, -1);
+ }
+ else {
+ int i;
+
+ for(i=0; i < ht->variable->astnode.ident.array_len; i++) {
+ formatted_read_assign_emit(meth, temp, TRUE, i+1);
+ }
+ }
+ }
+ else if(temp->nodetype == Identifier)
+ formatted_read_assign_emit(meth, temp, TRUE, -1);
+ else
+ {
+ fprintf(stderr,"Read list must consist of idents or implied loops\n");
+ fprintf(stderr," nodetype is %s\n", print_nodetype(temp));
+ continue;
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * formatted_read_implied_loop_bytecode_emit *
+ * *
+ * This function generates code for implied DO loops contained in READ *
+ * statements including FORMAT statements. *
+ * *
+ *****************************************************************************/
+
+void
+formatted_read_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *iot;
+
+ for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt)
+ {
+ if(iot->nodetype != Identifier) {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(iot));
+ fprintf(stderr," in implied loop (read stmt)\n");
+ }
+ else
+ formatted_read_assign_emit(meth, iot, FALSE, -1);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * formatted_read_implied_loop_sourcecode_emit *
+ * *
+ * This function generates code for implied DO loops contained in READ *
+ * statements including FORMAT statements. *
+ * *
+ *****************************************************************************/
+
+void
+formatted_read_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *iot;
+
+ fprintf(curfp,"{\n");
+ for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt)
+ {
+ if(iot->nodetype != Identifier) {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(iot));
+ fprintf(stderr," in implied loop (read stmt)\n");
+ }
+ else {
+ name_emit(meth, iot);
+
+ if((iot->vartype == Character) || (iot->vartype == String))
+ fprintf(curfp," = (%s) %s.remove(0);\n", java_wrapper[iot->vartype],
+ F2J_IO_VEC);
+ else if(iot->vartype == Logical)
+ fprintf(curfp," = ((Boolean) %s.remove(0)).booleanValue();\n",
+ F2J_IO_VEC);
+ else
+ fprintf(curfp," = ((Number) %s.remove(0)).%s();\n",
+ F2J_IO_VEC, numericValue_method[iot->vartype]);
+ }
+ }
+ fprintf(curfp,"}\n");
+}
+
+/*****************************************************************************
+ * *
+ * read_implied_loop_bytecode_emit *
+ * *
+ * This function generates code for implied DO loops contained in READ *
+ * statements. We dont handle any FORMAT statements. *
+ * *
+ *****************************************************************************/
+
+void
+read_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *assign_temp, *temp, *iot;
+ int c;
+
+ for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt)
+ {
+ if(iot->nodetype != Identifier) {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(iot));
+ fprintf(stderr," in implied loop (read stmt)\n");
+ }
+ else {
+ fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[iot->vartype]);
+ assign_temp = addnode();
+ assign_temp->nodetype = Assignment;
+
+ temp = iot;
+ temp->parent = assign_temp;
+ assign_temp->astnode.assignment.lhs = temp;
+
+ name_emit(meth, assign_temp->astnode.assignment.lhs);
+
+ bc_gen_load_op(meth, stdin_lvar, jvm_Object);
+
+ if( (temp->vartype == Character) || (temp->vartype == String) ) {
+ if(temp->astnode.ident.len < 0)
+ bc_push_int_const(meth, 1);
+ else
+ bc_push_int_const(meth, temp->astnode.ident.len);
+ }
+
+ c = bc_new_methodref(cur_class_file, EASYIN_CLASS, funcname[temp->vartype],
+ input_descriptors[temp->vartype]);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ LHS_bytecode_emit(meth, assign_temp);
+ }
+ }
+
+}
+
+/*****************************************************************************
+ * *
+ * read_implied_loop_sourcecode_emit *
+ * *
+ * This function generates code for implied DO loops contained in READ *
+ * statements. We dont handle any FORMAT statements. *
+ * *
+ *****************************************************************************/
+
+void
+read_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *iot;
+
+ fprintf(curfp,"{\n");
+ for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt)
+ {
+ if(iot->nodetype != Identifier) {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(iot));
+ fprintf(stderr," in implied loop (read stmt)\n");
+ }
+ else {
+ name_emit(meth, iot);
+ fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[iot->vartype]);
+ }
+ }
+ fprintf(curfp,"}\n");
+}
+
+/*****************************************************************************
+ * *
+ * isArrayNoIdx *
+ * *
+ * returns TRUE if this is an array reference which is not indexed. *
+ * *
+ *****************************************************************************/
+
+BOOL
+isArrayNoIdx(AST *var)
+{
+ return( (var->token == NAME) &&
+ (type_lookup(cur_array_table, var->astnode.ident.name) != NULL) &&
+ (var->astnode.ident.arraylist == NULL) );
+
+}
+
+/*****************************************************************************
+ * *
+ * format2str *
+ * *
+ * Converts a list of format items to a format string. *
+ * *
+ *****************************************************************************/
+
+char *
+format2str(AST *node)
+{
+ char buf[8192], *tmpstr;
+ AST *temp;
+ int i, j;
+
+ buf[0] = 0;
+
+ for(temp = node; temp; temp=temp->nextstmt) {
+ switch(temp->token) {
+ case EDIT_DESC:
+ case NAME:
+ strcat(buf, temp->astnode.ident.name);
+ break;
+ case STRING:
+ /* escaping quotes in the string to be passed to the Formatter.
+ * largest temp can be is 2 * len + 1 (if every char is a quote)
+ */
+
+ tmpstr = malloc(2 * strlen(temp->astnode.constant.number) + 1);
+ if(!tmpstr)
+ return NULL;
+
+ for(i = j = 0; i < strlen(temp->astnode.constant.number); i++) {
+ if(temp->astnode.constant.number[i] == '\'') {
+ tmpstr[j] = '\'';
+ j++;
+ tmpstr[j] = '\'';
+ j++;
+ }
+ else {
+ tmpstr[j] = temp->astnode.constant.number[i];
+ j++;
+ }
+ }
+ tmpstr[j] = 0;
+
+ strcat(buf, "'");
+ strcat(buf, tmpstr);
+ strcat(buf, "'");
+
+ free(tmpstr);
+ break;
+ case INTEGER:
+ strcat(buf, temp->astnode.constant.number);
+ break;
+ case REPEAT:
+ tmpstr = format2str(temp->astnode.label.stmt);
+ strcat(buf, "(");
+ strcat(buf, tmpstr);
+ strcat(buf, ")");
+ free(tmpstr);
+ break;
+ case CM:
+ strcat(buf, ",");
+ break;
+ case DIV:
+ strcat(buf, "/");
+ break;
+ case CAT:
+ strcat(buf, "//");
+ break;
+ case COLON:
+ strcat(buf, ":");
+ break;
+ default:
+ fprintf(stderr,"formatitem2str: Unknown token!!! %d (%s) - ",
+ temp->token, tok2str(temp->token));
+ if(gendebug)
+ printf("this node type %s\n",print_nodetype(temp));
+ break;
+ }
+ }
+
+ return strdup(buf);
+}
+
+/*****************************************************************************
+ * *
+ * gen_clear_io_vec *
+ * *
+ * Generates code to clear the Vector used for formatted I/O calls. *
+ * *
+ *****************************************************************************/
+
+void
+gen_clear_io_vec(JVM_METHOD *meth)
+{
+ int c;
+
+ fprintf(curfp, "%s.clear();\n", F2J_IO_VEC);
+
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "clear", "()V");
+ bc_append(meth, jvm_invokevirtual, c);
+}
+
+void
+write_argument_emit(JVM_METHOD *meth, AST *root)
+{
+ HASHNODE *ht;
+ int c;
+
+ if((root->nodetype == Identifier) &&
+ (ht=type_lookup(cur_array_table, root->astnode.ident.name)) &&
+ (root->astnode.ident.arraylist == NULL))
+ {
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ARRAY_SPEC_CLASS);
+ bc_append(cur_method, jvm_new,c);
+ bc_append(cur_method, jvm_dup);
+
+ fprintf(curfp, " %s.addElement(new ArraySpec(", F2J_IO_VEC);
+
+ if(ht->variable->astnode.ident.array_len == -1) {
+ fprintf(stderr, "Warning: passing implied size array to formatted write\n");
+ fprintf(stderr, " only using first element\n");
+ root->parent->nodetype = Call;
+ expr_emit(meth, root);
+ root->parent->nodetype = Write;
+ }
+ else
+ expr_emit(meth, root);
+
+ fprintf(curfp, ", %d));\n", ht->variable->astnode.ident.array_len);
+
+ bc_push_int_const(meth, ht->variable->astnode.ident.array_len);
+
+ c = bc_new_methodref(cur_class_file, ARRAY_SPEC_CLASS, "<init>",
+ array_spec_descriptor[root->vartype]);
+
+ bc_append(cur_method, jvm_invokespecial, c);
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement",
+ VEC_ADD_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ else {
+ ht = type_lookup(cur_type_table, root->astnode.ident.name);
+
+ if(ht && (root->vartype == String) &&
+ (root->astnode.ident.len == 1) &&
+ (root->astnode.ident.dim == 0) &&
+ (root->astnode.ident.arraylist == NULL) &&
+ (ht->variable->astnode.ident.startDim[2] != NULL))
+ {
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ARRAY_SPEC_CLASS);
+ bc_append(cur_method, jvm_new,c);
+ bc_append(cur_method, jvm_dup);
+
+ fprintf(curfp, " %s.addElement(new ArraySpec(", F2J_IO_VEC);
+
+ expr_emit(meth, root);
+
+ fprintf(curfp, "));\n");
+
+ c = bc_new_methodref(cur_class_file, ARRAY_SPEC_CLASS, "<init>",
+ "(Ljava/lang/String;)V");
+ }
+ else {
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class,
+ numeric_wrapper[root->vartype]);
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[root->vartype],
+ "<init>", wrapper_descriptor[root->vartype]);
+
+ fprintf(curfp, " %s.addElement(new %s(", F2J_IO_VEC,
+ java_wrapper[root->vartype]);
+ expr_emit(meth, root);
+ fprintf(curfp,"));\n");
+ }
+
+ bc_append(meth, jvm_invokespecial, c);
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement",
+ VEC_ADD_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * write_emit *
+ * *
+ * This function handles WRITE statements. It is FAR from complete, *
+ * but it is usually good enough to test the numerical routines. *
+ * *
+ *****************************************************************************/
+
+void
+write_emit(JVM_METHOD *meth, AST * root)
+{
+ char *fmt_str, tmp[100];
+ HASHNODE *hnode;
+ AST *temp;
+ int c;
+
+ /* look for a format statement */
+ sprintf(tmp,"%d", root->astnode.io_stmt.format_num);
+ if(gendebug)
+ printf("***Looking for format statement number: %s\n",tmp);
+
+ hnode = format_lookup(cur_format_table,tmp);
+
+ if(hnode)
+ fmt_str = format2str(hnode->variable->astnode.label.stmt);
+ else if(root->astnode.io_stmt.fmt_list != NULL)
+ fmt_str = strdup(root->astnode.io_stmt.fmt_list->astnode.constant.number);
+ else
+ fmt_str = NULL;
+
+ gen_clear_io_vec(meth);
+
+ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) {
+ if(temp->nodetype == IoImpliedLoop) {
+ implied_loop_emit(meth, temp, write_implied_loop_bytecode_emit,
+ write_implied_loop_sourcecode_emit);
+ }
+ else
+ write_argument_emit(meth, temp);
+ }
+
+ if(fmt_str) {
+ fprintf(curfp, "Util.f77write(\"%s\", %s);\n", fmt_str, F2J_IO_VEC);
+ bc_push_string_const(meth, fmt_str);
+ }
+ else {
+ fprintf(curfp, "Util.f77write(null, %s);\n", F2J_IO_VEC);
+ bc_append(meth, jvm_aconst_null);
+ }
+
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "f77write", F77_WRITE_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+}
+
+/*****************************************************************************
+ * *
+ * implied_loop_emit *
+ * *
+ * This function generates code for implied DO loops in I/O statements. *
+ * Dont worry about FORMAT statements. *
+ * *
+ *****************************************************************************/
+
+void
+implied_loop_emit(JVM_METHOD *meth, AST *node,
+ void loop_body_bytecode_emit(JVM_METHOD *, AST *),
+ void loop_body_sourcecode_emit(JVM_METHOD *, AST *))
+{
+ JVM_CODE_GRAPH_NODE *if_node, *goto_node, *iload_node;
+ AST *temp;
+ unsigned int icount;
+
+ temp = addnode();
+ temp->nodetype = Assignment;
+ temp->astnode.assignment.lhs = node->astnode.forloop.counter;
+ temp->astnode.assignment.lhs->parent = temp;
+ temp->astnode.assignment.rhs = node->astnode.forloop.start;
+ temp->astnode.assignment.rhs->parent = temp;
+
+ set_bytecode_status(meth, JAVA_ONLY);
+
+ fprintf(curfp,"for(");
+
+ assign_emit(meth, temp);
+
+ fprintf(curfp,"; ");
+
+ expr_emit(meth, node->astnode.forloop.counter);
+ fprintf(curfp," <= ");
+ expr_emit(meth, node->astnode.forloop.stop);
+
+ if(node->astnode.forloop.incr == NULL) {
+ fprintf(curfp,"; ");
+ expr_emit(meth, node->astnode.forloop.counter);
+ fprintf(curfp,"++)\n");
+ }
+ else
+ {
+ fprintf(curfp,"; ");
+ expr_emit(meth, node->astnode.forloop.counter);
+ fprintf(curfp," += ");
+ expr_emit(meth, node->astnode.forloop.incr);
+ fprintf(curfp,")\n");
+ }
+
+ loop_body_sourcecode_emit(meth, node);
+ set_bytecode_status(meth, JVM_ONLY);
+
+ /* the rest of this code is only generated as bytecode.
+ * first emit the initial assignment.
+ */
+ assign_emit(meth, temp);
+
+ /* now emit the expression to calculate the number of
+ * iterations that this loop should make and store the result
+ * into the next available local variable.
+ */
+ expr_emit(meth, node->astnode.forloop.iter_expr);
+ icount = bc_get_next_local(meth, jvm_Int);
+ bc_gen_store_op(meth, icount, jvm_Int);
+
+ /* goto the end of the loop where we test for completion */
+ goto_node = bc_append(meth, jvm_goto);
+
+ loop_body_bytecode_emit(meth, node);
+
+ /* increment loop variable */
+ assign_emit(meth, node->astnode.forloop.incr_expr);
+
+ /* decrement iteration count */
+ bc_gen_iinc(meth, icount, -1);
+
+ iload_node = bc_gen_load_op(meth, icount, jvm_Int);
+
+ bc_set_branch_target(goto_node, iload_node);
+
+ if_node = bc_append(meth, jvm_ifgt);
+ bc_set_branch_target(if_node, bc_get_next_instr(goto_node));
+
+ bc_release_local(meth, jvm_Int);
+ set_bytecode_status(meth, JAVA_AND_JVM);
+}
+
+/*****************************************************************************
+ * *
+ * write_implied_loop_sourcecode_emit *
+ * *
+ * this function emits the body of an implied loop (basically just the *
+ * StringBuffer.append() method invocations. (Java source only) *
+ * *
+ *****************************************************************************/
+
+void
+write_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *temp;
+
+ fprintf(curfp,"{\n");
+ for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt)
+ {
+ if(temp->nodetype == Identifier) {
+ write_argument_emit(meth, temp);
+ }
+ else if(temp->nodetype == Constant) {
+ fprintf(curfp, " %s.addElement(new %s(", F2J_IO_VEC,
+ java_wrapper[temp->vartype]);
+ expr_emit(meth, temp);
+ fprintf(curfp,"));\n");
+ }
+ else {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(temp));
+ fprintf(stderr," in implied loop (write stmt). Exiting.\n");
+ exit(EXIT_FAILURE);
+ }
+ }
+ fprintf(curfp,"}\n");
+}
+
+/*****************************************************************************
+ * *
+ * write_implied_loop_bytecode_emit *
+ * *
+ * this function emits the body of an implied loop (basically just the *
+ * StringBuffer.append() method invocations. (JVM bytecode only) *
+ * *
+ *****************************************************************************/
+
+void
+write_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node)
+{
+ AST *temp;
+ int c;
+
+ for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt)
+ {
+ /* emit loop body */
+
+ if(temp->nodetype == Identifier) {
+ write_argument_emit(meth, temp);
+ }
+ else if(temp->nodetype == Constant) {
+ bc_gen_load_op(meth, iovec_lvar, jvm_Object);
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class,
+ numeric_wrapper[temp->vartype]);
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype],
+ "<init>", wrapper_descriptor[temp->vartype]);
+
+ pushConst(meth, temp);
+
+ bc_append(meth, jvm_invokespecial, c);
+ c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement",
+ VEC_ADD_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ else {
+ fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ",
+ unit_name,print_nodetype(temp));
+ fprintf(stderr," in implied loop (write stmt). Exiting.\n");
+ exit(EXIT_FAILURE);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * blockif_emit *
+ * *
+ * This function generates the code which implements fortran's *
+ * block if. This could also be a simulated while loop, which *
+ * is why we push this loop's number on the while_list. This *
+ * way we can generate a java 'while' loop instead of the *
+ * simulated while loop using gotos. *
+ * *
+ *****************************************************************************/
+
+void
+blockif_emit (JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *next_node, *goto_node;
+ AST *prev = root->prevstmt;
+ int *tmp_int;
+ Dlist gotos, lptr;
+ AST *temp;
+
+ /* in bytecode, each if-block and elseif-block must have a goto at
+ * the end to branch to the statement following the end if. since we
+ * cannot know the PC of that statement until we've generated all
+ * the if-blocks, elseif-blocks, and else-block, we maintain a list
+ * of the gotos so that we may go back and fill in the branch targets.
+ */
+ gotos = make_dl();
+
+ /* first check if the if-block is NULL. if so, this cannot be a
+ * simulated while loop because the existence of a goto would cause
+ * the if-block to be non-null.
+ */
+ if(root->astnode.blockif.stmts != NULL) {
+ /* if the previous node was a label, this could be a simulated
+ * while loop.
+ */
+ if(prev != NULL) {
+ if(prev->nodetype == Label) {
+ tmp_int = (int*)f2jalloc(sizeof(int));
+
+ *tmp_int = root->prevstmt->astnode.label.number;
+
+ /* push this while loop's number on the stack */
+
+ dl_insert_b(while_list, tmp_int);
+
+ if(prev->astnode.label.stmt == NULL)
+ if((root->astnode.blockif.elseifstmts == NULL) &&
+ (root->astnode.blockif.elsestmts == NULL))
+ {
+ /* it appears that we are looking at a simulated while loop.
+ * bypass all the statements in the body of this if block
+ * and look at the last one. if it is a goto and the
+ * target is the label of the current if statement, then
+ * we generate a Java while loop. otherwise, we generate
+ * an if statement.
+ */
+
+ for
+ (
+ temp=root->astnode.blockif.stmts;
+ temp->nextstmt!=NULL;
+ temp = temp->nextstmt
+ )
+ ; /* do nothing */
+
+ if(temp->nodetype == Goto)
+ if(temp->astnode.go_to.label == prev->astnode.label.number) {
+ while_emit(meth, root);
+ dl_delete_list(gotos);
+ return;
+ }
+ }
+
+ /* pop this while loop's label number off the stack */
+ tmp_int = (int *)dl_pop(while_list);
+ f2jfree(tmp_int, sizeof(int));
+ }
+ }
+ }
+
+ fprintf (curfp, "if (");
+ if(root->astnode.blockif.conds != NULL)
+ expr_emit (meth, root->astnode.blockif.conds);
+
+ if_node = bc_append(meth, jvm_ifeq);
+
+ fprintf (curfp, ") {\n ");
+ if(root->astnode.blockif.stmts != NULL)
+ emit (root->astnode.blockif.stmts);
+ fprintf (curfp, "}\n");
+
+ if(root->astnode.blockif.elseifstmts || root->astnode.blockif.elsestmts)
+ {
+ goto_node = bc_append(meth, jvm_goto);
+
+ dl_insert_b(gotos, goto_node);
+
+ /* create a dummy instruction node so that
+ * we have a branch target for the goto statement.
+ * it will be removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(if_node, next_node);
+
+ for(temp = root->astnode.blockif.elseifstmts;
+ temp != NULL;
+ temp = temp->nextstmt)
+ {
+ goto_node = elseif_emit (meth, temp);
+ dl_insert_b(gotos, goto_node);
+ }
+
+ if(root->astnode.blockif.elsestmts != NULL)
+ else_emit (root->astnode.blockif.elsestmts);
+
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+
+ dl_traverse(lptr, gotos) {
+ goto_node = (JVM_CODE_GRAPH_NODE *) lptr->val;
+ bc_set_branch_target(goto_node, next_node);
+ }
+
+ dl_delete_list(gotos);
+ }
+ else {
+ /* Else there are no else or elseif blocks, so we do not need
+ * any gotos to branch from the end of the blocks to the statement
+ * following the block if. All we need to do is set the if_node
+ * branch target to the opcode to which we should branch if the
+ * conditional expression is false.
+ */
+
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(if_node, next_node);
+ }
+
+ /* If the endif has a statement label, create a new Label node
+ * and add it as the next statement. It will get emitted on the
+ * next call to emit().
+ */
+
+ if(root->astnode.blockif.endif_label >= 0) {
+ AST *newnode;
+
+ newnode = addnode();
+ newnode->nodetype = Label;
+ newnode->astnode.label.number = root->astnode.blockif.endif_label;
+ newnode->astnode.label.stmt = NULL;
+
+ newnode->nextstmt = root->nextstmt;
+ root->nextstmt = newnode;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * while_emit *
+ * *
+ * while_emit() is called when an if statement has been identified *
+ * as a simulated while loop, e.g.: *
+ * *
+ * 10 continue *
+ * if(x < 10) then *
+ * do something *
+ * x = x+1 *
+ * goto 10 *
+ * *
+ * this can be translated into java as: *
+ * *
+ * while(x<10) { *
+ * do something *
+ * x = x+1 *
+ * } *
+ * *
+ * that gives us one less goto statement to worry about. --Keith *
+ * *
+ *****************************************************************************/
+
+void
+while_emit(JVM_METHOD *meth, AST *root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *next_node;
+
+ fprintf(curfp, "while (");
+ if (root->astnode.blockif.conds != NULL)
+ expr_emit (meth, root->astnode.blockif.conds);
+ fprintf (curfp, ") {\n ");
+ if_node = bc_append(meth, jvm_ifeq);
+ emit (root->astnode.blockif.stmts);
+
+ /* create a dummy instruction node so that
+ * we have a branch target for the goto statement.
+ * it will be removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(if_node, next_node);
+
+ fprintf (curfp, "} // end while()\n");
+
+}
+
+/*****************************************************************************
+ * *
+ * elseif_emit *
+ * *
+ * This function generates the code for the fortran 'else if' *
+ * construct. *
+ * *
+ *****************************************************************************/
+
+JVM_CODE_GRAPH_NODE *
+elseif_emit (JVM_METHOD *meth, AST * root)
+{
+ JVM_CODE_GRAPH_NODE *if_node, *next_node, *goto_node;
+
+ if(gendebug)printf("in else if\n");
+ fprintf (curfp, "else if (");
+
+ if (root->astnode.blockif.conds != NULL)
+ expr_emit (meth, root->astnode.blockif.conds);
+ if_node = bc_append(meth, jvm_ifeq);
+ fprintf (curfp, ") {\n ");
+ emit (root->astnode.blockif.stmts);
+ fprintf (curfp, "} // Close else if()\n");
+
+ goto_node = bc_append(meth, jvm_goto);
+
+ /* create a dummy instruction node so that we have a branch target
+ * for the conditional statement. it will be removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(if_node, next_node);
+
+ return goto_node;
+}
+
+/*****************************************************************************
+ * *
+ * else_emit *
+ * *
+ * This function generates the code for the fortran 'else' *
+ * construct. *
+ * *
+ *****************************************************************************/
+
+void
+else_emit (AST * root)
+{
+ fprintf (curfp, "else {\n ");
+ emit (root->astnode.blockif.stmts);
+ fprintf (curfp, "} // Close else.\n");
+}
+
+/*****************************************************************************
+ * *
+ * method_name_emit *
+ * *
+ * This function generates the correct method name for this function call. *
+ * Depending on whether adapters are necessary, we may emit the name of the *
+ * Fortran function, the name of a reflective method invocation, or an *
+ * adapter method. *
+ * *
+ * Returns 1 if the Call is completely generated here, 0 otherwise. *
+ * *
+ *****************************************************************************/
+
+int
+method_name_emit (JVM_METHOD *meth, AST *root, BOOL adapter)
+{
+ char *tempname;
+ HASHNODE *ht;
+ AST *temp;
+ int c;
+
+ /* shouldn't be necessary to lowercase the name
+ * lowercase (root->astnode.ident.name);
+ */
+
+ tempname = strdup (root->astnode.ident.name);
+ *tempname = toupper (*tempname);
+
+ /* If this function was passed in as an argument, we call an
+ * 'adapter' which performs the reflective method invocation..
+ */
+
+ if(type_lookup(cur_args_table, root->astnode.ident.name)) {
+ if(gendebug)
+ printf("@@ calling passed-in func %s\n",root->astnode.ident.name);
+
+ /* if this function has no args, we can simplify the calling
+ * process by not creating an argument array or calling a
+ * method adapter.
+ */
+
+ if((root->astnode.ident.arraylist == NULL) ||
+ (root->astnode.ident.arraylist->nodetype == EmptyArgList))
+ {
+
+ /* no args. either function or subroutine. */
+
+ ht = type_lookup(cur_external_table, root->astnode.ident.name);
+ if(!ht) {
+ fprintf(stderr,"(2)Error: expected to find '%s' in external table.\n",
+ root->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object);
+ bc_append(meth, jvm_aconst_null);
+ bc_append(meth, jvm_aconst_null);
+
+ c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke",
+ INVOKE_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ if(root->nodetype == Call) {
+ /* already called invoke(). for CALL, ignore the return value. */
+ bc_append(meth, jvm_pop);
+
+ fprintf(curfp,"_%s_meth.invoke(null,null);\n",
+ root->astnode.ident.name);
+ }
+ else {
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ numeric_wrapper[root->vartype]);
+ bc_append(meth, jvm_checkcast, c);
+
+ if((root->vartype == String) || (root->vartype == Character)) {
+ fprintf(curfp,"(%s)_%s_meth.invoke(null,null)",
+ java_wrapper[root->vartype], root->astnode.ident.name);
+ }
+ else {
+ fprintf(curfp,"((%s)_%s_meth.invoke(null,null)).%s()",
+ java_wrapper[root->vartype], root->astnode.ident.name,
+ numericValue_method[root->vartype]);
+
+ c = bc_new_methodref(cur_class_file, numeric_wrapper[root->vartype],
+ numericValue_method[root->vartype],
+ numericValue_descriptor[root->vartype]);
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+ return 1;
+ }
+ else if (root->nodetype == Call) {
+
+ /* subroutine with args. */
+
+ unsigned int cnt = 0, arr_local;
+
+ for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt) {
+ cnt++;
+
+ if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name))
+ cnt++;
+ }
+
+ /* create object array to hold the args */
+
+ fprintf(curfp," Object [] _%s_args = new Object[%d];\n",
+ root->astnode.ident.name, cnt);
+
+ bc_push_int_const(meth, cnt);
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ "java/lang/Object");
+
+ bc_append(meth, jvm_anewarray, c);
+ arr_local = bc_get_next_local(meth, jvm_Object);
+ bc_gen_store_op(meth, arr_local,jvm_Object);
+
+ /* foreach arg, assign that arg to an element of the object array */
+
+ cnt = 0;
+ for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt)
+ {
+ fprintf(curfp,"_%s_args[%d] = ", root->astnode.ident.name, cnt);
+
+ bc_gen_load_op(meth, arr_local,jvm_Object);
+ bc_push_int_const(meth, cnt);
+
+ if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name))
+ {
+ expr_emit (meth, temp);
+ bc_append(meth, jvm_aastore);
+
+ fprintf(curfp,";\n");
+ fprintf(curfp,"_%s_args[%d] = new Integer(0);\n",
+ root->astnode.ident.name, ++cnt);
+
+ bc_gen_load_op(meth, arr_local,jvm_Object);
+ bc_push_int_const(meth, cnt); /* incremented 2 lines above */
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ numeric_wrapper[Integer]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[Integer],
+ "<init>", wrapper_descriptor[Integer]);
+ bc_push_int_const(meth, 0);
+
+ bc_append(meth, jvm_invokespecial, c);
+ }
+ else
+ {
+ fprintf(curfp,"new %s(", java_wrapper[temp->vartype]);
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ numeric_wrapper[temp->vartype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype],
+ "<init>", wrapper_descriptor[temp->vartype]);
+
+ expr_emit (meth, temp);
+ fprintf(curfp,");\n");
+
+ bc_append(meth, jvm_invokespecial, c);
+ }
+
+ bc_append(meth, jvm_aastore);
+
+ cnt++;
+ }
+
+ ht = type_lookup(cur_external_table, root->astnode.ident.name);
+ if(!ht) {
+ fprintf(stderr,"(3)Error: expected to find '%s' in external table.\n",
+ root->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object);
+ bc_append(meth, jvm_aconst_null);
+ bc_gen_load_op(meth, arr_local, jvm_Object);
+
+ c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke",
+ INVOKE_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ fprintf(curfp,"_%s_meth.invoke(null,_%s_args);\n",
+ root->astnode.ident.name, root->astnode.ident.name);
+
+ bc_release_local(meth, jvm_Object);
+
+ bc_append(meth, jvm_pop);
+ f2jfree(tempname, strlen(tempname)+1);
+ return 1;
+ }
+ else /* function with args. */
+ {
+ /* add this call to the list of calls which need adapters */
+
+ insert_methcall(methcall_list,root);
+
+ /* no bytecode to be emitted here */
+
+ fprintf(curfp,"%s_methcall",root->astnode.ident.name);
+ }
+ }
+ else if( adapter )
+ {
+ /* we need to generate an 'adapter' which will simulate
+ * passing array elements by reference.
+ */
+
+ if(gendebug)
+ printf("wow, guess we need an adapter for %s.\n",
+ root->astnode.ident.name);
+
+ insert_adapter(root);
+
+ /* Assume all methods that are invoked are static. */
+ fprintf (curfp, "%s_adapter", root->astnode.ident.name);
+ }
+ else {
+ JVM_METHODREF *mref = get_method_name(root, adapter);
+
+ /* mref should always be non-null, though i guess it's
+ * possible that the elements may be null.
+ */
+
+ if((mref->classname != NULL) && (strlen(mref->classname) > 0)) {
+ char *t;
+
+ t = char_substitution(mref->classname, '/', '.');
+ fprintf (curfp, "%s.%s", t, root->astnode.ident.name);
+ f2jfree(t, strlen(t)+1);
+ }
+ else
+ fprintf (curfp, "%s.%s", tempname, root->astnode.ident.name);
+
+ bc_free_fieldref(mref);
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * get_method_name *
+ * *
+ * the method that we call depends on whether this function needs an *
+ * adapter, reflection, etc. this function determines the correct method *
+ * name and returns it as a string. *
+ * *
+ *****************************************************************************/
+
+JVM_METHODREF *
+get_method_name(AST *root, BOOL adapter)
+{
+ char *buf, *tempname;
+ char *tmpdesc;
+ JVM_METHODREF *newmeth = NULL;
+
+ tempname = strdup (root->astnode.ident.name);
+ *tempname = toupper (*tempname);
+
+ buf = (char *)f2jalloc(
+ MAX((strlen(tempname) + strlen(root->astnode.ident.name)),
+ (strlen(root->astnode.ident.name) + 9)) + 5);
+ buf[0] = '\0';
+
+ if(type_lookup(cur_args_table, root->astnode.ident.name)) {
+ if((root->astnode.ident.arraylist->nodetype == EmptyArgList) ||
+ (root->astnode.ident.arraylist == NULL)) {
+ /* should not hit this */
+ }
+ else if (root->nodetype == Call) {
+ /* should not hit this */
+ }
+ else {
+ sprintf(buf,"%s_methcall",root->astnode.ident.name);
+ newmeth = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF));
+
+ newmeth->classname = strdup(cur_filename);
+ newmeth->methodname = strdup(buf);
+
+ tmpdesc = get_desc_from_arglist(root->astnode.ident.arraylist);
+
+ newmeth->descriptor = (char*)f2jalloc(strlen(tmpdesc) +
+ strlen(METHOD_CLASS) +
+ strlen(field_descriptor[root->vartype][0]) + 10);
+ strcpy(newmeth->descriptor, "(");
+ strcat(newmeth->descriptor, "L");
+ strcat(newmeth->descriptor, METHOD_CLASS);
+ strcat(newmeth->descriptor, ";");
+ strcat(newmeth->descriptor, tmpdesc);
+ strcat(newmeth->descriptor, ")");
+ strcat(newmeth->descriptor, field_descriptor[root->vartype][0]);
+
+ f2jfree(tmpdesc, strlen(tmpdesc)+1);
+
+ if(gendebug)
+ printf("methcall descriptor = %s\n",newmeth->descriptor);
+ }
+ }
+ else if(adapter)
+ {
+ HASHNODE *hashtemp;
+
+ sprintf (buf, "%s_adapter", root->astnode.ident.name);
+ newmeth = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF));
+ newmeth->classname = strdup(cur_filename);
+ newmeth->methodname = strdup(buf);
+
+ hashtemp = type_lookup(function_table, root->astnode.ident.name);
+
+ if(hashtemp) {
+ tmpdesc = get_adapter_desc(hashtemp->variable->astnode.source.descriptor,
+ root->astnode.ident.arraylist);
+ }
+ else {
+ JVM_METHODREF *mref;
+
+ mref = find_method(root->astnode.ident.name, descriptor_table);
+ if(mref)
+ tmpdesc = get_adapter_desc(mref->descriptor,
+ root->astnode.ident.arraylist);
+ else {
+ fprintf(stderr, "WARNING: could not find method descriptor\n");
+ tmpdesc = strdup("IIIIIII"); /* just some junk */
+ }
+ }
+
+ newmeth->descriptor = (char*)f2jalloc(strlen(tmpdesc) +
+ strlen(field_descriptor[root->vartype][0]) + 10);
+ strcpy(newmeth->descriptor, "(");
+ strcat(newmeth->descriptor, tmpdesc);
+ strcat(newmeth->descriptor, ")");
+ if(!type_lookup(cur_type_table, root->astnode.ident.name))
+ strcat(newmeth->descriptor, "V");
+ else
+ strcat(newmeth->descriptor, field_descriptor[root->vartype][0]);
+
+ f2jfree(tmpdesc, strlen(tmpdesc)+1);
+
+ if(gendebug)
+ printf("get_method_name: descriptor = '%s'\n",newmeth->descriptor);
+ }
+ else
+ {
+ newmeth = get_methodref(root);
+ }
+
+ f2jfree(buf,
+ MAX((strlen(tempname) + strlen(root->astnode.ident.name)),
+ (strlen(root->astnode.ident.name) + 9)) + 5);
+ f2jfree(tempname, strlen(tempname)+1);
+
+ return newmeth;
+}
+
+/*****************************************************************************
+ * *
+ * get_methodref *
+ * *
+ * looks for a method with the given name in the function table and returns *
+ * a methodref with the appropriate class, method, and descriptor. *
+ * *
+ *****************************************************************************/
+
+JVM_METHODREF *
+get_methodref(AST *node)
+{
+ JVM_METHODREF *new_mref, *srch_mref;
+ HASHNODE *ht;
+ char *tempname = NULL;
+
+ new_mref = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF));
+
+ /* first check the symbol table for information about this function. */
+
+ if( (ht = type_lookup(function_table, node->astnode.ident.name)) != NULL)
+ {
+ /* we found this method in the symbol table, so now we fill out the
+ * methodref structure based on the symtable info.
+ */
+ tempname = strdup (node->astnode.ident.name);
+ *tempname = toupper (*tempname);
+
+ new_mref->classname = bc_get_full_classname(tempname, package_name);
+ new_mref->methodname = strdup(node->astnode.ident.name);
+ if(ht->variable->astnode.source.descriptor == NULL) {
+ fprintf(stderr, "Warning: null descriptor for %s...",
+ new_mref->methodname);
+ fprintf(stderr, "probably not declared EXTERNAL\n");
+ }
+ else
+ new_mref->descriptor = strdup(ht->variable->astnode.source.descriptor);
+ }
+ else
+ {
+ /* we cannot find this method in the symbol table, so now we look
+ * in the descriptor table, which is generated from reading the .f2j
+ * files.
+ */
+
+ srch_mref = find_method(node->astnode.ident.name, descriptor_table);
+ if(!srch_mref)
+ {
+ /* if we reach this, then we cannot find this method anywhere.
+ * try to guess at the descriptor. Since the guess is likely to
+ * be wrong, generate a warning message (unless this is a function
+ * passed in as an argument).
+ */
+
+ if(type_lookup(cur_args_table, node->astnode.ident.name) == NULL) {
+ fprintf(stderr, "WARNING: could not resolve call to '%s'.\n",
+ node->astnode.ident.name);
+ fprintf(stderr, " This will probably result in incorrect code generation.\n");
+ fprintf(stderr, " Make sure the external function was compiled already and\n");
+ fprintf(stderr, " check the paths specified using the -c flag.\n");
+ }
+
+ tempname = strdup (node->astnode.ident.name);
+ *tempname = toupper (*tempname);
+
+ new_mref->classname = bc_get_full_classname(tempname, package_name);
+ new_mref->methodname = strdup(node->astnode.ident.name);
+
+ f2jfree(tempname, strlen(tempname)+1);
+ tempname = get_desc_from_arglist(node->astnode.ident.arraylist);
+
+ new_mref->descriptor = (char *)f2jalloc(strlen(tempname) + 10);
+
+ strcpy(new_mref->descriptor,"(");
+ strcat(new_mref->descriptor,tempname);
+ strcat(new_mref->descriptor,")V"); /* assume void return type */
+ }
+ else {
+ /* we may later free the mref, so dup the table entry */
+
+ new_mref->classname = strdup(srch_mref->classname);
+ new_mref->methodname = strdup(srch_mref->methodname);
+ new_mref->descriptor = strdup(srch_mref->descriptor);
+ }
+ }
+
+ if(tempname != NULL)
+ f2jfree(tempname, strlen(tempname)+1);
+
+ return new_mref;
+}
+
+/*****************************************************************************
+ * *
+ * call_emit *
+ * *
+ * This procedure implements Lapack and Blas type methods. *
+ * They are translated to static method invocations. *
+ * This is not a portable solution, it is specific to *
+ * routines generated by f2java. *
+ * *
+ *****************************************************************************/
+
+void
+call_emit (JVM_METHOD *meth, AST * root)
+{
+ BOOL adapter;
+ JVM_METHODREF *mref;
+ int c;
+
+ assert (root != NULL);
+
+ if(gendebug)
+ printf("@##@ in call_emit, %s\n",root->astnode.ident.name);
+
+ adapter = needs_adapter(root);
+
+ /* if method_name_emit() already completely generated the call, return now */
+
+ if( method_name_emit(meth, root, adapter) )
+ return;
+
+ if(gendebug)
+ printf("call_emit, %s not already emitted\n",root->astnode.ident.name);
+
+ if((root->astnode.ident.arraylist == NULL) ||
+ (root->astnode.ident.arraylist->nodetype == EmptyArgList))
+ {
+ /* the arg list is empty, just emit "()" and return */
+
+ mref = get_method_name(root, adapter);
+
+ if(gendebug)
+ printf("call_emit (type: %s), got class = '%s', name = '%s'\n",
+ returnstring[root->vartype], mref->classname, mref->methodname);
+
+ c = bc_new_methodref(cur_class_file,mref->classname, mref->methodname,
+ mref->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ if(root->nodetype == Call)
+ fprintf (curfp, "();\n");
+ else
+ fprintf (curfp, "()");
+
+ bc_free_fieldref(mref);
+
+ return;
+ }
+
+ fprintf (curfp, "(");
+
+ /* for reflective method call adapters, the first paramter should
+ * be the method to invoke.
+ */
+
+ if(type_lookup(cur_args_table, root->astnode.ident.name)) {
+ HASHNODE *ht;
+
+ fprintf(curfp,"_%s_meth",root->astnode.ident.name);
+
+ if(root->astnode.ident.arraylist != NULL)
+ fprintf(curfp,",");
+
+ ht = type_lookup(cur_external_table, root->astnode.ident.name);
+ if(!ht) {
+ fprintf(stderr,"(4)Error: expected to find '%s' in external table.\n",
+ root->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+
+ bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object);
+ }
+
+ emit_call_arguments(meth, root, adapter);
+
+ mref = get_method_name(root, adapter);
+
+ c = bc_new_methodref(cur_class_file,mref->classname, mref->methodname,
+ mref->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ /*
+ * Problem here, depends on who called this procedure.
+ * When this is used by the CALL keyword, it works as
+ * written. When used to create an external function call,
+ * it adds an extra ; and \n to the output. Might be
+ * able to fix this by checking the nodetype.
+ */
+
+ if(root->nodetype == Call)
+ fprintf (curfp, ");\n");
+ else
+ fprintf (curfp, ")");
+
+ if(gendebug)printf("leaving-call emit\n");
+ bc_free_fieldref(mref);
+} /* Close call_emit(). */
+
+/*****************************************************************************
+ * *
+ * emit_call_arguments *
+ * *
+ * this function attempts to find the method descriptor for the fortran *
+ * subroutine or function that we are calling. *
+ * *
+ *****************************************************************************/
+
+void
+emit_call_arguments(JVM_METHOD *meth, AST *root, BOOL adapter)
+{
+ JVM_METHODREF *mref;
+
+ /* look up the function that we are calling so that we may compare
+ * the parameters.
+ */
+
+ mref = get_methodref(root);
+
+ if(gendebug)
+ printf("Looking up function name %s...%s\n", root->astnode.ident.name,
+ mref ? "Found" : "Not found");
+
+ if(mref != NULL)
+ emit_call_args_known(meth, root, mref->descriptor, adapter);
+ else
+ emit_call_args_unknown(meth, root);
+
+ bc_free_fieldref(mref);
+}
+
+/*****************************************************************************
+ * *
+ * emit_call_args_known *
+ * *
+ * this function emits the arguments to a method call when we know the *
+ * descriptor for the method. in this case we can determine whether each *
+ * arg needs to be passed by reference or not. e.g. if you pass a constant *
+ * to a method expecting an intW object, then the constant must be wrapped *
+ * in an intW before calling the method. *
+ * *
+ *****************************************************************************/
+
+void
+emit_call_args_known(JVM_METHOD *meth, AST *root, char *desc, BOOL adapter)
+{
+ char *com_prefix, *dptr;
+ AST *temp;
+
+ if(gendebug)
+ printf("emit_call_args_known: desc = '%s'\n", desc);
+
+ temp = root->astnode.ident.arraylist;
+ dptr = bc_next_desc_token(desc);
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ {
+
+ com_prefix = get_common_prefix(temp->astnode.ident.name);
+
+ /*
+ * if the arg is an identifier AND
+ * it looks like an array access AND
+ * it is in the array table
+ */
+
+ if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist != NULL) &&
+ (type_lookup(cur_array_table, temp->astnode.ident.name)!=NULL))
+ {
+ arrayacc_arg_emit(meth, temp, dptr, adapter);
+ }
+
+ /*
+ * else if the arg is an identifier AND
+ * it does not look like an array access AND
+ * it is in the array table
+ */
+
+ else if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name) )
+ {
+ arrayref_arg_emit(meth, temp, dptr);
+ }
+
+ /*
+ * else if the arg is an identifier AND
+ * it does not look like an array access AND
+ * it is not in the array table
+ */
+
+ else if(omitWrappers && ((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL) &&
+ !type_lookup(cur_array_table, temp->astnode.ident.name) ))
+ {
+ scalar_arg_emit(meth, temp, dptr, com_prefix);
+ }
+ else if(omitWrappers && (temp->nodetype == Constant))
+ {
+ if(isPassByRef_desc(dptr) || (dptr[0] == '['))
+ {
+ int c;
+
+ fprintf(curfp,"new %s(",
+ wrapper_returns[get_type_from_field_desc(dptr)]);
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ full_wrappername[temp->vartype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype],
+ "<init>", wrapper_descriptor[temp->vartype]);
+
+ expr_emit (meth, temp);
+ fprintf(curfp,")");
+
+ bc_append(meth, jvm_invokespecial, c);
+ }
+ else
+ expr_emit(meth, temp);
+ }
+ else if(
+ ((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL) )
+ || (temp->nodetype == Constant) )
+ {
+ expr_emit(meth, temp);
+ }
+ else if(temp->nodetype != EmptyArgList)
+ {
+ wrapped_arg_emit(meth, temp, dptr);
+ }
+
+ /* if this arg is an array, then skip an extra token to compensate
+ * for the additional integer offset arg.
+ */
+
+ if(dptr[0] == '[')
+ dptr = bc_next_desc_token(dptr);
+
+ dptr = bc_next_desc_token(dptr);
+
+ if(temp->nextstmt != NULL)
+ fprintf(curfp, ",");
+
+ f2jfree(com_prefix, strlen(com_prefix)+1);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * arrayacc_arg_emit *
+ * *
+ * this function emits an argument to a method call when the arg: *
+ * - is an identifier AND *
+ * - it looks like an array access AND *
+ * - it is in the array table *
+ * *
+ *****************************************************************************/
+
+void
+arrayacc_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr, BOOL adapter)
+{
+ BOOL isarg, isext;
+ struct var_info *vtemp;
+
+ isarg = type_lookup(cur_args_table, temp->astnode.ident.name) != NULL;
+
+ if(gendebug)
+ printf("arrayacc_arg_emit() %s - %s\n", temp->astnode.ident.name, dptr);
+
+ vtemp = push_array_var(meth, temp);
+
+ if(dptr[0] == '[') /* it is expecting an array */
+ {
+
+ func_array_emit(meth, temp->astnode.ident.arraylist,
+ temp->astnode.ident.name, isarg, TRUE);
+ }
+ else /* it is not expecting an array */
+ {
+ /* In this case we are passing the array element to the
+ * adapter, so we dont wrap it in an object.
+ */
+
+ if(omitWrappers) {
+ if(adapter && isPassByRef_desc(dptr))
+ isext = TRUE;
+ else
+ isext = FALSE;
+ }
+ else {
+ if(adapter)
+ isext = TRUE;
+ else
+ isext = FALSE;
+ }
+
+ func_array_emit (meth, temp->astnode.ident.arraylist,
+ temp->astnode.ident.name, isarg, isext);
+
+ if(!isext)
+ bc_gen_array_load_op(meth, jvm_data_types[temp->vartype]);
+ }
+
+ free_var_info(vtemp);
+}
+
+/*****************************************************************************
+ * *
+ * arrayref_arg_emit *
+ * *
+ * this function emits an argument to a method call when the arg: *
+ * - the arg is an identifier AND *
+ * - it does not look like an array access AND *
+ * - it is in the array table *
+ * *
+ *****************************************************************************/
+
+void
+arrayref_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr)
+{
+
+ if(dptr[0] == '[') /* it is expecting an array */
+ {
+ if(gendebug)
+ printf("expecting array\n");
+
+ expr_emit(meth, temp);
+ }
+ else
+ {
+ struct var_info *vtemp;
+
+ if(gendebug)
+ printf("NOT expecting array\n");
+
+ vtemp = push_array_var(meth, temp);
+
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ /* fprintf(curfp,"%s%s[0]",com_prefix, temp->astnode.ident.name); */
+ fprintf(curfp,"[0]");
+ bc_push_int_const(meth, 0);
+ bc_gen_array_load_op(meth, jvm_data_types[temp->vartype]);
+ }
+ else
+ {
+ /* in this case, the array has no index and the corresponding
+ * parameter is pass-by-reference, so we assume an index of 0
+ * which would be the behavior of fortran.
+ */
+
+ bc_push_int_const(meth, 0);
+ fprintf(curfp,",0");
+ /*
+ * fprintf(curfp,"new %s(",
+ * wrapper_returns[get_type_from_field_desc(dptr)]);
+ * fprintf(curfp,"%s%s[0]", com_prefix,temp->astnode.ident.name);
+ * fprintf(curfp,")");
+ */
+ }
+
+ free_var_info(vtemp);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * scalar_arg_emit *
+ * *
+ * this function emits an argument to a method call when the arg: *
+ * - the arg is an identifier AND *
+ * - it does not look like an array access AND *
+ * - it is not in the array table *
+ * *
+ *****************************************************************************/
+
+void
+scalar_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr, char *com_prefix)
+{
+ if(gendebug) {
+ printf("scalar_arg_emit: ");
+ printf("name = %s (pass by ref = %s), dptr = %s (pass by ref = %s)\n",
+ temp->astnode.ident.name, cgPassByRef(temp->astnode.ident.name)?
+ "yes" : "no", dptr, isPassByRef_desc(dptr) ? "yes" : "no");
+ }
+
+ if(isPassByRef_desc(dptr) != cgPassByRef(temp->astnode.ident.name))
+ {
+
+ if(cgPassByRef(temp->astnode.ident.name)) {
+ struct var_info *ainf;
+
+ if(dptr[0] == '[')
+ fprintf(curfp,"%s%s",com_prefix,temp->astnode.ident.name);
+ else
+ fprintf(curfp,"%s%s.val",com_prefix,temp->astnode.ident.name);
+
+ ainf = get_var_info(temp);
+
+ if(dptr[0] == '[')
+ pushVar(cur_class_file, meth, temp->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, FALSE);
+ else
+ pushVar(cur_class_file, meth, temp->vartype, ainf->is_arg, ainf->class, ainf->name,
+ ainf->desc, ainf->localvar, TRUE);
+
+ free_var_info(ainf);
+ }
+ else if(type_lookup(cur_external_table, temp->astnode.ident.name)) {
+ external_emit(meth, temp);
+ }
+ else
+ fprintf(stderr,"Internal error: %s should not be primitive\n",
+ temp->astnode.ident.name);
+ }
+ else
+ {
+ if( temp->vartype != get_type_from_field_desc(dptr) )
+ fprintf(curfp,"(%s) ( ",returnstring[get_type_from_field_desc(dptr)]);
+
+ expr_emit(meth, temp);
+
+ if( temp->vartype != get_type_from_field_desc(dptr) ) {
+ fprintf(curfp,")");
+ bc_append(meth, typeconv_matrix[temp->vartype]
+ [get_type_from_field_desc(dptr)]);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * wrapped_arg_emit *
+ * *
+ * this function emits an argument to a method call when the arg does not *
+ * really fall into the other categories. *
+ * *
+ *****************************************************************************/
+
+void
+wrapped_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr)
+{
+ enum returntype vtype = get_type_from_field_desc(dptr);
+ int c = 0;
+
+ /*
+ * Otherwise, use wrappers.
+ */
+ if(omitWrappers) {
+ if(isPassByRef_desc(dptr)) {
+ fprintf(curfp,"new %s(", wrapper_returns[vtype]);
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ full_wrappername[temp->vartype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype],
+ "<init>", wrapper_descriptor[temp->vartype]);
+ }
+ }
+ else
+ {
+ fprintf(curfp,"new %s(", wrapper_returns[vtype]);
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ full_wrappername[temp->vartype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype],
+ "<init>", wrapper_descriptor[temp->vartype]);
+ }
+
+ if(gendebug) {
+ printf("emitting wrapped expr...\n");
+ printf(" wrapper type is %s\n",wrapper_returns[vtype]);
+ printf(" data type is %s\n",returnstring[temp->vartype]);
+ }
+
+ /* emit a cast if necessary */
+
+ if( temp->vartype != vtype )
+ fprintf(curfp,"(%s) ( ",returnstring[vtype]);
+
+ expr_emit(meth, temp);
+
+ if( temp->vartype != vtype ) {
+ fprintf(curfp,")");
+ bc_append(meth, typeconv_matrix[temp->vartype][vtype]);
+ }
+
+ if(omitWrappers) {
+ if(isPassByRef_desc(dptr)) {
+ fprintf(curfp,")");
+ bc_append(meth, jvm_invokespecial, c);
+ }
+ }
+ else
+ {
+ fprintf(curfp,")");
+ bc_append(meth, jvm_invokespecial, c);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * emit_call_args_unknown *
+ * *
+ * this function emits the arguments to a method call when the descriptor *
+ * of the method is unknown. in this case, we must guess at the appropriate *
+ * types - sometimes we are correct but most of the time, there is an error. *
+ * *
+ *****************************************************************************/
+
+void
+emit_call_args_unknown(JVM_METHOD *meth, AST *root)
+{
+ AST *temp;
+
+ temp = root->astnode.ident.arraylist;
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ {
+ if(((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.arraylist == NULL))
+ ||
+ (temp->nodetype == Constant))
+ {
+ expr_emit (meth, temp);
+ }
+ else
+ {
+ if(omitWrappers) {
+ expr_emit (meth, temp);
+ }
+ else
+ {
+ fprintf(curfp,"new %s(", wrapper_returns[temp->vartype]);
+ expr_emit (meth, temp);
+ fprintf(curfp,")");
+ }
+ }
+
+ if(temp->nextstmt != NULL)
+ fprintf(curfp, ",");
+ }
+}
+
+/*****************************************************************************
+ * *
+ * insert_methcall *
+ * *
+ * Insert this method call into the list. We are keeping track of *
+ * the method calls in order to generate adapter functions later. *
+ * *
+ *****************************************************************************/
+
+void
+insert_methcall(Dlist mlist, AST *root)
+{
+ Dlist new, p, tmplist;
+ AST *temp;
+ char * root_name;
+
+ if(gendebug)
+ printf("MTH: here i am in insert_methcall. name = %s\n",
+ root->astnode.ident.name);
+
+ /* if the list of lists is empty, create a new list to
+ * hold this node and insert it in the main list.
+ */
+
+ if(dl_empty(mlist)) {
+ if(gendebug)
+ printf("MTH: list is empty, create new one.\n");
+
+ new = make_dl();
+ dl_insert_b(new,root);
+ dl_insert_b(mlist,new);
+ return;
+ }
+
+ /* otherwise we must determine whether there is already
+ * a call to this function in the current program unit.
+ * if not, we create a new list which hangs off the main
+ * list. This new list contains pointers to all the calls
+ * to that function. if there is already a list corresponding
+ * to the function, we insert this node into that list.
+ * the reason we keep _all_ the calls is because we cannot
+ * know the parameters of some function that is passed in
+ * as an argument. So we must guess (we also have to guess
+ * at its return type). therefore, we keep around as many
+ * calls as possible to help clear up any ambiguity. for
+ * example, if the fortran source contains a call like:
+ * x = func(12)
+ * we must assume that since the constant is an integer, func
+ * must take an integer parameter. however, if there is
+ * another call to func later on in the program like this:
+ * x = func(y)
+ * then we can resolve the ambiguity by assuming that func's
+ * parameter should have the same type as the variable y.
+ */
+
+ root_name = root->astnode.ident.name;
+
+ dl_traverse(p,mlist) {
+ tmplist = (Dlist) dl_val(p);
+ temp = dl_val(dl_first(tmplist));
+
+ if(gendebug)
+ printf("MTH: temp name is %s.\n", temp->astnode.ident.name);
+
+ if(!strcmp(temp->astnode.ident.name,root_name)) {
+ /* found another function call... insert this node
+ * into the current list.
+ */
+ if(gendebug)
+ printf("MTH: found %s...inserting.\n", temp->astnode.ident.name);
+
+ dl_insert_b(tmplist,root);
+ return;
+ }
+ }
+
+ /* we did not find another call to this function. create
+ * a new list for it.
+ */
+
+ if(gendebug)
+ printf("MTH: could not find %s.\n", root->astnode.ident.name);
+
+ new = make_dl();
+ dl_insert_b(new,root);
+ dl_insert_b(mlist,new);
+}
+
+/*****************************************************************************
+ * *
+ * needs_adapter *
+ * *
+ * This function compares the expressions in the function call with *
+ * the arguments of the function to find one specific case: attempting *
+ * to pass an array element to a function that expects a scalar. If *
+ * we find such a case, we must generate an adapter that allows *
+ * pass by reference of the array element. Returns 1 if this function *
+ * call needs an adapter. If no adapter is needed or if we dont have *
+ * enough info to determine whether one is needed, this function *
+ * returns 0. *
+ * *
+ *****************************************************************************/
+
+int
+needs_adapter(AST *root)
+{
+ HASHNODE *hashtemp;
+ JVM_METHODREF *mtmp;
+ AST *temp;
+ char *dptr, *current_descriptor;
+
+ /* first, check for a null parameter list. if there are no parameters,
+ * we certainly wont need an adapter.
+ */
+ if((root->astnode.ident.arraylist->nodetype == EmptyArgList) ||
+ (root->astnode.ident.arraylist == NULL))
+ return 0;
+
+ if(gendebug)
+ printf("in needs_adapter: Looking up function name %s..\n",
+ root->astnode.ident.name);
+
+ if((hashtemp=type_lookup(function_table, root->astnode.ident.name)) != NULL)
+ current_descriptor = hashtemp->variable->astnode.source.descriptor;
+ else if((mtmp=find_method(root->astnode.ident.name,descriptor_table))!=NULL)
+ current_descriptor = mtmp->descriptor;
+ else
+ return 0;
+
+ /* if for some reason current_descriptor is null, just return false now */
+ if(!current_descriptor)
+ return 0;
+
+ if(gendebug)
+ printf("needs_adapter: got descriptor '%s'\n", current_descriptor);
+
+ dptr = bc_next_desc_token(current_descriptor);
+
+ temp = root->astnode.ident.arraylist;
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ {
+ if(dptr == NULL)
+ break;
+
+ /*
+ * if the arg is an identifier AND
+ * it is in the array table AND
+ * the function is not expecting an array
+ */
+ if(omitWrappers) {
+ if((temp->nodetype == Identifier) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name) &&
+ (dptr[0] != '[') && isPassByRef_desc(dptr))
+ return 1;
+ }
+ else {
+ if((temp->nodetype == Identifier) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name) &&
+ (dptr[0] != '['))
+ return 1;
+ }
+
+ /*
+ * if the arg is an identifier AND
+ * it is in the array table AND
+ * the function is expecting an array AND
+ * the data types are different
+ */
+ if((temp->nodetype == Identifier) &&
+ type_lookup(cur_array_table, temp->astnode.ident.name) &&
+ (dptr[0] == '[') && (get_type_from_field_desc(dptr+1) != temp->vartype))
+ {
+ fprintf(stderr, "Warning: in unit '%s', in call to '%s':\n",
+ unit_name, root->astnode.ident.name);
+ fprintf(stderr, " Array argument '%s' has wrong type.\n",
+ temp->astnode.ident.name);
+ fprintf(stderr, " A dummy array of the correct type will be passed.\n");
+ fprintf(stderr, " This should be ok for passing workspace arrays.\n");
+ fprintf(stderr, " Otherwise, there could be problems.\n");
+ return 1;
+ }
+
+ /*
+ * otherwise...
+ * if the arg is NOT in the array table AND
+ * the function IS expecting an array
+ */
+ if( ! type_lookup(cur_array_table, temp->astnode.ident.name) &&
+ dptr[0] == '[')
+ return 1;
+
+ /* consume the offset arg if necessary */
+ if(dptr[0] == '[')
+ dptr = bc_next_desc_token(dptr);
+ dptr = bc_next_desc_token(dptr);
+ }
+
+ if(gendebug)
+ printf("needs_adapter:returning 0\n");
+
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * assign_emit *
+ * *
+ * This function generates the code for assignment statements. *
+ * If it looks like the lhs and rhs have different types, we *
+ * try to provide the appropriate cast, but in some cases the *
+ * resulting code may need to be modified slightly. *
+ * *
+ * to generate an assignment statement in bytecode, we consider *
+ * three cases: *
+ * 1. LHS is a scalar, not wrapped in an object (e.g. a = expr) *
+ * in this case, the RHS should be emitted first, followed by *
+ * a store instruction to the LHS (unlike Java source where we *
+ * generate the LHS followed by the RHS). *
+ * 2. LHS is a scalar, wrapped in an object (e.g. a.val = expr) *
+ * in this case, we push a reference to the LHS on the stack *
+ * then emit the RHS as usual, followed by a putfield opcode *
+ * to store the value to the 'val' field. *
+ * 3. LHS is an array access (e.g. a[x] = expr) *
+ * in this case, we push a reference to the LHS then emit the *
+ * index expression. next emit the RHS and generate an *
+ * array store instruction (e.g. iastore). *
+ * *
+ *****************************************************************************/
+
+void
+assign_emit (JVM_METHOD *meth, AST * root)
+{
+ enum returntype ltype, rtype;
+ int c;
+ HASHNODE *hashtemp;
+
+ /* this used to be a pretty simple procedure:
+ * emit LHS
+ * print =
+ * emit RHS
+ * and that was it. but it turns out that Fortran doesn't really
+ * care much if the LHS and RHS are different types. However, Java
+ * doesn't like that, so we have to insert the appropriate cast or
+ * conversion if the types do not agree.
+ */
+
+ hashtemp = type_lookup(cur_type_table, root->astnode.assignment.lhs->astnode.ident.name);
+ if(hashtemp)
+ root->astnode.assignment.lhs->vartype = hashtemp->variable->vartype;
+ hashtemp = type_lookup(cur_type_table, root->astnode.assignment.rhs->astnode.ident.name);
+ if(hashtemp)
+ root->astnode.assignment.rhs->vartype = hashtemp->variable->vartype;
+
+ ltype = root->astnode.assignment.lhs->vartype;
+ rtype = root->astnode.assignment.rhs->vartype;
+
+ if(gendebug) {
+ printf("## ## codegen: ltype = %s (%d)\n",returnstring[ltype], ltype);
+ printf("## ## codegen: rtype = %s (%d)\n",returnstring[rtype], rtype);
+ }
+
+ /* handle lhs substring operations elsewhere */
+ if(root->astnode.assignment.lhs->nodetype == Substring) {
+ substring_assign_emit(meth, root);
+ }
+ else if((root->astnode.assignment.lhs->vartype == String)
+ && root->astnode.assignment.lhs->astnode.ident.arraylist
+ && !root->astnode.assignment.lhs->astnode.ident.arraylist->nextstmt
+ && !type_lookup(cur_array_table, root->astnode.assignment.lhs->astnode.ident.name))
+ {
+ /* this handles cases like:
+ * character a(1)
+ * a(1) = 'x'
+ * which technically isn't a substring operation, but we treat it as such.
+ */
+ root->astnode.assignment.lhs->astnode.ident.startDim[1] =
+ root->astnode.assignment.lhs->astnode.ident.arraylist;
+ substring_assign_emit(meth, root);
+ }
+ else {
+ name_emit (meth, root->astnode.assignment.lhs);
+ fprintf (curfp, " = ");
+
+ if(ltype != rtype) /* lhs and rhs have different types */
+ {
+
+ if((ltype != String) && ((rtype == String)||(rtype==Character)))
+ {
+ /* non-String = String */
+ fprintf(curfp,"%s.valueOf(",java_wrapper[ltype]);
+ expr_emit (meth, root->astnode.assignment.rhs);
+ fprintf(curfp,").%sValue()",returnstring[ltype]);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[ltype], "valueOf",
+ wrapper_valueOf_descriptor[ltype]);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[ltype],
+ numericValue_method[ltype],
+ numericValue_descriptor[ltype]);
+
+ bc_append(meth, jvm_invokevirtual, c);
+ }
+ else if( (ltype == Logical) && (rtype != String) )
+ {
+ JVM_CODE_GRAPH_NODE *if_node = NULL, *goto_node = NULL,
+ *iconst_node = NULL, *next_node = NULL;
+
+ /* boolean = numeric value */
+ expr_emit (meth, root->astnode.assignment.rhs);
+ fprintf(curfp," == 0 ? false : true");
+ if(rtype == Integer) {
+ if_node = bc_append(meth, jvm_ifeq);
+ bc_append(meth, jvm_iconst_1);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_0);
+ }
+ else if(rtype == Float) {
+ bc_append(meth, jvm_fconst_0);
+ bc_append(meth, jvm_fcmpl);
+ if_node = bc_append(meth, jvm_ifne);
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_1);
+ }
+ else if(rtype == Double) {
+ bc_append(meth, jvm_dconst_0);
+ bc_append(meth, jvm_dcmpl);
+ if_node = bc_append(meth, jvm_ifne);
+ bc_append(meth, jvm_iconst_0);
+ goto_node = bc_append(meth, jvm_goto);
+ iconst_node = bc_append(meth, jvm_iconst_1);
+ }
+ else
+ fprintf(stderr,"WARNING: unsupported cast.\n");
+
+ bc_set_branch_target(if_node, iconst_node);
+
+ /* create a dummy instruction node following the iconst so that
+ * we have a branch target for the goto statement. it'll be
+ * removed later.
+ */
+ next_node = bc_append(meth, jvm_xxxunusedxxx);
+ bc_set_branch_target(goto_node, next_node);
+ }
+ else
+ {
+ if(typeconv_matrix[rtype][ltype] == jvm_nop) {
+ if((ltype != String && ltype != Character) ||
+ (rtype != String && rtype != Character))
+ fprintf(stderr,"WARNING: unable to handle cast (%s->%s)!\n",
+ returnstring[rtype], returnstring[ltype]);
+ }
+
+ /* numeric value = numeric value of some other type */
+ fprintf(curfp,"(%s)(",returnstring[ltype]);
+ expr_emit (meth, root->astnode.assignment.rhs);
+ fprintf(curfp,")");
+ bc_append(meth, typeconv_matrix[rtype][ltype]);
+ }
+ }
+ else /* lhs and rhs have same types, everything is cool */
+ expr_emit (meth, root->astnode.assignment.rhs);
+ }
+
+ LHS_bytecode_emit(meth, root);
+ if(gendebug)printf("leaving-assign emit\n");
+}
+
+/*****************************************************************************
+ * *
+ * LHS_bytecode_emit *
+ * *
+ * emit the store op(s) required to store a value to the LHS of some *
+ * assignment statement. note: this has no effect on Java source... *
+ * this is only for bytecode since we have to emit a store op after the *
+ * RHS (and possibly a LHS array ref). *
+ * *
+ *****************************************************************************/
+
+void
+LHS_bytecode_emit(JVM_METHOD *meth, AST *root)
+{
+ char *name, *class, *desc, *com_prefix;
+ HASHNODE *isArg, *typenode, *ht;
+ int c;
+
+ name = root->astnode.assignment.lhs->astnode.ident.name;
+
+ if((typenode = type_lookup(cur_type_table, name)) != NULL)
+ desc = getVarDescriptor(typenode->variable);
+ else
+ desc = "asdf";
+
+ /* get the name of the common block class file, if applicable */
+
+ com_prefix = get_common_prefix(name);
+
+ isArg = type_lookup(cur_args_table,name);
+
+ if(com_prefix[0] != '\0')
+ {
+ char *idx;
+
+ /* if this is a COMMON variable, find out the merged
+ * name, if any, that we should use instead. Names are
+ * merged when different declarations of a common
+ * block use different variable names.
+ */
+
+ ht = type_lookup(cur_type_table,name);
+ if (ht == NULL)
+ fprintf(stderr,"assign_emit:Cant find %s in type_table\n", name);
+ else if(ht->variable->astnode.ident.merged_name != NULL)
+ name = ht->variable->astnode.ident.merged_name;
+
+ class = strdup(com_prefix);
+ while( (idx = strchr(class, '.')) != NULL )
+ *idx = '/';
+ class[strlen(class)-1] = '\0';
+ }
+ else {
+ /* want to be able to free() class later, so we must assign malloc'd
+ * memory to it in both cases.
+ */
+ class = strdup(cur_filename);
+ }
+
+
+ if(gendebug)
+ printf("in assign_emit, class = %s, name = %s, desc = %s\n",
+ class, name, desc);
+
+ if((root->astnode.assignment.lhs->astnode.ident.arraylist == NULL) ||
+ (root->astnode.assignment.lhs->nodetype == Substring))
+ {
+ /* LHS is not an array reference (note that the variable may be
+ * an array, but it isn't being indexed here). for bytecode,
+ * we now generate a store or putfield instruction, depending
+ * on whether the variable is wrapped or not.
+ */
+ if(omitWrappers &&
+ !cgPassByRef(root->astnode.assignment.lhs->astnode.ident.name))
+ {
+ /* we know that this cannot be a local variable because otherwise it
+ * would be pass by reference, given that it is the LHS of an
+ * assignment. thus, we generate a putstatic instruction.
+ */
+ if(gendebug) {
+ printf("generating LHS...\n");
+ printf("lhs descriptor = %s\n",desc);
+ printf("isArg = %s\n",isArg?"Yes":"No");
+ printf("local var #%d\n",
+ root->astnode.assignment.lhs->astnode.ident.localvnum);
+ }
+
+ storeVar(cur_class_file, meth, root->astnode.assignment.lhs->vartype,
+ (BOOL)isArg, class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE);
+ }
+ else {
+ int vt = root->astnode.assignment.lhs->vartype;
+ /* this is a wrapped primitive. the objectref and value should
+ * already be sitting on the stack, so now we generate a putfield
+ * instruction.
+ */
+ c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val",
+ val_descriptor[vt]);
+ bc_append(meth, jvm_putfield, c);
+ }
+ }
+ else {
+ /* the LHS is an array access. currently the stack holds a reference
+ * to the array, the array index, and the RHS expression. all we need
+ * to do now is generate an array store instruction (e.g. iastore).
+ */
+ bc_gen_array_store_op(meth, jvm_data_types[root->astnode.assignment.lhs->vartype]);
+ }
+
+ f2jfree(com_prefix, strlen(com_prefix)+1);
+ f2jfree(class, strlen(class)+1);
+}
+
+/*****************************************************************************
+ * *
+ * substring_assign_emit *
+ * *
+ * once upon a time, we generated some funky inline code to handle substring *
+ * ops on the LHS of an assignment. we moved that code to a method in *
+ * org.netlib.util.Util called insertString(), which takes the LHS string, *
+ * the RHS string, and the substring indices and returns the altered string. *
+ * *
+ *****************************************************************************/
+
+void
+substring_assign_emit(JVM_METHOD *meth, AST *root)
+{
+ AST *lhs = root->astnode.assignment.lhs;
+ AST *rhs = root->astnode.assignment.rhs;
+ int c, single_sub = 0;
+
+ if(gendebug)
+ printf("substring_assign_emit\n");
+
+ /* check if this is a single character array reference, e.g.:
+ * character x(10)
+ * x(3) = 'f'
+ */
+ if((lhs->astnode.ident.startDim[0] == NULL) &&
+ (lhs->astnode.ident.endDim[0] == NULL) &&
+ (lhs->astnode.ident.startDim[1] != NULL))
+ single_sub = 1;
+
+ lhs->nodetype = Substring;
+
+ name_emit(meth, lhs);
+
+ fprintf(curfp,"= Util.stringInsert(");
+
+ /* we want to call name_emit() on lhs again, but in this
+ * case we don't want it treated like an lvalue, so we'll
+ * just set root->astnode.assignment.lhs = NULL here
+ * and call scalar_emit() directly instead.
+ */
+ root->astnode.assignment.lhs = NULL;
+ scalar_emit(meth, lhs, NULL);
+ fprintf(curfp,",");
+
+ /* now reset the value just in case we need it later. */
+ root->astnode.assignment.lhs = lhs;
+
+ if(rhs->vartype == Character)
+ {
+ /*
+ * Java's Character class doesn't have a static toString
+ * method, so we have to create a new character object first.
+ *
+ * currently I dont think we ever hit this case, so the code
+ * here may be superfluous and is definitely untested.
+ */
+
+ /*
+ * c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ * "java/lang/Character");
+ *
+ * bc_append(jvm_new,c);
+ * bc_append(jvm_dup);
+ *
+ * c = bc_new_methodref(cur_class_file,"java/lang/Character",
+ * "<init>", "(C)V");
+ *
+ * fprintf(curfp,"new Character(");
+ * expr_emit(rhs);
+ * bc_append(jvm_invokespecial, c);
+ * fprintf(curfp,").toString(),");
+ * c = bc_new_methodref(cur_class_file,"java/lang/Character", "toString",
+ * "()Ljava/lang/String;");
+ * bc_append(jvm_invokestatic, c);
+ */
+
+ /* code above is broken, use code for STring */
+ expr_emit(meth, rhs);
+ fprintf(curfp,",");
+ }
+ else if(rhs->vartype == String)
+ {
+ expr_emit(meth, rhs);
+ fprintf(curfp,",");
+ }
+ else
+ {
+ fprintf(curfp,"%s.toString(", java_wrapper[rhs->vartype]);
+ expr_emit(meth, rhs);
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[rhs->vartype],
+ "toString", toString_descriptor[rhs->vartype]);
+ bc_append(meth, jvm_invokestatic, c);
+ fprintf(curfp,"),");
+ }
+
+ if(single_sub) {
+ expr_emit(meth, lhs->astnode.ident.startDim[1]);
+ }
+ else {
+ if(lhs->astnode.ident.startDim[0])
+ expr_emit(meth, lhs->astnode.ident.startDim[0]);
+ else
+ emit_default_substring_start(meth, lhs);
+ fprintf(curfp,",");
+ if(lhs->astnode.ident.endDim[0])
+ expr_emit(meth, lhs->astnode.ident.endDim[0]);
+ else
+ emit_default_substring_end(meth, lhs);
+ }
+
+ fprintf(curfp,")");
+
+ if(single_sub)
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "stringInsert", SINGLE_INS_DESC);
+ else
+ c = bc_new_methodref(cur_class_file, UTIL_CLASS, "stringInsert", INS_DESC);
+ bc_append(meth, jvm_invokestatic, c);
+}
+
+/*****************************************************************************
+ * *
+ * dl_int_examine *
+ * *
+ * This function returns the last item in a dlist of integers. *
+ * *
+ *****************************************************************************/
+
+int
+dl_int_examine(Dlist l)
+{
+ return ( *( (int *) dl_val(dl_last(l)) ) );
+}
+
+/*****************************************************************************
+ * *
+ * dl_astnode_examine *
+ * *
+ * This function returns the last item in a dlist of astnodes. *
+ * *
+ *****************************************************************************/
+
+AST *
+dl_astnode_examine(Dlist l)
+{
+ if(dl_empty(l))
+ return NULL;
+
+ return ( (AST *) dl_val(dl_last(l)) );
+}
+
+/*****************************************************************************
+ * *
+ * label_search *
+ * *
+ * searches a list of Forloop nodes for the one corresponding to the given *
+ * label (val). returns NULL if the node is not found. *
+ * *
+ *****************************************************************************/
+
+AST *
+label_search(Dlist l, int val)
+{
+ Dlist p;
+ AST *v;
+
+ dl_traverse(p,l) {
+ v = (AST *) p->val;
+ if( atoi( v->astnode.forloop.Label->astnode.constant.number ) == val )
+ return v;
+ }
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * dl_name_search *
+ * *
+ * This function searches for a value in a dlist of *
+ * AST nodes. Returns the node if it is found, NULL *
+ * otherwise. *
+ * *
+ *****************************************************************************/
+
+AST *
+dl_name_search(Dlist l, char *name)
+{
+ Dlist p;
+
+ dl_traverse(p,l)
+ if( !strcmp(((AST *)p->val)->astnode.ident.name,name) )
+ return p->val;
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * insert_adapter *
+ * *
+ * Insert this method call into the list. We are keeping track of *
+ * the method calls in order to generate adapter functions later. *
+ * *
+ *****************************************************************************/
+
+void
+insert_adapter(AST *node)
+{
+ HASHNODE *ht;
+ JVM_METHODREF *tmp;
+ AST *ptr;
+ Dlist p;
+
+ /* if there is not an adapter for this function call already in the list,
+ * insert it now
+ */
+
+ if(gendebug) {
+ printf("** here we are in insert_adapter\n");
+ printf("** \n");
+ }
+
+ dl_traverse(p, adapter_list )
+ {
+ ptr = (AST *) dl_val(p);
+
+ if( !strcmp(ptr->astnode.ident.name, node->astnode.ident.name) )
+ {
+ /* this function call is already in the list. now we must determine
+ * whether the prototypes of the adapters would be the same. If so,
+ * there's no need to insert this node in the adapter list. If the
+ * prototypes would be different, then we must insert this node.
+ */
+
+ if(gendebug)
+ printf("** %s is already in adapter_list. now checking args.\n",
+ node->astnode.ident.name);
+
+ if((ht=type_lookup(function_table, node->astnode.ident.name)) != NULL)
+ {
+ if(!adapter_insert_from_descriptor(node,ptr,
+ ht->variable->astnode.source.descriptor))
+ {
+ if(gendebug)
+ printf("** found an equivalent adapter. no need to insert.\n");
+
+ return;
+ }
+ }
+ else {
+ tmp = find_method(node->astnode.ident.name, descriptor_table);
+
+ if(tmp)
+ adapter_insert_from_descriptor(node, ptr, tmp->descriptor);
+ else {
+ if(gendebug)
+ printf("** cant find prototype...returning.\n");
+ }
+ /* cant find the prototype. normally, I dont think */
+ return; /* this case will be reached. */
+ }
+ }
+ }
+
+ if(gendebug)
+ printf("** inserting '%s' into adapter_list now.\n",
+ node->astnode.ident.name);
+
+ dl_insert_b(adapter_list,node);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_insert_from_descriptor *
+ * *
+ * this function determines whether the call pointed to by node is different *
+ * from the call pointed to by ptr. *
+ * *
+ *****************************************************************************/
+
+BOOL
+adapter_insert_from_descriptor(AST *node, AST *ptr, char *desc)
+{
+ int this_arg_is_arrayacc, other_arg_is_arrayacc, i;
+ int this_arg_is_scalar, other_arg_is_scalar;
+ AST *this_call, *other_call;
+ BOOL diff;
+ char *dptr;
+
+ if(gendebug)
+ printf("adapter_insert_from_descriptor: desc = '%s'\n", desc);
+
+ this_call = node->astnode.ident.arraylist;
+ other_call = ptr->astnode.ident.arraylist;
+
+ dptr = bc_next_desc_token(desc);
+
+ diff = FALSE;
+
+ for(i=0 ; this_call != NULL; this_call = this_call->nextstmt, i++)
+ {
+ if(dptr == NULL)
+ break;
+
+ if( other_call == NULL )
+ {
+ fprintf(stderr,"2:Function calls to %s in unit %s ",
+ node->astnode.ident.name, unit_name);
+ fprintf(stderr,"don't have same number of params\n");
+ return TRUE;
+ }
+
+ this_arg_is_arrayacc = (this_call->nodetype == Identifier) &&
+ /* (this_call->astnode.ident.arraylist != NULL) && */
+ type_lookup(cur_array_table, this_call->astnode.ident.name);
+
+ other_arg_is_arrayacc = (other_call->nodetype == Identifier) &&
+ /* (other_call->astnode.ident.arraylist != NULL) && */
+ type_lookup(cur_array_table, other_call->astnode.ident.name);
+
+ if( (dptr[0] == 'L') &&
+ (this_arg_is_arrayacc != other_arg_is_arrayacc ))
+ {
+ diff = TRUE;
+ }
+
+ this_arg_is_scalar = !type_lookup(cur_array_table,
+ this_call->astnode.ident.name);
+ other_arg_is_scalar = !type_lookup(cur_array_table,
+ other_call->astnode.ident.name);
+
+ if( (dptr[0] == '[') && (this_arg_is_scalar != other_arg_is_scalar ))
+ {
+ diff = TRUE;
+ }
+
+ other_call = other_call->nextstmt;
+
+ dptr = bc_next_desc_token(dptr);
+ }
+
+ return diff;
+}
+
+/*****************************************************************************
+ * *
+ * emit_adapters *
+ * *
+ * This function generates any adapters necessary to *
+ * allow functions to pass array elements by reference. *
+ * *
+ *****************************************************************************/
+
+void
+emit_adapters()
+{
+ char *tmpdesc, *ret_desc, *cur_name = NULL, *cur_desc=NULL;
+ JVM_METHOD *adapter_method;
+ HASHNODE *hashtemp;
+ JVM_METHODREF *mref;
+ Dlist p;
+ AST *cval;
+
+ dl_traverse(p,adapter_list)
+ {
+ cval = (AST *)dl_val(p);
+
+ cur_name=(char *)f2jrealloc(cur_name,strlen(cval->astnode.ident.name)+10);
+
+ strcpy(cur_name, cval->astnode.ident.name);
+ strcat(cur_name, "_adapter");
+
+ adapter_method = bc_new_method(cur_class_file, cur_name, NULL,
+ F2J_ADAPTER_ACC);
+
+ hashtemp = type_lookup(function_table, cval->astnode.ident.name);
+
+ if(hashtemp) {
+ char *tempname;
+
+ mref = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF));
+
+ tmpdesc = get_adapter_desc(hashtemp->variable->astnode.source.descriptor,
+ cval->astnode.ident.arraylist);
+
+ if(hashtemp->variable->nodetype == Function)
+ ret_desc =
+ field_descriptor[hashtemp->variable->astnode.source.returns][0];
+ else
+ ret_desc = "V";
+
+ cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) +
+ strlen(ret_desc) + 10);
+
+ strcpy(cur_desc,"(");
+ strcat(cur_desc,tmpdesc);
+ strcat(cur_desc,")");
+ strcat(cur_desc,ret_desc);
+
+ tempname = strdup( cval->astnode.ident.name );
+ *tempname = toupper(*tempname);
+
+ mref->classname = bc_get_full_classname(tempname, package_name);
+ mref->methodname = strdup(
+ hashtemp->variable->astnode.source.name->astnode.ident.name);
+ mref->descriptor = strdup(hashtemp->variable->astnode.source.descriptor);
+
+ adapter_emit_from_descriptor(adapter_method, mref, cval);
+
+ bc_free_fieldref(mref);
+ f2jfree(tmpdesc, strlen(tmpdesc)+1);
+ f2jfree(tempname, strlen(tempname)+1);
+ }
+ else {
+ if(gendebug)
+ printf("looking up descriptor for %s\n",cval->astnode.ident.name);
+
+ mref = find_method(cval->astnode.ident.name, descriptor_table);
+
+ if(mref) {
+ char *ret = get_return_type_from_descriptor(mref->descriptor);
+
+ if(gendebug)
+ printf("--- ret is '%s'\n", ret);
+
+ if(ret[0] == 'V')
+ ret_desc = "V";
+ else
+ ret_desc = field_descriptor[get_type_from_field_desc(ret)][0];
+
+ /* tmpdesc = get_desc_from_arglist(cval->astnode.ident.arraylist); */
+ tmpdesc = get_adapter_desc(mref->descriptor,
+ cval->astnode.ident.arraylist);
+
+ cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) +
+ strlen(ret_desc) + 10);
+
+ strcpy(cur_desc,"(");
+ strcat(cur_desc,tmpdesc);
+ strcat(cur_desc,")");
+ strcat(cur_desc,ret_desc);
+
+ adapter_emit_from_descriptor(adapter_method, mref, cval);
+
+ f2jfree(tmpdesc, strlen(tmpdesc)+1);
+ f2jfree(ret, strlen(ret)+1);
+ }
+ else {
+ fprintf(stderr,"Could not generate adapter for '%s'\n",
+ cval->astnode.ident.name);
+
+ /* assume that since cur_name was already allocated strlen(var)+10
+ * bytes and "BAD_ADAP" requires less than 10 bytes, there's no need
+ * to realloc here. but if we hit this case, then cur_desc may not
+ * have any memory allocated yet, so call realloc here.
+ */
+
+ strcpy(cur_name, "BAD_ADAP");
+
+ cur_desc=(char *)f2jrealloc(cur_name,4);
+ strcpy(cur_desc, "()V");
+ }
+ }
+
+ fprintf(indexfp,"%s:%s:%s\n",cur_filename, cur_name, cur_desc);
+
+ /* Now we know the descriptor for this adapter, so set the field in
+ * the method struct accordingly.
+ */
+
+ bc_set_method_descriptor(adapter_method, cur_desc);
+ }
+
+ if(cur_desc)
+ f2jfree(cur_desc, strlen(cur_desc)+1);
+ if(cur_name)
+ f2jfree(cur_name, strlen(cur_name)+1);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_emit_from_descriptor *
+ * *
+ * This function generates an adapters, in situations where the prototype *
+ * cannot be found in the symbol table. instead, we look for the descriptor *
+ * in any .f2j files in F2J_SEARCH_PATH. *
+ * *
+ *****************************************************************************/
+
+void
+adapter_emit_from_descriptor(JVM_METHOD *meth, JVM_METHODREF *mref, AST *node)
+{
+ enum returntype ret_type;
+ char *ret;
+ int lv_temp, retval_varnum = 0;
+
+ ret_type = Integer; /* init just to quiet a compiler warning */
+
+ fprintf(curfp,"// adapter for %s%s\n",
+ node->astnode.ident.name, mref->descriptor);
+
+ ret = get_return_type_from_descriptor(mref->descriptor);
+
+ if((ret == NULL) || (ret[0] == '[') || (ret[0] == 'L')) {
+ fprintf(stderr,"Not expecting NULL, reference, or array return type ");
+ fprintf(stderr,"for adapter '%s'\n", node->astnode.ident.name);
+ f2jfree(ret,strlen(ret)+1);
+ return;
+ }
+
+ if(ret[0] == 'V')
+ fprintf(curfp,"private static void %s_adapter(",
+ node->astnode.ident.name);
+ else {
+ fprintf(curfp,"private static %s %s_adapter(",
+ returnstring[get_type_from_field_desc(ret)],
+ node->astnode.ident.name);
+ ret_type = get_type_from_field_desc(ret);
+ }
+
+ adapter_args_emit_from_descriptor(meth, node->astnode.ident.arraylist,
+ mref->descriptor);
+
+ fprintf(curfp,")\n{\n");
+
+ lv_temp = meth->cur_local_number;
+
+ adapter_temps_emit_from_descriptor(meth, node->astnode.ident.arraylist,
+ mref->descriptor);
+
+ adapter_methcall_emit_from_descriptor(meth, node, lv_temp, mref, ret);
+
+ if(ret[0] != 'V') {
+ retval_varnum = bc_get_next_local(meth, jvm_data_types[ret_type]);
+ bc_gen_store_op(meth, retval_varnum, jvm_data_types[ret_type]);
+ }
+
+ adapter_assign_emit_from_descriptor(meth, node->astnode.ident.arraylist,
+ lv_temp, mref->descriptor);
+
+ if(ret[0] != 'V')
+ {
+ fprintf(curfp,"\nreturn %s_retval;\n",
+ node->astnode.ident.name);
+
+ bc_gen_load_op(meth, retval_varnum, jvm_data_types[ret_type]);
+ bc_append(meth, return_opcodes[ret_type]);
+ }
+ else
+ bc_append(meth, jvm_return);
+
+ fprintf(curfp,"}\n\n");
+ f2jfree(ret,strlen(ret)+1);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_args_emit_from_descriptor *
+ * *
+ * this function generates the argument list for an adapter, when the *
+ * prototype cannot be found in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+adapter_args_emit_from_descriptor(JVM_METHOD *meth, AST *arg,
+ char *desc)
+{
+ enum returntype ctype;
+ char *dptr;
+ int i, lvnum;
+
+ dptr = bc_next_desc_token(desc);
+
+ lvnum = 0;
+
+ for(i = 0; arg != NULL ; arg = arg->nextstmt, i++)
+ {
+ arg->astnode.ident.localvnum = lvnum;
+
+ if(dptr == NULL) {
+ fprintf(stderr,"adapter_args_emit_from_descriptor():");
+ fprintf(stderr,"mismatch between adapter call and prototype\n");
+ break;
+ }
+
+ ctype = get_type_from_field_desc(dptr);
+
+ if(gendebug)
+ printf("adapter_args.. arg=%s dptr = '%s'\n",
+ arg->astnode.ident.name,dptr);
+
+ if(dptr[0] == '[') {
+ if(type_lookup(cur_array_table,arg->astnode.ident.name)) {
+ if(get_type_from_field_desc(dptr+1) == arg->vartype) {
+ fprintf(curfp,"%s [] arg%d , int arg%d_offset ",
+ returnstring[get_type_from_field_desc(dptr+1)], i, i);
+ lvnum += 2;
+ }
+ else {
+ fprintf(curfp,"%s [] arg%d , int arg%d_offset ",
+ returnstring[arg->vartype], i, i);
+ lvnum += 2;
+ }
+ }
+ else {
+ fprintf(curfp,"%s arg%d ",
+ wrapper_returns[get_type_from_field_desc(dptr+1)], i);
+
+ lvnum++;
+ }
+
+ /* consume the offset arg */
+ dptr = bc_next_desc_token(dptr);
+ }
+ else if ( (arg->nodetype == Identifier) &&
+ /* (arg->astnode.ident.arraylist != NULL) && */
+ type_lookup(cur_array_table,arg->astnode.ident.name) &&
+ (dptr[0] != '[') )
+ {
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ fprintf(curfp,"%s arg%d ", returnstring[ctype], i);
+ if(ctype == Double)
+ lvnum += 2;
+ else
+ lvnum++;
+ }
+ else {
+ fprintf(curfp,"%s [] arg%d , int arg%d_offset ",
+ returnstring[ctype], i, i);
+ lvnum += 2;
+ }
+ }
+ else if( type_lookup(cur_external_table, arg->astnode.ident.name) )
+ {
+ fprintf(curfp,"Object arg%d ", i);
+ lvnum++;
+ }
+ else
+ {
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ fprintf(curfp,"%s arg%d ", returnstring[ctype], i);
+ if(ctype == Double)
+ lvnum += 2;
+ else
+ lvnum++;
+ }
+ else {
+ fprintf(curfp,"%s arg%d ", wrapper_returns[ctype], i);
+ lvnum++;
+ }
+ }
+
+ dptr = bc_next_desc_token(dptr);
+
+ if(arg->nextstmt != NULL)
+ fprintf(curfp,",");
+ }
+
+ /* set current local variable number to compensate for the method's
+ * arguments.
+ */
+ bc_set_cur_local_num(meth, lvnum);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_tmp_assign_emit *
+ * *
+ * this function generates the bytecode for the assignment to a temp *
+ * variable in the adapter. for example: *
+ * _f2j_tmp3 = new intW(arg3[arg3_offset]) *
+ * *
+ *****************************************************************************/
+
+void
+adapter_tmp_assign_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype)
+{
+ int c;
+ char *classname, *desc;
+
+ classname = full_wrappername[argtype];
+ desc = wrapper_descriptor[argtype];
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class, classname);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+
+ /* emit arg%d[arg%d_offset] */
+ bc_gen_load_op(meth, arglocal, jvm_Object);
+ bc_gen_load_op(meth, arglocal + 1, jvm_Int);
+ bc_gen_array_load_op(meth, jvm_data_types[argtype]);
+
+ c = bc_new_methodref(cur_class_file, classname, "<init>", desc);
+
+ bc_append(meth, jvm_invokespecial, c);
+
+ /* now assign value to next local */
+ bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_tmp_array_assign_emit *
+ * *
+ * this function generates the bytecode for the assignment to a temp *
+ * variable in the adapter. for example: *
+ * int [] _f2j_tmp3 = new int[1]; *
+ * *
+ *****************************************************************************/
+
+void
+adapter_tmp_array_assign_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype)
+{
+ int c;
+
+ bc_append(meth, jvm_iconst_1);
+ newarray_emit(meth, argtype);
+ bc_append(meth, jvm_dup);
+ bc_append(meth, jvm_iconst_0);
+ bc_gen_load_op(meth, arglocal, jvm_Object);
+ c = bc_new_fieldref(cur_class_file, full_wrappername[argtype], "val",
+ val_descriptor[argtype]);
+ bc_append(meth, jvm_getfield, c);
+ bc_gen_array_store_op(meth, jvm_data_types[argtype]);
+ bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_tmp_array_new_emit *
+ * *
+ * this function generates the bytecode for the assignment to a temp *
+ * variable in the adapter. for example: *
+ * int [] _f2j_tmp3 = new int[arg3.length]; *
+ * *
+ *****************************************************************************/
+
+void
+adapter_tmp_array_new_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype)
+{
+ bc_gen_load_op(meth, arglocal, jvm_Object);
+ bc_append(meth, jvm_arraylength);
+ newarray_emit(meth, argtype);
+ bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_temps_emit_from_descriptor *
+ * *
+ * this function generates the temporary variable declarations for an *
+ * adapter, when the prototype cannot be found in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+adapter_temps_emit_from_descriptor(JVM_METHOD *meth, AST *arg, char *desc)
+{
+ char *dptr, *wrapper;
+ int i;
+
+ dptr = bc_next_desc_token(desc);
+
+ for(i = 0; arg != NULL ; arg = arg->nextstmt, i++)
+ {
+ if(dptr == NULL)
+ break;
+
+ if((arg->nodetype == Identifier) &&
+ /* (arg->astnode.ident.arraylist != NULL) && */
+ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) &&
+ (dptr[0] != '['))
+ {
+ wrapper = get_wrapper_from_desc(dptr);
+
+ if(omitWrappers) {
+ if(isPassByRef_desc(dptr)) {
+ fprintf(curfp,"%s _f2j_tmp%d = new %s(arg%d[arg%d_offset]);\n",
+ wrapper, i, wrapper, i, i);
+ adapter_tmp_assign_emit(meth, arg->astnode.ident.localvnum,
+ get_type_from_field_desc(dptr));
+ }
+ }
+ else
+ {
+ fprintf(curfp,"%s _f2j_tmp%d = new %s(arg%d[arg%d_offset]);\n",
+ wrapper, i, wrapper, i, i);
+ adapter_tmp_assign_emit(meth, arg->astnode.ident.localvnum,
+ get_type_from_field_desc(dptr));
+ }
+
+ f2jfree(wrapper, strlen(wrapper)+1);
+ }
+ else if(dptr[0] == '[') {
+ if(! type_lookup(cur_array_table,arg->astnode.ident.name)) {
+ enum returntype ctype = get_type_from_field_desc(dptr);
+
+ fprintf(curfp,"%s [] _f2j_tmp%d = { arg%d.val };\n",
+ returnstring[ctype], i, i);
+
+ adapter_tmp_array_assign_emit(meth, arg->astnode.ident.localvnum,
+ ctype);
+ }
+ else if(get_type_from_field_desc(dptr+1) != arg->vartype) {
+ enum returntype ctype = get_type_from_field_desc(dptr);
+
+ fprintf(curfp,"%s [] _f2j_tmp%d = new %s[arg%d.length];\n",
+ returnstring[ctype], i, returnstring[ctype], i);
+
+ adapter_tmp_array_new_emit(meth, arg->astnode.ident.localvnum,
+ ctype);
+ }
+
+ dptr = bc_next_desc_token(dptr);
+ }
+
+ dptr = bc_next_desc_token(dptr);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * adapter_methcall_emit_from_descriptor *
+ * *
+ * this function generates the actual method call within the adapter. *
+ * used in the case when the prototype is not found in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+adapter_methcall_emit_from_descriptor(JVM_METHOD *meth, AST *node, int lv_temp,
+ JVM_METHODREF *mref, char *ret)
+{
+ char *tempname, *dptr;
+ int c;
+ AST *arg;
+ int i;
+
+ if((mref->classname != NULL) && (strlen(mref->classname) > 0))
+ tempname = char_substitution(mref->classname, '/', '.');
+ else {
+ tempname = strdup( node->astnode.ident.name );
+ *tempname = toupper(*tempname);
+ }
+
+ if(ret[0] == 'V')
+ fprintf(curfp,"\n%s.%s(",tempname, node->astnode.ident.name );
+ else
+ {
+ fprintf(curfp,"%s %s_retval;\n\n", ret,
+ node->astnode.ident.name);
+
+ fprintf(curfp,"%s_retval = %s.%s(", node->astnode.ident.name,
+ tempname, node->astnode.ident.name );
+ }
+
+ dptr = bc_next_desc_token(mref->descriptor);
+ arg = node->astnode.ident.arraylist;
+
+ for(i = 0; arg != NULL ; arg = arg->nextstmt, i++)
+ {
+ if(dptr == NULL)
+ break;
+
+ lv_temp = adapter_methcall_arg_emit(meth, arg, i, lv_temp, dptr);
+
+ /* skip extra field desc to compensate for offset arg */
+ if(dptr[0] == '[')
+ dptr = bc_next_desc_token(dptr);
+
+ dptr = bc_next_desc_token(dptr);
+
+ if(arg->nextstmt != NULL)
+ fprintf(curfp,",");
+ }
+
+ fprintf(curfp,");\n\n");
+
+ c = bc_new_methodref(cur_class_file, mref->classname,
+ mref->methodname,mref->descriptor);
+
+ bc_append(meth, jvm_invokestatic, c);
+
+ f2jfree(tempname, strlen(tempname)+1);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_methcall_arg_emit *
+ * *
+ * emit the argument to an adapter methodcall. *
+ * *
+ *****************************************************************************/
+
+int
+adapter_methcall_arg_emit(JVM_METHOD *meth, AST *arg, int i, int lv, char *dptr)
+{
+ if((arg->nodetype == Identifier) &&
+ /* (arg->astnode.ident.arraylist != NULL) && */
+ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) &&
+ (dptr[0] != '['))
+ {
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ fprintf(curfp,"arg%d",i);
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum,
+ jvm_data_types[get_type_from_field_desc(dptr)]);
+ }
+ else {
+ fprintf(curfp,"_f2j_tmp%d",i);
+ bc_gen_load_op(meth, lv++, jvm_Object);
+ }
+ }
+ else if( ! type_lookup(cur_array_table,arg->astnode.ident.name) &&
+ (dptr[0] == '['))
+ {
+ fprintf(curfp,"_f2j_tmp%d, 0",i);
+ bc_gen_load_op(meth, lv++, jvm_Object);
+ bc_append(meth, jvm_iconst_0);
+ }
+ else if((arg->nodetype == Identifier) &&
+ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) &&
+ (dptr[0] == '['))
+ {
+ if(get_type_from_field_desc(dptr+1) == arg->vartype) {
+ fprintf(curfp,"arg%d, arg%d_offset",i,i);
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_Object);
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum+1, jvm_Int);
+ }
+ else {
+ fprintf(curfp,"_f2j_tmp%d, arg%d_offset",i,i);
+ bc_gen_load_op(meth, lv++, jvm_Object);
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum+1, jvm_Int);
+ }
+ }
+ else
+ {
+ fprintf(curfp,"arg%d",i);
+ if(isPassByRef_desc(dptr))
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_Object);
+ else
+ bc_gen_load_op(meth, arg->astnode.ident.localvnum,
+ jvm_data_types[get_type_from_field_desc(dptr)]);
+ }
+
+ return lv;
+}
+
+/*****************************************************************************
+ * *
+ * adapter_assign_emit_from_descriptor *
+ * *
+ * this function emits the final assignments back to the array elements *
+ * after the call (when we cannot find the prototype in the sybmol table). *
+ * *
+ *****************************************************************************/
+
+void
+adapter_assign_emit_from_descriptor(JVM_METHOD *meth, AST *arg, int lv_temp, char *desc)
+{
+ char *dptr;
+ int i;
+
+ dptr = bc_next_desc_token(desc);
+
+ for(i = 0; arg != NULL ; arg = arg->nextstmt, i++)
+ {
+ if(dptr == NULL)
+ break;
+
+ if((arg->nodetype == Identifier) &&
+ /* (arg->astnode.ident.arraylist != NULL) && */
+ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) &&
+ (dptr[0] != '['))
+ {
+ if(omitWrappers) {
+ if(isPassByRef_desc(dptr))
+ adapter_assign_emit(meth, i,arg->astnode.ident.localvnum,lv_temp++,dptr);
+ }
+ else
+ {
+ adapter_assign_emit(meth, i,arg->astnode.ident.localvnum,lv_temp++,dptr);
+ }
+ }
+ else if(dptr[0] == '[') {
+
+ if( !type_lookup(cur_array_table,arg->astnode.ident.name) )
+ {
+ adapter_array_assign_emit(meth, i,arg->astnode.ident.localvnum,
+ lv_temp++,dptr);
+ }
+ else if(get_type_from_field_desc(dptr+1) != arg->vartype) {
+ lv_temp++;
+ }
+
+ /* skip extra field desc to compensate for offset arg */
+
+ dptr = bc_next_desc_token(dptr);
+ }
+
+ dptr = bc_next_desc_token(dptr);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * adapter_assign_emit *
+ * *
+ * emit the assignment back to the array element. *
+ * *
+ *****************************************************************************/
+
+void
+adapter_assign_emit(JVM_METHOD *meth, int i, int argvnum, int lv, char *dptr)
+{
+ enum returntype vt;
+ int c;
+
+ fprintf(curfp,"arg%d[arg%d_offset] = _f2j_tmp%d.val;\n",i,i,i);
+
+ vt = get_type_from_field_desc(dptr);
+
+ bc_gen_load_op(meth, argvnum, jvm_Object);
+ bc_gen_load_op(meth, argvnum+1, jvm_Int);
+
+ bc_gen_load_op(meth, lv, jvm_Object);
+ c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val",
+ val_descriptor[vt]);
+ bc_append(meth, jvm_getfield, c);
+
+ bc_gen_array_store_op(meth, jvm_data_types[vt]);
+}
+
+/*****************************************************************************
+ * *
+ * adapter_array_assign_emit *
+ * *
+ * emit the assignment back to the wrapper from the array element. *
+ * *
+ * arg3.val = _f2j_tmp3[0]; *
+ * *
+ *****************************************************************************/
+
+void
+adapter_array_assign_emit(JVM_METHOD *meth, int i, int argvnum, int lv, char *dptr)
+{
+ enum returntype vt;
+ int c;
+
+ fprintf(curfp,"arg%d.val = _f2j_tmp%d[0];\n",i,i);
+
+ if(gendebug)
+ printf("#@@# calling get_type_from_field_desc(%s) = ", dptr);
+
+ vt = get_type_from_field_desc(dptr);
+
+ if(gendebug)
+ printf(" '%s'\n", returnstring[vt]);
+
+ bc_gen_load_op(meth, argvnum, jvm_Object);
+ bc_gen_load_op(meth, lv, jvm_Object);
+ bc_append(meth, jvm_iconst_0);
+ bc_gen_array_load_op(meth, jvm_data_types[vt]);
+
+ c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val",
+ val_descriptor[vt]);
+ bc_append(meth, jvm_putfield, c);
+}
+
+/*****************************************************************************
+ * *
+ * get_desc_from_arglist *
+ * *
+ * this function generates the argument descriptors based on an the list *
+ * of arguments. note that the descriptor returned does not include the *
+ * parens or return type because in some cases, we need to prepend or append *
+ * args to the descriptor. *
+ * *
+ *****************************************************************************/
+
+char *
+get_desc_from_arglist(AST *list)
+{
+ struct _str * temp_desc = NULL;
+ HASHNODE *ht;
+ AST *arg;
+ char *p;
+ int dim;
+
+ for(arg = list; arg != NULL; arg = arg->nextstmt) {
+ dim = 0;
+
+ if(omitWrappers) {
+ if( arg->nodetype == Identifier ) {
+ ht = type_lookup(cur_type_table,arg->astnode.ident.name);
+ if(ht) {
+ dim = ht->variable->astnode.ident.dim > 0;
+
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[ht->variable->vartype][dim]);
+ }
+ else {
+ dim = arg->astnode.ident.dim > 0;
+
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[arg->vartype][dim]);
+ }
+
+ }
+ else if( arg->nodetype == Constant )
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[get_type(arg->astnode.constant.number)][0]);
+ else
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[arg->vartype][0]);
+ }
+ else
+ {
+ if( arg->nodetype == Identifier ) {
+ ht = type_lookup(cur_type_table,arg->astnode.ident.name);
+ if(ht) {
+ dim = ht->variable->astnode.ident.dim > 0;
+
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[ht->variable->vartype][dim]);
+ }
+ else {
+ dim = arg->astnode.ident.dim > 0;
+
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[arg->vartype][dim]);
+ }
+ }
+ else if( arg->nodetype == Constant )
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[get_type(arg->astnode.constant.number)][0]);
+ else
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[arg->vartype][0]);
+ }
+
+ if(dim)
+ temp_desc = strAppend(temp_desc, "I");
+ }
+
+ p = temp_desc->val;
+
+ f2jfree(temp_desc, sizeof(struct _str));
+
+ return p;
+}
+
+
+/*****************************************************************************
+ * *
+ * emit_invocations *
+ * *
+ * This function generates adapter functions which use reflection to *
+ * call another method. This is used to implement passing functions as *
+ * arguments. *
+ * *
+ *****************************************************************************/
+
+void
+emit_invocations()
+{
+ JVM_METHOD *meth;
+ Dlist p, tmplist;
+ int count, obj_array_varnum;
+ char *cur_name=NULL, *cur_desc=NULL, *tmpdesc;
+ int c;
+ AST *temp;
+
+ dl_traverse(p,methcall_list) {
+ tmplist = (Dlist) dl_val(p);
+
+ temp = (AST *) dl_val(dl_first(tmplist));
+
+ /* allocate enough space for the name + "_methcall" and null-term */
+
+ cur_name = (char *)f2jrealloc(cur_name,
+ strlen(temp->astnode.ident.name) + 10);
+ strcpy(cur_name, temp->astnode.ident.name);
+ strcat(cur_name, "_methcall");
+
+ fprintf(curfp,"// reflective method invocation for %s\n",
+ temp->astnode.ident.name);
+ fprintf(curfp,"private static %s %s(",
+ returnstring[temp->vartype], cur_name);
+ fprintf(curfp,"java.lang.reflect.Method _funcptr");
+
+ tmpdesc = get_desc_from_arglist(temp->astnode.ident.arraylist);
+ cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) +
+ strlen(METHOD_CLASS) + strlen(field_descriptor[temp->vartype][0]) + 10);
+
+ strcpy(cur_desc, "(");
+ strcat(cur_desc, "L");
+ strcat(cur_desc, METHOD_CLASS);
+ strcat(cur_desc, ";");
+ strcat(cur_desc, tmpdesc);
+ strcat(cur_desc, ")");
+ strcat(cur_desc, field_descriptor[temp->vartype][0]);
+
+ meth = bc_new_method(cur_class_file, cur_name, cur_desc,
+ F2J_ADAPTER_ACC);
+
+ bc_add_method_exception(meth, "java.lang.reflect.InvocationTargetException");
+ bc_add_method_exception(meth, "java.lang.IllegalAccessException");
+
+ count = methcall_arglist_emit(temp);
+
+ fprintf(curfp,")\n throws java.lang.reflect.InvocationTargetException,\n");
+ fprintf(curfp," java.lang.IllegalAccessException\n{\n");
+
+ fprintf(curfp,"Object [] _funcargs = new Object [%d];\n", count);
+ fprintf(curfp,"%s _retval;\n", returnstring[temp->vartype]);
+
+ /* create a new object array and store it in the first local var */
+ bc_push_int_const(meth, count);
+ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, "java/lang/Object");
+ bc_append(meth, jvm_anewarray, c);
+ obj_array_varnum = bc_get_next_local(meth, jvm_Object);
+ bc_gen_store_op(meth, obj_array_varnum, jvm_Object);
+
+ methcall_obj_array_emit(meth, temp, obj_array_varnum);
+
+ fprintf(curfp,
+ "_retval = ( (%s) _funcptr.invoke(null,_funcargs)).%sValue();\n",
+ java_wrapper[temp->vartype], returnstring[temp->vartype]);
+
+ /* load _funcptr, which should always be local var 0 */
+ bc_gen_load_op(meth, 0, jvm_Object);
+ bc_append(meth, jvm_aconst_null);
+ bc_gen_load_op(meth, obj_array_varnum, jvm_Object);
+
+ c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke",
+ INVOKE_DESC);
+ bc_append(meth, jvm_invokevirtual, c);
+
+ c = cp_find_or_insert(cur_class_file,CONSTANT_Class,
+ numeric_wrapper[temp->vartype]);
+ bc_append(meth, jvm_checkcast, c);
+
+ c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype],
+ numericValue_method[temp->vartype],
+ numericValue_descriptor[temp->vartype]);
+
+ bc_append(meth, jvm_invokevirtual, c);
+
+ bc_append(meth, return_opcodes[temp->vartype]);
+
+ fprintf(curfp,"return _retval;\n");
+ fprintf(curfp,"}\n");
+
+ fprintf(indexfp,"%s:%s:%s\n",cur_filename, cur_name, cur_desc);
+
+ f2jfree(tmpdesc, strlen(tmpdesc)+1);
+ }
+
+ if(cur_name) f2jfree(cur_name, strlen(cur_name)+1);
+ if(cur_desc) f2jfree(cur_desc, strlen(cur_desc)+1);
+}
+
+/*****************************************************************************
+ * *
+ * methcall_arglist_emit *
+ * *
+ * This function generates the list of arguments to the method adapter. *
+ * the return value is an integer representing the number of arguments. *
+ * *
+ *****************************************************************************/
+
+int
+methcall_arglist_emit(AST *temp)
+{
+ enum returntype rtype;
+ HASHNODE *ht;
+ int count=0, dim;
+ AST *arg;
+
+ for(arg = temp->astnode.ident.arraylist; arg != NULL; arg = arg->nextstmt) {
+ fprintf(curfp,",");
+
+ dim = arg->astnode.ident.dim;
+
+ if(omitWrappers) {
+ if( arg->nodetype == Identifier ) {
+ ht = type_lookup(cur_type_table,arg->astnode.ident.name);
+
+ if(ht) {
+ rtype = ht->variable->vartype;
+ dim = ht->variable->astnode.ident.dim;
+ }
+ else
+ rtype = arg->vartype;
+ }
+ else if( arg->nodetype == Constant )
+ rtype = get_type(arg->astnode.constant.number);
+ else
+ rtype = arg->vartype;
+
+ if(dim >0)
+ fprintf(curfp," %s [] _arg%d ", returnstring[rtype], count);
+ else
+ fprintf(curfp," %s _arg%d ", returnstring[rtype], count);
+ }
+ else
+ {
+ if( arg->nodetype == Identifier ) {
+ ht = type_lookup(cur_type_table,arg->astnode.ident.name);
+
+ if(ht) {
+ rtype = ht->variable->vartype;
+ dim = ht->variable->astnode.ident.dim;
+ }
+ else
+ rtype = arg->vartype;
+ }
+ else if( arg->nodetype == Constant )
+ rtype = get_type(arg->astnode.constant.number);
+ else
+ rtype = arg->vartype;
+
+ if(dim >0)
+ fprintf(curfp," %s [] _arg%d ", wrapper_returns[rtype], count);
+ else
+ fprintf(curfp," %s _arg%d ", wrapper_returns[rtype], count);
+ }
+
+ if(dim > 0) {
+ fprintf(curfp,", int _arg%d_offset ", count);
+ /* normally, we'd increment count by two, but i'm hacking this
+ * a bit so that the lapack tester works correctly.
+ */
+ /* count += 2; */
+ }
+
+ count++;
+ }
+
+ return count;
+}
+
+/*****************************************************************************
+ * *
+ * methcall_obj_array_emit *
+ * *
+ * This function generates the initialization of the object array which we *
+ * must pass to the reflective invoke call. *
+ * *
+ *****************************************************************************/
+
+void
+methcall_obj_array_emit(JVM_METHOD *meth, AST *temp, int lv)
+{
+ enum returntype rtype;
+ HASHNODE *ht;
+ int ai = 0, vi = 1, dim;
+ AST *arg;
+
+ rtype = Integer; /* just here to quiet a compiler warning */
+
+ for(arg=temp->astnode.ident.arraylist;arg!=NULL;arg=arg->nextstmt,ai++,vi++)
+ {
+ dim = arg->astnode.ident.dim;
+
+ if(omitWrappers) {
+ if( arg->nodetype == Identifier ) {
+ ht = type_lookup(cur_type_table,arg->astnode.ident.name);
+
+ if(ht) {
+ rtype = ht->variable->vartype;
+ dim = ht->variable->astnode.ident.dim;
+ }
+ else
+ rtype = arg->vartype;
+ }
+ else if( arg->nodetype == Constant )
+ rtype = get_type(arg->astnode.constant.number);
+ else
+ rtype = arg->vartype;
+
+
+ fprintf(curfp," _funcargs[%d] = new %s(", ai,java_wrapper[rtype]);
+
+ if(dim > 0) {
+ fprintf(curfp,"_arg%d[_arg%d_offset]);\n", ai, ai);
+
+ arg_array_assign_emit(cur_class_file, meth, lv, ai, vi, rtype);
+ vi++;
+ }
+ else {
+ fprintf(curfp,"_arg%d);\n", ai);
+ arg_assignment_emit(cur_class_file, meth, lv, ai, vi, TRUE, rtype);
+ }
+ }
+ else
+ {
+ if(dim > 0) {
+ fprintf(curfp," _funcargs[%d] = _arg%d[_arg%d_offset];\n",ai,ai,ai);
+ arg_array_assign_emit(cur_class_file, meth, lv, ai, vi, rtype);
+ vi++;
+ }
+ else {
+ fprintf(curfp," _funcargs[%d] = _arg%d;\n",ai,ai);
+ arg_assignment_emit(cur_class_file, meth, lv, ai, vi, FALSE, rtype);
+ }
+ }
+
+ if((rtype == Double) && (dim == 0))
+ vi++;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * arg_array_assign_emit *
+ * *
+ * this function emits the bytecode for an assignment of an argument to the *
+ * object array (e.g. _funcargs[%d] = _arg%d[_arg%d_offset]). *
+ * *
+ *****************************************************************************/
+
+void
+arg_array_assign_emit(JVM_CLASS *cclass, JVM_METHOD *meth,
+ int array_vnum, int array_idx, int arg_vnum, enum returntype argtype)
+{
+ int c;
+
+ bc_gen_load_op(meth, array_vnum, jvm_Object);
+ bc_push_int_const(meth, array_idx);
+
+ c = cp_find_or_insert(cclass,CONSTANT_Class,
+ numeric_wrapper[argtype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+ bc_gen_load_op(meth, arg_vnum, jvm_Object);
+ bc_gen_load_op(meth, arg_vnum + 1, jvm_Int);
+ bc_gen_array_load_op(meth, jvm_data_types[argtype]);
+
+ c = bc_new_methodref(cclass, numeric_wrapper[argtype],
+ "<init>", wrapper_descriptor[argtype]);
+ bc_append(meth, jvm_invokespecial, c);
+
+ bc_gen_array_store_op(meth, jvm_data_types[Object]);
+}
+
+/*****************************************************************************
+ * *
+ * arg_assignment_emit *
+ * *
+ * this function emits the bytecode for an assignment of an argument to the *
+ * object array (e.g. _funcargs[%d] = _arg%d). *
+ * *
+ *****************************************************************************/
+
+void
+arg_assignment_emit(JVM_CLASS *cclass, JVM_METHOD *meth,
+ int array_vnum, int array_idx, int arg_vnum, BOOL wrap,
+ enum returntype argtype)
+{
+ int c;
+
+ bc_gen_load_op(meth, array_vnum, jvm_Object);
+ bc_push_int_const(meth, array_idx);
+
+ if(wrap) {
+ c = cp_find_or_insert(cclass,CONSTANT_Class,
+ numeric_wrapper[argtype]);
+
+ bc_append(meth, jvm_new,c);
+ bc_append(meth, jvm_dup);
+ bc_gen_load_op(meth, arg_vnum, jvm_data_types[argtype]);
+
+ c = bc_new_methodref(cclass, numeric_wrapper[argtype],
+ "<init>", wrapper_descriptor[argtype]);
+
+ bc_append(meth, jvm_invokespecial, c);
+ }
+ else
+ bc_gen_load_op(meth, arg_vnum, jvm_data_types[argtype]);
+
+ bc_append(meth, jvm_aastore);
+}
+
+/*****************************************************************************
+ * *
+ * char_substitution *
+ * *
+ * this function substitutes every occurrence of 'from_char' with 'to_char' *
+ * typically this is used to convert package names: *
+ * *
+ * e.g. "java.lang.whatever" -> "java/lang/whatever" *
+ * *
+ *****************************************************************************/
+
+char *
+char_substitution(char *str, int from_char, int to_char)
+{
+ char *newstr = strdup(str);
+ char *idx;
+
+ while( (idx = strchr(newstr, from_char)) != NULL )
+ *idx = to_char;
+
+ return newstr;
+}
+
+#ifdef VCG_CONTROL_FLOW
+
+/*****************************************************************************
+ * *
+ * cfg_emit *
+ * *
+ * this function generates a VCG (visualization of compiler graphs) file *
+ * containing a representation of the control flow graph. *
+ * *
+ *****************************************************************************/
+
+void
+cfg_emit(Dlist cgraph, char *mname)
+{
+ JVM_CODE_GRAPH_NODE *val;
+ char *filename, *warn;
+ char node_label[200];
+ FILE *v;
+ Dlist tmp;
+
+ filename = (char *)f2jalloc(strlen(cur_filename) + strlen(mname) + 10);
+ sprintf(filename, "%s_%s.cfg", cur_filename, mname);
+
+ v = fopen(filename,"w");
+
+ if(v) {
+
+ print_vcg_header(v, "Control Flow Graph");
+
+ dl_traverse(tmp,cgraph) {
+ val = (JVM_CODE_GRAPH_NODE *) tmp->val;
+
+ if(!val->visited)
+ warn = "(UNVISITED!!)";
+ else
+ warn = "";
+
+ sprintf(node_label,"%d: %s %s\nstack_pre: %d", val->pc,
+ jvm_opcode[val->op].op, warn, val->stack_depth);
+
+ print_vcg_node(v, val->pc, node_label);
+ if((val->next != NULL) && (val->op != jvm_goto)
+ && (val->op != jvm_goto_w))
+ print_vcg_nearedge(v, val->pc, val->next->pc);
+
+ if(val->branch_target != NULL)
+ print_vcg_edge(v, val->pc, val->branch_target->pc);
+ }
+
+ print_vcg_trailer(v);
+ fclose(v);
+ }
+ else
+ fprintf(stderr, "couldn't open vcg file: '%s'\n",filename);
+}
+#endif
+
+/*****************************************************************************
+ * *
+ * assign_varnums_to_arguments *
+ * *
+ * This routine numbers the local variables for generating bytecode. *
+ * *
+ * Horribly kludged routines with massive loop of *
+ * duplicated code. *
+ * *
+ * ...cleaned this routine up somewhat. --kgs 5/5/00 *
+ * *
+ *****************************************************************************/
+
+int
+assign_varnums_to_arguments(AST * root)
+{
+ AST * locallist;
+ HASHNODE * hashtemp, * ht2;
+ int localnum = 0;
+
+ /* if root is NULL, this is probably a PROGRAM (no args) */
+ if(root == NULL)
+ return 1;
+
+ /* This loop takes care of the stuff coming in from the
+ * argument list.
+ */
+ for (locallist = root ; locallist; locallist = locallist->nextstmt)
+ {
+ if(gendebug)
+ printf("assign_varnums_to_arguments(%s): arg list name: %s, local varnum: %d\n",
+ cur_filename, locallist->astnode.ident.name, localnum);
+
+ hashtemp = type_lookup(cur_type_table, locallist->astnode.ident.name);
+ if(hashtemp == NULL)
+ {
+ ht2=type_lookup(cur_args_table, locallist->astnode.ident.name);
+ if(ht2) {
+ if(gendebug)
+ printf("assign_varnums_to_arguments(%s):%s in args table, set lvnum: %d\n",
+ cur_filename, locallist->astnode.ident.name, localnum);
+
+ ht2->variable->astnode.ident.localvnum = localnum;
+ localnum++;
+ continue;
+ }
+ else {
+ fprintf(stderr,"Type table is screwed in assign locals.\n");
+ fprintf(stderr,"could not find %s\n", locallist->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+ }
+
+ hashtemp->variable->astnode.ident.localvnum = localnum;
+
+ /* Check to see if it is a double or if it is an array declaration.
+ * Doubles take up two stack entries, so we increment by 2. Arrays
+ * only take up one stack entry, but we add an integer offset
+ * parameter which takes up an additional entry.
+ *
+ * also check whether this is pass by reference, because objects
+ * always occupy 1 stack entry, even if the data type is double.
+ */
+
+ if(gendebug)
+ printf("assign_varnums_to_arguments(%s): name: %s, pass by ref: %s\n",
+ cur_filename, locallist->astnode.ident.name,
+ hashtemp->variable->astnode.ident.passByRef ? "yes" : "no");
+
+ if((hashtemp->variable->vartype == Double ||
+ hashtemp->variable->astnode.ident.arraylist != NULL) &&
+ (!hashtemp->variable->astnode.ident.passByRef))
+ localnum += 2;
+ else
+ localnum++;
+
+ if(gendebug)
+ printf("ARG %s %d\n", hashtemp->variable->astnode.ident.name,
+ hashtemp->variable->astnode.ident.localvnum);
+ }
+
+ return localnum;
+} /* Close assign_varnums_to_arguments(). */
+
+/*****************************************************************************
+ * *
+ * print_nodetype *
+ * *
+ * This is primarily a debugging tool. Given a node, it returns a *
+ * string containing the node type. *
+ * *
+ *****************************************************************************/
+
+char *
+print_nodetype (AST *root)
+{
+ static char temp[100];
+
+ if(root == NULL) {
+ return("print_nodetpe: NULL root");
+ }
+
+ switch (root->nodetype)
+ {
+ case Source:
+ return("Source");
+ case Progunit:
+ return("Progunit");
+ case Subroutine:
+ return("Subroutine");
+ case Function:
+ return("Function");
+ case Program:
+ return("Program");
+ case Blockif:
+ return("Blockif");
+ case Common:
+ return("Common");
+ case CommonList:
+ return("CommonList");
+ case DataStmt:
+ return("DataStmt");
+ case DataList:
+ return("DataList");
+ case Elseif:
+ return("Elseif");
+ case Else:
+ return("Else");
+ case Forloop:
+ return("Forloop");
+ case Format:
+ return("Format");
+ case Constant:
+ return("Constant");
+ case Method:
+ return("Method");
+ case Identifier:
+ return("Identifier");
+ case Label:
+ return("Label");
+ case Logicalif:
+ return("Logicalif");
+ case Typedec:
+ return("Typedec");
+ case Assignment:
+ return("Assignment");
+ case Expression:
+ return("Expression");
+ case Return:
+ return("Return");
+ case Goto:
+ return("Goto");
+ case Call:
+ return("Call");
+ case Statement:
+ return("Statement");
+ case Relationalop:
+ return("Relationalop");
+ case Logicalop:
+ return("Logicalop");
+ case Binaryop:
+ return("Binaryop");
+ case Power:
+ return("Power");
+ case Unaryop:
+ return("Unaryop");
+ case Save:
+ return("Save");
+ case Specification:
+ return("Specification");
+ case Substring:
+ return("Substring");
+ case End:
+ return("End");
+ case Write:
+ return("Write");
+ case Stop:
+ return("Stop");
+ case Pause:
+ return("Pause");
+ case ComputedGoto:
+ return("ComputedGoto");
+ case ArrayAccess:
+ return("ArrayAccess");
+ case ArrayDec:
+ return("ArrayDec");
+ case Read:
+ return("Read");
+ case EmptyArgList:
+ return("EmptyArgList");
+ case IoExplist:
+ return("IoExplist");
+ case IoImpliedLoop:
+ return("IoImpliedLoop");
+ case DataImpliedLoop:
+ return("DataImpliedLoop");
+ case Unimplemented:
+ return("Unimplemented");
+ case Equivalence:
+ return("Equivalence");
+ case Comment:
+ return("Comment");
+ case MainComment:
+ return("MainComment");
+ case Dimension:
+ return("Dimension");
+ default:
+ sprintf(temp, "print_nodetype(): Unknown Node: %d", root->nodetype);
+ return(temp);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * get_return_type_from_descriptor *
+ * *
+ * given a method descriptor, this function returns the string representing *
+ * the return type of the method. *
+ * *
+ *****************************************************************************/
+
+char *
+get_return_type_from_descriptor(char *desc)
+{
+ char *dptr;
+
+ dptr = desc;
+
+ /* skip characters until we hit the closing paren, making sure that
+ * we dont go beyond the end of hte string.
+ */
+
+ while(*dptr != ')') {
+ if((*dptr == '\0') || (*(dptr+1) == '\0')) {
+ fprintf(stderr,"Could not determine return type for descriptor '%s'\n",
+ desc);
+ return NULL;
+ }
+
+ dptr++;
+ }
+
+ /* now skip over the closing paren and return the remaining portion
+ * of the descriptor */
+
+ return strdup(dptr+1);
+}
+
+/*****************************************************************************
+ * *
+ * get_retstring_from_field_desc *
+ * *
+ * given a field descriptor, this function returns the string representation *
+ * of the appropriate java data type. *
+ * *
+ *****************************************************************************/
+
+enum returntype
+get_type_from_field_desc(char * fd)
+{
+ enum returntype rt = Integer;
+ char * wrap;
+
+ switch(fd[0]) {
+ case 'B':
+ rt = Integer;
+ break;
+ case 'C':
+ rt = Character;
+ break;
+ case 'D':
+ rt = Double;
+ break;
+ case 'F':
+ rt = Float;
+ break;
+ case 'I':
+ rt = Integer;
+ break;
+ case 'J':
+ rt = Integer;
+ break;
+ case 'S':
+ rt = Integer;
+ break;
+ case 'Z':
+ rt = Logical;
+ break;
+ case 'V':
+ rt = Object; /* no void in the array, so use object instead */
+ break;
+ case '[':
+ rt = get_type_from_field_desc(fd+1);
+ break;
+ case 'L':
+ wrap = get_wrapper_from_desc(fd);
+
+ if(!strcmp(wrap, "StringW"))
+ rt = String;
+ else if(!strcmp(wrap, "complexW"))
+ rt = Complex;
+ else if(!strcmp(wrap, "intW"))
+ rt = Integer;
+ else if(!strcmp(wrap, "doubleW"))
+ rt = Double;
+ else if(!strcmp(wrap, "floatW"))
+ rt = Float;
+ else if(!strcmp(wrap, "booleanW"))
+ rt = Logical;
+ else if(!strcmp(wrap, "String"))
+ rt = String;
+ else if(!strcmp(wrap, "Object"))
+ rt = Object;
+ else
+ fprintf(stderr,"get_type_from_field_desc() hit default case '%s'!!\n",
+ fd);
+
+ f2jfree(wrap, strlen(wrap)+1);
+ break;
+ default:
+ fprintf(stderr,"get_type_from_field_desc() hit default case '%s'!!\n",
+ fd);
+ rt = Integer;
+ }
+
+ return rt;
+}
+
+/*****************************************************************************
+ * *
+ * get_wrapper_from_desc *
+ * *
+ * given the descriptor of one of the numeric wrappers, return just the *
+ * last part (e.g. Integer, Double, etc). assume that desc points to the *
+ * initial 'L' of the field descriptor, but may contain extraneous chars *
+ * after the final ';'. *
+ * *
+ *****************************************************************************/
+
+char *
+get_wrapper_from_desc(char *desc)
+{
+ char *ls, *dptr, *new;
+
+ ls = dptr = desc;
+
+ while( *dptr != ';' ) {
+ if(*dptr == '\0')
+ return desc;
+
+ if(*dptr == '/')
+ ls = dptr;
+
+ dptr++;
+ }
+
+ new = strdup(ls+1);
+ new[(int)(dptr-ls-1)] = '\0';
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * get_field_desc_from_ident *
+ * *
+ * given the AST node of some identifier, return the appropriate field *
+ * descriptor. *
+ * *
+ *****************************************************************************/
+
+char *
+get_field_desc_from_ident(AST *node)
+{
+ char *fdesc;
+ int isArray = node->astnode.ident.dim > 0;
+
+ if(omitWrappers && !node->astnode.ident.passByRef)
+ fdesc = field_descriptor[node->vartype][isArray];
+ else
+ fdesc = wrapped_field_descriptor[node->vartype][isArray];
+
+ return fdesc;
+}
+
+/*****************************************************************************
+ * *
+ * get_adapter_desc *
+ * *
+ * given a pointer to the function arg list, this function returns the *
+ * corresponding descriptor. *
+ * *
+ *****************************************************************************/
+
+char *
+get_adapter_desc(char *dptr, AST *arg)
+{
+ struct _str * temp_desc = NULL;
+ char *p;
+ int i;
+
+ dptr = bc_next_desc_token(dptr);
+
+ for(i = 0; arg != NULL ; arg = arg->nextstmt, i++)
+ {
+ if(dptr == NULL) {
+ fprintf(stderr,"get_adapter_desc():");
+ fprintf(stderr,"mismatch between adapter call and prototype\n");
+ break;
+ }
+
+ if(dptr[0] == '[') {
+ if(!type_lookup(cur_array_table,arg->astnode.ident.name)) {
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[get_type_from_field_desc(dptr+1)][0]);
+ }
+ else {
+ if(arg->vartype == get_type_from_field_desc(dptr+1)) {
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[get_type_from_field_desc(dptr+1)][1]);
+ temp_desc = strAppend(temp_desc, "I");
+ }
+ else {
+ temp_desc = strAppend(temp_desc, field_descriptor[arg->vartype][1]);
+ temp_desc = strAppend(temp_desc, "I");
+ }
+ }
+
+ dptr = bc_next_desc_token(dptr);
+ }
+ else if ( (arg->nodetype == Identifier) &&
+ type_lookup(cur_array_table,arg->astnode.ident.name))
+ {
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[get_type_from_field_desc(dptr)][0]);
+ }
+ else {
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[get_type_from_field_desc(dptr)][1]);
+ temp_desc = strAppend(temp_desc, "I");
+ }
+ }
+ else if( type_lookup(cur_external_table, arg->astnode.ident.name) )
+ {
+ temp_desc = strAppend(temp_desc, field_descriptor[Object][0]);
+ }
+ else
+ {
+ if(omitWrappers && !isPassByRef_desc(dptr)) {
+ temp_desc = strAppend(temp_desc,
+ field_descriptor[get_type_from_field_desc(dptr)][0]);
+ }
+ else {
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[get_type_from_field_desc(dptr)][0]);
+ }
+ }
+
+ dptr = bc_next_desc_token(dptr);
+ }
+
+ p = temp_desc->val;
+
+ f2jfree(temp_desc, sizeof(struct _str));
+
+ return p;
+}
+
+/*****************************************************************************
+ * *
+ * cast_data_stmt *
+ * *
+ * function prints a cast for a data statement and returns the token *
+ * vartype to be pushed onto the stack. *
+ * *
+ * called from: data_scalar_emit *
+ *****************************************************************************/
+
+int
+cast_data_stmt(AST *LHS, int no_change){
+ int tok = no_change;
+
+ if(LHS->vartype == Integer)
+ tok = INTEGER;
+ else if(LHS->vartype == Float)
+ tok = FLOAT;
+ else if(LHS->vartype == Double)
+ tok = DOUBLE;
+
+ fprintf(curfp, "(%s) ", returnstring[LHS->vartype]);
+
+ return tok;
+}
+
+
+/**
+ ** below are functions that we might want to move to the bytecode library
+ ** but the dependency on returntype enum would have to be eliminated.
+ **/
+
+/*****************************************************************************
+ * *
+ * pushVar *
+ * *
+ * pushes a local variable or field onto the stack. *
+ * *
+ *****************************************************************************/
+
+void
+pushVar(JVM_CLASS *cclass, JVM_METHOD *meth, enum returntype vt,
+ BOOL isArg, char *class, char *name, char *desc, int lv, BOOL deref)
+{
+ int c;
+
+ if(gendebug) {
+ /* printf("in pushvar, vartype is %s\n", returnstring[vt]); */
+ printf(" desc is %s\n", desc);
+ printf(" local varnum is %d\n", lv);
+ }
+
+ if(isArg || (lv != -1)) {
+ /* for reference types, always use aload */
+ if((desc[0] == 'L') || (desc[0] == '['))
+ bc_gen_load_op(meth, lv, jvm_Object);
+ else
+ bc_gen_load_op(meth, lv, jvm_data_types[vt]);
+ }
+ else {
+ c = bc_new_fieldref(cclass, class, name, desc);
+ bc_append(meth, jvm_getstatic, c);
+ }
+
+ if(deref) {
+ c = bc_new_fieldref(cclass, full_wrappername[vt], "val",
+ val_descriptor[vt]);
+ bc_append(meth, jvm_getfield, c);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * storeVar *
+ * *
+ * stores a value from the stack to a local variable. *
+ * *
+ *****************************************************************************/
+
+void
+storeVar(JVM_CLASS *cclass, JVM_METHOD *meth,
+ enum returntype vt, BOOL isArg, char *class, char *name, char *desc,
+ int lv, BOOL deref)
+{
+ int c;
+
+ if(gendebug) {
+ /* printf("in store, vartype is %s\n", returnstring[vt]); */
+ printf(" desc is %s\n", desc);
+ printf(" local varnum is %d\n", lv);
+ }
+
+ if(isArg || (lv != -1)) {
+ /* for reference types, always use aload */
+ if((desc[0] == 'L') || (desc[0] == '['))
+ bc_gen_store_op(meth, lv, jvm_Object);
+ else
+ bc_gen_store_op(meth, lv, jvm_data_types[vt]);
+ }
+ else {
+ c = bc_new_fieldref(cclass, class, name, desc);
+ bc_append(meth, jvm_putstatic, c);
+ }
+
+ if(deref) {
+ c = bc_new_fieldref(cclass, full_wrappername[vt], "val",
+ val_descriptor[vt]);
+ bc_append(meth, jvm_putfield, c);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * escape_double_quotes *
+ * *
+ * Adds backslash escapes to strings that are to be emitted in Java source. *
+ * For example, 'string "with" quotes' -> 'string \"with\" quotes' *
+ * *
+ *****************************************************************************/
+
+char *
+escape_double_quotes(char *str)
+{
+ char *newstr;
+ int i, ni;
+
+ newstr = (char *)malloc(strlen(str) * 2 + 1);
+
+ if(!newstr) return NULL;
+
+ ni = 0;
+
+ for(i=0;i<strlen(str);i++) {
+ if(str[i] != '"') {
+ newstr[ni] = str[i];
+ ni++;
+ }
+ else {
+ newstr[ni] = '\\';
+ newstr[ni+1] = '"';
+ ni += 2;
+ }
+ }
+
+ newstr[ni] = 0;
+
+ return newstr;
+}
diff --git a/src/codegen.h b/src/codegen.h
new file mode 100644
index 0000000..f3039ee
--- /dev/null
+++ b/src/codegen.h
@@ -0,0 +1,335 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/codegen.h,v $
+ * $Revision: 1.91 $
+ * $Date: 2007/12/14 20:56:39 $
+ * $Author: keithseymour $
+ */
+
+/*****************************************************************************
+ * codegen.h *
+ * *
+ * Definitions of constants related to code generation. *
+ * *
+ *****************************************************************************/
+
+#ifndef _CODEGEN_H
+#define _CODEGEN_H
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include<ctype.h>
+#include"f2j.h"
+#include"y.tab.h"
+#include"codegen.h"
+#include"f2jmem.h"
+
+/*****************************************************************************
+ * Following are some fully-qualified class names and method descriptors *
+ * for commonly used methods. *
+ * *
+ * JL_STRING is the fully-qualified name of the String class *
+ * STR_CONST_DESC is the descriptor for the String constructor *
+ * TRIM_DESC is the descriptor for java.lang.String.trim() *
+ * STREQV_DESC is the descriptor for java.lang.String.equalsIgnoreCase() *
+ * SUBSTR_DESC is the descriptor for java.lang.String.substring(int,int) *
+ * F2J_UTIL defines the default name of the f2java utility package. *
+ * UTIL_CLASS is where the insertString() method is defined. *
+ * STRICT_UTIL_CLASS is an fp strict version of UTIL_CLASS. *
+ * INS_DESC is the desc for insertString, used for LHS substring assignments *
+ * JL_SYSTEM is the fully-qualified name of the System class, for System.out *
+ * OUT_DESC is the desc for System.out, the standard output stream. *
+ * STRBUF_DESC is the desc for StringBuffer's constructor. *
+ * *
+ *****************************************************************************/
+
+#define JL_STRING "java/lang/String"
+#define JL_CHAR "java/lang/Character"
+#define JL_OBJECT "java/lang/Object"
+#define JL_NUMBER "java/lang/Number"
+#define STR_CONST_DESC "(Ljava/lang/String;)V"
+#define CHAR_ARRAY_DESC "([C)V"
+#define TRIM_DESC "()Ljava/lang/String;"
+#define STREQV_DESC "(Ljava/lang/String;)Z"
+#define SUBSTR_DESC "(II)Ljava/lang/String;"
+#define STRLEN_DESC "()I"
+#define F77_READ_DESC "(Ljava/lang/String;Ljava/util/Vector;)I"
+#define F77_WRITE_DESC "(Ljava/lang/String;Ljava/util/Vector;)V"
+#define F2J_UTIL "org/netlib/util"
+#define UTIL_CLASS "org/netlib/util/Util"
+#define ARRAY_SPEC_CLASS "org/netlib/util/ArraySpec"
+#define STRICT_UTIL_CLASS "org/netlib/util/StrictUtil"
+#define INS_DESC "(Ljava/lang/String;Ljava/lang/String;II)Ljava/lang/String;"
+#define SINGLE_INS_DESC "(Ljava/lang/String;Ljava/lang/String;I)Ljava/lang/String;"
+#define JL_SYSTEM "java/lang/System"
+#define PRINTSTREAM "java/io/PrintStream"
+#define OUT_DESC "Ljava/io/PrintStream;"
+#define STRINGBUFFER "java/lang/StringBuffer"
+#define STRBUF_DESC "(Ljava/lang/String;)V"
+#define REGIONMATCHES_DESC "(ILjava/lang/String;II)Z"
+#define TOSTRING_DESC "()Ljava/lang/String;"
+#define VEC_ADD_DESC "(Ljava/lang/Object;)V"
+#define VEC_REMOVE_DESC "(I)Ljava/lang/Object;"
+#define CHARAT_DESC "(I)C"
+#define COMPARE_DESC "(Ljava/lang/String;)I"
+#define VECTOR_CLASS "java/util/Vector"
+#define VECTOR_DESC "()V"
+#define EASYIN_CLASS "org/netlib/util/EasyIn"
+#define EASYIN_DESC "()V"
+#define ETIME_CLASS "org/netlib/util/Etime"
+#define ETIME_DESC "()V"
+#define SECOND_CLASS "org/netlib/util/Second"
+#define IOEXCEPTION "java/io/IOException"
+#define METHOD_CLASS "java/lang/reflect/Method"
+#define GETMETHODS_DESC "()[Ljava/lang/reflect/Method;"
+#define JL_CLASS "java/lang/Class"
+#define GETCLASS_DESC "()Ljava/lang/Class;"
+#define INVOKE_DESC "(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;"
+#define THROWABLE_CLASS "java/lang/Throwable"
+#define GETMSG_DESC "()Ljava/lang/String;"
+#define TOLOWER_DESC "()Ljava/lang/String;"
+#define STRCHARAT_DESC "(Ljava/lang/String;I)Ljava/lang/String;"
+#define EXIT_DESC "(I)V"
+#define PAUSE_DESC "(Ljava/lang/String;)V"
+#define PAUSE_NOARG_DESC "()V"
+#define INVOKE_EXCEPTION "java/lang/reflect/InvocationTargetException"
+#define ACCESS_EXCEPTION "java/lang/IllegalAccessException"
+
+#define F2J_STDIN "__f2j_stdin"
+#define F2J_IO_VEC "__io_vec"
+
+#define THREEARG_MAX_FUNC "Util.max"
+#define THREEARG_MAX_FUNC_STRICT "StrictUtil.max"
+#define THREEARG_MIN_FUNC "Util.min"
+#define THREEARG_MIN_FUNC_STRICT "StrictUtil.min"
+
+#define CB_PREFIX "common_block/"
+#define CB_DELIMITER '|'
+#define CB_SEPARATOR ','
+
+#define MAX(a, b) (((a) > (b)) ? (a) : (b))
+
+/*****************************************************************************
+ * comment out the following line to disable the generation of VCG control *
+ * flow graphs. *
+ *****************************************************************************/
+/* #define VCG_CONTROL_FLOW */
+
+/*****************************************************************************
+ * Definitions of code generation status. These are used to set the target *
+ * language that f2java is currently generating. *
+ *****************************************************************************/
+
+#define JAVA_ONLY 1
+#define JVM_ONLY 2
+#define JAVA_AND_JVM 3
+
+#define MAX_CODE_LEN 65535
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+#ifdef VCG_CONTROL_FLOW
+void cfg_emit(Dlist, char *);
+#endif
+
+char
+ * tok2str(int),
+ * format2str(AST *),
+ * lowercase(char *),
+ * escape_double_quotes(char *),
+ * get_common_prefix(char *),
+ * getVarDescriptor(AST *),
+ * char_substitution(char *, int, int),
+ * get_return_type_from_descriptor(char *),
+ * get_wrapper_from_desc(char *),
+ * get_field_desc_from_ident(AST *),
+ * get_desc_from_arglist(AST *),
+ * get_adapter_desc(char *, AST *),
+ * getNameFromCommonDesc(char *, int),
+ * getFieldDescFromCommonDesc(char *, int),
+ * getMergedName(AST *),
+ * getMergedDescriptor(AST *, enum returntype),
+ * getCommonVarName(AST *);
+
+METHODTAB
+ * methodscan (METHODTAB * , char * );
+
+void
+ pushConst(JVM_METHOD *, AST *),
+ pushVar(JVM_CLASS *, JVM_METHOD *, enum returntype, BOOL,
+ char *, char *, char *, int, BOOL),
+ storeVar(JVM_CLASS *, JVM_METHOD *, enum returntype, BOOL,
+ char *, char *, char *, int, BOOL),
+ arg_array_assign_emit(JVM_CLASS *, JVM_METHOD *, int,
+ int, int, enum returntype),
+ arg_assignment_emit(JVM_CLASS *, JVM_METHOD *, int,
+ int, int, BOOL, enum returntype),
+ read_implied_loop_bytecode_emit(JVM_METHOD *, AST *),
+ formatted_read_implied_loop_bytecode_emit(JVM_METHOD *, AST *),
+ write_implied_loop_bytecode_emit(JVM_METHOD *, AST *),
+ forloop_bytecode_emit(JVM_METHOD *, AST *),
+ forloop_end_bytecode(JVM_METHOD *, AST *),
+ LHS_bytecode_emit(JVM_METHOD *, AST *),
+ stop_emit(JVM_METHOD *, AST *),
+ pause_emit(JVM_METHOD *, AST *),
+ external_emit(JVM_METHOD *, AST *),
+ maxmin_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *, char *, char *),
+ max_intrinsic_emit (JVM_METHOD *, AST *, METHODTAB *),
+ min_intrinsic_emit (JVM_METHOD *, AST *, METHODTAB *),
+ while_emit(JVM_METHOD *, AST *),
+ substring_assign_emit(JVM_METHOD *, AST *),
+ dint_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *),
+ emit_call_args_known(JVM_METHOD *, AST *, char *, BOOL),
+ emit_call_args_unknown(JVM_METHOD *, AST *),
+ emit_call_arguments(JVM_METHOD *, AST *, BOOL),
+ aint_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *),
+ intrinsic_arg_emit(JVM_METHOD *, AST *, enum returntype),
+ intrinsic0_call_emit(JVM_METHOD *, AST *, METHODTAB *),
+ intrinsic_call_emit(JVM_METHOD *, AST *, METHODTAB *, enum returntype),
+ intrinsic2_call_emit(JVM_METHOD *, AST *, METHODTAB *, enum returntype),
+ intrinsic_lexical_compare_emit(JVM_METHOD *, AST *, METHODTAB *),
+ intrinsic_emit(JVM_METHOD *, AST *),
+ implied_loop_emit(JVM_METHOD *, AST *, void (*)(JVM_METHOD *, AST *),
+ void (*)(JVM_METHOD *, AST*)),
+ read_implied_loop_sourcecode_emit(JVM_METHOD *, AST *),
+ formatted_read_implied_loop_sourcecode_emit(JVM_METHOD *, AST *),
+ scalar_emit(JVM_METHOD *, AST *, HASHNODE *),
+ write_implied_loop_sourcecode_emit(JVM_METHOD *, AST *),
+ array_emit(JVM_METHOD *, AST *),
+ emit_interface(AST *),
+ substring_emit(JVM_METHOD *, AST *),
+ subcall_emit(JVM_METHOD *, AST *),
+ emit_methcall(FILE *, AST *),
+ name_emit (JVM_METHOD *, AST *),
+ print_eqv_list(AST *, FILE *),
+ open_output_file(AST *, char *),
+ print_string_initializer(JVM_METHOD *, AST *),
+ typedec_emit_all_static(JVM_METHOD *, AST *),
+ vardec_emit(JVM_METHOD *, AST *, enum returntype, char *),
+ assign_varnums_to_locals(JVM_METHOD *, AST *),
+ local_emit(JVM_METHOD *, AST *),
+ emit_adapters(void),
+ newarray_emit(JVM_METHOD *, enum returntype),
+ constructor (AST *),
+ typedec_emit (JVM_METHOD *, AST *),
+ data_emit(JVM_METHOD *, AST *),
+ equiv_emit (JVM_METHOD *, AST *),
+ call_emit (JVM_METHOD *, AST *),
+ forloop_emit (JVM_METHOD *, AST *),
+ blockif_emit (JVM_METHOD *, AST *),
+ logicalif_emit (JVM_METHOD *, AST *),
+ arithmeticif_emit (JVM_METHOD *, AST *),
+ goto_emit (JVM_METHOD *, AST *),
+ computed_goto_emit (JVM_METHOD *, AST *),
+ assigned_goto_emit (JVM_METHOD *, AST *),
+ label_emit (JVM_METHOD *, AST *),
+ write_emit (JVM_METHOD *, AST *),
+ common_emit(AST *),
+ read_emit (JVM_METHOD *, AST *),
+ unformatted_read_emit(JVM_METHOD *, AST *),
+ formatted_read_emit(JVM_METHOD *, AST *, char *),
+ emit_invocations(void),
+ merge_equivalences(AST *),
+ print_equivalences(AST *),
+ emit_prolog_comments(AST *),
+ emit_javadoc_comments(AST *),
+ prepare_comments(AST *),
+ insert_fields(AST *),
+ return_emit(JVM_METHOD *),
+ end_emit(JVM_METHOD *),
+ emit (AST *),
+ field_emit(AST *),
+ invoke_constructor(JVM_METHOD *, char *, AST *, char *),
+ set_bytecode_status(JVM_METHOD *, int),
+ inline_format_emit(JVM_METHOD *, AST *, BOOL),
+ assign_emit (JVM_METHOD *, AST *),
+ expr_emit(JVM_METHOD *, AST *),
+ substring_expr_emit(JVM_METHOD *, AST *),
+ relationalop_emit(JVM_METHOD *, AST *),
+ logicalop_emit(JVM_METHOD *, AST *),
+ constant_expr_emit(JVM_METHOD *, AST *),
+ unaryop_emit(JVM_METHOD *, AST *),
+ binaryop_emit(JVM_METHOD *, AST *),
+ power_emit(JVM_METHOD *, AST *),
+ parenthesized_expr_emit(JVM_METHOD *, AST *),
+ else_emit (AST *),
+ insert_adapter(AST *),
+ insert_methcall(Dlist, AST *),
+ reflect_declarations_emit(JVM_METHOD *, AST *),
+ data_scalar_emit(JVM_METHOD *, enum returntype, AST *, AST *, int),
+ func_array_emit(JVM_METHOD *, AST *, char *, int, int),
+ methcall_obj_array_emit(JVM_METHOD *, AST *, int),
+ adapter_emit_from_descriptor(JVM_METHOD *, JVM_METHODREF *, AST *),
+ adapter_args_emit_from_descriptor(JVM_METHOD *, AST *, char *),
+ adapter_temps_emit_from_descriptor(JVM_METHOD *, AST *, char *),
+ adapter_methcall_emit_from_descriptor(JVM_METHOD *, AST *, int, JVM_METHODREF *, char *),
+ adapter_assign_emit_from_descriptor(JVM_METHOD *, AST *, int, char *),
+ adapter_tmp_assign_emit(JVM_METHOD *, int, enum returntype),
+ adapter_assign_emit(JVM_METHOD *, int, int, int, char *),
+ adapter_array_assign_emit(JVM_METHOD *, int, int, int, char *),
+ arrayacc_arg_emit(JVM_METHOD *, AST *, char *, BOOL),
+ arrayref_arg_emit(JVM_METHOD *, AST *, char *),
+ scalar_arg_emit(JVM_METHOD *, AST *, char *, char *),
+ wrapped_arg_emit(JVM_METHOD *, AST *, char *),
+ gen_clear_io_vec(JVM_METHOD *),
+ initialize_lists(void),
+ free_lists();
+
+int
+ assign_varnums_to_arguments(AST *),
+ cast_data_stmt(AST *, int),
+ cgPassByRef(char *),
+ dl_int_examine(Dlist),
+ needs_adapter(AST *),
+ idxNeedsDecr(AST *),
+ method_name_emit (JVM_METHOD *, AST *, BOOL),
+ data_repeat_emit(JVM_METHOD *, AST *, AST *, unsigned int),
+ methcall_arglist_emit(AST *),
+ num_locals_in_descriptor(char *),
+ adapter_methcall_arg_emit(JVM_METHOD *, AST *, int, int, char *),
+ determine_var_length(HASHNODE *);
+
+double
+ eval_const_expr(AST *);
+
+HASHNODE
+ * format_lookup(SYMTABLE *, char *);
+
+JVM_CODE_GRAPH_NODE
+ * elseif_emit (JVM_METHOD *, AST *);
+
+AST
+ * label_search(Dlist, int),
+ * dl_astnode_examine(Dlist),
+ * dl_name_search(Dlist, char *),
+ * addnode(void),
+ * data_var_emit(JVM_METHOD *, AST *, AST *, HASHNODE *, int),
+ * data_implied_loop_emit(JVM_METHOD *, AST * , AST *),
+ * data_array_emit(JVM_METHOD *, int , AST *, AST *),
+ * data_string_emit(JVM_METHOD *, int , AST *, AST *),
+ * format_item_emit(JVM_METHOD *, AST *, AST **);
+
+enum returntype
+ get_type_from_field_desc(char *),
+ get_type(char *);
+
+JVM_METHODREF
+ * get_method_name(AST *, BOOL),
+ * get_methodref(AST *),
+ * find_commonblock(char *, Dlist),
+ * find_method(char *, Dlist);
+
+BOOL
+ adapter_insert_from_descriptor(AST *, AST *, char *),
+ is_static(AST *),
+ is_local(AST *),
+ isArrayNoIdx(AST *);
+
+struct var_info
+ * get_var_info(AST *),
+ * push_array_var(JVM_METHOD *, AST *);
+
+
+#endif
diff --git a/src/dlist.c b/src/dlist.c
new file mode 100644
index 0000000..20c1f69
--- /dev/null
+++ b/src/dlist.c
@@ -0,0 +1,115 @@
+/* Jim Plank's dlist routines. Contact plank at cs.utk.edu */
+
+#include <stdio.h> /* Basic includes and definitions */
+#include <stdlib.h>
+#include "dlist.h"
+#include "f2jmem.h"
+
+/*---------------------------------------------------------------------*
+ * PROCEDURES FOR MANIPULATING DOUBLY LINKED LISTS
+ * Each list contains a sentinal node, so that
+ * the first item in list l is l->flink. If l is
+ * empty, then l->flink = l->blink = l.
+ *---------------------------------------------------------------------*/
+
+Dlist make_dl()
+{
+ Dlist d;
+
+ d = (Dlist) f2jalloc (sizeof(struct dlist));
+ d->flink = d;
+ d->blink = d;
+ d->val = (void *) 0;
+ return d;
+}
+
+void
+dl_insert_b(node, val) /* Inserts to the end of a list */
+Dlist node;
+void *val;
+{
+ Dlist last_node, new;
+
+ new = (Dlist) f2jalloc (sizeof(struct dlist));
+ new->val = val;
+
+ last_node = node->blink;
+
+ node->blink = new;
+ last_node->flink = new;
+ new->blink = last_node;
+ new->flink = node;
+}
+
+void
+dl_insert_list_b(Dlist node, Dlist list_to_insert)
+{
+ Dlist last_node, f, l;
+
+ if (dl_empty(list_to_insert)) {
+ free(list_to_insert);
+ return;
+ }
+ f = list_to_insert->flink;
+ l = list_to_insert->blink;
+ last_node = node->blink;
+
+ node->blink = l;
+ last_node->flink = f;
+ f->blink = last_node;
+ l->flink = node;
+ free(list_to_insert);
+}
+
+void
+dl_delete_node(item) /* Deletes an arbitrary iterm */
+Dlist item;
+{
+ item->flink->blink = item->blink;
+ item->blink->flink = item->flink;
+ free(item);
+}
+
+void
+dl_delete_list(l)
+Dlist l;
+{
+ Dlist d, next_node;
+
+ if(l == NULL)
+ return;
+
+ d = l->flink;
+ while(d != l) {
+ next_node = d->flink;
+ free(d);
+ d = next_node;
+ }
+ free(d);
+}
+
+void *
+dl_val(l)
+Dlist l;
+{
+ return l->val;
+}
+
+void*
+dl_pop(li)
+Dlist li;
+{
+ Dlist item = dl_last(li);
+ void *tmp;
+
+ if(item == NULL)
+ return NULL;
+
+ item->flink->blink = item->blink;
+ item->blink->flink = item->flink;
+
+ tmp = dl_val(item);
+ f2jfree(item, sizeof(Dlist));
+
+ return tmp;
+}
diff --git a/src/dlist.h b/src/dlist.h
new file mode 100644
index 0000000..869c7b6
--- /dev/null
+++ b/src/dlist.h
@@ -0,0 +1,50 @@
+/* Jim Plank's dlist routines. Contact plank at cs.utk.edu */
+
+#ifndef _DLIST_H
+#define _DLIST_H
+
+typedef struct dlist {
+ struct dlist *flink;
+ struct dlist *blink;
+ void *val;
+} *Dlist;
+
+/* Nil, first, next, and prev are macro expansions for list traversal
+ * primitives. */
+
+#define dl_nil(l) (l)
+
+#define dl_first(l) (l->flink)
+
+#define dl_last(l) (l->blink)
+
+#define dl_next(n) (n->flink)
+
+#define dl_prev(n) (n->blink)
+
+/* These are the routines for manipluating lists */
+
+extern Dlist make_dl(void);
+extern void dl_insert_b(Dlist, void *); /* Makes a new node, and inserts it before
+ the given node -- if that node is the
+ head of the list, the new node is
+ inserted at the end of the list */
+#define dl_insert_a(n, val) dl_insert_b(n->flink, val)
+
+extern void dl_delete_node(Dlist); /* Deletes and free's a node */
+
+extern void dl_delete_list(Dlist); /* Deletes the entire list from
+ existance */
+extern void *dl_val(Dlist); /* Returns node->val (used to shut lint up) */
+extern void *dl_pop(Dlist); /* returns the first node and removes
+ it from the list */
+
+extern void dl_insert_list_b(Dlist, Dlist);
+
+#define dl_traverse(ptr, list) \
+ for (ptr = dl_first(list); ptr != dl_nil(list); ptr = dl_next(ptr))
+#define dl_traverse_b(ptr, list) \
+ for (ptr = dl_last(list); ptr != dl_nil(list); ptr = dl_prev(ptr))
+#define dl_empty(list) (list->flink == list)
+
+#endif
diff --git a/src/f2j-config.h b/src/f2j-config.h
new file mode 100644
index 0000000..eda5d77
--- /dev/null
+++ b/src/f2j-config.h
@@ -0,0 +1,13 @@
+/*
+ * $Source: $
+ * $Revision: $
+ * $Date: $
+ * $Author: $
+ */
+
+#ifndef _F2J_CONFIG_H
+#define _F2J_CONFIG_H
+
+#define F2J_VERSION "0.8.1"
+
+#endif
diff --git a/src/f2j-config.h.in b/src/f2j-config.h.in
new file mode 100644
index 0000000..a9d650d
--- /dev/null
+++ b/src/f2j-config.h.in
@@ -0,0 +1,13 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2j-config.h.in,v $
+ * $Revision: 1.1 $
+ * $Date: 2008/06/24 21:03:44 $
+ * $Author: keithseymour $
+ */
+
+#ifndef _F2J_CONFIG_H
+#define _F2J_CONFIG_H
+
+#define F2J_VERSION "@F2J_VERSION@"
+
+#endif
diff --git a/src/f2j.h b/src/f2j.h
new file mode 100644
index 0000000..9b40b37
--- /dev/null
+++ b/src/f2j.h
@@ -0,0 +1,700 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2j.h,v $
+ * $Revision: 1.90 $
+ * $Date: 2007/12/12 21:47:41 $
+ * $Author: keithseymour $
+ */
+
+
+#ifndef _F2J_H
+#define _F2J_H
+
+/*****************************************************************************
+ * f2j.h *
+ * *
+ * Header file for the Fortran-to-Java translator. *
+ * *
+ *****************************************************************************/
+
+#include<assert.h>
+#include<stdlib.h>
+#include"symtab.h"
+#include"dlist.h"
+#include"bytecode.h"
+#include"opcodes.h"
+
+#define FALSE 0
+#define TRUE 1
+
+#define F2J_CLASS_ACC (JVM_ACC_PUBLIC | JVM_ACC_FINAL | JVM_ACC_SUPER)
+#define F2J_NORMAL_ACC (JVM_ACC_PUBLIC | JVM_ACC_STATIC)
+#define F2J_STRICT_ACC (JVM_ACC_STRICT | F2J_NORMAL_ACC)
+#define F2J_ADAPTER_ACC (JVM_ACC_PRIVATE | JVM_ACC_STATIC)
+#define F2J_INIT_ACC (JVM_ACC_PUBLIC)
+
+#define MIN(x,y) ((x)<(y)?(x):(y)) /* the minimum of two numbers */
+
+/*****************************************************************************
+ * Define VCG as 1 if VCG output is desired (VCG == Visualization of *
+ * Compiler Graphs) *
+ *****************************************************************************/
+
+#define VCG 0
+
+/*****************************************************************************
+ * Defines for optimization of the use of object wrappers: *
+ * NOT_VISITED - f2j has not started optimizing this routine *
+ * VISITED - f2j has started optimizing, but has not finished *
+ * FINISHED - optimization is complete for this routine *
+ *****************************************************************************/
+
+#define NOT_VISITED 0
+#define VISITED 1
+#define FINISHED 2
+
+/*****************************************************************************
+* Definitions for intrinsic variable names. At certain pts in the parser, we *
+* do not know whether this intrinsic name represents an intrinsic call, *
+* function call, array name, or a regular variable. *
+*****************************************************************************/
+
+#define INTRIN_NOT_NAMED 0
+#define INTRIN_NAMED_VARIABLE 1
+#define INTRIN_NAMED_ARRAY 2
+#define INTRIN_NAMED_ARRAY_OR_FUNC_CALL 3
+
+/*****************************************************************************
+ * Definitions for an expandable string structure. STR_INIT is the initial *
+ * size of the string, while STR_CHUNK is the number of bytes by which we *
+ * increment the string when it is too small. *
+ *****************************************************************************/
+
+#define STR_INIT 50
+#define STR_CHUNK 20
+
+#define MAX_CONST_LEN 80
+
+/*****************************************************************************
+ * BIGBUFF is the maximum size in characters of an input line (including) *
+ * continuations. Had a segfault on a very long continued line *
+ * in a lapack routine. This is a hack, should *
+ * reallaoc when buffer overflows instead. *
+ * *
+ * YYTEXTLEN is the maximum size in characters of the token string. *
+ *****************************************************************************/
+
+#define BIGBUFF 2000
+#define YYTEXTLEN 2000
+
+struct _str {
+ unsigned int size;
+ char *val;
+};
+
+/*****************************************************************************
+ * this structure holds information about an array access, including the *
+ * full name of the array, local variable number, etc. *
+ *****************************************************************************/
+
+struct var_info {
+ char *name; /* name of variable incl common prefix if appropriate */
+ char *desc; /* field descriptor of variable */
+ char *class; /* class name of variable */
+ int localvar; /* local variable num of this variable, if appropriate */
+ BOOL is_arg; /* is this variable an arg to the current prog unit? */
+};
+
+/*****************************************************************************
+ * This struct retains information about included files that are on the *
+ * stack (so we can keep track of which line number we were on when we *
+ * started the included file. *
+ *****************************************************************************/
+
+typedef struct _include_file_info
+{
+ char *name;
+ int line_num;
+ FILE *fp;
+}
+INCLUDED_FILE;
+
+/*****************************************************************************
+ * This struct defines an entry in the implicit table, which holds info *
+ * about any IMPLICIT statements and the mapping between first letter and *
+ * data type. *
+ *****************************************************************************/
+
+typedef struct _itab_entry {
+ enum returntype type;
+ int len;
+ int declared;
+} ITAB_ENTRY;
+
+/*****************************************************************************
+ * F2J_PATH_VAR defines the environment variable used to specify the search *
+ * path for .f2j method/descriptor files. *
+ *****************************************************************************/
+
+#define F2J_PATH_VAR "F2J_SEARCH_PATH"
+
+/*****************************************************************************
+ * bitfields representing the valid arguments to intrinsics. the generic *
+ * intrinsics may take many different valid types, so we OR them together in *
+ * some cases. *
+ *****************************************************************************/
+
+#define STRING_ARG 64
+#define CHAR_ARG 32
+#define COMPLEX_ARG 16
+#define DOUBLE_ARG 8
+#define REAL_ARG 4
+#define INT_ARG 2
+#define LOGICAL_ARG 1
+#define NO_ARG 0
+
+#define IRDC_ARGS (INT_ARG | REAL_ARG | DOUBLE_ARG | COMPLEX_ARG)
+#define IRD_ARGS (INT_ARG | REAL_ARG | DOUBLE_ARG)
+#define IR_ARGS (INT_ARG | REAL_ARG)
+#define RD_ARGS (REAL_ARG | DOUBLE_ARG)
+#define RDC_ARGS (REAL_ARG | DOUBLE_ARG | COMPLEX_ARG)
+#define CS_ARGS (STRING_ARG | CHAR_ARG)
+
+/*****************************************************************************
+ * MAX_ARRAY_DIM is the maximum number of dimensions allowed in an array. *
+ *****************************************************************************/
+
+#define MAX_ARRAY_DIM 7
+
+/*****************************************************************************
+ * MAIN_DESCRIPTOR is the descriptor required for a main() method in Java. *
+ *****************************************************************************/
+
+#define MAIN_DESCRIPTOR "([Ljava/lang/String;)V"
+
+/*****************************************************************************
+ * If DEBUGGEM is defined as 1, yyparse produces voluminous, detailed *
+ * output to stderr during parsing. *
+ *****************************************************************************/
+
+#define DEBUGGEM 0
+
+/* Enumeration of the different kinds of Specification statements */
+
+enum spectype
+{
+ External, Intrinsic, Implicit, Parameter
+};
+
+/* Represents whether an expression is on the lhs or rhs. */
+
+enum _expr_side
+{
+ left, right
+};
+
+/* Enumeration of all the different kinds of nodes in the AST */
+
+enum _nodetype
+{
+ Source = 1,
+ Progunit,
+ Subroutine,
+ Function,
+ Program,
+ Blockif,
+ Comment,
+ MainComment,
+ Common,
+ CommonList,
+ DataStmt,
+ DataList,
+ Dimension,
+ Elseif,
+ Else,
+ Forloop,
+ Format,
+ Constant,
+ Method,
+ Identifier,
+ Label,
+ Logicalif,
+ Arithmeticif,
+ Typedec,
+ Assignment,
+ Expression,
+ Equivalence,
+ Return,
+ Goto,
+ Call,
+ Statement,
+ Relationalop,
+ Logicalop,
+ Binaryop,
+ Power,
+ Unaryop,
+ Save,
+ Specification,
+ Substring,
+ End,
+ Write,
+ Read,
+ Stop,
+ Pause,
+ ComputedGoto,
+ AssignedGoto,
+ ArrayAccess,
+ ArrayDec,
+ ArrayIdxRange,
+ EmptyArgList,
+ IoExplist,
+ DataImpliedLoop,
+ IoImpliedLoop,
+ StmtLabelAssign,
+ Unimplemented
+};
+
+/*****************************************************************************
+ * Structure for program units (program, function, subroutine). *
+ *****************************************************************************/
+
+struct _source
+{
+ enum returntype returns; /* The return type of this program unit */
+
+ struct ast_node
+ *name, /* node representing this unit's name */
+ *progtype, /* type of unit (e.g. PROGRAM, FUNCTION) */
+ *typedecs, /* type declarations */
+ *statements, /* executable statements */
+ *args, /* argument list */
+ *equivalences, /* list of equivalences */
+ *prologComments, /* comments preceding unit header */
+ *javadocComments; /* comm. to be emitted in javadoc format */
+
+ SYMTABLE
+ *type_table, /* general symbol table for this unit */
+ *external_table, /* external funcs called from this unit */
+ *intrinsic_table, /* intrinsic funcs called from this unit */
+ *args_table, /* table of this unit's arguments */
+ *array_table, /* variables that are declared as arrays */
+ *format_table, /* FORMAT statements */
+ *data_table, /* variables declared in a DATA stmt */
+ *save_table, /* variables declared in a SAVE stmt */
+ *common_table, /* variables declared in a COMMON stmt */
+ *parameter_table, /* variables declared as PARAMETERS */
+ *equivalence_table; /* variables that are equivalenced */
+
+ Dlist
+ stmt_assign_list, /* labels used in ASSIGN TO statements */
+ constants_table; /* constant_pool info for bytecode gen. */
+
+ BOOL
+ needs_input, /* does this unit read any data */
+ needs_output, /* does this unit write any data */
+ needs_reflection, /* does this unit call a passed-in func */
+ needs_blas; /* does this unit call any BLAS routines */
+
+ int
+ scalarOptStatus, /* status of optimization on this unit */
+ save_all; /* is there a SAVE stmt without var list */
+
+ JVM_CLASS
+ *class; /* class file for this program unit */
+
+ char * descriptor; /* method descriptor for this prog unit */
+};
+
+/*****************************************************************************
+ * Structure for expressions and assignment statements. *
+ *****************************************************************************/
+
+struct _assignment
+{
+ BOOL parens; /* used only by expr nodes. TRUE if the */
+ /* expression is enclosed by parens */
+
+ char
+ minus, /* unary sign of this expression */
+ optype; /* kind of operation (e.g. +, -, *, etc) */
+
+ struct ast_node
+ *lhs, /* left-hand side of expr or assignment */
+ *rhs; /* right-hand side of expr or assignment */
+};
+
+/*****************************************************************************
+ * This structure represents variable declarations. *
+ *****************************************************************************/
+
+struct _typeunit
+{
+ enum spectype specification; /* what kind of declaration this is */
+
+ enum returntype returns; /* the data type of this declaration */
+
+ struct ast_node *declist; /* list of variables being declared */
+};
+
+/*****************************************************************************
+ * This structure represents DO loops. *
+ *****************************************************************************/
+
+struct _forloop
+{
+ unsigned int
+ localvar; /* local var holding iteration count */
+
+ struct ast_node
+ *counter, /* the loop variable */
+ *Label, /* label of the CONTINUE for this loop */
+ *start, /* initial loop assignment (e.g. i = 0) */
+ *stop, /* stop when counter equals stop */
+ *incr, /* amount to increment each iteration */
+ *iter_expr, /* expression to calc # of iterations */
+ *incr_expr; /* expression to calc increment */
+
+ JVM_CODE_GRAPH_NODE
+ *goto_node; /* graph node of initial loop goto op */
+};
+
+/*****************************************************************************
+ * This structure represents constants. *
+ *****************************************************************************/
+
+struct _constant
+{
+ int
+ cp_index; /* constant pool index of this constant */
+
+ char
+ *opcode, /* e.g., iconst_1, bipush 121.23 */
+ *number; /* the constant */
+};
+
+/*****************************************************************************
+ * This structure represents labels. *
+ *****************************************************************************/
+
+struct _label
+{
+ int
+ number; /* the label number */
+
+ JVM_CODE_GRAPH_NODE
+ *instr; /* bytecode instruction with this label */
+
+ struct ast_node *stmt; /* the statement after this label */
+};
+
+/*****************************************************************************
+ * This structure represents identifiers. An identifier can be a scalar *
+ * variable, array variable, function name, or subroutine name. *
+ *****************************************************************************/
+
+struct _ident
+{
+ int
+ dim, /* number of dimensions (for arrays) */
+ position, /* ident's position in COMMON block */
+ len, /* size of ident (e.g. CHARACTER*8 = 8) */
+ array_len, /* num elements in array (if not implied)*/
+ localvnum, /* local variable number (for bytecode) */
+ which_implicit; /* default 0, array 1, var 2, lfunc 3, intrin 4 */
+
+ BOOL
+ passByRef, /* is this ident pass by reference */
+ needs_declaration, /* does this ident need a declaration */
+ explicit; /* true is explicitly declared */
+
+ struct ast_node
+ *startDim[MAX_ARRAY_DIM], /* start expression for each dimension */
+ /* also used as start exp idx for substr */
+ *endDim[MAX_ARRAY_DIM], /* ending expression for each dimension */
+ /* also used as end exp idx for substr */
+ *arraylist; /* expression representing array size */
+
+ char
+ *leaddim, /* leading dimension variable or const */
+ *opcode, /* A string records the appropriate *
+ * method to invoke on the stack when *
+ * opcode is emitted. *
+ * e.g., opcode = strdup("iload_1"); */
+ *commonBlockName, /* name of COMMON block this ident is in */
+ name[MAX_CONST_LEN], /* this ident's name */
+ *merged_name, /* this ident's merged name (e.g. in *
+ * cases of equivalence or COMMON) */
+ *descriptor; /* constant pool descriptor of the ident */
+};
+
+/*****************************************************************************
+ * This structure represents Logical IF statements and Block IF statements. *
+ * A logical if is a one-line IF statement with no ELSE or ELSE IF. *
+ * For example, *
+ * IF(a.eq.b) x=12 *
+ * *
+ * A Block if is an IF-THEN statement with optional ELSE and ELSE IF *
+ * blocks. For example, *
+ * IF(a.eq.b) THEN *
+ * x=12 *
+ * ELSE *
+ * x=0 *
+ * END IF *
+ *****************************************************************************/
+
+struct _logicalif
+{
+ int
+ endif_label; /* label of ENDIF stmt if present */
+
+ struct ast_node
+ *conds, /* the conditional expression to test */
+ *stmts, /* statements to execute if expr is TRUE */
+ *elseifstmts, /* list of ELSE IF statements */
+ *elsestmts; /* stmts to exectue if no IF or ELSE IF *
+ * expression was TRUE */
+};
+
+/*****************************************************************************
+ * This structure represents the Arithmetic IF. The arithmetic IF consists *
+ * of an expression and three labels. If the expression evaluates to a *
+ * negative value, control goes to the statement corresponding to the first *
+ * label. If the expression is 0, jump to the second label. If the *
+ * expression is positive, jump to the third label. *
+ *****************************************************************************/
+
+struct _arithmeticif
+{
+ struct ast_node *cond; /* the conditional expression */
+
+ int
+ neg_label, /* branch to this label if expr < 0 */
+ zero_label, /* branch to this label if expr == 0 */
+ pos_label; /* branch to this label if expr > 0 */
+};
+
+/*****************************************************************************
+ * This structure represents the GOTO statement. *
+ *****************************************************************************/
+
+struct _goto
+{
+ int label; /* which label to branch to */
+};
+
+/*****************************************************************************
+ * This structure represents IO statements (READ and WRITE). *
+ *****************************************************************************/
+
+struct _io
+{
+ int
+ io_type, /* is this a READ or WRITE statement */
+ file_desc, /* file descriptor (not currently used) */
+ format_num, /* FORMAT desc for this statement */
+ end_num; /* where to branch on error */
+
+ struct ast_node
+ *fmt_list, /* inline FORMAT info (w/ WRITE) */
+ *arg_list; /* list of expressions to read or write */
+};
+
+/*****************************************************************************
+ * This structure represents DATA statements. *
+ *****************************************************************************/
+
+struct _data_stmt
+{
+ struct ast_node
+ *nlist, /* list of variable initializations */
+ *clist; /* list of values to initialize with */
+};
+
+/*****************************************************************************
+ * This structure represents COMMON blocks. *
+ *****************************************************************************/
+
+struct _commonblock
+{
+ char *name; /* the name of the common block */
+ struct ast_node *nlist; /* list of variables in this block */
+};
+
+/*****************************************************************************
+ * This structure represents the computed GOTO. The computed GOTO consists *
+ * of a list of labels followed by an expression. The expression is *
+ * evaluated and control flows to the Nth label in the list, where N is the *
+ * integer value of the expression. For example, *
+ * X = 3 *
+ * GOTO (10, 20, 30, 40) X *
+ *****************************************************************************/
+
+struct _computed_goto
+{
+ struct ast_node
+ *name, /* expr that determines where to branch */
+ *intlist; /* list of labels (targets) */
+};
+
+/*****************************************************************************
+ * The main data structure, a "tagged union". This represents a node *
+ * of the AST. *
+ *****************************************************************************/
+
+typedef struct ast_node
+{
+ int token; /* this node's token (from lexer) */
+ enum returntype vartype; /* data type of this node */
+
+ struct ast_node
+ *nextstmt, /* statement or item following this one */
+ *prevstmt, /* statement or item preceding this one */
+ *parent; /* parent of this node */
+
+ enum _expr_side expr_side; /* which side this node is on */
+
+ enum _nodetype nodetype; /* what kind of node this is */
+
+ /*
+ * For any given node, one of the following structures should apply,
+ * depending on the node type.
+ */
+
+ union
+ {
+ struct _goto go_to; /* goto is a reserved word! */
+ struct _io io_stmt;
+ struct _label label;
+ struct _ident ident;
+ struct _source source;
+ struct _forloop forloop;
+ struct _typeunit typeunit;
+ struct _constant constant;
+ struct _commonblock common;
+ struct _data_stmt data, equiv;
+ struct _arithmeticif arithmeticif;
+ struct _computed_goto computed_goto;
+ struct _logicalif logicalif, blockif;
+ struct _assignment assignment, expression;
+ }
+ astnode;
+}
+AST;
+
+
+/*****************************************************************************
+ * keyword lookup table. *
+ *****************************************************************************/
+
+typedef struct _kwdtab
+{
+ char *kwd; /* text of the keyword */
+ int ktok; /* token code */
+ int klex; /* lexical value */
+}
+KWDTAB;
+
+/*****************************************************************************
+ * Java intrinsic methods. *
+ *****************************************************************************/
+
+enum _intrinsics {
+ ifunc_INT, ifunc_IFIX, ifunc_IDINT, ifunc_REAL, ifunc_FLOAT, ifunc_SNGL,
+ ifunc_DBLE, ifunc_CMPLX, ifunc_ICHAR, ifunc_CHAR, ifunc_AINT, ifunc_DINT,
+ ifunc_ANINT, ifunc_DNINT, ifunc_NINT, ifunc_IDNINT, ifunc_ABS, ifunc_IABS,
+ ifunc_DABS, ifunc_CABS, ifunc_MOD, ifunc_AMOD, ifunc_DMOD, ifunc_SIGN,
+ ifunc_ISIGN, ifunc_DSIGN, ifunc_DIM, ifunc_IDIM, ifunc_DDIM, ifunc_DPROD,
+ ifunc_MAX, ifunc_MAX0, ifunc_AMAX1, ifunc_DMAX1, ifunc_AMAX0, ifunc_MAX1,
+ ifunc_MIN, ifunc_MIN0, ifunc_AMIN1, ifunc_DMIN1, ifunc_AMIN0, ifunc_MIN1,
+ ifunc_LEN, ifunc_INDEX, ifunc_AIMAG, ifunc_CONJG, ifunc_SQRT, ifunc_DSQRT,
+ ifunc_CSQRT, ifunc_EXP, ifunc_DEXP, ifunc_CEXP, ifunc_LOG, ifunc_ALOG,
+ ifunc_DLOG, ifunc_CLOG, ifunc_LOG10, ifunc_ALOG10, ifunc_DLOG10, ifunc_SIN,
+ ifunc_DSIN, ifunc_CSIN, ifunc_COS, ifunc_DCOS, ifunc_CCOS, ifunc_TAN,
+ ifunc_DTAN, ifunc_ASIN, ifunc_DASIN, ifunc_ACOS, ifunc_DACOS, ifunc_ATAN,
+ ifunc_DATAN, ifunc_ATAN2, ifunc_DATAN2, ifunc_SINH, ifunc_DSINH, ifunc_COSH,
+ ifunc_DCOSH, ifunc_TANH, ifunc_DTANH, ifunc_LGE, ifunc_LGT, ifunc_LLE,
+ ifunc_LLT, ifunc_ETIME, ifunc_SECOND
+};
+
+typedef struct method_tab
+{
+ enum _intrinsics intrinsic; /* id of this intrinsic */
+ char *fortran_name; /* name of the Fortran intrinsic */
+
+ /* for Java source generation: */
+ char *java_method; /* name of the corresponding Java func */
+ char *strict_java_method; /* strict version (e.g. StrictMath.abs) */
+
+ /* for bytecode generation: */
+ char *class_name; /* fully qualified Java class name */
+ char *strict_class_name; /* strict version of the class name */
+ char *method_name; /* method name */
+ char *descriptor; /* corresponding Java func descriptor */
+
+ char args; /* bitfield of valid args to intrinsic */
+ enum returntype ret; /* return type of this intrinsic */
+}
+METHODTAB;
+
+/*****************************************************************************
+ * Enumeration of the relational operators. *
+ *****************************************************************************/
+
+enum relops
+{
+ rel_eq = 1, /* equals */
+ rel_ne, /* not equal */
+ rel_lt, /* less than */
+ rel_le, /* less than or equal */
+ rel_gt, /* greater than */
+ rel_ge /* greater than or equal */
+};
+
+/*****************************************************************************
+ * This structure represents a 'substitution'. This associates an integer *
+ * value with a variable name. *
+ *****************************************************************************/
+
+typedef struct {
+ char *name; /* variable name */
+ unsigned int val; /* value */
+} SUBSTITUTION;
+
+
+/*****************************************************************************
+ * Function prototypes to keep the compiler from complaining. *
+ *****************************************************************************/
+
+void
+ javaheader (FILE *, char *),
+ initialize(void),
+ uppercase(char *),
+ print_vcg_header(FILE *, char *),
+ print_vcg_trailer(FILE *),
+ print_vcg_node(FILE *, int, char *),
+ print_vcg_nearedge(FILE *, int, int),
+ print_vcg_edge(FILE *, int, int),
+ print_vcg_typenode(FILE *, int, char *),
+ add_implicit_to_tree(AST *);
+
+Dlist
+ build_method_table(char *);
+
+char
+ * get_method_descriptor(AST *, SYMTABLE *, SYMTABLE *, SYMTABLE *),
+ * print_nodetype ( AST * );
+
+struct _str
+ * strAppend(struct _str *, char *);
+
+int
+ isPassByRef(char *, SYMTABLE *, SYMTABLE *, SYMTABLE *);
+
+BOOL
+ isPassByRef_desc(char *);
+
+double
+ mypow(double, double);
+
+AST *clone_ident(AST *);
+
+#endif
diff --git a/src/f2j_externs.h b/src/f2j_externs.h
new file mode 100644
index 0000000..6484524
--- /dev/null
+++ b/src/f2j_externs.h
@@ -0,0 +1,70 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2j_externs.h,v $
+ * $Revision: 1.9 $
+ * $Date: 2007/07/30 20:52:25 $
+ * $Author: keithseymour $
+ */
+
+extern int
+ lineno, /* current line number */
+ statementno, /* current statement number */
+ func_stmt_num, /* current statement number within this function */
+ ignored_formatting, /* number of format statements ignored */
+ bad_format_count; /* number of invalid format stmts encountered */
+
+extern FILE
+ *ifp, /* input file pointer */
+ *vcgfp, /* VCG output file pointer */
+ *indexfp; /* method and descriptor index for all prog units */
+
+extern char
+ *inputfilename, /* name of the input file */
+ *package_name, /* what to name the package, e.g. org.netlib.blas */
+ *output_dir, /* path to which f2java should store class files */
+ line_buffer[]; /* copy of the fortran line */
+
+
+extern BOOL
+ strictFp, /* should we declare generated code as strictfp */
+ strictMath, /* should we use Java's strict fp math mode */
+ omitWrappers, /* should we try to optimize use of wrappers */
+ genInterfaces, /* should we generate simplified interfaces */
+ genJavadoc, /* should we generate javadoc-compatible comments */
+ noOffset, /* should we generate offset args in interfaces */
+ f2j_arrays_static, /* force all arrays to be declared static */
+ save_all_override; /* force all variables to be declared static */
+
+extern SYMTABLE
+ *type_table, /* General symbol table */
+ *external_table, /* external functions */
+ *intrinsic_table, /* intrinsic functions */
+ *args_table, /* arguments to the current unit */
+ *array_table, /* array variables */
+ *format_table, /* format statements */
+ *data_table, /* variables contained in DATA statements */
+ *save_table, /* variables contained in SAVE statements */
+ *common_table, /* variables contained in COMMON statements */
+ *parameter_table, /* PARAMETER variables */
+ *function_table, /* table of functions */
+ *java_keyword_table, /* table of Java reserved words */
+ *blas_routine_table, /* table of BLAS routines */
+ *common_block_table, /* COMMON blocks */
+ *global_func_table, /* Global function table */
+ *global_common_table, /* Global COMMON table */
+ *generic_table; /* table of the generic intrinsic functions */
+
+extern Dlist
+ constants_table, /* constants (for bytecode constant pool gen.) */
+ include_paths, /* list of paths to search for included files */
+ descriptor_table; /* list of method descriptors from *.f2j files */
+
+extern INCLUDED_FILE
+ *current_file_info; /* lexer information about the current file */
+
+#ifdef _WIN32
+#define FILE_DELIM "\\"
+#define PATH_DELIM ";"
+#else
+#define FILE_DELIM "/"
+#define PATH_DELIM ":"
+#endif
diff --git a/src/f2jlex.c b/src/f2jlex.c
new file mode 100644
index 0000000..a6fe676
--- /dev/null
+++ b/src/f2jlex.c
@@ -0,0 +1,1956 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2jlex.c,v $
+ * $Revision: 1.75 $
+ * $Date: 2007/12/12 21:47:41 $
+ * $Author: keithseymour $
+ */
+
+/*****************************************************************************
+ * f2jlex.c *
+ * *
+ * This is a lexer for a Fortran front-end written to *
+ * translate Fortran numerical linear algebra code into *
+ * Java. The lexer interacts with a yacc generated parser *
+ * and implements a subset of the commands used by the *
+ * flex scanner. Due to the nature of yacc (uses globals) *
+ * the scanner takes no arguments, but examines the globally *
+ * declared input source buffer. It returns a single token *
+ * and it's associated lexical value at each call. EOF *
+ * condition passes control back to main() for program *
+ * termination. *
+ * *
+ *****************************************************************************/
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include<ctype.h>
+#include"initialize.h"
+#include"f2jmem.h"
+#include"f2j_externs.h"
+
+/*****************************************************************************
+ * Set lexdebug TRUE for debugging output from the lexer routines. *
+ *****************************************************************************/
+
+int lexdebug = FALSE;
+char line_buffer[BIGBUFF];
+
+char yytext[YYTEXTLEN]; /* token text */
+
+/*****************************************************************************
+ * Stuff for Sale's algorithm when I get around to it. *
+ * They need to be global for now to set contexts. It is *
+ * probably possible to rewrite in terms of a struct to *
+ * pass around in the lexer, the contexts will have to be *
+ * global for the parser to use. *
+ * *
+ * I am setting these in the `collapse_white_space() *
+ * routine. *
+ *****************************************************************************/
+
+BOOL letterseen; /* we have seen a letter in this line */
+BOOL equalseen; /* we have seen an equals in this line */
+BOOL commaseen; /* we have seen a comma in this line */
+
+/*****************************************************************************
+ * a couple of buffers for manipulating the text of the current line. *
+ *****************************************************************************/
+
+typedef struct _buffer
+{
+ char stmt[BIGBUFF];
+ char text[BIGBUFF];
+}
+BUFFER;
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+int
+ yylex (void),
+ prelex (BUFFER *);
+
+char
+ *tok2str(int),
+ *f2j_fgets(char *, int, FILE *);
+
+FILE
+ *open_included_file(char *);
+
+int
+ name_scan (BUFFER *),
+ keyscan (register KWDTAB *, BUFFER *),
+ number_scan (BUFFER *, int, int),
+ string_or_char_scan (BUFFER *);
+
+void
+ truncate_bang_comments(BUFFER *),
+ check_continued_lines (FILE *, char *),
+ collapse_white_space (BUFFER *);
+
+METHODTAB
+ * methodscan (METHODTAB *, char *);
+
+extern Dlist
+ file_stack;
+
+/*****************************************************************************
+ * STANDALONE is defined in the makefile when compiling the *
+ * lex file as a stand alone program for debugging the lexer. *
+ *****************************************************************************/
+
+#ifdef STANDALONE
+
+union yylval_ {
+ struct ast_node *ptnode; /* pointer to AST node */
+ int tok; /* token ID */
+ enum returntype type; /* data type */
+ char lexeme[30]; /* text token */
+}yylval;
+
+/*****************************************************************************
+ * This main function is used for testing the lexer. It is only compiled *
+ * if STANDALONE is defined. *
+ *****************************************************************************/
+
+main (int argc, char **argv)
+{
+ extern FILE *ifp;
+ int token = 1;
+ ifp = fopen (argv[1], "rb");
+
+ while (token != 0)
+ {
+ token = yylex ();
+
+ /* This prints out some random int on the EOF
+ * condition.
+ */
+
+ if(lexdebug) {
+ printf ("From main: %d\n", token);
+ printf ("yytext: %s\n\n", yytext);
+ }
+ }
+
+ if(lexdebug)
+ printf ("EOF\n");
+} /* Close main(). */
+
+#endif /* STANDALONE */
+
+/*****************************************************************************
+ * *
+ * yylex *
+ * *
+ * yylex() has to call prelex() to take of all the *
+ * fortran nasties such as initial whitespace, unreserved *
+ * keywords, context sensitivity, etc. prelex() returns *
+ * a "card image" of characters to be tokenized. *
+ *****************************************************************************/
+
+int
+yylex ()
+{
+ static int tokennumber;
+ static int firsttoken;
+ static int parencount = 0;
+ static int format_stmt; /* are we lexing a format statement */
+ int token = 0;
+
+ /* yyparse() makes a call to yylex() each time it needs a
+ * token. To get a statement to parse, yylex() calls
+ * prelex() with the statement buffer. This occurs
+ * when the value of the statement buffer is 0.
+ * Since we don't want the statement to change between
+ * calls, we declare it static, and initialize it to
+ * null at the start of the program. We may also need
+ * the actual text of the fortran input, so we grab
+ * that also.
+ */
+
+ static BUFFER buffer =
+ {
+ {0}, /* Token string. */
+ {0} /* Text string. */
+ };
+
+ /* Test so that yylex will know when to call prelex to get
+ * another character string.
+ */
+
+ if (buffer.stmt[0] == '\0')
+ {
+ if(lexdebug) printf("calling prelex\n");
+ token = prelex (&buffer); /* No more tokens? Get another statement. */
+
+ if(token == INCLUDE) {
+ INCLUDED_FILE *newfile;
+ FILE *tempfp;
+ Dlist lp;
+ int tmplen;
+
+ buffer.stmt[0] = '\n'; buffer.stmt[1] = '\0';
+ buffer.text[0] = '\n'; buffer.text[1] = '\0';
+
+ /* check for cycle in the include stack */
+ dl_traverse(lp, file_stack) {
+ newfile = (INCLUDED_FILE *)dl_val(lp);
+ if( !strcmp(newfile->name, yylval.lexeme) ) {
+ fprintf(stderr,"Warning: loop in include (not including %s)\n",
+ yylval.lexeme);
+ strcpy(yylval.lexeme,"Include error\n");
+
+ return COMMENT;
+ }
+ }
+
+ tempfp = open_included_file(yylval.lexeme);
+
+ /* add the newline since we will send a COMMENT token back
+ * to the parser, with yylval containing the file name. the
+ * parser expects all comments to be terminated with \n\0.
+ */
+ tmplen = strlen(yylval.lexeme);
+ yylval.lexeme[ tmplen ] = '\n';
+ yylval.lexeme[ tmplen + 1] = '\0';
+
+ if(!tempfp) {
+ fprintf(stderr,"Error: could not open include file %s",
+ yylval.lexeme);
+ return COMMENT;
+ }
+
+ current_file_info->line_num = lineno+1;
+
+ newfile = (INCLUDED_FILE *)f2jalloc(sizeof(INCLUDED_FILE));
+
+ /* for internal use, strip the newline from the file name */
+ newfile->name = strdup(yylval.lexeme);
+ newfile->name[strlen(newfile->name)-1] = '\0';
+ newfile->line_num = 0;
+ newfile->fp = tempfp;
+
+ dl_insert_b(file_stack, current_file_info);
+ ifp = tempfp;
+ current_file_info = newfile;
+ lineno = 0;
+
+ return COMMENT;
+ }
+
+ if(token == COMMENT) {
+ if(lexdebug)
+ printf("0.1: lexer returns %s (%s)\n", tok2str(token),buffer.stmt);
+ buffer.stmt[0] = '\n'; buffer.stmt[1] = '\0';
+ buffer.text[0] = '\n'; buffer.text[1] = '\0';
+ return COMMENT;
+ }
+
+ tokennumber = 0; /* Reset for each statement. */
+ parencount = 0; /* Reset for each statement. */
+ format_stmt = 0; /* Reset for each statement. */
+ firsttoken = 0; /* Reset for each statement. */
+ }
+
+ if(lexdebug)
+ printf("here in yylex(), buffer.stmt = \"%s\"\n",buffer.stmt);
+
+
+ /* Check for end of file condition. */
+
+ if (*buffer.stmt == '\0') {
+ /* I am not sure exactly what is going on here...
+ * I may later comment this out to investigate the
+ * behavior. If this does work, it is confusing with
+ * what I said above.
+ */
+
+ if(lexdebug)
+ printf("(first): lexer returning 0 \n");
+ return 0;
+ }
+
+ /* All the context handling will need to be handled
+ * before keyscanning. Contexts will include `if'
+ * and `do' statements. This is "Sale's algorithm"
+ * stuff. The global vars commaseen, letterseen and
+ * equalseen are boolean flags set in the
+ * `collapse_white_space()' procedure.
+ */
+
+ /* This section of code has grown to the point where it needs
+ * to broken into one or two smaller procedures. It
+ * is getting difficult to follow. -dmd 9/26/97
+ */
+
+#define SALES 1
+
+#if SALES
+
+ /* Fortran statements begin with a keyword except under
+ * certain very specific circumstances (detailed in
+ * technical report. */
+
+ if (tokennumber == 0)
+ {
+ if (commaseen == FALSE &&
+ equalseen == TRUE &&
+ letterseen == FALSE)
+ {
+ if (isalpha ( (int) *buffer.stmt))
+ token = name_scan (&buffer);
+
+ if (token)
+ {
+ tokennumber++;
+ if(lexdebug)
+ printf("1: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+ /* Trap errors. */
+ }
+ else /* Other three cases. */
+ {
+ if(lexdebug)
+ printf("keyscanning %s, ",buffer.stmt);
+
+ token = keyscan (tab_type, &buffer);
+
+ if(lexdebug)
+ printf("token = %d\n",token);
+
+ if (token)
+ {
+ firsttoken = token;
+ tokennumber++;
+ if(lexdebug)
+ printf("2: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+
+ token = keyscan (tab_stmt, &buffer);
+
+ if (token)
+ {
+ firsttoken = token;
+ tokennumber++;
+ if(token == END)
+ func_stmt_num = 0;
+ yylval.lexeme[0] = '\0';
+ if(lexdebug)
+ printf("3: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+
+ /* Scan for a labeled (numbered) statement. */
+ if (isdigit ((int) *buffer.stmt))
+ token = number_scan (&buffer, format_stmt, tokennumber);
+
+ if (token)
+ {
+ firsttoken = token;
+ tokennumber++;
+
+ /* this is really a hack. I'm trying to sniff out
+ * labeled else/elseif/endif statements and avoid
+ * passing the integer token back to the parser.
+ * I was getting several shift/reduce conflicts and
+ * didn't want to sort them out, especially since
+ * the label is ignored for else and elseif. For
+ * endif, we let the label get passed back to the
+ * parser in yylval.lexeme.
+ */
+
+ if(!strncasecmp(buffer.stmt, "else", 4) ||
+ !strncasecmp(buffer.stmt, "elseif", 6) ||
+ !strncasecmp(buffer.stmt, "endif", 5))
+ {
+ token = keyscan(tab_stmt, &buffer);
+
+ if(!token) {
+ fprintf(stderr, "Error: expected keyword token.\n");
+ exit(-1);
+ }
+
+ if(lexdebug)
+ printf("3.9: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+
+ if(lexdebug)
+ printf("4: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+ /* Should probably trap errors here. */
+ }
+ /* Should probably trap errors here. */
+ } /* Close if (firsttoken == 0). */
+
+ if(lexdebug)
+ printf("func_stmt_num = %d, firsttoken = %d, and tokennumber = %d\n",
+ func_stmt_num,firsttoken,tokennumber);
+
+ if((func_stmt_num == 1) &&
+ ((firsttoken == ARITH_TYPE) || (firsttoken == CHAR_TYPE)) &&
+ (tokennumber ==1))
+ {
+ token = keyscan (tab_stmt, &buffer);
+
+ if (token)
+ {
+ tokennumber++;
+ if(lexdebug)
+ printf("5: lexer returns %s (%s)\n",tok2str(token),
+ buffer.stmt);
+ return token;
+ }
+ }
+
+ /* If we're tokenizing an IMPLICIT statement, then we need to check
+ * whether we're inside the parens or not. If not, then this must
+ * be a type (integer, real, etc). If inside the parens, then this
+ * must be a letter or hyphen. We pass the letter as a NAME token.
+ */
+
+ if(firsttoken == IMPLICIT) {
+ if(lexdebug)
+ printf("first tok is IMPLICIT, parentcount = %d\n",parencount);
+
+ if(parencount > 0) {
+ if (isalpha ( (int) *buffer.stmt))
+ token = name_scan (&buffer);
+ }
+ else {
+ token = keyscan (tab_type, &buffer);
+ }
+
+ if(token) {
+ tokennumber++;
+ if(lexdebug)
+ printf("5.1: lexer returns %s (%s)\n",tok2str(token),
+ buffer.stmt);
+ return token;
+ }
+ }
+
+ /* Since we are tracking parentheses, we need to
+ * scan for miscellaneous tokens. We are really
+ * sniffing for parens...
+ */
+
+ token = keyscan (tab_toks, &buffer);
+
+ /* if we found no keyword and this is a READ statement,
+ * check for an END keyword
+ */
+
+ if(!token && (firsttoken == READ))
+ token = keyscan (read_toks, &buffer);
+
+ if(!token && (firsttoken == OPEN))
+ token = keyscan (open_toks, &buffer);
+
+ if (token)
+ {
+ if (token == OP)
+ parencount++;
+ if (token == CP)
+ parencount--;
+ tokennumber++;
+
+ if(lexdebug)
+ printf("6: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+
+ return token;
+ }
+
+ /* Now check context again. This should be the only other
+ * place necessary to scan for keywords. The keywords we
+ * expect to find are THEN, CONTINUE, and logical if
+ * statement keywords.
+ */
+
+ if ((letterseen == TRUE &&
+ (firsttoken == IF || firsttoken == ELSEIF) &&
+ parencount == 0) ||
+ /* Takes care of labeled (numbered) statements,
+ * i.e. 10 CONTINUE. */
+ firsttoken == INTEGER)
+ {
+ if (equalseen == TRUE)
+ {
+ char *stmt_copy = strdup(buffer.stmt);
+ char *text_copy = strdup(buffer.text);
+
+ /*Changed on 2/27/01 added if statement to catch if variable*/
+ token = keyscan (tab_stmt, &buffer);
+ if( ((token == DO) || (token == IF))
+ &&
+ /* (((tokennumber != 1) && (firsttoken != INTEGER)) || */
+ (((tokennumber != 0) && (firsttoken != INTEGER)) ||
+ ((tokennumber != 1) && (firsttoken == INTEGER)))
+ )
+ {
+ if(lexdebug)
+ printf("got incorrect DO or IF keyword, restoring buffer\n");
+ strcpy(buffer.stmt,stmt_copy);
+ strcpy(buffer.text,text_copy);
+ }
+ else{
+ /* First, look for labeled DO statement */
+ strcpy(buffer.stmt,stmt_copy);
+ strcpy(buffer.text,text_copy);
+ if((token = keyscan (tab_stmt, &buffer)) == DO)
+ {
+ if(lexdebug)
+ printf("7.1: lexer returns %s (%s)\n",tok2str(token),buffer.stmt);
+ f2jfree(stmt_copy, strlen(stmt_copy)+1);
+ f2jfree(text_copy, strlen(text_copy)+1);
+ return token;
+ }
+ strcpy(buffer.stmt,stmt_copy);
+ strcpy(buffer.text,text_copy);
+ if((token = keyscan (tab_stmt, &buffer)) == IF)
+ {
+ if(lexdebug)
+ printf("7.1.2: lexer returns %s (%s)\n", tok2str(token), buffer.stmt);
+ return token;
+ }
+ }
+
+ strcpy(buffer.stmt,stmt_copy);
+ strcpy(buffer.text,text_copy);
+
+ if (isalpha ((int) *buffer.stmt))
+ token = name_scan (&buffer);
+
+ if (token)
+ {
+ tokennumber++;
+ if(lexdebug)
+ {
+ printf("7.2: lexer returns %s (%s)\n",tok2str(token),buffer.stmt);
+
+ if(token == NAME)
+ printf("7.2: ...and the name is %s\n",yylval.lexeme);
+ }
+ f2jfree(stmt_copy, strlen(stmt_copy)+1);
+ f2jfree(text_copy, strlen(text_copy)+1);
+ return token;
+ }
+ f2jfree(stmt_copy, strlen(stmt_copy)+1);
+ f2jfree(text_copy, strlen(text_copy)+1);
+ }
+ else /* equalseen == FALSE. */
+ {
+ char *stmt_copy = strdup(buffer.stmt);
+ char *text_copy = strdup(buffer.text);
+
+ token = keyscan (tab_stmt, &buffer);
+
+ /* There should probably be a trap in here to catch
+ bad keywords. */
+ if (token)
+ {
+ if( ((token == DO) || (token == IF) || (token == DATA))
+ &&
+ /* (((tokennumber != 1) && (firsttoken != INTEGER)) || */
+ (((tokennumber != 0) && (firsttoken != INTEGER)) ||
+ ((tokennumber != 1) && (firsttoken == INTEGER)))
+ )
+ {
+ if(lexdebug)
+ printf("got incorrect DO or IF keyword, restoring buffer\n");
+ strcpy(buffer.stmt,stmt_copy);
+ strcpy(buffer.text,text_copy);
+ }
+ else {
+ tokennumber++;
+
+ if(token == FORMAT)
+ format_stmt = 1;
+ if(lexdebug)
+ printf("8: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+
+ f2jfree(stmt_copy, strlen(stmt_copy)+1);
+ f2jfree(text_copy, strlen(text_copy)+1);
+ return token;
+ }
+ }
+ else {
+ /* trying to trap the TO in ASSIGN integer TO name.
+ * check tokennumber == 3 to avoid checking the name part (since the
+ * name could be "TO"). using 3 because we have a label
+ * number as the first token and we start numbering at 0, so
+ * the TO keyword would be number 3.
+ */
+
+ if(!commaseen && (tokennumber == 3)) {
+ token = keyscan (assign_toks, &buffer);
+
+ if(token) {
+ tokennumber++;
+
+ if(lexdebug)
+ printf("8.1: lexer returns %s (%s)\n",
+ tok2str(token), buffer.stmt);
+ return token;
+ }
+ }
+ }
+
+ f2jfree(stmt_copy, strlen(stmt_copy)+1);
+ f2jfree(text_copy, strlen(text_copy)+1);
+ }
+ }
+
+ /* If we are parsing an ASSIGN statement, trap the TO keyword.
+ * There's no label number, so the token number is 2. (see
+ * comment above).
+ */
+
+ if((firsttoken == ASSIGN) && (tokennumber == 2)) {
+ token = keyscan (assign_toks, &buffer);
+
+ if(token) {
+ tokennumber++;
+
+ if(lexdebug)
+ printf("8.2: lexer returns %s (%s)\n",
+ tok2str(token), buffer.stmt);
+ return token;
+ }
+ }
+
+ if (isalpha ((int) *buffer.stmt))
+ token = name_scan (&buffer);
+
+ if (token)
+ {
+ tokennumber++;
+
+ if(lexdebug)
+ printf("firsttoken = %s and format_stmt = %s\n",
+ tok2str(firsttoken), format_stmt?"TRUE":"FALSE");
+
+ /* check to see if we're parsing a FORMAT statment so
+ * that we can look for edit speicification characters
+ */
+
+ if((firsttoken == INTEGER) && (format_stmt)) {
+ if(lexdebug)
+ printf("****the spec is '%s'\n", yylval.lexeme);
+
+ if((yylval.lexeme[0] == 'X') || (yylval.lexeme[0] == 'P') ||
+ (yylval.lexeme[0] == 'x') || (yylval.lexeme[0] == 'p'))
+ {
+ char *tmp;
+
+ token = EDIT_DESC;
+ if(strlen(yylval.lexeme) > 1) {
+ if(lexdebug)
+ printf("now we want to push '%s' back before '%s'\n",
+ yylval.lexeme + 1,buffer.stmt);
+
+ tmp = strdup(buffer.stmt);
+ strcpy(buffer.stmt,yylval.lexeme + 1);
+ strcat(buffer.stmt,tmp);
+ yylval.lexeme[1] = '\0';
+
+ if(lexdebug)
+ printf("now lexeme = '%s' and buffer.stmt = '%s'\n",
+ yylval.lexeme,buffer.stmt);
+
+ strcpy(buffer.text,buffer.stmt);
+ }
+ }
+
+ if( (yylval.lexeme[0] == 'A') || (yylval.lexeme[0] == 'a') ||
+ (yylval.lexeme[0] == 'F') || (yylval.lexeme[0] == 'f') ||
+ (yylval.lexeme[0] == 'I') || (yylval.lexeme[0] == 'i') ||
+ (yylval.lexeme[0] == 'D') || (yylval.lexeme[0] == 'd') ||
+ (yylval.lexeme[0] == 'G') || (yylval.lexeme[0] == 'g') ||
+ (yylval.lexeme[0] == 'E') || (yylval.lexeme[0] == 'e') ||
+ (yylval.lexeme[0] == 'L') || (yylval.lexeme[0] == 'l'))
+ {
+ token = EDIT_DESC;
+
+ /* the following if statment grabs format specs like
+ * G10.3 (although, at this point, we've already got
+ * G10 so now we want to grab the rest and append it)
+ */
+
+ if( buffer.stmt[0] == '.' )
+ {
+ char *bufptr = strdup(buffer.stmt);
+ int len=1;
+
+ /* len is initialized to 1, so we skip the '.' char */
+ while(!isdigit((int) bufptr[len]))
+ len++;
+
+ bufptr[len+1] = '\0';
+ strcat(yylval.lexeme,bufptr);
+ f2jfree(bufptr, strlen(bufptr)+1);
+ bufptr = strdup(buffer.stmt + len + 1);
+
+ strcpy(buffer.stmt,bufptr);
+ strcpy(buffer.text,bufptr);
+
+ f2jfree(bufptr, strlen(bufptr)+1);
+ }
+
+ if(lexdebug)
+ printf("8.5: lexer returns %s (%s)\n",
+ tok2str(token),buffer.stmt);
+ return token;
+ }
+ }
+
+ if((firsttoken == IMPLICIT) &&
+ (!strcmp(yylval.lexeme,"NONE") || !strcmp(yylval.lexeme,"none")))
+ token = NONE;
+
+ if(lexdebug)
+ printf("9: lexer returns %s (%s)\n",tok2str(token),buffer.stmt);
+
+ return token;
+ }
+
+ if(isdigit ((int) *buffer.stmt) || *buffer.stmt == '.') {
+ token = number_scan (&buffer,format_stmt, tokennumber);
+ }
+
+ if (token)
+ {
+ tokennumber++;
+ if(lexdebug) {
+ printf("10: lexer returns %s (%s)\n",tok2str(token),buffer.stmt);
+ printf("10: lexeme is '%s'\n",yylval.lexeme);
+ }
+ return token;
+ }
+
+ token = string_or_char_scan (&buffer);
+
+ if (token)
+ {
+ tokennumber++;
+ if(lexdebug)
+ printf("11: lexer returns %s (%s)\n",tok2str(token),buffer.stmt);
+ return token;
+ }
+
+#endif /* SALES */
+
+#if NOTSALES
+ token = keyscan (tab_type, &buffer);
+ if (token)
+ return token;
+
+ token = keyscan (tab_toks, &buffer);
+ if (token)
+ return token;
+
+ token = keyscan (tab_stmt, &buffer);
+ if (token)
+ return token;
+
+ /* Else... we gotta scan the silly string for NAMES or CONSTS. */
+
+ if (isalpha (*buffer.stmt))
+ token = name_scan (&buffer);
+ if (token)
+ return token;
+
+ if (isdigit (*buffer.stmt))
+ token = number_scan (&buffer,format_stmt, tokennumber);
+ if (token)
+ return token;
+
+ token = string_or_char_scan (&buffer);
+ if (token)
+ return token;
+#endif /* NOTSALES */
+
+
+ /* This code below appears to never get called.
+ * Not sure why not.
+ */
+
+ if(lexdebug) {
+ printf ("Token (yylex): %d\n",token);
+ printf("(second): lexer returning 0\n");
+ }
+
+ return 0;
+} /* Close yylex(). */
+
+
+/*****************************************************************************
+ * *
+ * open_included_file *
+ * *
+ * search all the include paths specified on the command line with -I (note *
+ * that the current directory is always included first). return NULL if *
+ * the file could not be found in any directory. *
+ * *
+ *****************************************************************************/
+
+FILE *
+open_included_file(char *filename)
+{
+ Dlist tmp;
+ FILE *tempfp;
+ char *prefix, *full_file = NULL;
+
+ dl_traverse(tmp, include_paths) {
+ prefix = (char *)dl_val(tmp);
+ full_file = (char *)f2jrealloc(full_file,
+ strlen(prefix) + strlen(filename) + 2);
+
+ strcpy(full_file, prefix);
+ strcat(full_file, FILE_DELIM);
+ strcat(full_file, filename);
+
+ if((tempfp = fopen(full_file,"rb")) != NULL)
+ return tempfp;
+ }
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * prelex *
+ * *
+ * Ok, here is how it is going to work. yylex() will *
+ * call prelex() to get a statement that has all of the *
+ * comments pounded out of it, all the white space *
+ * collapsed, and all of the line labels, contexts, *
+ * continuations, etc., set. What prelex does NOT check *
+ * is whether there is six spaces of white at the *
+ * beginning of each statement. *
+ * *
+ *****************************************************************************/
+
+int
+prelex (BUFFER * bufstruct)
+{
+ if(lexdebug)
+ printf("entering prelex()\n");
+
+ do {
+ if (f2j_fgets (bufstruct->stmt, BIGBUFF, ifp) != NULL)
+ {
+ if(lexdebug)
+ printf("the line is [%s](%d)\n",bufstruct->stmt,
+ (int)strlen(bufstruct->stmt));
+
+ /* truncate anything beyond 72 characters */
+ bufstruct->stmt[72] = '\n';
+ bufstruct->stmt[73] = '\0';
+
+ /* Dispose of comments and blank lines for now.
+ * Later, a COMMENT token can be defined and the
+ * comment returned for inclusion in either
+ * source or assembler code.
+ */
+
+ if (bufstruct->stmt[0] == 'c' ||
+ bufstruct->stmt[0] == 'C' ||
+ bufstruct->stmt[0] == '*' ||
+ bufstruct->stmt[0] == '\n')
+ {
+ lineno++;
+ strcpy(yylval.lexeme, bufstruct->stmt);
+ return COMMENT;
+ }
+
+ if(lexdebug)
+ printf ("First char in buffer: %c\n", bufstruct->stmt[0]);
+
+ /* Ok, we have a line that is not a comment and that
+ * does not start and end with a newline, i.e. blank.
+ * If the current statement is continued on the
+ * next line, that statement is catenated to the
+ * current statement.
+ */
+
+ check_continued_lines (ifp, bufstruct->stmt);
+ collapse_white_space (bufstruct);
+ truncate_bang_comments(bufstruct);
+
+ if(bufstruct->stmt[0] == '\n') {
+ lineno++;
+ strcpy(yylval.lexeme, bufstruct->stmt);
+ return COMMENT;
+ }
+
+ if( ! strncmp(bufstruct->stmt, "INCLUDE", 7) ) {
+ /* we are probably looking at an include statement */
+ int iidx, yidx;
+ BOOL ftickseen;
+
+#define FTICK 39
+#define INC_OFFSET 8
+
+ if(bufstruct->stmt[7] != FTICK) {
+ fprintf(stderr,"Badly formed INCLUDE statement\n");
+ strcpy(yylval.lexeme, bufstruct->stmt);
+ return COMMENT;
+ }
+
+ yidx = 0;
+ iidx = INC_OFFSET;
+ ftickseen = FALSE;
+
+ while( (bufstruct->stmt[iidx] != '\0') && (iidx < BIGBUFF)) {
+ if(bufstruct->stmt[iidx] == FTICK) {
+ if((bufstruct->stmt[iidx+1] == FTICK)) {
+ yylval.lexeme[yidx] = bufstruct->stmt[iidx];
+ yylval.lexeme[yidx+1] = bufstruct->stmt[iidx+1];
+
+ iidx+=2;
+ yidx+=2;
+
+ continue;
+ }
+ else {
+ ftickseen = TRUE;
+ break;
+ }
+ }
+
+ yylval.lexeme[yidx] = bufstruct->stmt[iidx];
+ iidx++;
+ yidx++;
+ }
+
+
+ if(! ftickseen) {
+ fprintf(stderr,"Badly formed INCLUDE statement\n");
+ strcpy(yylval.lexeme, bufstruct->stmt);
+ return COMMENT;
+ }
+
+ yylval.lexeme[yidx] = '\0';
+
+ return INCLUDE;
+ }
+
+ if(lexdebug)
+ printf ("From prelex: %s\n", bufstruct->stmt);
+
+ lineno++;
+ statementno++;
+ func_stmt_num++;
+ return 0;
+ }
+
+ /* EOF conditions. */
+
+ if(lexdebug)
+ printf ("EOF\n");
+
+ current_file_info = (INCLUDED_FILE *)dl_pop(file_stack);
+ if(current_file_info != NULL) {
+ ifp = current_file_info->fp;
+ lineno = current_file_info->line_num;
+ }
+ }while(current_file_info != NULL);
+
+ bufstruct->stmt[0] = '\0';
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * truncate_bang_comments *
+ * *
+ * This routine takes the buffer after it has had all continued lines *
+ * appended and removes "!" style comments. *
+ * *
+ *****************************************************************************/
+
+void
+truncate_bang_comments(BUFFER * bufstruct)
+{
+ BOOL in_string = FALSE;
+ char *cp;
+
+ for (cp = bufstruct->stmt; *cp; cp++)
+ {
+ /* if we see a '!' and we're not in the middle of a string, then
+ * truncate the remaining comment.
+ */
+
+ if(*cp == '!' && !in_string) {
+ *cp = '\n';
+ *(cp+1) = '\0';
+ break;
+ }
+
+ if(*cp == '\'') {
+ if(in_string) {
+ if(*(cp+1) != '\'')
+ in_string = FALSE;
+ else
+ cp++;
+ }
+ else {
+ in_string = TRUE;
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * collapse_white_space *
+ * *
+ * Get rid of all of the white space, newlines, etc. in the *
+ * statement. Literal strings are handled by keeping the *
+ * quoting ticks (') and copying the quoted text verbatim *
+ * into the returned string. This routine modifies the *
+ * character array stored in the fields of `bufstruct'. *
+ * This procedure also implements Sale's algorithm to trap *
+ * keywords. *
+ *****************************************************************************/
+
+void
+collapse_white_space (BUFFER * bufstruct)
+{
+ /* `cp' is character pointer, `tcp' is temporary cp and
+ * `yycp' points at the text buffer for some (what?) reason.
+ */
+
+ register char *cp, *tcp, *yycp;
+ char tempbuf[BIGBUFF];
+ int parens = 0;
+
+ commaseen = FALSE, equalseen = FALSE, letterseen = FALSE;
+
+ tcp = tempbuf;
+ yycp = bufstruct->text;
+
+ if(lexdebug)
+ printf("entering collapse_white_space, buffer is [%s]\n",
+ bufstruct->stmt);
+
+
+ for (cp = bufstruct->stmt; *cp; cp++)
+ {
+ /* Get rid of all of the newlines, tabs, whitespace. */
+ if (*cp == ' ' ||
+ *cp == '\t' ||
+ *cp == '\n')
+ continue;
+
+ /* If a single front tick is seen, stand by
+ * to copy a literal string, delimited between
+ * two tick marks. This section in here was left out
+ * the string in the prelexed statement. This was
+ * handled with at hack.
+ */
+
+ if (*cp == '\'') /* Escape the tick mark with a slash "\" */
+ {
+ int done=FALSE;
+
+ *tcp = *cp;
+ tcp++;
+
+ /* Hack... */
+ *yycp = *cp;
+ yycp++;
+ cp++;
+
+ while(!done)
+ {
+ while (*cp != '\'') /* Literal copy until next tick. */
+ {
+ *tcp = *cp;
+ tcp++;
+
+ /* Hack... All this while loop does is increment
+ * without using the toupper function. The next
+ * two lines were left out originally.
+ */
+
+ *yycp = *cp;
+ yycp++;
+ cp++;
+ } /* End while() for copying strings. */
+
+ /* At this point, we have seen a tick, but now we
+ * determine whether it is really the end of the string
+ * or an escape sequence e.g.
+ * str = 'doesn''t parse'
+ * 9/30/97 --Keith
+ */
+
+ if(*(cp+1) == '\'') /* if next char after tick is a tick */
+ {
+ *tcp = *cp;
+ tcp++;
+ *yycp = *cp;
+ yycp++;
+ cp++;
+ *tcp = *cp;
+ tcp++;
+ *yycp = *cp;
+ yycp++;
+ cp++;
+ }
+ else
+ done = TRUE;
+ } /* end while(not done) */
+ } /* End if() for copying character strings. */
+
+ /* We need to track the number of opening and closing
+ * parentheses "(" and ")" to implement Sale's algorithm.
+ */
+
+ if(*cp == '(')
+ parens++;
+ if(*cp == ')')
+ parens--;
+
+ /* Examine the characters outside of matching parentheses.
+ * Whats between matching parentheses doesn't matter.
+ */
+
+ if(parens == 0)
+ {
+ if(*cp == ',')
+ commaseen = TRUE;
+ if(*cp == '=')
+ equalseen = TRUE;
+
+ if (*cp == ')')
+ {
+ char * lpp; /* Last parens pointer, temporary. */
+
+ /* Ok, lets peep ahead to the next non-whitespace
+ * character and see if its a letter. The for()
+ * loop merely sets the pointer for look-ahead.
+ */
+
+ for (lpp=cp+1;isspace((int) *lpp);lpp++);
+
+ /* Since we have an opportunity, let's trap the
+ * error condition of having isspace() pick up
+ * a newline following the last paren. */
+
+ /*
+ * if (*lpp == '\n')
+ * {
+ * printf("Bad syntax, \" followed by \"\\n\"\n");
+ * exit(EXIT_FAILURE);
+ * }
+ * else
+ */
+
+ if (isalpha((int) *lpp)) letterseen = TRUE;
+
+ } /* End if for ")". */
+ } /* End if for no parens. */
+
+ *yycp = *cp;
+ yycp++;
+ *tcp = toupper (*cp);
+ tcp++;
+ } /* End of for() loop. */
+
+ /* Insert newline for statement separator. This helps parse
+ * situations where end and beginning of adjacent statements
+ * are NAME tokens, i.e. NAME NAME, etc. Also, newlines are
+ * natural fortran statement separators.
+ */
+
+ *yycp = '\n';
+ *tcp = '\n';
+
+ /* Insert an null character to mark the end of the string. */
+
+ *(yycp+1) = 0;
+ *(tcp+1) = 0;
+
+ /* Our new string is ready for lexing! */
+
+ strcpy (bufstruct->stmt, tempbuf);
+ strcpy (line_buffer, tempbuf);
+}
+
+
+/*****************************************************************************
+ * *
+ * Check and see whether the next line continues the *
+ * present line. Marker for line continuation is any character *
+ * in column 6. *
+ *****************************************************************************/
+
+void
+check_continued_lines (FILE * fp, char *current_line)
+{
+ int items, short_line;
+ char next_line[100];
+ int i,j ; /* rws indexes for chopping off end of line */
+
+ /* Now we have to determine whether the statement
+ * is continued on the next line by getting another
+ * line and examining column 6 for a continuation marker.
+ */
+
+ for(;;)
+ {
+ next_line[0] = '\0';
+ items = fread (next_line, 1, 6, fp);
+
+ /* If we are NOT at the end of file, reset the
+ * pointer to the start of the line so that
+ * the next fgets will grab the entire line.
+ */
+
+ if(items == 0)
+ return; /* End of file. */
+
+ /* check for a newline within the first 6 characters
+ * of the next line. if one exists, it cannot be a
+ * continued line.
+ */
+ short_line = 0;
+ for(i=0;i<items;i++)
+ if(next_line[i] == '\n') {
+ short_line = 1;
+ break;
+ }
+
+ if(short_line || (next_line[0] != ' '))
+ {
+ if( fseek (fp, -items, SEEK_CUR) < 0 ) {
+ printf("could not seek\n");
+ perror("reason");
+ }
+ return;
+ }
+
+ /* F77 spec says that any character other than a
+ * blank or 0 signifies a continuation
+ */
+
+ /* changed the following comparison since there
+ * will be no null-termination of next_line after
+ * calling fread().
+ *
+ * if((strlen(next_line) < 6) ||
+ *
+ * instead, just compare the number of items read in
+ * by fread().
+ *
+ * --kgs 4/18/00
+ */
+
+ if((items < 6) ||
+ (next_line[5] == ' ') ||
+ (next_line[5] == '0'))
+ {
+ /* There is no continuation marker. Reset the
+ * pointer to the start of the line, and return.
+ */
+
+ if(lexdebug)
+ printf("no continuation marker.\n");
+
+ if( fseek (fp, -items, SEEK_CUR) < 0 ) {
+ printf("could not seek\n");
+ perror("reason");
+ }
+ return;
+ }
+ else
+ {
+ /* We have a continuation marker. Get another line
+ * and cat it to the previous.
+ */
+
+ if(lexdebug)
+ printf ("char 6, next_line: %c\n", next_line[5]);
+
+ f2j_fgets (next_line, 100, fp);
+
+ if(lexdebug)
+ printf("the next_line is [%s](%d)\n",next_line,
+ (int)strlen(next_line));
+
+ /* rws August 21, 2003
+ * added next four lines
+ */
+
+ /* truncate anything beyond 72 characters (72-6=66) */
+ j = strlen(next_line);
+
+ for (i=66;i<j;i++)
+ next_line[i] = '\0';
+
+ /* rws August 21, 2003
+ * next line no longer needed
+ */
+ /* next_line[strlen(next_line)-1] = '\0'; */
+
+ if(current_line[strlen(current_line)-1] == '\n')
+ current_line[strlen(current_line)-1] = '\0';
+
+ strcat (current_line, next_line);
+ lineno++;
+ }
+ }
+} /* End of check_continued_lines(). */
+
+/*****************************************************************************
+ * *
+ * keyscan *
+ * *
+ * Step through the symbol tables to see if the current string can be *
+ * recognized as a token in the symbol table. Also, set yytext here. *
+ *****************************************************************************/
+
+int
+keyscan (register KWDTAB * tab, BUFFER * bufstruct)
+{
+ unsigned int tokenlength;
+ char *scp, *yycp, swap_buf[BIGBUFF];
+ scp = bufstruct->stmt;
+ yycp = bufstruct->text;
+
+ while (tab->kwd)
+ {
+ /* Get the stringlength of the token in the symbol table.
+ * A better way to do this might be to include the length
+ * of the keyword in the table instead of computing it
+ * everytime.
+ */
+
+ tokenlength = strlen (tab->kwd);
+
+ /* Try to match a substring of the current string (scp).*/
+ if (!strncmp (scp, tab->kwd, tokenlength))
+ {
+ if(tokenlength > YYTEXTLEN-1)
+ fprintf(stderr,"Warning: going to write past yytext (%d)\n",
+ tokenlength);
+
+ strncpy (yytext, yycp, tokenlength);
+ yycp += tokenlength;
+ yytext[tokenlength] = '\0';
+
+ strcpy(swap_buf, yycp);
+ strcpy(bufstruct->text, swap_buf);
+
+ /* Save the type or kind of relational operator
+ * immediate reduction in the parser. This
+ * implementation is pretty lame, a hold over
+ * from Levine's quick and dirty lexer.
+ */
+
+ if((tab->ktok == ARITH_TYPE) || (tab->ktok == CHAR_TYPE))
+ yylval.type = tab->klex;
+ if(tab->ktok == RELOP)
+ yylval.tok = tab->klex;
+
+ /* Now set the string pointer to point at the first
+ * character past the end of the string.
+ */
+
+ scp += tokenlength;
+
+ strcpy(swap_buf, scp);
+ strcpy(bufstruct->stmt, swap_buf);
+
+ return tab->ktok;
+ }
+ tab++; /* Check the next table entry. */
+ } /* Close the while() loop. */
+ return 0; /* Not a recognized token. */
+} /* Close keyscan(). */
+
+
+/*****************************************************************************
+ * *
+ * methodscan *
+ * *
+ * Called after hash lookup indicates there is java method *
+ * equivalent in the fortran source code. Returns a pointer *
+ * to the java string equivalent to the fortran source code. *
+ * This is surely a hack. *
+ *****************************************************************************/
+
+METHODTAB *
+methodscan (METHODTAB * tab, char * name)
+{
+
+ /* The method translation table is initialized in
+ * the header block of this file. We treat the table
+ * as a linear linked list by stepping through the
+ * array entries with the pointer `*tab'. Note that
+ * `NULL' last entry in the table shuts down the for()
+ * loop.
+ */
+
+ while (tab->fortran_name != NULL) {
+ if (tab->fortran_name == NULL)
+ return NULL;
+
+ if (!strcmp (tab->fortran_name,name)) {
+ if(lexdebug)
+ printf("java_name: %s\n", tab->java_method);
+
+ return tab;
+ }
+ tab++;
+ } /* Close for() loop. */
+
+ return NULL; /* Not in table. */
+} /* Close methodscan(). */
+
+
+/*****************************************************************************
+ * *
+ * name_scan *
+ * *
+ * Scan a card image for a named identifier. *
+ *****************************************************************************/
+
+int
+name_scan (BUFFER * bufstruct)
+{
+ char *ncp, *tcp, swap_buf[BIGBUFF];
+ unsigned int tokenlength = 0;
+
+ ncp = bufstruct->stmt;
+ tcp = bufstruct->text;
+
+ /* Find the name.
+ * We checked the first character in yylex to make sure
+ * it was alphabetic.
+ */
+
+ while (isalnum ((int) *ncp) || (*ncp == '_'))
+ {
+ ncp++;
+ tokenlength++;
+ }
+
+ strncpy (yylval.lexeme, tcp, tokenlength);
+ yylval.lexeme[tokenlength] = '\0';
+ tcp += tokenlength;
+
+ strcpy(swap_buf, tcp);
+ strcpy(bufstruct->text, swap_buf);
+
+ strcpy(swap_buf, ncp);
+ strcpy(bufstruct->stmt, swap_buf);
+
+ return NAME;
+} /* Close name_scan(). */
+
+
+/*****************************************************************************
+ * *
+ * number_scan *
+ * *
+ * Scan a card image for a numerical constant. *
+ * Need to add code in here to change exp numbers *
+ * to doubles, or at least to replace the instances *
+ * of 'd' and 'D' with 'e'. *
+ * *
+ * 9/30/97 - Added fmt parameter which is a boolean *
+ * representing whether or not this number occurs *
+ * within a format statement. If so, we only *
+ * want to return the integer part of the spec... *
+ * e.g., if our input is 2D36.8, just return 2 *
+ * --Keith *
+ *****************************************************************************/
+
+int
+number_scan (BUFFER * bufstruct, int fmt, int toknum)
+{
+ char *ncp, *tcp, swap_buf[BIGBUFF];
+ BUFFER tempbuf;
+ int token;
+ unsigned int tokenlength = 0;
+ int type = INTEGER; /* Default, in case we find nothing else. */
+
+ ncp = bufstruct->stmt; /* Number character pointer. */
+ tcp = bufstruct->text; /* Literal text character pointer. */
+
+ if(lexdebug) {
+ printf("here in number scan\n buf.stmt = '%s'\n",bufstruct->stmt);
+ printf(" buf.text = '%s'\n",bufstruct->text);
+ }
+
+ if(fmt || (toknum == 0)) {
+ while(isdigit ((int) *ncp)) {
+ ncp++;
+ tokenlength++;
+ }
+ }
+ else {
+
+ /* Test and see whether it is a number (constant).
+ * If so, store the literal text in yytext. These
+ * long logical expressions are probably not very
+ * efficient, but they should be easy to read.
+ */
+
+ while (isdigit ((int) *ncp) ||
+ *ncp == '.' ||
+ *ncp == 'D' ||
+ *ncp == 'd' ||
+ *ncp == 'E' ||
+ *ncp == 'e')
+ {
+ switch (*ncp)
+ {
+ case '.':
+
+ /* If there is a dot, there may be a float or double or
+ * exponential, or an integer followed by a keyword such as
+ * .AND., .OR., etc.
+ */
+
+ strcpy (tempbuf.stmt, ncp);
+ strcpy (tempbuf.text, tcp);
+ token = keyscan (tab_toks, &tempbuf);
+
+ if (token)
+ break; /* Leave the while() loop. */
+
+ /* Else if there is no token returned, check for
+ * the usual double or exponential number.
+ */
+
+ /* If the next character, i.e. *(ncp+1) is a digit,
+ * increment and continue while loop,
+ * else get out of while loop.
+ */
+
+ if (isdigit ((int) *(ncp + 1)))
+ {
+ ncp += 2;
+ tokenlength += 2;
+ type = FLOAT; /* Case of `nn.dd...' */
+
+ /* Control passes to back to
+ * while() loop; get another
+ * character.
+ */
+
+ continue;
+ }
+ else
+ {
+ ncp++;
+ tokenlength++;
+ type = FLOAT; /* Case of `nn.' */
+
+ /* Back to while() loop
+ * for another character.*/
+
+ continue;
+ }
+ case 'E':
+ case 'e':
+ case 'D':
+ case 'd':
+ /* This exponential notation stuff works pretty good.
+ * It will need to be modified to express the
+ * number in exponential notation as an equivalent
+ * double.
+ *
+ * First, take care of the case that looks like this:
+ * 1.0e+1 or 1.0e-1.
+ */
+
+ if (*(ncp + 1) == '+' || *(ncp + 1) == '-')
+ {
+ if(*ncp == 'e' || *ncp == 'E')
+ type = E_EXPONENTIAL;
+ else
+ type = D_EXPONENTIAL;
+
+ ncp += 2;
+ tokenlength += 2;
+
+ continue; /* Loop again. */
+ }
+
+ /* Now take care of cases that look like this: 1.0e1. */
+
+ if (isdigit ((int) *(ncp + 1)))
+ {
+ if(*ncp == 'e' || *ncp == 'E')
+ type = E_EXPONENTIAL;
+ else
+ type = D_EXPONENTIAL;
+
+ ncp++;
+ tokenlength++;
+
+ continue; /* Loop again. */
+ }
+ else
+ break; /* Break switch. */
+
+ default: /* All digits do this. */
+ ncp++;
+ tokenlength++;
+ continue; /* Loop again. */
+ } /* Close switch(). */
+
+ break;
+ } /* Close while() loop. */
+ }
+
+ if(lexdebug) {
+ printf("ok that was fun, ncp = '%s', tcp = '%s'",ncp,tcp);
+ printf(" and tokenlength = %d\n",tokenlength);
+ }
+
+ strncpy (yylval.lexeme, tcp, tokenlength);
+ yylval.lexeme[tokenlength] = '\0';
+
+ if(lexdebug)
+ printf ("Number: %s\n", yytext);
+
+ tcp += tokenlength;
+
+ strcpy(swap_buf, tcp);
+ strcpy(bufstruct->text, swap_buf);
+
+ strcpy(swap_buf, ncp);
+ strcpy(bufstruct->stmt, swap_buf);
+
+ return type;
+} /* Close name_ident_scan(). */
+
+
+/*****************************************************************************
+ * *
+ * string_or_char_scan *
+ * *
+ * Scan a string, making sure to check for escaped ticks in the text. *
+ *****************************************************************************/
+
+int
+string_or_char_scan (BUFFER * bufstruct)
+{
+ unsigned int tokenlength = 0;
+ char *scp, *textcp, swap_buf[BIGBUFF];
+ scp = bufstruct->stmt;
+ textcp = bufstruct->text;
+
+ /* Test and see if there is a tic (`'') mark. */
+
+ if (*scp == '\'')
+ {
+ int done = FALSE;
+
+ scp++;
+ textcp++;
+
+ if(lexdebug)
+ printf ("scp: %s\n", scp);
+
+ /* Loop until we find another tick (') mark. */
+
+ while(!done)
+ {
+ while (*scp != '\'')
+ {
+ scp++;
+ tokenlength++;
+ }
+
+ /* Now we determine whether this is the final tick
+ * or just an escape sequence to actually print a
+ * tick. If it's an escape, substitute a backslash
+ * for the first tick. that is, '' -> \'
+ * 9/30/97 --Keith
+ *
+ * I'm not sure why I was using backslash here, but
+ * it wasn't necessary, so changing it to just blank
+ * the first tick.
+ * 7/5/04 --keith
+ */
+
+ if( *(scp + 1) == '\'' )
+ {
+ *(textcp + tokenlength) = ' ';
+ scp+=2;
+ tokenlength+=2;
+ }
+ else
+ done = TRUE;
+ }
+
+ if(tokenlength > YYTEXTLEN-1)
+ fprintf(stderr,"Warning: going to write past yytext (%d)\n",
+ tokenlength);
+
+ strncpy (yytext, textcp, tokenlength);
+ yytext[tokenlength] = '\0'; /* Terminate the string at tick. */
+ strcpy(yylval.lexeme, yytext);
+ textcp += tokenlength;
+
+ /* Now increment to get past the tic marks. */
+ scp++;
+ textcp++;
+
+ strcpy(swap_buf, scp);
+ strcpy(bufstruct->stmt, swap_buf);
+
+ strcpy(swap_buf, textcp);
+ strcpy(bufstruct->text, swap_buf);
+
+ /* Reset the value; strlen does not include the value
+ * of '\0' that terminates the string.
+ */
+
+ tokenlength = strlen(yylval.lexeme);
+
+ if (tokenlength == 1)
+ return CHAR;
+ else
+ return STRING;
+ }
+ else
+ return 0;
+} /* Close string_or_char_scan(). */
+
+char *
+f2j_fgets(char *s, int n, FILE *f)
+{
+ char *rv;
+ int len;
+
+ rv = fgets(s, n, f);
+
+ if(rv == NULL) return NULL;
+
+ len = strlen(s);
+
+ switch(len) {
+ case 0:
+ s[0] = '\0';
+ break;
+ case 1:
+ s[0] = '\n';
+ s[1] = '\0';
+ break;
+ default:
+ if( s[len-2] == '\r' ) {
+ s[len -2] = '\n';
+ s[len -1] = '\0';
+ }
+ break;
+ }
+
+ return s;
+}
+
+/*****************************************************************************
+ * *
+ * tok2str *
+ * *
+ * Return the string representation of a token. This function is used *
+ * primarily for debugging purposes. *
+ *****************************************************************************/
+
+char *
+tok2str(int tok)
+{
+ switch(tok)
+ {
+ case PLUS:
+ return("PLUS");
+ case MINUS:
+ return("MINUS");
+ case OP:
+ return("OP");
+ case CP:
+ return("CP");
+ case STAR:
+ return("STAR");
+ case POW:
+ return("POW");
+ case DIV:
+ return("DIV");
+ case CAT:
+ return("CAT");
+ case CM:
+ return("CM");
+ case EQ:
+ return("EQ");
+ case COLON:
+ return("COLON");
+ case NL:
+ return("NL");
+ case NOT:
+ return("NOT");
+ case AND:
+ return("AND");
+ case OR:
+ return("OR");
+ case RELOP:
+ return("RELOP");
+ case EQV:
+ return("EQV");
+ case NEQV:
+ return("NEQV");
+ case NAME:
+ return("NAME");
+ case DOUBLE:
+ return("DOUBLE");
+ case INTEGER:
+ return("INTEGER");
+ case E_EXPONENTIAL:
+ return("E_EXPONENTIAL");
+ case D_EXPONENTIAL:
+ return("D_EXPONENTIAL");
+ case CONST_EXP:
+ return("CONST_EXP");
+ case TrUE:
+ return("TrUE");
+ case FaLSE:
+ return("FaLSE");
+ case ICON:
+ return("ICON");
+ case RCON:
+ return("RCON");
+ case LCON:
+ return("LCON");
+ case CCON:
+ return("CCON");
+ case FLOAT:
+ return("FLOAT");
+ case CHARACTER:
+ return("CHARACTER");
+ case LOGICAL:
+ return("LOGICAL");
+ case COMPLEX:
+ return("COMPLEX");
+ case NONE:
+ return("NONE");
+ case IF:
+ return("IF");
+ case THEN:
+ return("THEN");
+ case ELSE:
+ return("ELSE");
+ case ELSEIF:
+ return("ELSEIF");
+ case ENDIF:
+ return("ENDIF");
+ case ENDDO:
+ return("ENDDO");
+ case DO:
+ return("DO");
+ case GOTO:
+ return("GOTO");
+ case ASSIGN:
+ return("ASSIGN");
+ case TO:
+ return("TO");
+ case CONTINUE:
+ return("CONTINUE");
+ case STOP:
+ return("STOP");
+ case PAUSE:
+ return("PAUSE");
+ case RDWR:
+ return("RDWR");
+ case END:
+ return("END");
+ case STRING:
+ return("STRING");
+ case CHAR:
+ return("CHAR");
+ case OPEN:
+ return("OPEN");
+ case CLOSE:
+ return("CLOSE");
+ case BACKSPACE:
+ return("BACKSPACE");
+ case REWIND:
+ return("REWIND");
+ case ENDFILE:
+ return("ENDFILE");
+ case FORMAT:
+ return("FORMAT");
+ case PROGRAM:
+ return("PROGRAM");
+ case FUNCTION:
+ return("FUNCTION");
+ case SUBROUTINE:
+ return("SUBROUTINE");
+ case ENTRY:
+ return("ENTRY");
+ case CALL:
+ return("CALL");
+ case RETURN:
+ return("RETURN");
+ case ARITH_TYPE:
+ return("ARITH_TYPE");
+ case CHAR_TYPE:
+ return("CHAR_TYPE");
+ case DIMENSION:
+ return("DIMENSION");
+ case COMMON:
+ return("COMMON");
+ case EQUIVALENCE:
+ return("EQUIVALENCE");
+ case EXTERNAL:
+ return("EXTERNAL");
+ case PARAMETER:
+ return("PARAMETER");
+ case INTRINSIC:
+ return("INTRINSIC");
+ case IMPLICIT:
+ return("IMPLICIT");
+ case SAVE:
+ return("SAVE");
+ case DATA:
+ return("DATA");
+ case COMMENT:
+ return("COMMENT");
+ case WRITE:
+ return("WRITE");
+ case FMT:
+ return("FMT");
+ case READ:
+ return("READ");
+ case EDIT_DESC:
+ return("EDIT_DESC");
+ case REPEAT:
+ return("REPEAT");
+ default:
+ {
+ static char asdf[20];
+
+ sprintf(asdf,"Unknown token: %d\n",tok);
+ return(asdf);
+ }
+ }
+}
diff --git a/src/f2jmain.c b/src/f2jmain.c
new file mode 100644
index 0000000..0213f39
--- /dev/null
+++ b/src/f2jmain.c
@@ -0,0 +1,723 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2jmain.c,v $
+ * $Revision: 1.69 $
+ * $Date: 2008/06/24 21:03:44 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * f2jmain.c *
+ * *
+ * This file contains the main routine for the Fortran-to-Java translator. *
+ * *
+ *****************************************************************************/
+
+#include<stdlib.h>
+#include<sys/types.h>
+#include<dirent.h>
+#include<stdio.h>
+#include<stdarg.h>
+#include<ctype.h>
+#include<string.h>
+#include<time.h>
+#include<signal.h>
+#include"f2j-config.h"
+#include"f2j.h"
+#include"y.tab.h"
+#include"dlist.h"
+#include"f2jmem.h"
+#include"f2j_externs.h"
+
+extern char *java_reserved_words[];
+extern char *blas_routines[];
+extern char *generic_intrinsics[];
+extern char *unit_name;
+extern char *optarg;
+extern Dlist file_stack;
+extern Dlist include_paths;
+
+#ifdef _WIN32
+ char null_file[] = "f2j.tmp";
+#else
+ char null_file[] = "/dev/null";
+#endif
+
+FILE *devnull; /* pointer to the file /dev/null */
+
+AST
+ *addnode(void);
+
+char
+ *f2j_fgets(char *, int, FILE *);
+
+SYMTABLE
+ *new_symtable (int);
+
+int
+ yyparse (void);
+
+void
+ type_insert (SYMTABLE *, AST *, enum returntype, char *),
+ handle_segfault(int),
+ insert_entries(char *, Dlist);
+
+extern int
+ getopt(int, char *const *, const char *);
+
+/*****************************************************************************
+ * main *
+ * *
+ * This is the main f2java routine. Parse the command-line options and *
+ * open the input file. *
+ * *
+ *****************************************************************************/
+
+int
+main (int argc, char **argv)
+{
+ char classname[130];
+ char *truncfilename;
+ char sourcename[130];
+ char vcgname[130];
+ char *indexname;
+ char *f2jpath;
+ char *search_path;
+
+ AST *temp;
+ int errflg = 0;
+ int c;
+ int i;
+
+ /* split the help string into multiple sections to comply
+ * with some iso standard on string lengths...
+ */
+ char f2java_help[] = "The program is used as follows:\n\n\
+To compile a program into Java source code:\n\
+ f2java filename\n\n";
+
+ char f2java_help_I_option[] = "The -I option specifies\
+ a path to be searched for\nincluded files (may be used\
+ multiple times).\n\n";
+
+#ifdef _WIN32
+ char f2java_help_c_option[] = "The -c option may also be\
+ used to specify the search\n\
+path for \".f2j\" files. It is a semicolon-separated\n\
+list of paths, like a Java CLASSPATH). For example:\n\n\
+ f2java -c .;..\\objects filename\n\n";
+#else
+ char f2java_help_c_option[] = "The -c option may also be\
+ used to specify the search\n\
+path for \".f2j\" files. It is a colon-separated\n\
+list of paths, like a Java CLASSPATH). For example:\n\n\
+ f2java -c .:../objects filename\n\n";
+#endif
+
+ char f2java_help_p_option[] = "The -p option may also be\
+ used to specify the name\n\
+of the package. For example:\n\n\
+ f2java -p org.netlib.blas filename\n\n";
+
+ char f2java_help_o_option[] = "The -o option specifies\
+ the destination directory\n\
+to which the code should be written.\n\n";
+
+ char f2java_help_w_option[] = "The -w option forces all\
+ scalars to be generated as\n\
+wrapped objects. The default behavior is to only\n\
+wrap those scalars that must be passed by reference.\n\n";
+
+ char f2java_help_i_option[] = "The -i option causes f2j\
+ to generate a high-level\n\
+interface to each subroutine and function.\n\n";
+
+ char f2java_help_h_option[] = "The -h option displays\
+ this helpful information.\n\n";
+
+ char f2java_help_s_option[] = "The -s option causes f2j\
+ to simplify the interfaces\n\
+by removing the offset parameter and using a zero offset.\n\
+It isn't necessary to specify the -i flag in addition\n\
+to the -s.\n\n";
+
+ char f2java_help_d_option[] = "The -d options causes f2j\
+ to generate comments in\n\
+a format suitable for javadoc. It is a bit of a LAPACK-\n\
+specfic hack...the longest comment in the program unit\n\
+is placed in the javadoc comment. It works fine for\n\
+BLAS/LAPACK code (or any other code where the longest\n\
+comment is the one that describes the function), but\n\
+will most likely not work for other code.\n\n";
+
+ char f2java_help_fm_option[] = "The -fm option causes f2j\
+ to generate code that calls\njava.lang.StrictMath\
+ instead of java.lang.Math. By\ndefault, java.lang.Math is used.\n\n";
+
+ char f2java_help_fs_option[] = "The -fs option causes f2j\
+ to declare the generated\ncode as strictfp (strict floating point).\
+ By default,\nthe generated code is not strict.\n\n";
+
+ char f2java_help_fb_option[] = "The -fb option enables\
+ both the -fm and -fs options.\n\n";
+
+ char f2java_help_vs_option[] = "The -vs option causes f2j\
+ to generate all variables\nas static class variables.\
+ By default f2j generates\nvariables as locals.\n\n";
+
+ char f2java_help_va_option[] = "The -va option causes f2j\
+ to generate arrays\nas static class variables,\
+ but other\nvariables are generated as locals.\n\n";
+
+ signal(SIGSEGV,handle_segfault);
+
+ omitWrappers = TRUE;
+ strictMath = FALSE;
+ strictFp = FALSE;
+ genInterfaces = FALSE;
+ genJavadoc = FALSE;
+ noOffset = FALSE;
+ package_name = NULL;
+ output_dir = NULL;
+ search_path = NULL;
+ save_all_override = FALSE;
+ f2j_arrays_static = FALSE;
+
+ file_stack = make_dl();
+ include_paths = make_dl();
+ dl_insert_b(include_paths, ".");
+
+ ignored_formatting = 0;
+ bad_format_count = 0;
+
+ while((c = getopt(argc,argv,"I:c:p:wif:sdho:v:")) != EOF)
+ switch(c) {
+ case 'I':
+ dl_insert_b(include_paths, optarg);
+ break;
+ case 'c':
+ search_path = optarg;
+ break;
+ case 'p':
+ package_name = optarg;
+ break;
+ case 'f':
+ if(!strcmp("b", optarg))
+ strictMath = strictFp = TRUE;
+ else if(!strcmp("m", optarg))
+ strictMath = TRUE;
+ else if(!strcmp("s", optarg))
+ strictFp = TRUE;
+ break;
+ case 'w':
+ omitWrappers = FALSE;
+ break;
+ case 'h':
+ printf("This is Fortran-to-Java version %s.\n\n", F2J_VERSION);
+ printf("%s",f2java_help);
+ printf("%s",f2java_help_I_option);
+ printf("%s",f2java_help_c_option);
+ printf("%s",f2java_help_p_option);
+ printf("%s",f2java_help_o_option);
+ printf("%s",f2java_help_w_option);
+ printf("%s",f2java_help_i_option);
+ printf("%s",f2java_help_h_option);
+ printf("%s",f2java_help_s_option);
+ printf("%s",f2java_help_d_option);
+ printf("%s",f2java_help_fm_option);
+ printf("%s",f2java_help_fs_option);
+ printf("%s",f2java_help_fb_option);
+ printf("%s",f2java_help_vs_option);
+ printf("%s",f2java_help_va_option);
+ exit(EXIT_SUCCESS);
+ break;
+ case 'i':
+ genInterfaces = TRUE;
+ break;
+ case 'd':
+ genJavadoc = TRUE;
+ break;
+ case 's':
+ noOffset = TRUE;
+ break;
+ case 'v':
+ if(!strcmp("s", optarg))
+ save_all_override = TRUE;
+ else if(!strcmp("a", optarg))
+ f2j_arrays_static = TRUE;
+ else {
+ fprintf(stderr,"-v%s: bad argument\n",optarg);
+ errflg++;
+ }
+
+ break;
+ case 'o':
+ output_dir = optarg;
+ break;
+ case '?':
+ errflg++;
+ break;
+ default:
+ printf("Bad arg.\n");
+ break;
+ }
+
+ if(errflg || (argc < 2))
+ {
+ fprintf(stderr, "Usage: f2java [-I include path] [-c search path]");
+ fprintf(stderr, " [-p package name] [-o output dir]");
+ fprintf(stderr, " [-w] [-i] [-s] [-d] [-vs] [-va] [-fs] [-fm] [-fb] <filename>\n");
+ fprintf(stderr, "For help: f2java -h\n");
+ exit(EXIT_FAILURE);
+ }
+
+ if(noOffset)
+ genInterfaces = TRUE;
+
+ inputfilename = argv[argc - 1];
+
+ if((ifp = fopen (inputfilename, "rb"))==NULL) {
+ fprintf(stderr,"Input file not found: '%s'\n",inputfilename);
+ exit(EXIT_FAILURE);
+ }
+
+ current_file_info = (INCLUDED_FILE *)f2jalloc(sizeof(INCLUDED_FILE));
+ current_file_info->name = strdup(inputfilename);
+ current_file_info->line_num = 0;
+ current_file_info->fp = ifp;
+
+ truncfilename = strdup(inputfilename);
+ truncfilename = strtok (truncfilename, ".");
+ *truncfilename = toupper (*truncfilename);
+
+ /* Loathsome hacks... */
+ strcpy (classname, truncfilename);
+ strcpy (sourcename, truncfilename);
+ strcpy (vcgname, truncfilename);
+
+ strcat (sourcename, ".java");
+ strcat (vcgname, ".vcg");
+
+ initialize ();
+
+#if VCG
+ if((vcgfp = fopen(vcgname, "w"))==NULL) {
+ fprintf(stderr,"Cannot open output file '%s'.\n",sourcename);
+ perror("Reason");
+ exit(EXIT_FAILURE);
+ }
+#endif
+
+ indexname = (char *)f2jalloc(strlen(truncfilename) + 5);
+
+ strcpy(indexname, truncfilename);
+ strcat(indexname, ".f2j");
+
+ if((indexfp = bc_fopen_fullpath(indexname,"w", output_dir)) == NULL) {
+ fprintf(stderr,"Error opening index file: '%s'\n", indexname);
+ exit(EXIT_FAILURE);
+ }
+
+ /* the Java keywords are stored in a list of strings. Store them
+ * all in a hash table for quick lookup. */
+
+ java_keyword_table = (SYMTABLE *) new_symtable (211);
+ temp = addnode();
+
+ for(i=0;java_reserved_words[i] != NULL; i++)
+ type_insert(java_keyword_table,temp,0,java_reserved_words[i]);
+
+ blas_routine_table = (SYMTABLE *) new_symtable(211);
+ temp = addnode();
+
+ for(i=0;blas_routines[i] != NULL; i++)
+ type_insert(blas_routine_table,temp,0,blas_routines[i]);
+
+ generic_table = (SYMTABLE *) new_symtable(211);
+ temp = addnode();
+
+ for(i=0;generic_intrinsics[i] != NULL; i++)
+ type_insert(generic_table,temp,0,generic_intrinsics[i]);
+
+ /* if search path was not specified on command line, then
+ * check for environment variable.
+ */
+ if(search_path == NULL) {
+ f2jpath = getenv(F2J_PATH_VAR);
+
+ if(f2jpath == NULL) {
+ /* can't use strtok on constant strings, so create a new one here */
+ f2jpath = strdup(".");
+ }
+ }
+ else
+ f2jpath = search_path;
+
+ descriptor_table = build_method_table(f2jpath);
+
+ devnull = fopen(null_file,"w");
+
+ if(devnull == NULL) {
+ fprintf(stderr,"Cannot open %s for writing\n", null_file);
+ exit(EXIT_FAILURE);
+ }
+
+ fprintf(stderr,"%s:\n",inputfilename);
+
+ if(yyparse() != 0) {
+ fprintf(stderr, "Parsing failed.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ fclose(ifp);
+
+#if VCG
+ fclose(vcgfp);
+#endif
+
+ if(bad_format_count > 0)
+ fprintf(stderr,"Unsupported formatting (%d statements)\n", bad_format_count);
+
+ if(ignored_formatting > 0)
+ fprintf(stderr,"Ignored %d format statement(s) with implied loops\n",
+ ignored_formatting);
+
+ if(fclose(indexfp) < 0) {
+ fprintf(stderr,"error closing indexfp...\n");
+ perror("reason");
+ }
+
+ if(fclose(devnull) < 0) {
+ fprintf(stderr,"error closing devnull...\n");
+ perror("reason");
+ }
+
+#ifdef _WIN32
+ /* for windows, we should delete the temp file created earlier. */
+ if(remove(null_file) < 0) {
+ fprintf(stderr,"couldn't remove temp file...\n");
+ perror("reason");
+ }
+#endif
+
+ exit(EXIT_SUCCESS);
+}
+
+/*****************************************************************************
+ * *
+ * javaheader *
+ * *
+ * The header for the Java source will depend on whether the *
+ * BLAS or LAPACK routines are being compiled. The way this *
+ * works is to have the CLASSPATH point at the directory that *
+ * contains directories that contain the actual classes. *
+ * The preprocessor junk is a necessary evil, at least temporarily. *
+ * *
+ *****************************************************************************/
+
+void
+javaheader (FILE * fp, char *reflect)
+{
+ fprintf(fp,"/*\n");
+ fprintf(fp," * Produced by f2java. f2java is part of the Fortran-\n");
+ fprintf(fp," * -to-Java project at the University of Tennessee Netlib\n");
+ fprintf(fp," * numerical software repository.\n *\n");
+ fprintf(fp," * Original authorship for the BLAS and LAPACK numerical\n");
+ fprintf(fp," * routines may be found in the Fortran source, available at\n");
+ fprintf(fp," * http://www.netlib.org.\n *\n");
+ fprintf(fp," * Fortran input file: %s\n", inputfilename);
+ fprintf(fp," * f2java version: %s\n *\n", F2J_VERSION);
+ fprintf(fp," */\n\n");
+
+ if(package_name != NULL)
+ fprintf(fp,"package %s;\n",package_name);
+
+ fprintf(fp,"import java.lang.*;\n");
+ fprintf(fp,"import org.netlib.util.*;\n\n");
+ fprintf(fp,"%s", reflect); /* the import stmt for reflection capability */
+
+ fprintf(fp,"\n\n");
+}
+
+/*****************************************************************************
+ * initialize *
+ * *
+ * Take care of some other crap that cannot be handled in the *
+ * parser. Basically, I should initialize ALL of the symbol *
+ * tables in here, then access all of them as externs. As a *
+ * matter of fact, I should put all initializations into their *
+ * own file. *
+ * *
+ *****************************************************************************/
+
+void
+initialize ()
+{
+ int tablesize = 211;
+
+ lineno = 0;
+ statementno = 0;
+ func_stmt_num = 0;
+
+/*
+ * array_table = (SYMTABLE *) new_symtable (tablesize);
+ * format_table = (SYMTABLE *) new_symtable (tablesize);
+ * data_table = (SYMTABLE *) new_symtable (tablesize);
+ * save_table = (SYMTABLE *) new_symtable (tablesize);
+ * common_table = (SYMTABLE *) new_symtable (tablesize);
+ * parameter_table = (SYMTABLE *) new_symtable (tablesize);
+ */
+ common_block_table = (SYMTABLE *) new_symtable (tablesize);
+ function_table = (SYMTABLE *) new_symtable (tablesize);
+ global_func_table = (SYMTABLE *) new_symtable (tablesize);
+ global_common_table = (SYMTABLE *) new_symtable (tablesize);
+}
+
+
+/*****************************************************************************
+ * uppercase *
+ * *
+ * This should be located in some other file *
+ * than main(). Procedure simply uppercases *
+ * every character in a string. *
+ * *
+ *****************************************************************************/
+
+void
+uppercase(char * name)
+{
+ while (*name)
+ {
+ *name = toupper(*name);
+ name++;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * handle_segfault *
+ * *
+ * This function is called whenever the program seg faults. We flush *
+ * stdout so that we can get a better idea of where the program was when it *
+ * crashed. *
+ * *
+ *****************************************************************************/
+
+void handle_segfault(int x)
+{
+ fflush(stdout);
+ fprintf(stderr,"Segmentation Fault, stdout flushed. [%d]\n", x);
+ if(unit_name != NULL)
+ fprintf(stderr,"unit name is %s\n",unit_name);
+ fflush(stderr);
+ exit(EXIT_FAILURE);
+}
+
+/*****************************************************************************
+ * *
+ * build_method_table *
+ * *
+ * this function searches through all the .f2j files found in directories *
+ * specified in the user's F2J_SEARCH_PATH environment variable and builds *
+ * a list of the method descriptors. *
+ * *
+ *****************************************************************************/
+
+Dlist
+build_method_table(char *path)
+{
+ char *token;
+ struct dirent *dir_entry;
+ DIR *cur_dir;
+ int len;
+ int size = 5;
+ char * full_path;
+ Dlist paths, tmp, new_table;
+
+ new_table = make_dl();
+
+ full_path = (char *)f2jalloc(size);
+
+ token = strtok(path, PATH_DELIM);
+
+ if(token == NULL)
+ return NULL;
+
+ paths = make_dl();
+
+ /* gotta build a list of tokens in the F2J_SEARCH_PATH
+ * because nested calls to strtok() don't work.
+ */
+ do {
+ dl_insert_b(paths, token);
+ } while( (token = strtok(NULL, PATH_DELIM)) != NULL);
+
+ dl_traverse(tmp, paths) {
+ token = (char *) tmp->val;
+
+ if((cur_dir = opendir(token)) == NULL)
+ continue;
+
+ while((dir_entry = readdir(cur_dir)) != NULL) {
+ len = strlen(dir_entry->d_name);
+ if((len > 4) && !strncmp(dir_entry->d_name+(len-4), ".f2j", 4)) {
+
+ if((len + strlen(token) +2) > (unsigned int)size) {
+ size = (len + strlen(token)) * 2; /* double for good measure */
+ full_path = f2jrealloc(full_path, size);
+ }
+
+ strcpy(full_path, token);
+ if(full_path[strlen(full_path)-1] != FILE_DELIM[0])
+ strcat(full_path, FILE_DELIM);
+ strcat(full_path, dir_entry->d_name);
+ insert_entries(full_path, new_table);
+ }
+ }
+
+ closedir(cur_dir);
+ }
+
+ f2jfree(full_path, size);
+ dl_delete_list(paths);
+
+ return new_table;
+}
+
+/*****************************************************************************
+ * *
+ * find_method *
+ * *
+ * this function searches the given Dlist for a method reference matching *
+ * the given method name. the first matching entry is returned. *
+ * *
+ *****************************************************************************/
+
+JVM_METHODREF *
+find_method(char *meth, Dlist methtab)
+{
+ Dlist tmp;
+ JVM_METHODREF * entry;
+
+ dl_traverse(tmp, methtab) {
+ entry = (JVM_METHODREF *) tmp->val;
+
+ if( !strcmp(entry->methodname, meth) )
+ return entry;
+ }
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * get_line *
+ * *
+ * Keeps reading chunks from the specified file until a newline is found. *
+ * Appends all the chunks to one string and returns that. *
+ * *
+ *****************************************************************************/
+
+char *
+get_line(FILE *in)
+{
+#define BUFSZ 400
+ char buf[BUFSZ];
+ char *rv, *line, *ltmp;
+ int idx = 0, cur_size = BUFSZ;
+
+ if(!in) return NULL;
+
+ line = (char *)malloc(BUFSZ);
+ *line = '\0';
+
+ if(!line) return NULL;
+
+ do {
+ rv = fgets(buf, BUFSZ, in);
+
+ if(!rv)
+ return NULL;
+
+ memcpy(line+idx, buf, BUFSZ);
+ idx += strlen(buf);
+
+ cur_size += BUFSZ;
+ ltmp = realloc(line, cur_size);
+
+ if(!ltmp) return NULL;
+ line = ltmp;
+ } while(buf[strlen(buf)-1] != '\n');
+
+ return line;
+}
+
+/*****************************************************************************
+ * *
+ * insert_entries *
+ * *
+ * given the filename, insert all method/descriptor entries from that file *
+ * into the specified Dlist. *
+ * *
+ *****************************************************************************/
+
+void
+insert_entries(char *path, Dlist methtab)
+{
+ char * class, * method, * desc, * buf;
+ FILE *in;
+
+ if((in = fopen(path, "rb")) == NULL)
+ return;
+
+ while((buf=get_line(in)) != NULL) {
+ buf[strlen(buf)-1] = '\0';
+ class = strtok(buf,":");
+ method = strtok(NULL,":");
+ desc = strtok(NULL,":");
+
+ if(!class || !method || !desc)
+ continue;
+
+ dl_insert_b(methtab, bc_new_method_node(class,method,desc));
+ }
+
+ fclose(in);
+
+ return;
+}
+
+/*****************************************************************************
+ * *
+ * strAppend *
+ * *
+ * Append the given string value (new) to the expandable string (str), *
+ * allocating more memory if necessary. *
+ * *
+ *****************************************************************************/
+
+struct _str *
+strAppend(struct _str *str, char *new)
+{
+ if(str == NULL) {
+ str = (struct _str *)f2jalloc(sizeof (struct _str));
+ str->size = STR_INIT;
+ str->val = (char *)f2jalloc(STR_INIT);
+ str->val[0] = '\0';
+ }
+
+ if(strlen(new) + strlen(str->val) >= str->size) {
+ if(strlen(new) > STR_CHUNK) {
+ str->val = (char *)f2jrealloc(str->val, str->size + strlen(new));
+ str->size += strlen(new);
+ }
+ else {
+ str->val = (char *)f2jrealloc(str->val, str->size + STR_CHUNK);
+ str->size += STR_CHUNK;
+ }
+ }
+
+ strcat(str->val, new);
+
+ return str;
+}
diff --git a/src/f2jmem.c b/src/f2jmem.c
new file mode 100644
index 0000000..58c7460
--- /dev/null
+++ b/src/f2jmem.c
@@ -0,0 +1,173 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2jmem.c,v $
+ * $Revision: 1.16 $
+ * $Date: 2007/12/12 21:47:41 $
+ * $Author: keithseymour $
+ */
+
+/*****************************************************************************
+ * f2jmem.c *
+ * *
+ * This file contains the memory management routines for f2j. *
+ * *
+ *****************************************************************************/
+
+#include"f2jmem.h"
+
+/*****************************************************************************
+ * *
+ * f2jfree *
+ * *
+ * Wrapper around free which may overwrite the memory such that we can find *
+ * problems early (only if DEBUG_MEM is defined). *
+ * *
+ *****************************************************************************/
+
+void
+f2jfree(void *p, size_t size)
+{
+#ifdef DEBUG_MEM
+ memset(p, 0xA, size);
+#endif
+
+ free(p);
+}
+
+/*****************************************************************************
+ * *
+ * f2jalloc *
+ * *
+ * Error-checking memory allocation routine for f2java. we can't recover *
+ * from an out of memory condition, so we'll just call exit() which will *
+ * close all open streams for us. *
+ * *
+ *****************************************************************************/
+
+void *
+f2jalloc(size_t numbytes)
+{
+ void * mem = malloc(numbytes);
+
+ if(mem == NULL)
+ alloc_error(numbytes);
+
+ return mem;
+}
+
+/*****************************************************************************
+ * *
+ * f2jcalloc *
+ * *
+ * Error-checking memory allocation routine for f2java. we can't recover *
+ * from an out of memory condition, so we'll just call exit() which will *
+ * close all open streams for us. *
+ * *
+ *****************************************************************************/
+
+void *
+f2jcalloc(size_t numitems, size_t numbytes)
+{
+ void * mem = calloc(numitems, numbytes);
+
+ if(mem == NULL)
+ alloc_error(numbytes);
+
+ return mem;
+}
+
+/*****************************************************************************
+ * *
+ * f2jrealloc *
+ * *
+ * Error-checking memory allocation routine for f2java. we can't recover *
+ * from an out of memory condition, so we'll just call exit() which will *
+ * close all open streams for us. *
+ * *
+ *****************************************************************************/
+
+void *
+f2jrealloc(void *ptr, size_t size)
+{
+ void *mem = realloc(ptr, size);
+
+ if(mem == NULL)
+ alloc_error(size);
+
+ return mem;
+}
+
+/*****************************************************************************
+ * *
+ * alloc_error *
+ * *
+ * called when there is an error allocating memory. this function prints *
+ * an error message and exits. *
+ * *
+ *****************************************************************************/
+
+void
+alloc_error(size_t size)
+{
+ fprintf(stderr,"f2java: Error allocating %d bytes of memory. Stopping.\n",
+ (int)size);
+ perror("Reason:");
+ exit(EXIT_FAILURE);
+}
+
+/*****************************************************************************
+ * *
+ * free_var_info *
+ * *
+ * frees a variable info structure. *
+ * *
+ *****************************************************************************/
+
+void
+free_var_info(struct var_info *v)
+{
+ f2jfree(v->name, strlen(v->name)+1);
+ f2jfree(v->desc, strlen(v->desc)+1);
+ f2jfree(v->class, strlen(v->class)+1);
+ f2jfree(v, sizeof(struct var_info));
+}
+
+/*****************************************************************************
+ * free_ast_node *
+ * *
+ * *
+ *****************************************************************************/
+
+void
+free_ast_node(AST *n)
+{
+ if( n == NULL )
+ return;
+
+ switch(n->nodetype) {
+ case Constant:
+ if(n->astnode.constant.number)
+ free(n->astnode.constant.number);
+ break;
+ case Identifier:
+ case Typedec:
+ case Assignment:
+ break;
+ case IoExplist:
+ /* currently we should ignore this */
+ break;
+ case Expression:
+ free_ast_node(n->astnode.expression.rhs);
+ break;
+ case Binaryop:
+ case Power:
+ free_ast_node(n->astnode.expression.lhs);
+ free_ast_node(n->astnode.expression.rhs);
+ break;
+ default:
+ fprintf(stderr,"free_ast_node() warning: unsupported node %s.\n",
+ print_nodetype(n));
+ break; /*ansi*/
+ }
+
+ f2jfree(n, sizeof(AST));
+}
diff --git a/src/f2jmem.h b/src/f2jmem.h
new file mode 100644
index 0000000..a0d3248
--- /dev/null
+++ b/src/f2jmem.h
@@ -0,0 +1,23 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2jmem.h,v $
+ * $Revision: 1.6 $
+ * $Date: 2004/02/04 06:25:43 $
+ * $Author: keithseymour $
+ */
+
+
+#ifndef F2JMEM_H
+#define F2JMEM_H
+
+#include"f2j.h"
+
+void
+ alloc_error(size_t),
+ f2jfree(void *, size_t),
+ free_var_info(struct var_info *),
+ * f2jalloc(size_t),
+ * f2jcalloc(size_t, size_t),
+ * f2jrealloc(void *, size_t),
+ free_ast_node(AST *);
+
+#endif
diff --git a/src/f2jparse.y b/src/f2jparse.y
new file mode 100644
index 0000000..50e11ef
--- /dev/null
+++ b/src/f2jparse.y
@@ -0,0 +1,5203 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/f2jparse.y,v $
+ * $Revision: 1.144 $
+ * $Date: 2007/12/12 21:47:41 $
+ * $Author: keithseymour $
+ */
+
+%{
+
+/*****************************************************************************
+ * f2jparse *
+ * *
+ * This is a yacc parser for a subset of Fortran 77. It builds an AST *
+ * which is used by codegen() to generate Java code. *
+ * *
+ *****************************************************************************/
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<ctype.h>
+#include<string.h>
+#include"f2j.h"
+#include"f2j_externs.h"
+#include"f2jmem.h"
+
+/*****************************************************************************
+ * Define YYDEBUG as 1 to get debugging output from yacc. *
+ *****************************************************************************/
+
+#define YYDEBUG 0
+
+/*****************************************************************************
+ * Global variables. *
+ *****************************************************************************/
+
+int
+ debug = FALSE, /* set to TRUE for debugging output */
+ emittem = 1, /* set to 1 to emit Java, 0 to just parse */
+ len = 1, /* keeps track of the size of a data type */
+ temptok, /* temporary token for an inline expr */
+ save_all, /* is there a SAVE stmt without a var list */
+ cur_do_label; /* current 'do..end do' loop label */
+
+AST
+ * unit_args = NULL, /* pointer to args for this program unit */
+ * equivList = NULL; /* list to keep track of equivalences */
+
+Dlist
+ assign_labels, /* labels used in ASSIGN TO statements */
+ subroutine_names, /* holds the names of subroutines */
+ do_labels; /* generated labels for 'do..end do' loops */
+
+enum returntype
+ typedec_context = Object; /* what kind of type dec we are parsing */
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+METHODTAB
+ * methodscan (METHODTAB *, char *);
+
+int
+ yylex(void),
+ intrinsic_or_implicit(char *),
+ in_dlist_stmt_label(Dlist, AST *),
+ in_dlist(Dlist, char *);
+
+double
+ eval_const_expr(AST *);
+
+char
+ * lowercase(char * ),
+ * first_char_is_minus(char *),
+ * unary_negate_string(char *),
+ * tok2str(int );
+
+void
+ yyerror(char *),
+ start_vcg(AST *),
+ emit(AST *),
+ jas_emit(AST *),
+ init_tables(void),
+ addEquiv(AST *),
+ assign(AST *),
+ typecheck(AST *),
+ optScalar(AST *),
+ type_insert (SYMTABLE * , AST * , enum returntype , char *),
+ type_hash(AST *),
+ merge_common_blocks(AST *),
+ arg_table_load(AST *),
+ exp_to_double (char *, char *),
+ assign_function_return_type(AST *, AST *),
+ insert_name(SYMTABLE *, AST *, enum returntype),
+ store_array_var(AST *),
+ initialize_implicit_table(ITAB_ENTRY *),
+ printbits(char *, void *, int),
+ print_sym_table_names(SYMTABLE *);
+
+AST
+ * dl_astnode_examine(Dlist l),
+ * addnode(void),
+ * switchem(AST *),
+ * gen_incr_expr(AST *, AST *),
+ * gen_iter_expr(AST *, AST *, AST *),
+ * initialize_name(char *),
+ * process_typestmt(enum returntype, AST *),
+ * process_array_declaration(AST *, AST *),
+ * process_subroutine_call(AST *, AST *);
+
+SYMTABLE
+ * new_symtable (int );
+
+extern METHODTAB intrinsic_toks[];
+
+ITAB_ENTRY implicit_table[26];
+
+%}
+
+%union {
+ struct ast_node *ptnode;
+ int tok;
+ enum returntype type;
+ char lexeme[YYTEXTLEN];
+}
+
+/* generic tokens */
+
+%token PLUS MINUS OP CP STAR POW DIV CAT CM EQ COLON NL
+%token NOT AND OR
+%token RELOP EQV NEQV
+%token <lexeme> NAME DOUBLE INTEGER E_EXPONENTIAL D_EXPONENTIAL
+%token CONST_EXP TrUE FaLSE ICON RCON LCON CCON
+%token FLOAT CHARACTER LOGICAL COMPLEX NONE
+
+/* a zillion keywords */
+
+%token IF THEN ELSE ELSEIF ENDIF DO GOTO ASSIGN TO CONTINUE STOP
+%token RDWR END ENDDO STRING CHAR PAUSE
+%token OPEN CLOSE BACKSPACE REWIND ENDFILE FORMAT
+%token PROGRAM FUNCTION SUBROUTINE ENTRY CALL RETURN
+%token <type> ARITH_TYPE CHAR_TYPE
+%token DIMENSION INCLUDE
+%token COMMON EQUIVALENCE EXTERNAL PARAMETER INTRINSIC IMPLICIT
+%token SAVE DATA COMMENT READ WRITE PRINT FMT EDIT_DESC REPEAT
+
+%token OPEN_IOSTAT OPEN_ERR OPEN_FILE OPEN_STATUS OPEN_ACCESS
+%token OPEN_FORM OPEN_UNIT OPEN_RECL OPEN_BLANK
+
+/* these are here to silence conflicts related to parsing comments */
+
+%nonassoc RELOP
+%nonassoc LOWER_THAN_COMMENT
+%nonassoc COMMENT
+
+/* All of my additions or changes to Levine's code. These
+ * non-terminals are in alphabetic order because I have had to
+ * change the grammar quite a bit. It is tiring trying to root
+ * out the location of a non-terminal, much easier to find when
+ * in alphabetic order.
+ */
+
+%type <ptnode> Arraydeclaration Arrayname Arraynamelist Assignment
+%type <ptnode> Arrayindexlist Arithmeticif ArraydecList AssignedGoto
+%type <ptnode> Blockif Boolean Close Comment
+%type <ptnode> Call Constant Continue EndDo
+%type <ptnode> Data DataList DataConstantExpr DataConstant DataItem
+%type <ptnode> /* DataElement */ Do_incr Doloop
+%type <ptnode> DataLhs DataConstantList Dimension LoopBounds
+%type <ptnode> Do_vals Double Float
+%type <ptnode> EquivalenceStmt EquivalenceList EquivalenceItem
+%type <ptnode> Else Elseif Elseifs EndIf End Exp Explist Exponential External
+%type <ptnode> Function Functionargs F2java
+%type <ptnode> Fprogram Ffunction Fsubroutine
+%type <ptnode> Goto Common CommonList CommonSpec ComputedGoto
+%type <ptnode> IfBlock Implicit Integer Intlist Intrinsic
+%type <ptnode> ImplicitSpecItem ImplicitLetterList ImplicitLetter
+%type <ptnode> Label Lhs Logicalif
+%type <ptnode> Name UndeclaredName Namelist UndeclaredNamelist
+%type <ptnode> LhsList Open
+%type <ptnode> Parameter Pdec Pdecs Program PrintIoList
+%type <ptnode> Read IoExp IoExplist Return Rewind
+%type <ptnode> Save Specstmt Specstmts SpecStmtList Statements
+%type <ptnode> Statement StmtLabelAssign Subroutinecall
+%type <ptnode> Sourcecodes Sourcecode Star
+%type <ptnode> String Subroutine Stop SubstringOp Pause
+%type <ptnode> Typestmt ArithTypevar ArithTypevarlist
+%type <ptnode> CharTypevar CharTypevarlist
+%type <type> ArithTypes ArithSimpleType CharTypes CharSimpleType
+%type <type> AnySimpleType AnyTypes
+%type <ptnode> Write WriteFileDesc FormatSpec EndSpec
+%type <ptnode> Format FormatExplist FormatExp FormatSeparator
+%type <ptnode> RepeatableItem UnRepeatableItem RepeatSpec
+%type <ptnode> log_disjunct log_term log_factor log_primary
+%type <ptnode> arith_expr term factor char_expr primary
+%type <ptnode> Ios CharExp OlistItem Olist UnitSpec
+
+%%
+
+F2java: Sourcecodes
+ {
+ AST *temp, *prev, *commentList = NULL;
+
+ if(debug)
+ printf("F2java -> Sourcecodes\n");
+ $$ = switchem($1);
+
+#if VCG
+ if(emittem) start_vcg($$);
+#endif
+ prev = NULL;
+ for(temp=$$;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(emittem) {
+
+ if(temp->nodetype == Comment)
+ {
+ if((prev == NULL) ||
+ ((prev != NULL) && (prev->nodetype != Comment)))
+ commentList = temp;
+ }
+ else
+ {
+ /* commentList may be NULL here so we must check
+ * for that in codegen.
+ */
+ temp->astnode.source.prologComments = commentList;
+
+ typecheck(temp);
+
+ if(omitWrappers)
+ optScalar(temp);
+
+ emit(temp);
+
+ commentList = NULL;
+ }
+ }
+ prev = temp;
+ }
+ }
+;
+
+Sourcecodes: Sourcecode
+ {
+ AST *temp;
+
+ if(debug)
+ printf("Sourcecodes -> Sourcecode\n");
+ $$=$1;
+
+ /* insert the name of the program unit into the
+ * global function table. this will allow optScalar()
+ * to easily get a pointer to a function.
+ */
+
+ if(omitWrappers && ($1->nodetype != Comment)) {
+ temp = $1->astnode.source.progtype->astnode.source.name;
+
+ type_insert(global_func_table, $1, 0, temp->astnode.ident.name);
+ }
+ }
+ | Sourcecodes Sourcecode
+ {
+ AST *temp;
+
+ if(debug)
+ printf("Sourcecodes -> Sourcecodes Sourcecode\n");
+ $2->prevstmt = $1;
+ $$=$2;
+
+ /* insert the name of the program unit into the
+ * global function table. this will allow optScalar()
+ * to easily get a pointer to a function.
+ */
+
+ if(omitWrappers && ($2->nodetype != Comment)) {
+ temp = $2->astnode.source.progtype->astnode.source.name;
+
+ type_insert(global_func_table, $2, 0, temp->astnode.ident.name);
+ }
+ }
+;
+
+Sourcecode : Fprogram
+ {
+ if(debug)
+ printf("Sourcecode -> Fprogram\n");
+ $$=$1;
+ }
+ | Fsubroutine
+ {
+ if(debug)
+ printf("Sourcecode -> Fsubroutine\n");
+ $$=$1;
+ }
+ | Ffunction
+ {
+ if(debug)
+ printf("Sourcecode -> Ffunction\n");
+ $$=$1;
+ }
+ | Comment
+ {
+ if(debug)
+ printf("Sourcecode -> Comment\n");
+ $$=$1;
+ }
+;
+
+Fprogram: Program Specstmts Statements End
+ {
+ if(debug)
+ printf("Fprogram -> Program Specstmts Statements End\n");
+
+ add_implicit_to_tree($2);
+
+ $$ = addnode();
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ $$->astnode.source.type_table = type_table;
+ $$->astnode.source.external_table = external_table;
+ $$->astnode.source.intrinsic_table = intrinsic_table;
+ $$->astnode.source.args_table = args_table;
+ $$->astnode.source.array_table = array_table;
+ $$->astnode.source.format_table = format_table;
+ $$->astnode.source.data_table = data_table;
+ $$->astnode.source.save_table = save_table;
+ $$->astnode.source.common_table = common_table;
+ $$->astnode.source.parameter_table = parameter_table;
+ $$->astnode.source.constants_table = constants_table;
+ $$->astnode.source.equivalences = equivList;
+ $$->astnode.source.stmt_assign_list = assign_labels;
+
+ $$->astnode.source.javadocComments = NULL;
+ $$->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ $$->astnode.source.needs_input = FALSE;
+ $$->astnode.source.needs_output = FALSE;
+ $$->astnode.source.needs_reflection = FALSE;
+ $$->astnode.source.needs_blas = FALSE;
+
+ if(omitWrappers)
+ $$->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $4->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Progunit;
+ $$->astnode.source.progtype = $1;
+ $$->astnode.source.typedecs = $2;
+ $4->prevstmt = $3;
+ $$->astnode.source.statements = switchem($4);
+
+ /* a PROGRAM has no args, so set the symbol table
+ to NULL */
+ args_table = NULL;
+
+ $1->astnode.source.descriptor = MAIN_DESCRIPTOR;
+ }
+;
+
+
+Fsubroutine: Subroutine Specstmts Statements End
+ {
+ HASHNODE *ht;
+ AST *temp;
+
+ if(debug)
+ printf("Fsubroutine -> Subroutine Specstmts Statements End\n");
+
+ add_implicit_to_tree($2);
+
+ $$ = addnode();
+ $1->parent = $$;
+ $2->parent = $$;
+ $3->parent = $$;
+ $4->parent = $$;
+ $$->nodetype = Progunit;
+ $$->astnode.source.progtype = $1;
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ $$->astnode.source.type_table = type_table;
+ $$->astnode.source.external_table = external_table;
+ $$->astnode.source.intrinsic_table = intrinsic_table;
+ $$->astnode.source.args_table = args_table;
+ $$->astnode.source.array_table = array_table;
+ $$->astnode.source.format_table = format_table;
+ $$->astnode.source.data_table = data_table;
+ $$->astnode.source.save_table = save_table;
+ $$->astnode.source.common_table = common_table;
+ $$->astnode.source.parameter_table = parameter_table;
+ $$->astnode.source.constants_table = constants_table;
+ $$->astnode.source.equivalences = equivList;
+ $$->astnode.source.stmt_assign_list = assign_labels;
+
+ $$->astnode.source.javadocComments = NULL;
+ $$->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ $$->astnode.source.needs_input = FALSE;
+ $$->astnode.source.needs_output = FALSE;
+ $$->astnode.source.needs_reflection = FALSE;
+ $$->astnode.source.needs_blas = FALSE;
+
+ if(omitWrappers)
+ $$->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ $$->astnode.source.typedecs = $2;
+ $4->prevstmt = $3;
+ $$->astnode.source.statements = switchem($4);
+
+ /* foreach arg to this program unit, store the array
+ * size, if applicable, from the hash table into the
+ * node itself.
+ */
+
+ for(temp=$1->astnode.source.args;temp!=NULL;temp=temp->nextstmt)
+ {
+ if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL)
+ {
+ temp->vartype=ht->variable->vartype;
+ temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist;
+ }
+ if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){
+ ht->variable->vartype=temp->vartype;
+ }
+ }
+
+ type_insert(function_table, $1, 0,
+ $1->astnode.source.name->astnode.ident.name);
+ }
+;
+
+Ffunction: Function Specstmts Statements End
+ {
+ HASHNODE *ht;
+ AST *temp;
+
+ if(debug)
+ printf("Ffunction -> Function Specstmts Statements End\n");
+
+ assign_function_return_type($1, $2);
+
+ add_implicit_to_tree($2);
+
+ $$ = addnode();
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ $$->astnode.source.type_table = type_table;
+ $$->astnode.source.external_table = external_table;
+ $$->astnode.source.intrinsic_table = intrinsic_table;
+ $$->astnode.source.args_table = args_table;
+ $$->astnode.source.array_table = array_table;
+ $$->astnode.source.format_table = format_table;
+ $$->astnode.source.data_table = data_table;
+ $$->astnode.source.save_table = save_table;
+ $$->astnode.source.common_table = common_table;
+ $$->astnode.source.parameter_table = parameter_table;
+ $$->astnode.source.constants_table = constants_table;
+ $$->astnode.source.equivalences = equivList;
+ $$->astnode.source.stmt_assign_list = assign_labels;
+
+ $$->astnode.source.javadocComments = NULL;
+ $$->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ $$->astnode.source.needs_input = FALSE;
+ $$->astnode.source.needs_output = FALSE;
+ $$->astnode.source.needs_reflection = FALSE;
+ $$->astnode.source.needs_blas = FALSE;
+ if(omitWrappers)
+ $$->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $4->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Progunit;
+ $$->astnode.source.progtype = $1;
+ $$->astnode.source.typedecs = $2;
+ $4->prevstmt = $3;
+ $$->astnode.source.statements = switchem($4);
+
+ /* foreach arg to this program unit, store the array
+ * size, if applicable, from the hash table into the
+ * node itself.
+ */
+
+ for(temp=$1->astnode.source.args;temp!=NULL;temp=temp->nextstmt)
+ {
+ if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL)
+ {
+ temp->vartype=ht->variable->vartype;
+ temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist;
+ }
+ if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){
+ ht->variable->vartype=temp->vartype;
+ }
+ }
+
+ type_insert(function_table, $1, 0,
+ $1->astnode.source.name->astnode.ident.name);
+ }
+
+;
+
+Program: PROGRAM UndeclaredName NL
+ {
+ if(debug)
+ printf("Program -> PROGRAM UndeclaredName\n");
+
+ unit_args = NULL;
+
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ lowercase($2->astnode.ident.name);
+ $$->astnode.source.name = $2;
+ $$->nodetype = Program;
+ $$->token = PROGRAM;
+ $$->astnode.source.args = NULL;
+
+ init_tables();
+
+ fprintf(stderr," MAIN %s:\n",$2->astnode.ident.name);
+ }
+;
+
+Subroutine: SUBROUTINE UndeclaredName Functionargs NL
+ {
+ if(debug)
+ printf("Subroutine -> SUBROUTINE UndeclaredName Functionargs NL\n");
+
+ unit_args = $3;
+
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ if($3 != NULL)
+ $3->parent = $$; /* 9-4-97 - Keith */
+
+ $$->astnode.source.name = $2;
+ $$->nodetype = Subroutine;
+ $$->token = SUBROUTINE;
+ $$->astnode.source.args = switchem($3);
+
+ fprintf(stderr,"\t%s:\n",$2->astnode.ident.name);
+ }
+ | SUBROUTINE UndeclaredName NL
+ {
+ if(debug)
+ printf("Subroutine -> SUBROUTINE UndeclaredName NL\n");
+
+ unit_args = NULL;
+
+ init_tables();
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+
+ $$->astnode.source.name = $2;
+ $$->nodetype = Subroutine;
+ $$->token = SUBROUTINE;
+ $$->astnode.source.args = NULL;
+
+ fprintf(stderr,"\t%s:\n",$2->astnode.ident.name);
+ }
+;
+
+Function: AnySimpleType FUNCTION UndeclaredName Functionargs NL
+ {
+ if(debug)
+ printf("Function -> AnySimpleType FUNCTION UndeclaredName Functionargs NL\n");
+
+ unit_args = $4;
+
+ $$ = addnode();
+
+ $3->parent = $$; /* 9-4-97 - Keith */
+ if($4 != NULL)
+ $4->parent = $$; /* 9-4-97 - Keith */
+ $$->astnode.source.name = $3;
+ $$->nodetype = Function;
+ $$->token = FUNCTION;
+ $$->astnode.source.returns = $1;
+ $$->vartype = $1;
+ $3->vartype = $1;
+ $$->astnode.source.args = switchem($4);
+
+ /* since the function name is the implicit return value
+ * and it can be treated as a variable, we insert it into
+ * the hash table for lookup later.
+ */
+
+ $3->astnode.ident.localvnum = -1;
+ insert_name(type_table, $3, $1);
+
+ fprintf(stderr,"\t%s:\n",$3->astnode.ident.name);
+ }
+ | FUNCTION UndeclaredName Functionargs NL
+ {
+ enum returntype ret;
+
+ unit_args = $3;
+
+ $$ = addnode();
+
+ $2->parent = $$;
+ if($3 != NULL)
+ $3->parent = $$;
+ $$->astnode.source.name = $2;
+ $$->nodetype = Function;
+ $$->token = FUNCTION;
+ ret = implicit_table[tolower($2->astnode.ident.name[0]) - 'a'].type;
+ $$->astnode.source.returns = ret;
+ $$->vartype = ret;
+ $2->vartype = ret;
+ $$->astnode.source.args = switchem($3);
+
+ $2->astnode.ident.localvnum = -1;
+ insert_name(type_table, $2, ret);
+
+ fprintf(stderr,"\t%s:\n",$2->astnode.ident.name);
+ }
+;
+
+Specstmts: SpecStmtList %prec LOWER_THAN_COMMENT
+ {
+ AST *tmparg;
+
+ if(debug){
+ printf("Specstmts -> SpecStmtList\n");
+ }
+ $1 = switchem($1);
+ type_hash($1);
+ $$=$1;
+
+ for(tmparg = unit_args; tmparg; tmparg=tmparg->nextstmt) {
+ HASHNODE *ht;
+
+ ht = type_lookup(type_table, tmparg->astnode.ident.name);
+
+ if(ht) {
+ if(!ht->variable->astnode.ident.explicit)
+ ht->variable->vartype =
+ implicit_table[tolower(tmparg->astnode.ident.name[0]) - 'a'].type;
+ }
+ else
+ fprintf(stderr, "warning: didn't find %s in symbol table\n",
+ tmparg->astnode.ident.name);
+ }
+ }
+;
+
+SpecStmtList: Specstmt
+ {
+ $$=$1;
+ }
+ | SpecStmtList Specstmt
+ {
+ $2->prevstmt = $1;
+ $$ = $2;
+ }
+;
+
+Specstmt: Dimension
+ {
+ $$ = $1;
+ }
+ | EquivalenceStmt
+ {
+ $$ = $1;
+ }
+ | Common
+ {
+ $$ = $1;
+ }
+ | Save
+ {
+ $$=$1;
+ }
+ | Intrinsic
+ {
+ $$=$1;
+ }
+ | Typestmt
+ {
+ $$=$1;
+ }
+ | External
+ {
+ $$=$1;
+ }
+ | Parameter
+ {
+ $$=$1;
+ }
+ | Implicit
+ {
+ $$=$1;
+ }
+ | Data NL
+ {
+ $$=$1;
+ }
+ | Comment
+ {
+ $$ = $1;
+ }
+;
+
+Dimension: DIMENSION ArraydecList NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $2 = switchem($2);
+ $$->nodetype = Dimension;
+
+ $$->astnode.typeunit.declist = $2;
+ }
+;
+
+ArraydecList: ArraydecList CM Arraydeclaration
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ $$->nodetype = Dimension;
+ }
+ | Arraydeclaration
+ {
+ $$ = $1;
+ $$->nodetype = Dimension;
+ }
+;
+
+/* the EQUIVALENCE productions are taken from Robert Moniot's
+ * ftnchek grammar.
+ */
+
+EquivalenceStmt: EQUIVALENCE EquivalenceList NL
+ {
+ $$ = addnode();
+ $$->nodetype = Equivalence;
+ $$->prevstmt = NULL;
+ $$->nextstmt = NULL;
+ $$->astnode.equiv.nlist = switchem($2);
+ }
+;
+
+EquivalenceList: OP EquivalenceItem CP
+ {
+ AST *tmp;
+
+ $$ = addnode();
+ $$->nodetype = Equivalence;
+ $$->prevstmt = NULL;
+ $$->nextstmt = NULL;
+ $$->astnode.equiv.clist = switchem($2);
+
+ for(tmp=$2;tmp!=NULL;tmp=tmp->prevstmt)
+ tmp->parent = $$;
+
+ addEquiv($$->astnode.equiv.clist);
+ }
+ | EquivalenceList CM OP EquivalenceItem CP
+ {
+ AST *tmp;
+
+ $$ = addnode();
+ $$->nodetype = Equivalence;
+ $$->astnode.equiv.clist = switchem($4);
+ $$->prevstmt = $1;
+ $$->nextstmt = NULL;
+
+ for(tmp=$4;tmp!=NULL;tmp=tmp->prevstmt)
+ tmp->parent = $$;
+
+ addEquiv($$->astnode.equiv.clist);
+ }
+;
+
+EquivalenceItem: Lhs
+ {
+ $$ = $1;
+ }
+ | EquivalenceItem CM Lhs
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+Common: COMMON CommonList NL
+ {
+ $$ = addnode();
+ $$->nodetype = CommonList;
+ $$->astnode.common.name = NULL;
+
+ $$->astnode.common.nlist = switchem($2);
+ merge_common_blocks($$->astnode.common.nlist);
+ }
+;
+
+CommonList: CommonSpec
+ {
+ $$ = $1;
+ }
+ | CommonList CommonSpec
+ {
+ $2->prevstmt = $1;
+ $$ = $2;
+ }
+;
+
+CommonSpec: DIV UndeclaredName DIV ArithTypevarlist
+ {
+ AST *temp;
+ int pos;
+
+ if(debug){
+ printf("CommonSpec -> DIV UndeclaredName DIV Namelist\n");
+ }
+
+ $$ = addnode();
+ $$->nodetype = Common;
+ $$->astnode.common.name = strdup($2->astnode.ident.name);
+ $$->astnode.common.nlist = switchem($4);
+
+ pos = 0;
+
+ /* foreach variable in the COMMON block... */
+ for(temp=$$->astnode.common.nlist;temp!=NULL;temp=temp->nextstmt)
+ {
+ temp->astnode.ident.commonBlockName =
+ strdup($2->astnode.ident.name);
+
+ if(omitWrappers)
+ temp->astnode.ident.position = pos++;
+
+ /* insert this name into the common table */
+ if(debug)
+ printf("@insert %s (block = %s) into common table\n",
+ temp->astnode.ident.name, $2->astnode.ident.name);
+
+ type_insert(common_table, temp, Float, temp->astnode.ident.name);
+ }
+
+ type_insert(global_common_table, $$, Float, $$->astnode.common.name);
+ free_ast_node($2);
+ }
+ | CAT ArithTypevarlist /* CAT is // */
+ {
+ AST *temp;
+
+ /* This is an unnamed common block */
+ if(debug){
+ printf("CommonSpec -> CAT Namelist\n");
+ }
+
+ $$ = addnode();
+ $$->nodetype = Common;
+ $$->astnode.common.name = strdup("Blank");
+ $$->astnode.common.nlist = switchem($2);
+
+ /* foreach variable in the COMMON block... */
+ for(temp=$2;temp!=NULL;temp=temp->prevstmt) {
+ temp->astnode.ident.commonBlockName = "Blank";
+
+ /* insert this name into the common table */
+
+ if(debug)
+ printf("@@insert %s (block = unnamed) into common table\n",
+ temp->astnode.ident.name);
+
+ type_insert(common_table, temp, Float, temp->astnode.ident.name);
+ }
+
+ type_insert(global_common_table, $$, Float, $$->astnode.common.name);
+ }
+;
+
+/* SAVE is ignored by the code generator.
+ * ..not anymore 12/10/01 kgs
+ */
+
+Save: SAVE NL
+ {
+ /*
+ * I think in this case every variable is supposed to
+ * be saved, but we already emit every variable as
+ * static. do nothing here. --Keith
+ */
+
+ $$ = addnode();
+ $$->nodetype = Save;
+ save_all = TRUE;
+ }
+ | SAVE DIV Namelist DIV NL
+ {
+ AST *temp;
+
+ if(debug){
+ printf("Save -> SAVE DIV Namelist DIV NL\n");
+ }
+ $$ = addnode();
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Save;
+
+ for(temp=$3;temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into save table\n",
+ temp->astnode.ident.name);
+
+ type_insert(save_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+ | SAVE Namelist NL
+ {
+ AST *temp;
+ if(debug){
+ printf("Save -> SAVE Namelist NL\n");
+ }
+
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Save;
+
+ for(temp=$2;temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into save table\n",
+ temp->astnode.ident.name);
+
+ type_insert(save_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+;
+
+Implicit: IMPLICIT ImplicitSpecList NL
+ {
+ $$=addnode();
+ $$->nodetype = Specification;
+ $$->token = IMPLICIT;
+ }
+ | IMPLICIT NONE NL
+ {
+ $$=addnode();
+ $$->nodetype = Specification;
+ $$->token = IMPLICIT;
+ fprintf(stderr,"Warning: IMPLICIT NONE ignored.\n");
+ }
+;
+
+ImplicitSpecList: ImplicitSpecItem
+ {
+ /* I don't think anything needs to be done here */
+ }
+ | ImplicitSpecList CM ImplicitSpecItem
+ {
+ /* or here either. */
+ }
+;
+
+ImplicitSpecItem: AnyTypes OP ImplicitLetterList CP
+ {
+ AST *temp;
+
+ for(temp=$3;temp!=NULL;temp=temp->prevstmt) {
+ char *start_range, *end_range;
+ char start_char, end_char;
+ int i;
+
+ start_range = temp->astnode.expression.lhs->astnode.ident.name;
+ end_range = temp->astnode.expression.rhs->astnode.ident.name;
+
+ start_char = tolower(start_range[0]);
+ end_char = tolower(end_range[0]);
+
+ if((strlen(start_range) > 1) || (strlen(end_range) > 1)) {
+ yyerror("IMPLICIT spec must contain single character.");
+ exit(EXIT_FAILURE);
+ }
+
+ if(end_char < start_char) {
+ yyerror("IMPLICIT range in backwards order.");
+ exit(EXIT_FAILURE);
+ }
+
+ for(i=start_char - 'a'; i <= end_char - 'a'; i++) {
+ if(implicit_table[i].declared) {
+ yyerror("Duplicate letter specified in IMPLICIT statement.");
+ exit(EXIT_FAILURE);
+ }
+
+ implicit_table[i].type = $1;
+ implicit_table[i].declared = TRUE;
+ implicit_table[i].len = len; /* global set in Types production */
+ }
+ }
+ }
+;
+
+ImplicitLetterList: ImplicitLetter
+ {
+ $$ = $1;
+ }
+ | ImplicitLetterList CM ImplicitLetter
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+ImplicitLetter: UndeclaredName
+ {
+ $$ = addnode();
+ $$->nodetype = Expression;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $1;
+ }
+ | UndeclaredName MINUS UndeclaredName
+ {
+ $$ = addnode();
+ $$->nodetype = Expression;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+;
+
+Data: DATA DataList
+ {
+ /* $$ = $2; */
+ $$ = addnode();
+ $$->nodetype = DataList;
+ $$->astnode.label.stmt = $2;
+ }
+;
+
+DataList: DataItem
+ {
+ $$ = $1;
+ }
+ | DataList CM DataItem
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+DataItem: LhsList DIV DataConstantList DIV
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.data.nlist = switchem($1);
+ $$->astnode.data.clist = switchem($3);
+
+ $$->nodetype = DataStmt;
+ $$->prevstmt = NULL;
+ $$->nextstmt = NULL;
+
+ for(temp=$1;temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into data table\n",
+ temp->astnode.ident.name);
+
+ temp->parent = $$;
+
+ if(temp->nodetype == DataImpliedLoop)
+ type_insert(data_table, temp, Float,
+ temp->astnode.forloop.Label->astnode.ident.name);
+ else
+ type_insert(data_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+;
+
+DataConstantList: DataConstantExpr
+ {
+ $$ = $1;
+ }
+ | DataConstantList CM DataConstantExpr
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+DataConstantExpr: DataConstant
+ {
+ $$ = $1;
+ }
+ | DataConstant STAR DataConstant
+ {
+ $$ = $1;
+ $$=addnode();
+ $$->nodetype = Binaryop;
+ $$->token = STAR;
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->astnode.expression.optype = '*';
+ }
+;
+
+DataConstant: Constant
+ {
+ $$ = $1;
+ }
+ | UndeclaredName
+ {
+ HASHNODE *hash_temp;
+ if((parameter_table != NULL) &&
+ ((hash_temp = type_lookup(parameter_table, yylval.lexeme)) != NULL))
+ {
+ $$ = addnode();
+ $$->nodetype = Constant;
+ $$->vartype = hash_temp->variable->vartype;
+ $$->token = hash_temp->variable->token;
+ $$->astnode.constant.number = strdup(hash_temp->variable->astnode.constant.number);
+ }
+ else{
+ printf("Error: '%s' is not a constant\n",yylval.lexeme);
+ exit(EXIT_FAILURE);
+ }
+ }
+ | MINUS Constant
+ {
+ char *neg_string;
+
+ neg_string = unary_negate_string($2->astnode.constant.number);
+
+ if(!neg_string) {
+ fprintf(stderr, "Error generating negated string (DataConstant)\n");
+ exit(EXIT_FAILURE);
+ }
+
+ free($2->astnode.constant.number);
+ $2->astnode.constant.number = neg_string;
+
+ $$ = $2;
+ }
+;
+
+LhsList: DataLhs
+ {
+ $$ = $1;
+ }
+ | LhsList CM DataLhs
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+DataLhs: Lhs
+ {
+ $$ = $1;
+ }
+ | OP Lhs CM UndeclaredName EQ LoopBounds CP
+ {
+ $6->astnode.forloop.counter = $4;
+ $6->astnode.forloop.Label = $2;
+ $$ = $6;
+ $2->parent = $$;
+ $4->parent = $$;
+ }
+;
+
+LoopBounds: Integer CM Integer
+ {
+ $$ = addnode();
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->nodetype = DataImpliedLoop;
+ $$->astnode.forloop.start = $1;
+ $$->astnode.forloop.stop = $3;
+ $$->astnode.forloop.incr = NULL;
+ }
+ | Integer CM Integer CM Integer
+ {
+ $$ = addnode();
+ $1->parent = $$;
+ $3->parent = $$;
+ $5->parent = $$;
+ $$->nodetype = DataImpliedLoop;
+ $$->astnode.forloop.start = $1;
+ $$->astnode.forloop.stop = $3;
+ $$->astnode.forloop.incr = $5;
+ }
+;
+
+/* Here is where the fun begins. */
+
+/* No newline token here. Newlines have to be dealt with at
+ * a lower level.
+ */
+
+Statements: Statement
+ {
+ $$ = $1;
+ }
+ | Statements Statement
+ {
+ $2->prevstmt = $1;
+ $$ = $2;
+ }
+;
+
+Statement: Assignment NL /* NL has to be here because of parameter dec. */
+ {
+ $$ = $1;
+ $$->nodetype = Assignment;
+ }
+ | Call
+ {
+ $$ = $1;
+ $$->nodetype = Call;
+ }
+ | StmtLabelAssign
+ {
+ $$ = $1;
+ $$->nodetype = StmtLabelAssign;
+ }
+ | Logicalif
+ {
+ $$ = $1;
+ $$->nodetype = Logicalif;
+ }
+ | Arithmeticif
+ {
+ $$ = $1;
+ $$->nodetype = Arithmeticif;
+ }
+ | Blockif
+ {
+ $$ = $1;
+ $$->nodetype = Blockif;
+ }
+ | Doloop
+ {
+ $$ = $1;
+ $$->nodetype = Forloop;
+ }
+ | Return
+ {
+ $$ = $1;
+ $$->nodetype = Return;
+ }
+ | AssignedGoto
+ {
+ $$ = $1;
+ $$->nodetype = AssignedGoto;
+ }
+ | ComputedGoto
+ {
+ $$ = $1;
+ $$->nodetype = ComputedGoto;
+ }
+ | Goto
+ {
+ $$ = $1;
+ $$->nodetype = Goto;
+ }
+ | Label
+ {
+ $$ = $1;
+ $$->nodetype = Label;
+ }
+ | EndDo
+ {
+ $$ = $1;
+ $$->nodetype = Label;
+ }
+ | Continue
+ {
+ $$ = $1;
+ $$->nodetype = Label;
+ }
+ | Write
+ {
+ $$ = $1;
+ $$->nodetype = Write;
+ }
+ | Read
+ {
+ $$ = $1;
+ $$->nodetype = Read;
+ }
+ | Stop
+ {
+ $$ = $1;
+ $$->nodetype = Stop;
+ }
+ | Pause
+ {
+ $$ = $1;
+ $$->nodetype = Pause;
+ }
+ | Open
+ {
+ $$ = $1;
+ $$->nodetype = Unimplemented;
+ }
+ | Close
+ {
+ $$ = $1;
+ $$->nodetype = Unimplemented;
+ }
+ | Comment
+ {
+ $$ = $1;
+ $$->nodetype = Comment;
+ }
+ | Rewind
+ {
+ $$ = $1;
+ $$->nodetype = Unimplemented;
+ }
+;
+
+Comment: COMMENT NL
+ {
+ $$ = addnode();
+ $$->token = COMMENT;
+ $$->nodetype = Comment;
+ $$->astnode.ident.len = 0;
+ strcpy($$->astnode.ident.name, yylval.lexeme);
+ }
+;
+
+Open: OPEN OP Olist CP NL
+ {
+ fprintf(stderr,"Warning: OPEN not implemented.. skipping.\n");
+
+ $$ = addnode();
+ $$->nodetype = Unimplemented;
+ }
+;
+
+Olist: Olist CM OlistItem
+ /* UNIMPLEMENTED */
+ | OlistItem
+ /* UNIMPLEMENTED */
+;
+
+OlistItem: OPEN_UNIT EQ UnitSpec
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | UnitSpec
+ {
+ /* UNIMPLEMENTED */
+ $$ = $1;
+ }
+ | OPEN_IOSTAT EQ Ios
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_ERR EQ Integer
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_FILE EQ CharExp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_STATUS EQ CharExp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_ACCESS EQ CharExp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_FORM EQ CharExp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_RECL EQ Exp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+ | OPEN_BLANK EQ CharExp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $3;
+ }
+;
+
+UnitSpec: Exp
+ {
+ /* UNIMPLEMENTED */
+ $$ = $1;
+ }
+ | STAR
+ {
+ /* UNIMPLEMENTED */
+ $$ = addnode();
+ }
+;
+
+CharExp: UndeclaredName
+ /* UNIMPLEMENTED */
+ | String
+ /* UNIMPLEMENTED */
+;
+
+Ios: UndeclaredName
+ /* UNIMPLEMENTED */
+ | UndeclaredName OP Arrayindexlist CP
+ /* UNIMPLEMENTED */
+;
+
+Close: CLOSE OP UndeclaredName CP NL
+ {
+ fprintf(stderr,"WArning: CLOSE not implemented.\n");
+ $$ = $3;
+ }
+;
+
+Rewind: REWIND UndeclaredName NL
+ {
+ fprintf(stderr,"Warning: REWIND not implemented.\n");
+ $$ = $2;
+ }
+;
+
+End: END NL
+ {
+ $$ = addnode();
+ $$->token = END;
+ $$->nodetype = End;
+ }
+ |
+ Integer END NL
+ {
+ AST *end_temp;
+
+ end_temp = addnode();
+ end_temp->token = END;
+ end_temp->nodetype = End;
+
+ $$ = addnode();
+ end_temp->parent = $$;
+ $$->nodetype = Label;
+ $$->astnode.label.number = atoi($1->astnode.constant.number);
+ $$->astnode.label.stmt = end_temp;
+ free_ast_node($1);
+ }
+;
+
+/*
+ * We have to load up a symbol table here with the names of all the
+ * variables that are passed in as arguments to our function or
+ * subroutine. Also need to pass `namelist' off to a procedure
+ * to load a local variable table for opcode generation.
+ *
+ * i inlined the call to init_tables() because when parsing the
+ * argument list, if some arg matched a name previously defined as
+ * a PARAMETER in some other program unit, then arg_table_load()
+ * would catch that and assume that the Name represented a paramter
+ * and reinitialize the node as if it were a constant. kgs 7/26/00
+ */
+
+Functionargs: OP {init_tables();} Namelist CP
+ {
+ if(debug){
+ printf("Functionargs -> OP Namelist CP\n");
+ }
+ $3 = switchem($3);
+ arg_table_load($3);
+ $$ = $3;
+ }
+ | OP CP
+ {
+ if(debug){
+ printf("Functionargs -> OP Namelist CP\n");
+ }
+ init_tables();
+ $$ = NULL;
+ }
+;
+
+
+Namelist: Name
+ {
+ if(debug){
+ printf("Namelist -> Name\n");
+ }
+ $$=$1;
+ }
+ | Namelist CM Name
+ {
+ if(debug){
+ printf("Namelist -> Namelist CM Name\n");
+ }
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+/*
+ * Somewhere in the actions associated with this production,
+ * I need to ship off the type and variable list to get hashed.
+ * Also need to pass `typevarlist' off to a procedure
+ * to load a local variable table for opcode generation.
+ */
+
+Typestmt: ArithTypes ArithTypevarlist NL
+ {
+ $$ = process_typestmt($1, $2);
+ }
+ | CharTypes CharTypevarlist NL
+ {
+ $$ = process_typestmt($1, $2);
+ }
+;
+
+ArithTypes: ArithSimpleType
+ {
+ $$ = $1;
+ len = 1;
+ }
+ | ArithSimpleType Star Integer
+ {
+ $$ = $1;
+ len = atoi($3->astnode.constant.number);
+ free_ast_node($2);
+ free_ast_node($3);
+ }
+;
+
+ArithSimpleType: ARITH_TYPE
+ {
+ $$ = yylval.type;
+ typedec_context = $$;
+ }
+;
+
+CharTypes: CharSimpleType
+ {
+ $$ = $1;
+ len = 1;
+ }
+ | CharSimpleType Star Integer
+ {
+ $$ = $1;
+ len = atoi($3->astnode.constant.number);
+ free_ast_node($2);
+ free_ast_node($3);
+ }
+ | CharSimpleType Star OP Star CP
+ {
+ $$ = $1;
+ len = -1;
+ free_ast_node($2);
+ free_ast_node($4);
+ }
+;
+
+CharSimpleType: CHAR_TYPE
+ {
+ $$ = yylval.type;
+ typedec_context = $$;
+ }
+;
+
+AnySimpleType: ArithSimpleType
+ {
+ $$ = $1;
+ }
+ | CharSimpleType
+ {
+ $$ = $1;
+ }
+;
+
+AnyTypes: ArithTypes
+ {
+ $$ = $1;
+ }
+ | CharTypes
+ {
+ $$ = $1;
+ }
+;
+
+/* Here I'm going to do the same thing I did with Explist. That is,
+ * each element in the list of typevars will have a parent link to a
+ * single node indicating that the context of the array is a
+ * declaration. --Keith
+ */
+
+ArithTypevarlist: ArithTypevar
+ {
+ $1->parent = addnode();
+ $1->parent->nodetype = Typedec;
+
+ $$ = $1;
+ }
+ | ArithTypevarlist CM ArithTypevar
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ $$ = $3;
+ }
+;
+
+ArithTypevar: Name
+ {
+ $$ = $1;
+ $$->astnode.ident.len = -1;
+ }
+ | Name Star Integer
+ {
+ $$ = $1;
+ $$->astnode.ident.len = atoi($3->astnode.constant.number);
+ }
+ | Arraydeclaration
+ {
+ $$ = $1;
+ $$->astnode.ident.len = -1;
+ }
+;
+
+CharTypevarlist: CharTypevar
+ {
+ $1->parent = addnode();
+ $1->parent->nodetype = Typedec;
+
+ $$ = $1;
+ }
+ | CharTypevarlist CM CharTypevar
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ $$ = $3;
+ }
+;
+
+CharTypevar: Name
+ {
+ $$ = $1;
+ $$->astnode.ident.len = -1;
+ }
+ | Name Star Integer
+ {
+ $$ = $1;
+ $$->astnode.ident.len = atoi($3->astnode.constant.number);
+ }
+ | Name Star OP Star CP
+ {
+ $$ = $1;
+ $$->astnode.ident.len = -1;
+ }
+ | Arraydeclaration
+ {
+ $$ = $1;
+ $$->astnode.ident.len = -1;
+ }
+;
+
+/* Deleted the Type REAL hack... Need to take care of that in the
+ * lexer. This CHAR and STRING stuff is in the wrong place and
+ * needs to get axed. Putting the TYPE back in ...
+ * ^^^^^^^^^^^ it is commented out for now 9-12-97, Keith
+ * moved to 'Constant' production 9-17-97, Keith
+ */
+
+/*
+ * Might have to explicitly set the arraydeclist pointer to
+ * NULL in this action. `Name' gets pointed to by the node
+ * that carries the array information.
+ */
+
+Name: NAME
+ {
+ HASHNODE *hashtemp;
+
+ lowercase(yylval.lexeme);
+
+ if(type_lookup(java_keyword_table,yylval.lexeme))
+ yylval.lexeme[0] = toupper(yylval.lexeme[0]);
+
+
+ /* check if the name we're looking at is defined as a parameter.
+ * if so, instead of inserting an Identifier node here, we're just
+ * going to insert the Constant node that corresponds to
+ * the parameter. normally the only time we'd worry about
+ * such a substitution would be when the ident was the lhs
+ * of some expression, but that should not happen with parameters.
+ *
+ * otherwise, if not a parameter, get a new AST node initialized
+ * with this name.
+ *
+ * added check for null parameter table because this Name could
+ * be reduced before we initialize the tables. that would mean
+ * that this name is the function name, so we dont want this to
+ * be a parameter anyway. kgs 11/7/00
+ *
+ */
+
+
+ if((parameter_table != NULL) &&
+ ((hashtemp = type_lookup(parameter_table,yylval.lexeme)) != NULL))
+ {
+ /* had a problem here just setting $$ = hashtemp->variable
+ * when there's an arraydec with two of the same PARAMETERS
+ * in the arraynamelist, e.g. A(NMAX,NMAX). so, instead we
+ * just copy the relevant fields from the constant node.
+ */
+ if(debug)
+ printf("not calling init name, param %s\n", yylval.lexeme);
+ $$ = addnode();
+ $$->nodetype = hashtemp->variable->nodetype;
+ $$->vartype = hashtemp->variable->vartype;
+ $$->token = hashtemp->variable->token;
+ $$->astnode.constant.number =
+ strdup(hashtemp->variable->astnode.constant.number);
+ }
+ else{
+ if(debug)
+ printf("Name -> NAME\n");
+ $$ = initialize_name(yylval.lexeme);
+ }
+ }
+;
+
+/*
+ * UndeclaredName is similar to Name except that it is used in
+ * contexts where the name is not actually going to be a declared
+ * variable. Thus in Name, we can insert implicitly defined variables
+ * into the hash table, but here in UndeclaredName we do not.
+ */
+
+UndeclaredName: NAME
+ {
+ lowercase(yylval.lexeme);
+
+ $$=addnode();
+ $$->token = NAME;
+ $$->nodetype = Identifier;
+
+ $$->astnode.ident.needs_declaration = FALSE;
+
+ if(omitWrappers)
+ $$->astnode.ident.passByRef = FALSE;
+
+ if(type_lookup(java_keyword_table,yylval.lexeme))
+ yylval.lexeme[0] = toupper(yylval.lexeme[0]);
+
+ strcpy($$->astnode.ident.name, yylval.lexeme);
+ }
+;
+
+UndeclaredNamelist: UndeclaredName
+ {
+ $$=$1;
+ }
+ | UndeclaredNamelist CM UndeclaredName
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+String: STRING
+ {
+ $$=addnode();
+ $$->token = STRING;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup(yylval.lexeme);
+
+ $$->vartype = String;
+ if(debug)
+ printf("**The string value is %s\n",$$->astnode.constant.number);
+ }
+ | CHAR
+ {
+ $$=addnode();
+ $$->token = STRING;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup(yylval.lexeme);
+
+ $$->vartype = String;
+ if(debug)
+ printf("**The char value is %s\n",$$->astnode.constant.number);
+ }
+;
+
+Arraydeclaration: Name OP Arraynamelist CP
+ {
+ $$ = process_array_declaration($1, $3);
+ }
+;
+
+Arraynamelist: Arrayname
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = ArrayDec;
+ $1->parent = temp;
+ if($1->nodetype == ArrayIdxRange) {
+ $1->astnode.expression.lhs->parent = temp;
+ $1->astnode.expression.rhs->parent = temp;
+ }
+
+ $$=$1;
+ }
+ | Arraynamelist CM Arrayname
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ if($3->nodetype == ArrayIdxRange) {
+ $3->astnode.expression.lhs->parent = $1->parent;
+ $3->astnode.expression.rhs->parent = $1->parent;
+ }
+ $$ = $3;
+ }
+;
+
+Arrayname: Exp
+ {
+ $$ = $1;
+ }
+ | Star
+ {
+ $$=$1;
+ }
+ | Exp COLON Exp
+ {
+ $$ = addnode();
+ $$->nodetype = ArrayIdxRange;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+;
+
+/* We reduce STAR here, make changes in the Binaryops
+ * reductions for that. This handles the fortran array
+ * declaration, e.g., array(*).
+ */
+
+Star: STAR
+ {
+ $$=addnode();
+ $$->nodetype = Identifier;
+ *$$->astnode.ident.name = '*';
+ }
+;
+
+StmtLabelAssign: ASSIGN Integer TO Name NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $4->parent = $$;
+ $$->nodetype = StmtLabelAssign;
+ $$->astnode.assignment.lhs = $4;
+ $$->astnode.assignment.rhs = $2;
+
+ /* add this label to the list of assigned labels */
+
+ if(in_dlist_stmt_label(assign_labels, $2) == 0) {
+ if(debug)
+ printf("inserting label num %s in assign_labels list\n",
+ $2->astnode.constant.number);
+ dl_insert_b(assign_labels, $2);
+ }
+ }
+;
+
+/* At some point, I will need to typecheck the `Name' on the left
+ * hand side of this rule in case it has an array form. If it looks like
+ * an array, but it isn't in the array table, that's an error.
+ */
+
+Assignment: Lhs EQ Exp /* NL (Assignment is also used in the parameter
+ * declaration, where it is not followed by a NL.
+ */
+ {
+ $$ = addnode();
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Assignment;
+ $$->astnode.assignment.lhs = $1;
+ $$->astnode.assignment.rhs = $3;
+ }
+;
+
+Lhs: Name
+ {
+ $$=$1;
+ $$->nextstmt = NULL;
+ $$->prevstmt = NULL;
+ }
+ | Name OP Arrayindexlist CP
+ {
+ AST *temp;
+
+ /* Use the following declaration in case we
+ * need to switch index order.
+ *
+ * HASHNODE * hashtemp;
+ */
+
+ $$ = addnode();
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Identifier;
+ $$->prevstmt = NULL;
+ $$->nextstmt = NULL;
+
+ free_ast_node($3->parent);
+ for(temp = $3; temp != NULL; temp = temp->prevstmt)
+ temp->parent = $$;
+
+ strcpy($$->astnode.ident.name, $1->astnode.ident.name);
+
+ /* This is in case we want to switch index order later.
+ *
+ * hashtemp = type_lookup(array_table, $1->astnode.ident.name);
+ * if(hashtemp)
+ * $$->astnode.ident.arraylist = $3;
+ * else
+ * $$->astnode.ident.arraylist = switchem($3);
+ */
+
+ /* We don't switch index order. */
+
+ $$->astnode.ident.arraylist = switchem($3);
+ free_ast_node($1);
+ }
+ | SubstringOp
+ {
+ $$ = $1;
+ }
+;
+
+Arrayindexlist: Exp
+ {
+ $1->parent = addnode();
+ $1->parent->nodetype = Identifier;
+
+ $$ = $1;
+ }
+ | Arrayindexlist CM Exp
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ $$ = $3;
+ }
+;
+
+/* New do loop productions. Entails rewriting in codegen.c
+ * to emit java source code.
+ */
+
+Doloop: Do_incr Do_vals
+ {
+ $$ = $2;
+ $$->nodetype = Forloop;
+ $$->astnode.forloop.Label = $1;
+ }
+;
+
+
+Do_incr: DO Integer
+ {
+ $$ = $2;
+ }
+
+ | DO Integer CM
+ {
+ $$ = $2;
+ }
+ | DO
+ {
+ char *loop_label;
+
+ loop_label = (char *)malloc(32);
+ if(!loop_label) {
+ fprintf(stderr,"Malloc error\n");
+ exit(EXIT_FAILURE);
+ }
+ sprintf(loop_label,"%d", cur_do_label);
+ cur_do_label++;
+
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup(loop_label);
+ $$->vartype = Integer;
+
+ dl_insert_b(do_labels, strdup($$->astnode.constant.number));
+
+ free(loop_label);
+ }
+;
+
+
+Do_vals: Assignment CM Exp NL
+ {
+ AST *counter;
+
+ $$ = addnode();
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $3->parent = $$; /* 9-4-97 - Keith */
+ counter = $$->astnode.forloop.counter = $1->astnode.assignment.lhs;
+ $$->astnode.forloop.start = $1;
+ $$->astnode.forloop.stop = $3;
+ $$->astnode.forloop.incr = NULL;
+ $$->astnode.forloop.iter_expr = gen_iter_expr($1->astnode.assignment.rhs,$3,NULL);
+ $$->astnode.forloop.incr_expr = gen_incr_expr(counter,NULL);
+ }
+ | Assignment CM Exp CM Exp NL
+ {
+ AST *counter;
+
+ $$ = addnode();
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $5->parent = $$; /* 9-4-97 - Keith */
+ counter = $$->astnode.forloop.counter = $1->astnode.assignment.lhs;
+ $$->nodetype = Forloop;
+ $$->astnode.forloop.start = $1;
+ $$->astnode.forloop.stop = $3;
+ $$->astnode.forloop.incr = $5;
+ $$->astnode.forloop.iter_expr = gen_iter_expr($1->astnode.assignment.rhs,$3,$5);
+ $$->astnode.forloop.incr_expr = gen_incr_expr(counter,$5);
+ }
+;
+
+/*
+ * changed the Label production to allow any statement to have
+ * a line number. -- keith
+ */
+Label: Integer Statement
+ {
+ $$ = addnode();
+ $1->parent = $$;
+ $2->parent = $$;
+ $$->nodetype = Label;
+ $$->astnode.label.number = atoi($1->astnode.constant.number);
+ $$->astnode.label.stmt = $2;
+ free_ast_node($1);
+ }
+ | Integer Format NL
+ {
+ /* HASHNODE *newnode; */
+ char *tmpLabel;
+
+ tmpLabel = (char *) f2jalloc(10); /* plenty of space for a f77 label num */
+
+ /* newnode = (HASHNODE *) f2jalloc(sizeof(HASHNODE)); */
+
+ $$ = addnode();
+ $1->parent = $$;
+ $2->parent = $$;
+ $$->nodetype = Format;
+ $$->astnode.label.number = atoi($1->astnode.constant.number);
+ $$->astnode.label.stmt = $2;
+ $2->astnode.label.number = $$->astnode.label.number;
+ if(debug)
+ printf("@@ inserting format line num %d\n",$$->astnode.label.number);
+
+ sprintf(tmpLabel,"%d",$2->astnode.label.number);
+
+ type_insert(format_table,$2,0,tmpLabel);
+ free_ast_node($1);
+ }
+;
+
+/* The following productions for FORMAT parsing are derived
+ * from Robert K. Moniot's grammar (see ftnchek-2.9.4)
+ */
+
+Format: FORMAT OP FormatExplist CP
+ {
+ $$ = addnode();
+ $$->nodetype = Format;
+ $$->astnode.label.stmt = switchem($3);
+ }
+;
+
+FormatExplist: FormatExp
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = Format;
+ $1->parent = temp;
+
+ $$ = $1;
+ }
+ | FormatExplist FormatExp
+ {
+ $1->nextstmt = $2;
+ $2->prevstmt = $1;
+ $2->parent = $1->parent;
+ if(($2->token == REPEAT) && ($1->token == INTEGER)) {
+ $2->astnode.label.number = atoi($1->astnode.constant.number);
+
+ if(debug)
+ printf("## setting number = %s\n", $1->astnode.constant.number);
+ }
+ if(debug) {
+ if($2->token == REPEAT)
+ printf("## $2 is repeat token, $1 = %s ##\n",tok2str($1->token));
+ if($1->token == REPEAT)
+ printf("## $1 is repeat token, $2 = %s ##\n",tok2str($2->token));
+ }
+ $$ = $2;
+ }
+;
+
+FormatExp:
+ RepeatableItem
+ {
+ $$ = $1;
+ }
+ | UnRepeatableItem
+ {
+ $$ = $1;
+ }
+ | FormatSeparator
+ {
+ $$ = $1;
+ }
+;
+
+RepeatableItem: EDIT_DESC /* A, F, I, D, G, E, L, X */
+ {
+ $$ = addnode();
+ $$->token = EDIT_DESC;
+ strcpy($$->astnode.ident.name, yylval.lexeme);
+ }
+ | UndeclaredName
+ {
+ $$ = $1;
+ }
+ | UndeclaredName '.' Constant
+ {
+ /* ignore the constant part for now */
+ free_ast_node($3);
+
+ $$ = $1;
+ }
+ | OP FormatExplist CP
+ {
+ $$ = addnode();
+ $$->token = REPEAT;
+ $$->astnode.label.stmt = switchem($2);
+ if(debug)
+ printf("## setting number = 1\n");
+ $$->astnode.label.number = 1;
+ }
+;
+
+UnRepeatableItem: String
+ {
+ $$ = $1;
+ }
+ | RepeatSpec
+ {
+ $$ = $1;
+ }
+;
+
+FormatSeparator:
+ CM
+ {
+ $$ = addnode();
+ $$->token = CM;
+ }
+ | DIV
+ {
+ $$ = addnode();
+ $$->token = DIV;
+ }
+ | CAT /* CAT is two DIVs "//" */
+ {
+ $$ = addnode();
+ $$->token = CAT;
+ }
+ | COLON
+ {
+ $$ = addnode();
+ $$->token = COLON;
+ }
+;
+
+RepeatSpec: Integer
+ {
+ $$ = $1;
+ }
+ | PLUS Integer
+ {
+ $$ = $2;
+ }
+/*
+ this will stay commented out until I know the
+meaning of a negative repeat specification.
+
+ | MINUS Integer
+ {
+ $$ = $1;
+ }
+*/
+;
+
+Continue: Integer CONTINUE NL
+ {
+ $$ = addnode();
+ $1->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Label;
+ $$->astnode.label.number = atoi($1->astnode.constant.number);
+ $$->astnode.label.stmt = NULL;
+ free_ast_node($1);
+ }
+;
+
+EndDo: ENDDO NL
+ {
+ char *loop_label;
+
+ $$ = addnode();
+ $$->nodetype = Label;
+
+ loop_label = (char *)dl_pop(do_labels);
+
+ $$->astnode.label.number = atoi(loop_label);
+ $$->astnode.label.stmt = NULL;
+ }
+;
+
+Write: WRITE OP WriteFileDesc CM FormatSpec CP IoExplist NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Write;
+ $$->astnode.io_stmt.fmt_list = NULL;
+
+ /* unimplemented
+ $$->astnode.io_stmt.file_desc = ;
+ */
+
+ if($5->nodetype == Constant)
+ {
+ if($5->astnode.constant.number[0] == '*') {
+ $$->astnode.io_stmt.format_num = -1;
+ free_ast_node($5);
+ }
+ else if($5->token == STRING) {
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+ else {
+ $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number);
+ free_ast_node($5);
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+
+ $$->astnode.io_stmt.arg_list = switchem($7);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+
+ /* currently ignoring the file descriptor.. */
+ free_ast_node($3);
+ }
+ | PRINT Integer PrintIoList NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Write;
+ $$->astnode.io_stmt.fmt_list = NULL;
+
+ $$->astnode.io_stmt.format_num = atoi($2->astnode.constant.number);
+ $$->astnode.io_stmt.arg_list = switchem($3);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ free_ast_node($2);
+ }
+ | PRINT STAR PrintIoList NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Write;
+ $$->astnode.io_stmt.fmt_list = NULL;
+
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.arg_list = switchem($3);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ }
+ | PRINT String PrintIoList NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Write;
+ $$->astnode.io_stmt.fmt_list = $2;
+
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.arg_list = switchem($3);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ }
+;
+
+PrintIoList: CM IoExplist
+ {
+ $$ = $2;
+ }
+ | /* empty */
+ {
+ $$ = NULL;
+ }
+;
+
+/* Maybe I'll implement this stuff someday. */
+
+WriteFileDesc:
+ Exp
+ {
+ /* do nothing for now */
+ $$ = $1;
+ }
+ | STAR
+ {
+ /* do nothing for now */
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("*");
+ $$->vartype = Integer;
+ }
+;
+
+FormatSpec:
+ FMT EQ Integer
+ {
+ $$ = $3;
+ }
+ | Integer
+ {
+ $$ = $1;
+ }
+ | FMT EQ STAR
+ {
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("*");
+ $$->vartype = Integer;
+ }
+ | STAR
+ {
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("*");
+ $$->vartype = Integer;
+ }
+ | FMT EQ String
+ {
+ $$ = $3;
+ }
+ | String
+ {
+ $$ = $1;
+ }
+ | FMT EQ UndeclaredName
+ {
+ fprintf(stderr,"Warning - ignoring FMT = %s\n",
+ $3->astnode.ident.name);
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("*");
+ $$->vartype = Integer;
+ }
+;
+
+Read: READ OP WriteFileDesc CM FormatSpec CP IoExplist NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Read;
+ $$->astnode.io_stmt.fmt_list = NULL;
+ $$->astnode.io_stmt.end_num = -1;
+
+ if($5->nodetype == Constant)
+ {
+ if($5->astnode.constant.number[0] == '*') {
+ $$->astnode.io_stmt.format_num = -1;
+ free_ast_node($5);
+ }
+ else if($5->token == STRING) {
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+ else {
+ $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number);
+ free_ast_node($5);
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+
+ $$->astnode.io_stmt.arg_list = switchem($7);
+
+ if($$->astnode.io_stmt.arg_list && $$->astnode.io_stmt.arg_list->parent)
+ free_ast_node($$->astnode.io_stmt.arg_list->parent);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent = $$;
+
+ /* currently ignoring the file descriptor and format spec. */
+ free_ast_node($3);
+ }
+ | READ OP WriteFileDesc CM FormatSpec CM EndSpec CP IoExplist NL
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->astnode.io_stmt.io_type = Read;
+ $$->astnode.io_stmt.fmt_list = NULL;
+
+ if($5->nodetype == Constant)
+ {
+ if($5->astnode.constant.number[0] == '*') {
+ $$->astnode.io_stmt.format_num = -1;
+ free_ast_node($5);
+ }
+ else if($5->token == STRING) {
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+ else {
+ $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number);
+ free_ast_node($5);
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ $$->astnode.io_stmt.format_num = -1;
+ $$->astnode.io_stmt.fmt_list = $5;
+ }
+
+ $$->astnode.io_stmt.end_num = atoi($7->astnode.constant.number);
+ free_ast_node($7);
+
+ $$->astnode.io_stmt.arg_list = switchem($9);
+
+ if($$->astnode.io_stmt.arg_list && $$->astnode.io_stmt.arg_list->parent)
+ free_ast_node($$->astnode.io_stmt.arg_list->parent);
+
+ for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent = $$;
+
+ /* currently ignoring the file descriptor.. */
+ free_ast_node($3);
+ }
+;
+
+IoExplist: IoExp
+ {
+ $1->parent = addnode();
+ $1->parent->nodetype = IoExplist;
+
+ $$ = $1;
+ }
+ | IoExplist CM IoExp
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ $$ = $3;
+ }
+ | /* empty - should this be allowed for READ? */
+ {
+ $$ = NULL;
+ }
+;
+
+IoExp: Exp
+ {
+ $$ = $1;
+ }
+ | OP Explist CM Name EQ Exp CM Exp CP /* implied do loop */
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->nodetype = IoImpliedLoop;
+ $$->astnode.forloop.start = $6;
+ $$->astnode.forloop.stop = $8;
+ $$->astnode.forloop.incr = NULL;
+ $$->astnode.forloop.counter = $4;
+ $$->astnode.forloop.Label = switchem($2);
+ $$->astnode.forloop.iter_expr = gen_iter_expr($6,$8,NULL);
+ $$->astnode.forloop.incr_expr = gen_incr_expr($4,NULL);
+
+ $2->parent = $$;
+ for(temp = $2; temp != NULL; temp = temp->nextstmt)
+ temp->parent = $$;
+ $4->parent = $$;
+ $6->parent = $$;
+ $8->parent = $$;
+ }
+ | OP Explist CM Name EQ Exp CM Exp CM Exp CP /* implied do loop */
+ {
+ AST *temp;
+
+ $$ = addnode();
+ $$->nodetype = IoImpliedLoop;
+ $$->astnode.forloop.start = $6;
+ $$->astnode.forloop.stop = $8;
+ $$->astnode.forloop.incr = $10;
+ $$->astnode.forloop.counter = $4;
+ $$->astnode.forloop.Label = switchem($2);
+ $$->astnode.forloop.iter_expr = gen_iter_expr($6,$8,$10);
+ $$->astnode.forloop.incr_expr = gen_incr_expr($4,$10);
+
+ $2->parent = $$;
+ for(temp = $2; temp != NULL; temp = temp->nextstmt)
+ temp->parent = $$;
+ $4->parent = $$;
+ $6->parent = $$;
+ $8->parent = $$;
+ $10->parent = $$;
+ }
+;
+
+EndSpec: END EQ Integer
+ {
+ $$ = $3;
+ }
+;
+
+/* Got a problem when a Blockif opens with a Blockif. The
+ * first statement of the second Blockif doesn't get into the
+ * tree. Might be able to use do loop for example to fix this.
+ *
+ * --apparently the problem mentioned in the comment above has
+ * been fixed now.
+ */
+
+Blockif: IF OP Exp CP THEN NL IfBlock Elseifs Else EndIf NL
+ {
+ $$ = addnode();
+ $3->parent = $$;
+ if($7 != NULL)
+ $7->parent = $$; /* 9-4-97 - Keith */
+ if($8 != NULL)
+ $8->parent = $$; /* 9-4-97 - Keith */
+ if($9 != NULL)
+ $9->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Blockif;
+ $$->astnode.blockif.conds = $3;
+ $7 = switchem($7);
+ $$->astnode.blockif.stmts = $7;
+
+ /* If there are any `else if' statements,
+ * switchem. Otherwise, NULL pointer checked
+ * in code generating functions.
+ */
+ $8 = switchem($8);
+ $$->astnode.blockif.elseifstmts = $8; /* Might be NULL. */
+ $$->astnode.blockif.elsestmts = $9; /* Might be NULL. */
+
+ $$->astnode.blockif.endif_label = $10->astnode.blockif.endif_label;
+ }
+;
+
+IfBlock: /* Empty. */ {$$=0;} /* if block may be null */
+ | Statements
+ {
+ $$ = $1;
+ }
+;
+
+Elseifs: /* Empty. */ {$$=0;} /* No `else if' statements, NULL pointer. */
+ | Elseif
+ {
+ $$ = $1;
+ }
+ | Elseifs Elseif
+ {
+ $2->prevstmt = $1;
+ $$ = $2;
+ }
+;
+
+
+Elseif: ELSEIF OP Exp CP THEN NL Statements
+ {
+ $$=addnode();
+ $3->parent = $$;
+ $7->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Elseif;
+ $$->astnode.blockif.conds = $3;
+ $$->astnode.blockif.stmts = switchem($7);
+ }
+;
+
+
+Else: /* Empty. */ {$$=0;} /* No `else' statements, NULL pointer. */
+ | ELSE NL Statements
+ {
+ $$=addnode();
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Else;
+ $$->astnode.blockif.stmts = switchem($3);
+ }
+ | ELSE NL
+ {
+ $$ = 0;
+ }
+;
+
+EndIf: ENDIF
+ {
+ if(debug) printf("EndIf\n");
+ $$ = addnode();
+ $$->nodetype = Blockif;
+
+ if(strlen(yylval.lexeme) > 0)
+ $$->astnode.blockif.endif_label = atoi(yylval.lexeme);
+ else
+ $$->astnode.blockif.endif_label = -1;
+ }
+;
+
+Logicalif: IF OP Exp CP Statement
+ {
+ $$ = addnode();
+ $3->parent = $$;
+ $5->parent = $$; /* 9-4-97 - Keith */
+ $$->astnode.logicalif.conds = $3;
+ $$->astnode.logicalif.stmts = $5;
+ }
+;
+
+Arithmeticif: IF OP Exp CP Integer CM Integer CM Integer NL
+ {
+ $$ = addnode();
+ $$->nodetype = Arithmeticif;
+ $3->parent = $$;
+ $5->parent = $$;
+ $7->parent = $$;
+ $9->parent = $$;
+
+ $$->astnode.arithmeticif.cond = $3;
+ $$->astnode.arithmeticif.neg_label = atoi($5->astnode.constant.number);
+ $$->astnode.arithmeticif.zero_label = atoi($7->astnode.constant.number);
+ $$->astnode.arithmeticif.pos_label = atoi($9->astnode.constant.number);
+ free_ast_node($5);
+ free_ast_node($7);
+ free_ast_node($9);
+ }
+;
+
+/*
+ * This _may_ have to be extended to deal with
+ * jasmin opcode. Variables of type array need
+ * to have their arguments emitted in reverse order
+ * so that java can increment in row instead of column
+ * order. So we look each name up in the array table,
+ * it is in there we leave the argument list reversed,
+ * otherwise, it is a subroutine or function (method)
+ * call and we reverse the arguments.
+ *
+ * I don't think the above comment makes sense anymore.
+ * --kgs 7/2007
+ */
+
+Subroutinecall: Name OP Explist CP
+ {
+ $$ = process_subroutine_call($1, $3);
+ }
+;
+
+SubstringOp: Name OP Exp COLON Exp CP
+ {
+ if(debug)
+ printf("SubString! format = c(e1:e2)\n");
+ $$ = addnode();
+ $1->parent = $$;
+ $3->parent = $$;
+ $5->parent = $$;
+ strcpy($$->astnode.ident.name, $1->astnode.ident.name);
+ $$->nodetype = Substring;
+ $$->token = NAME;
+ $$->astnode.ident.startDim[0] = $3;
+ $$->astnode.ident.endDim[0] = $5;
+ free_ast_node($1);
+ }
+ | Name OP COLON Exp CP
+ {
+ if(debug)
+ printf("SubString! format = c(:e2)\n");
+ $$ = addnode();
+ $1->parent = $$;
+ $4->parent = $$;
+ strcpy($$->astnode.ident.name, $1->astnode.ident.name);
+ $$->nodetype = Substring;
+ $$->token = NAME;
+ $$->astnode.ident.startDim[0] = NULL;
+ $$->astnode.ident.endDim[0] = $4;
+ free_ast_node($1);
+ }
+ | Name OP Exp COLON CP
+ {
+ if(debug)
+ printf("SubString! format = c(e1:)\n");
+ $$ = addnode();
+ $1->parent = $$;
+ $3->parent = $$;
+ strcpy($$->astnode.ident.name, $1->astnode.ident.name);
+ $$->nodetype = Substring;
+ $$->token = NAME;
+ $$->astnode.ident.startDim[0] = $3;
+ $$->astnode.ident.endDim[0] = NULL;
+ free_ast_node($1);
+ }
+ | Name OP COLON CP
+ {
+ if(debug)
+ printf("SubString! format = c(:)\n");
+ $$ = addnode();
+ $1->parent = $$;
+ strcpy($$->astnode.ident.name, $1->astnode.ident.name);
+ $$->nodetype = Substring;
+ $$->token = NAME;
+ $$->astnode.ident.startDim[0] = NULL;
+ $$->astnode.ident.endDim[0] = NULL;
+ free_ast_node($1);
+ }
+;
+
+
+/*
+ * What I'm going to try to do here is have each element
+ * of the list linked back to a single node through its
+ * parent pointer. This will allow the code generator
+ * to check the array context (whether it is being used
+ * as part of an external call or part of a call to an
+ * intrinsic function or some other use). --Keith
+ */
+
+Explist: Exp
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = Call;
+ $1->parent = temp;
+
+ $$ = $1;
+ }
+ | Explist CM Exp
+ {
+ $3->prevstmt = $1;
+ $3->parent = $1->parent;
+ $$ = $3;
+ }
+ | /* empty */
+ {
+ $$ = NULL;
+ }
+;
+
+/* This is not exactly right. There will need to
+ * be a struct to handle this.
+ */
+Call: CALL Subroutinecall NL
+ {
+ /* we don't want subroutines in the type_table
+ * make a dlist to stuff the names in and check
+ * them in initialize_name.
+ */
+
+ if(in_dlist(subroutine_names, $2->astnode.ident.name)==0){
+ if(debug){
+ printf("inserting %s in dlist and del from type\n",
+ $2->astnode.ident.name);
+ }
+ dl_insert_b(subroutine_names, strdup($2->astnode.ident.name));
+ hash_delete(type_table, $2->astnode.ident.name);
+ }
+ if(debug){
+ printf("call: %s\n", $2->astnode.ident.name);
+ }
+
+ $$ = $2;
+ $$->nodetype = Call;
+ }
+ | CALL UndeclaredName NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $$->nodetype = Identifier;
+ strcpy($$->astnode.ident.name, $2->astnode.ident.name);
+ $$->astnode.ident.arraylist = addnode();
+ $$->astnode.ident.arraylist->nodetype = EmptyArgList;
+ free_ast_node($2);
+ }
+;
+
+/* again we borrowed from Moniot's grammar....from the Exp production down to
+ * the primary production is from his ftnchek grammar. --keith 2/17/98.
+ */
+
+Exp: log_disjunct
+ {
+ $$ = $1;
+ }
+ | Exp EQV log_disjunct
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->token = EQV;
+ $$->nodetype = Logicalop;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+ | Exp NEQV log_disjunct
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->token = NEQV;
+ $$->nodetype = Logicalop;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+;
+
+log_disjunct: log_term
+ {
+ $$ = $1;
+ }
+ | log_disjunct OR log_term
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->token = OR;
+ $$->nodetype = Logicalop;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+;
+
+log_term: log_factor
+ {
+ $$ = $1;
+ }
+ | log_term AND log_factor
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->token = AND;
+ $$->nodetype = Logicalop;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ }
+;
+
+log_factor: log_primary
+ {
+ $$ = $1;
+ }
+ | NOT log_primary
+ {
+ $$=addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $$->token = NOT;
+ $$->nodetype = Logicalop;
+ $$->astnode.expression.lhs = 0;
+ $$->astnode.expression.rhs = $2;
+ }
+;
+
+log_primary: arith_expr
+ {
+ $$ = $1;
+ }
+ | log_primary RELOP {temptok = yylval.tok;} log_primary
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $4->expr_side = right;
+ $1->parent = $$;
+ $4->parent = $$;
+ $$->nodetype = Relationalop;
+ $$->token = temptok;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $4;
+ }
+;
+
+arith_expr: term
+ {
+ $$ = $1;
+ }
+ | MINUS term
+ {
+ if($2->nodetype == Constant) {
+ char *neg_string;
+
+ neg_string = unary_negate_string($2->astnode.constant.number);
+
+ if(!neg_string) {
+ fprintf(stderr, "Error generating negated string (arith_expr)\n");
+ exit(EXIT_FAILURE);
+ }
+
+ free($2->astnode.constant.number);
+ $2->astnode.constant.number = neg_string;
+
+ $$ = $2;
+ }
+ else {
+ $$ = addnode();
+ $2->parent = $$;
+ $$->astnode.expression.rhs = $2;
+ $$->astnode.expression.lhs = 0;
+ $$->astnode.expression.minus = '-';
+ $$->nodetype = Unaryop;
+ $$->vartype = $2->vartype;
+ }
+ }
+ | PLUS term
+ {
+ if($2->nodetype == Constant) {
+ $$ = $2;
+ }
+ else {
+ $$ = addnode();
+ $2->parent = $$;
+ $$->astnode.expression.rhs = $2;
+ $$->astnode.expression.lhs = 0;
+ $$->astnode.expression.minus = '+';
+ $$->nodetype = Unaryop;
+ $$->vartype = $2->vartype;
+ }
+ }
+ | arith_expr PLUS term
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $$->token = PLUS;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ $$->nodetype = Binaryop;
+ $$->astnode.expression.optype = '+';
+ }
+ | arith_expr MINUS term
+ {
+ $$=addnode();
+ $$->token = MINUS;
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ $$->nodetype = Binaryop;
+ $$->astnode.expression.optype = '-';
+ }
+;
+
+term: factor
+ {
+ $$ = $1;
+ }
+ | term DIV factor
+ {
+ $$=addnode();
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $$->token = DIV;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ $$->nodetype = Binaryop;
+ $$->astnode.expression.optype = '/';
+ }
+ | term STAR factor
+ {
+ $$=addnode();
+
+ $$->token = STAR;
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ $$->nodetype = Binaryop;
+ $$->astnode.expression.optype = '*';
+ }
+;
+
+factor: char_expr
+ {
+ $$ = $1;
+ }
+ | char_expr POW factor
+ {
+ $$=addnode();
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->nodetype = Power;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ }
+;
+
+char_expr: primary
+ {
+ $$ = $1;
+ }
+ | char_expr CAT primary
+ {
+ $$=addnode();
+ $$->token = CAT;
+ $1->expr_side = left;
+ $3->expr_side = right;
+ $1->parent = $$;
+ $3->parent = $$;
+ $$->astnode.expression.lhs = $1;
+ $$->astnode.expression.rhs = $3;
+ $$->vartype = MIN($1->vartype, $3->vartype);
+ $$->nodetype = Binaryop;
+ $$->astnode.expression.optype = '+';
+ }
+;
+
+primary: Name {$$=$1;}
+ | Constant
+ {
+ $$ = $1;
+ }
+ /* | Complex {$$=$1;} */
+ | Subroutinecall {$$=$1;}
+ | SubstringOp {$$=$1;}
+ | OP Exp CP
+ {
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Expression;
+ $$->astnode.expression.parens = TRUE;
+ $$->astnode.expression.rhs = $2;
+ $$->astnode.expression.lhs = NULL;
+ $$->vartype = $2->vartype;
+ }
+;
+
+/*
+Complex: OP Constant CM Constant CP {$$=addnode();}
+;
+*/
+
+/* `TRUE' and `FALSE' have already been typedefed
+ * as BOOLEANs.
+ */
+Boolean: TrUE
+ {
+ $$ = addnode();
+ $$->token = TrUE;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("true");
+ $$->vartype = Logical;
+ }
+ | FaLSE
+ {
+ $$ = addnode();
+ $$->token = FaLSE;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup("false");
+ $$->vartype = Logical;
+ }
+
+;
+
+Constant:
+ Integer
+ {
+ $$ = $1;
+ }
+ | Float
+ {
+ $$ = $1;
+ }
+ | Double
+ {
+ $$ = $1;
+ }
+ | Exponential
+ {
+ $$ = $1;
+ }
+ | Boolean
+ {
+ $$ = $1;
+ }
+ | String /* 9-16-97, keith */
+ {
+ $$ = $1;
+ }
+;
+
+Integer : INTEGER
+ {
+ if(debug)printf("Integer\n");
+ $$ = addnode();
+ $$->token = INTEGER;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup(yylval.lexeme);
+ $$->vartype = Integer;
+ }
+;
+
+Double: DOUBLE
+ {
+ $$ = addnode();
+ $$->token = DOUBLE;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number = strdup(yylval.lexeme);
+ $$->vartype = Double;
+ }
+;
+
+Float: FLOAT
+ {
+ $$ = addnode();
+ $$->token = FLOAT;
+ $$->nodetype = Constant;
+ $$->astnode.constant.number =
+ (char *)malloc(strlen(yylval.lexeme) + 2);
+ strcpy($$->astnode.constant.number, yylval.lexeme);
+ strcat($$->astnode.constant.number, "f");
+ $$->vartype = Float;
+ }
+;
+
+
+/*
+ * Call exp_to_double() to change the 'D' to 'e' for emitting
+ * exponentials in Java source.
+ */
+
+Exponential: E_EXPONENTIAL
+ {
+ char tempname[60];
+
+ $$ = addnode();
+ $$->token = E_EXPONENTIAL;
+ $$->nodetype = Constant;
+ exp_to_double(yylval.lexeme, tempname);
+ $$->astnode.constant.number =
+ (char *)malloc(strlen(tempname) + 2);
+ strcpy($$->astnode.constant.number, tempname);
+ strcat($$->astnode.constant.number, "f");
+ $$->vartype = Float;
+ }
+ | D_EXPONENTIAL
+ {
+ char tempname[60];
+
+ $$ = addnode();
+ $$->token = D_EXPONENTIAL;
+ $$->nodetype = Constant;
+ exp_to_double(yylval.lexeme, tempname);
+ $$->astnode.constant.number = strdup(tempname);
+ $$->vartype = Double;
+ }
+;
+
+/* All the easy productions that work go here. */
+
+Return: RETURN NL
+ {
+ $$= addnode();
+ }
+;
+
+Pause: PAUSE NL
+ {
+ $$ = addnode();
+ $$->nodetype = Pause;
+ $$->astnode.constant.number = strdup("");
+ }
+ | PAUSE String NL
+ {
+ $$ = $2;
+ $$->nodetype = Pause;
+ }
+;
+
+Stop: STOP NL
+ {
+ $$ = addnode();
+ $$->nodetype = Stop;
+ $$->astnode.constant.number = strdup("");
+ }
+ | STOP String NL
+ {
+ $$ = $2;
+ $$->nodetype = Stop;
+ }
+;
+
+Goto: GOTO Integer NL
+ {
+ $$ = addnode();
+ $2->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Goto;
+ if(debug)
+ printf("goto label: %d\n", atoi(yylval.lexeme));
+ $$->astnode.go_to.label = atoi(yylval.lexeme);
+ free_ast_node($2);
+ }
+;
+
+ComputedGoto: GOTO OP Intlist CP Exp NL
+ {
+ $$ = addnode();
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $5->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = ComputedGoto;
+ $$->astnode.computed_goto.name = $5;
+ $$->astnode.computed_goto.intlist = switchem($3);
+ if(debug)
+ printf("Computed go to,\n");
+ }
+ | GOTO OP Intlist CP CM Exp NL
+ {
+ $$ = addnode();
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $6->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = ComputedGoto;
+ $$->astnode.computed_goto.name = $6;
+ $$->astnode.computed_goto.intlist = switchem($3);
+ if(debug)
+ printf("Computed go to,\n");
+ }
+;
+
+AssignedGoto: GOTO Name OP Intlist CP NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $4->parent = $$;
+ $$->nodetype = AssignedGoto;
+ $$->astnode.computed_goto.name = $2;
+ $$->astnode.computed_goto.intlist = switchem($4);
+ if(debug)
+ printf("Assigned go to,\n");
+ }
+ | GOTO Name CM OP Intlist CP NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $5->parent = $$;
+ $$->nodetype = AssignedGoto;
+ $$->astnode.computed_goto.name = $2;
+ $$->astnode.computed_goto.intlist = switchem($5);
+ if(debug)
+ printf("Assigned go to,\n");
+ }
+ | GOTO Name NL
+ {
+ $$ = addnode();
+ $2->parent = $$;
+ $$->nodetype = AssignedGoto;
+ $$->astnode.computed_goto.name = $2;
+ $$->astnode.computed_goto.intlist = NULL;
+ if(debug)
+ printf("Assigned go to (no intlist)\n");
+ }
+;
+
+Intlist: Integer
+ {
+ $$ = $1;
+ }
+ | Intlist CM Integer
+ {
+ $3->prevstmt = $1;
+ $$ = $3;
+ }
+;
+
+Parameter: PARAMETER OP Pdecs CP NL
+ {
+ $$ = addnode();
+ $3->parent = $$; /* 9-4-97 - Keith */
+ $$->nodetype = Specification;
+ $$->astnode.typeunit.specification = Parameter;
+ $$->astnode.typeunit.declist = switchem($3);
+ }
+;
+
+Pdecs: Pdec
+ {
+ $$=$1;
+ }
+ | Pdecs CM Pdec
+ {
+ $3->prevstmt = $1;
+ $$=$3;
+ }
+;
+
+Pdec: Assignment
+ {
+ void add_decimal_point(char *);
+ double constant_eval;
+ HASHNODE *ht;
+ char *cur_id;
+ AST *temp;
+
+ if(debug)
+ printf("Parameter...\n");
+
+ $$ = $1;
+ $$->nodetype = Assignment;
+
+ constant_eval = eval_const_expr($$->astnode.assignment.rhs);
+
+ if(debug) {
+ printf("### constant_eval is %.40g\n", constant_eval);
+ printf("### constant_eval is %.40e\n", constant_eval);
+ }
+
+ temp = addnode();
+ temp->nodetype = Constant;
+
+ ht = type_lookup(type_table, $$->astnode.assignment.lhs->astnode.ident.name);
+
+ if(ht)
+ temp->vartype = ht->variable->vartype;
+ else
+ temp->vartype = $$->astnode.assignment.rhs->vartype;
+
+ switch(temp->vartype) {
+ case String:
+ case Character:
+ temp->token = STRING;
+ temp->astnode.constant.number =
+ strdup($$->astnode.assignment.rhs->astnode.constant.number);
+ break;
+ case Complex:
+ fprintf(stderr,"Pdec: Complex not yet supported.\n");
+ break;
+ case Logical:
+ temp->token = $$->astnode.assignment.rhs->token;
+ temp->astnode.constant.number =
+ strdup(temp->token == TrUE ? "true" : "false");
+ break;
+ case Float:
+ temp->token = FLOAT;
+
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%.40g",constant_eval);
+ add_decimal_point(temp->astnode.constant.number);
+ strcat(temp->astnode.constant.number, "f");
+
+ break;
+ case Double:
+ temp->token = DOUBLE;
+
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%.40g",constant_eval);
+ add_decimal_point(temp->astnode.constant.number);
+
+ break;
+ case Integer:
+ temp->token = INTEGER;
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%d",(int)constant_eval);
+ break;
+ default:
+ fprintf(stderr,"Pdec: bad vartype!\n");
+ }
+
+ free_ast_node($$->astnode.assignment.rhs);
+ $$->astnode.assignment.rhs = temp;
+
+ if(debug)
+ printf("### the constant is '%s'\n",
+ temp->astnode.constant.number);
+
+ cur_id = strdup($$->astnode.assignment.lhs->astnode.ident.name);
+
+ if(type_lookup(java_keyword_table,cur_id))
+ cur_id[0] = toupper(cur_id[0]);
+
+ if(debug)
+ printf("insert param_table %s\n", $$->astnode.assignment.lhs->astnode.ident.name);
+ hash_delete(type_table, $$->astnode.assignment.lhs->astnode.ident.name);
+ type_insert(parameter_table, temp, 0, cur_id);
+ free_ast_node($$->astnode.assignment.lhs);
+ }
+;
+
+External: EXTERNAL UndeclaredNamelist NL
+ {
+ $$=addnode();
+ $2->parent = $$; /* 9-3-97 - Keith */
+ $$->nodetype = Specification;
+ $$->token = EXTERNAL;
+ $$->astnode.typeunit.declist = switchem($2);
+ $$->astnode.typeunit.specification = External;
+ }
+;
+
+Intrinsic: INTRINSIC UndeclaredNamelist NL
+ {
+ $$=addnode();
+ $2->parent = $$; /* 9-3-97 - Keith */
+ $$->nodetype = Specification;
+ $$->token = INTRINSIC;
+ $$->astnode.typeunit.declist = switchem($2);
+ $$->astnode.typeunit.specification = Intrinsic;
+ }
+;
+
+
+%%
+
+
+/*****************************************************************************
+ * *
+ * yyerror *
+ * *
+ * The standard yacc error routine. *
+ * *
+ *****************************************************************************/
+
+void
+yyerror(char *s)
+{
+ extern Dlist file_stack;
+ INCLUDED_FILE *pfile;
+ Dlist tmp;
+
+ if(current_file_info)
+ printf("%s:%d: %s\n", current_file_info->name, lineno, s);
+ else
+ printf("line %d: %s\n", lineno, s);
+
+ dl_traverse_b(tmp, file_stack) {
+ pfile = (INCLUDED_FILE *)dl_val(tmp);
+
+ printf("\tincluded from: %s:%d\n", pfile->name, pfile->line_num);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * add_decimal_point *
+ * *
+ * this is just a hack to compensate for the fact that there's no printf *
+ * specifier that does exactly what we want. assume the given string *
+ * represents a floating point number. if there's no decimal point in the *
+ * string, then append ".0" to it. However, if there's an 'e' in the string *
+ * then javac will interpret it as floating point. The only real problem *
+ * that occurs is when the constant is too big to fit as an integer, but has *
+ * no decimal point, so javac flags it as an error (int constant too big). *
+ * *
+ *****************************************************************************/
+
+void
+add_decimal_point(char *str)
+{
+ BOOL found_dec = FALSE;
+ char *p = str;
+
+ while( *p != '\0' ) {
+ if( *p == '.' ) {
+ found_dec = TRUE;
+ break;
+ }
+
+ if( *p == 'e' )
+ return;
+
+ p++;
+ }
+
+ if(!found_dec)
+ strcat(str, ".0");
+}
+
+/*****************************************************************************
+ * *
+ * addnode *
+ * *
+ * To keep things simple, there is only one type of parse tree node. *
+ * *
+ *****************************************************************************/
+
+AST *
+addnode()
+{
+ return (AST*)f2jcalloc(1,sizeof(AST));
+}
+
+
+/*****************************************************************************
+ * *
+ * switchem *
+ * *
+ * Need to turn the linked list around, *
+ * so that it can traverse forward instead of in reverse. *
+ * What I do here is create a doubly linked list. *
+ * Note that there is no `sentinel' or `head' node *
+ * in this list. It is acyclic and terminates in *
+ * NULL pointers. *
+ * *
+ *****************************************************************************/
+
+AST *
+switchem(AST * root)
+{
+ if(root == NULL)
+ return NULL;
+
+ if (root->prevstmt == NULL)
+ return root;
+
+ while (root->prevstmt != NULL)
+ {
+ root->prevstmt->nextstmt = root;
+ root = root->prevstmt;
+ }
+
+ return root;
+}
+
+/*****************************************************************************
+ * *
+ * assign_array_dims *
+ * *
+ * This is used by DIMENSION and COMMON to set the specified array *
+ * dimensions, possibly in the absence of a type declaration. If we *
+ * haven't seen a delcaration for this variable yet, create a new node. *
+ * Otherwise, assign the array dimensions to the existing node. *
+ * *
+ *****************************************************************************/
+
+void
+assign_array_dims(AST *var)
+{
+ HASHNODE *hash_entry;
+ AST *node;
+ int i;
+
+ hash_entry = type_lookup(type_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ if(debug){
+ printf("Calling initalize name from assign_array_dims\n");
+ }
+
+ node = initialize_name(var->astnode.ident.name);
+
+ /* if it's an intrinsic_named array */
+ if(node->astnode.ident.which_implicit == INTRIN_NAMED_ARRAY_OR_FUNC_CALL){
+ node->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY;
+ type_insert(type_table, node, node->vartype, var->astnode.ident.name);
+ }
+
+ if(debug)
+ printf("assign_array_dims: %s\n", var->astnode.ident.name);
+ }
+
+ node->astnode.ident.localvnum = -1;
+ node->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ node->astnode.ident.dim = var->astnode.ident.dim;
+ node->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ node->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+
+ /* do the same for the array table */
+
+ hash_entry = type_lookup(array_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ node = initialize_name(var->astnode.ident.name);
+ type_insert(array_table, node, node->vartype, var->astnode.ident.name);
+ hash_entry = type_lookup(array_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ fprintf(stderr, "internal error: lookup failed after insert\n");
+ return;
+ }
+ }
+
+ node->astnode.ident.localvnum = -1;
+ node->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ node->astnode.ident.dim = var->astnode.ident.dim;
+ node->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ node->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+}
+
+/*****************************************************************************
+ * *
+ * assign_common_array_dims *
+ * *
+ * For arrays declared in COMMON blocks, we go ahead and assign the *
+ * dimensions in case they aren't dimensioned anywhere else. *
+ * *
+ *****************************************************************************/
+
+void
+assign_common_array_dims(AST *root)
+{
+ AST *Clist, *temp;
+
+ for(Clist = root->astnode.common.nlist; Clist != NULL; Clist = Clist->nextstmt)
+ {
+ for(temp=Clist->astnode.common.nlist; temp!=NULL; temp=temp->nextstmt)
+ {
+ if(temp->astnode.ident.arraylist)
+ assign_array_dims(temp);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * type_hash *
+ * *
+ * For now, type_hash takes a tree (linked list) of type *
+ * declarations from the Decblock rule. It will need to *
+ * get those from Intrinsic, External, Parameter, etc. *
+ * *
+ *****************************************************************************/
+
+void
+type_hash(AST * types)
+{
+ HASHNODE *hash_entry;
+ AST * temptypes, * tempnames;
+ int return_type;
+
+ /* Outer for loop traverses typestmts, inner for()
+ * loop traverses declists. Code for stuffing symbol table is
+ * is in inner for() loop.
+ */
+ for (temptypes = types; temptypes; temptypes = temptypes->nextstmt)
+ {
+ /* Long assignment, set up the for() loop here instead of
+ the expression list. */
+ tempnames = temptypes->astnode.typeunit.declist;
+
+ /* Need to set the return value here before entering
+ the next for() loop. */
+ return_type = temptypes->astnode.typeunit.returns;
+
+ if(debug)
+ printf("type_hash(): type dec is %s\n", print_nodetype(temptypes));
+
+ if(temptypes->nodetype == CommonList) {
+ assign_common_array_dims(temptypes);
+ continue;
+ }
+
+ /* skip parameter statements and data statements */
+ if(( (temptypes->nodetype == Specification) &&
+ (temptypes->astnode.typeunit.specification == Parameter))
+ || (temptypes->nodetype == DataList))
+ continue;
+
+ for (; tempnames; tempnames = tempnames->nextstmt)
+ {
+ int i;
+
+ /* ignore parameter assignment stmts */
+ if((tempnames->nodetype == Assignment) ||
+ (tempnames->nodetype == DataStmt))
+ continue;
+
+ /* Stuff names and return types into the symbol table. */
+ if(debug)
+ printf("Type hash: '%s' (%s)\n", tempnames->astnode.ident.name,
+ print_nodetype(tempnames));
+
+ if(temptypes->nodetype == Dimension)
+ assign_array_dims(tempnames);
+ else {
+ /* check whether there is already an array declaration for this ident.
+ * this would be true in case of a normal type declaration with array
+ * declarator, in which case we'll do a little extra work here. but
+ * for idents that were previously dimensioned, we need to get this
+ * info out of the table.
+ */
+
+ hash_entry = type_lookup(array_table,tempnames->astnode.ident.name);
+ if(hash_entry) {
+ AST *var = hash_entry->variable;
+
+ tempnames->astnode.ident.localvnum = -1;
+ tempnames->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ tempnames->astnode.ident.dim = var->astnode.ident.dim;
+ tempnames->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ tempnames->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ tempnames->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+ }
+ if((temptypes->token != INTRINSIC) && (temptypes->token != EXTERNAL))
+ {
+ hash_entry = type_lookup(type_table,tempnames->astnode.ident.name);
+
+ if(hash_entry == NULL) {
+ tempnames->vartype = return_type;
+ tempnames->astnode.ident.localvnum = -1;
+
+ if(debug){
+ printf("hh type_insert: %s\n", tempnames->astnode.ident.name);
+ }
+
+ type_insert(type_table, tempnames, return_type,
+ tempnames->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (non-external): %s\n",
+ tempnames->astnode.ident.name);
+ }
+ else {
+ if(debug) {
+ printf("type_hash: Entry already exists...");
+ printf("going to override the type.\n");
+ }
+ hash_entry->variable->vartype = tempnames->vartype;
+ }
+ }
+ }
+
+ /* Now separate out the EXTERNAL from the INTRINSIC on the
+ * fortran side.
+ */
+
+ if(temptypes != NULL) {
+ AST *newnode;
+
+ /* create a new node to stick into the intrinsic/external table
+ * so that the type_table isn't pointing to the same node.
+ */
+ newnode = addnode();
+ strcpy(newnode->astnode.ident.name,tempnames->astnode.ident.name);
+ newnode->vartype = return_type;
+ newnode->nodetype = Identifier;
+
+ switch (temptypes->token)
+ {
+ case INTRINSIC:
+ type_insert(intrinsic_table,
+ newnode, return_type, newnode->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (INTRINSIC): %s\n",
+ newnode->astnode.ident.name);
+
+ break;
+ case EXTERNAL:
+ type_insert(external_table,
+ newnode, return_type, newnode->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (EXTERNAL): %s\n",
+ newnode->astnode.ident.name);
+
+ break;
+ default:
+ /* otherwise free the node that we didn't use. */
+ free_ast_node(newnode);
+ break; /* ansi thing */
+
+ } /* Close switch(). */
+ }
+ } /* Close inner for() loop. */
+ } /* Close outer for() loop. */
+} /* Close type_hash(). */
+
+
+/*****************************************************************************
+ * *
+ * exp_to_double *
+ * *
+ * Java recognizes numbers of the form 1.0e+1, so the `D' and `d' need *
+ * to be replaced with 'e'. *
+ * *
+ *****************************************************************************/
+
+void
+exp_to_double (char *lexeme, char *temp)
+{
+ char *cp = lexeme;
+
+ while (*cp) /* While *cp != '\0'... */
+ {
+ if (*cp == 'd' || /* sscanf can recognize 'E'. */
+ *cp == 'D')
+ {
+ *cp = 'e'; /* Replace the 'd' or 'D' with 'e'. */
+ break; /* Should be only one 'd', 'D', etc. */
+ }
+ cp++; /* Examine the next character. */
+ }
+
+ /* Java should be able to handle exponential notation as part
+ * of the float or double constant.
+ */
+
+ strcpy(temp,lexeme);
+} /* Close exp_to_double(). */
+
+
+/*****************************************************************************
+ * *
+ * arg_table_load *
+ * *
+ * Initialize and fill a table with the names of the *
+ * variables passed in as arguments to the function or *
+ * subroutine. This table is later checked when variable *
+ * types are declared so that variables are not declared *
+ * twice. *
+ * *
+ *****************************************************************************/
+
+void
+arg_table_load(AST * arglist)
+{
+ AST * temp;
+
+ /* We traverse down `prevstmt' because the arglist is
+ * built with right recursion, i.e. in reverse. This
+ * procedure, 'arg_table_load()' is called when the non-
+ * terminal `functionargs' is reduced, before the
+ * argument list is reversed. Note that a NULL pointer
+ * at either end of the list terminates the for() loop.
+ */
+
+ for(temp = arglist; temp; temp = temp->nextstmt)
+ {
+ type_insert(args_table, temp, 0, temp->astnode.ident.name);
+ if(debug)
+ printf("#@Arglist var. name: %s\n", temp->astnode.ident.name);
+ }
+}
+
+
+/*****************************************************************************
+ * *
+ * lowercase *
+ * *
+ * This function takes a string and converts all characters to *
+ * lowercase. *
+ * *
+ *****************************************************************************/
+
+char * lowercase(char * name)
+{
+ char *ptr = name;
+
+ while (*name)
+ {
+ *name = tolower(*name);
+ name++;
+ }
+
+ return ptr;
+}
+
+/*****************************************************************************
+ * *
+ * store_array_var *
+ * *
+ * We need to make a table of array variables, because *
+ * fortran accesses arrays by columns instead of rows *
+ * as C and java does. During code generation, the array *
+ * variables are emitted in reverse to get row order. *
+ * *
+ *****************************************************************************/
+
+void
+store_array_var(AST * var)
+{
+
+ if(type_lookup(array_table, var->astnode.ident.name) != NULL)
+ fprintf(stderr,"Error: more than one array declarator for array '%s'\n",
+ var->astnode.ident.name);
+ else
+ type_insert(array_table, var, 0, var->astnode.ident.name);
+
+ if(debug)
+ printf("Array name: %s\n", var->astnode.ident.name);
+}
+
+/*****************************************************************************
+ * *
+ * mypow *
+ * *
+ * Double power function. writing this here so that we *
+ * dont have to link in the math library. *
+ * *
+ *****************************************************************************/
+
+double
+mypow(double x, double y)
+{
+ double result;
+ int i;
+
+ if(y < 0)
+ {
+ fprintf(stderr,"Warning: got negative exponent in mypow!\n");
+ return 0.0;
+ }
+
+ if(y == 0)
+ return 1.0;
+
+ if(y == 1)
+ return x;
+
+ result = x;
+
+ for(i=0;i<y-1;i++)
+ result *= x;
+
+ return result;
+}
+
+/*****************************************************************************
+ * *
+ * init_tables *
+ * *
+ * This function initializes all the symbol tables we'll need during *
+ * parsing and code generation. *
+ * *
+ *****************************************************************************/
+
+void
+init_tables()
+{
+ if(debug)
+ printf("Initializing tables.\n");
+
+ initialize_implicit_table(implicit_table);
+ array_table = (SYMTABLE *) new_symtable(211);
+ format_table = (SYMTABLE *) new_symtable(211);
+ data_table = (SYMTABLE *) new_symtable(211);
+ save_table = (SYMTABLE *) new_symtable(211);
+ common_table = (SYMTABLE *) new_symtable(211);
+ parameter_table = (SYMTABLE *) new_symtable(211);
+ type_table = (SYMTABLE *) new_symtable(211);
+ intrinsic_table = (SYMTABLE *) new_symtable(211);
+ external_table = (SYMTABLE *) new_symtable(211);
+ args_table = (SYMTABLE *) new_symtable(211);
+ constants_table = make_dl();
+ assign_labels = make_dl();
+ equivList = NULL;
+ save_all = FALSE;
+
+ cur_do_label = 1000000;
+
+ subroutine_names = make_dl();
+ do_labels = make_dl();
+}
+
+/*****************************************************************************
+ * *
+ * merge_common_blocks *
+ * *
+ * In Fortran, different declarations of the same COMMON block may use *
+ * differently named variables. Since f2j is going to generate only one *
+ * class file to represent the COMMON block, we can only use one of these *
+ * variable names. What we attempt to do here is take the different names *
+ * and merge them into one name, which we use wherever that common variable *
+ * is used. *
+ * *
+ *****************************************************************************/
+
+void
+merge_common_blocks(AST *root)
+{
+ HASHNODE *ht;
+ AST *Clist, *temp;
+ int count;
+ char ** name_array;
+ char *comvar = NULL, *var, und_var[80],
+ var_und[80], und_var_und[80], *t;
+
+ for(Clist = root; Clist != NULL; Clist = Clist->nextstmt)
+ {
+ /*
+ * First check whether this common block is already in
+ * the table.
+ */
+
+ ht=type_lookup(common_block_table,Clist->astnode.common.name);
+
+ for(temp=Clist->astnode.common.nlist, count = 0;
+ temp!=NULL; temp=temp->nextstmt)
+ count++;
+
+ name_array = (char **) f2jalloc( count * sizeof(name_array) );
+
+ /* foreach COMMON variable */
+
+ for(temp=Clist->astnode.common.nlist, count = 0;
+ temp!=NULL; temp=temp->nextstmt, count++)
+ {
+ var = temp->astnode.ident.name;
+
+ /* to merge two names we concatenate the second name
+ * to the first name, separated by an underscore.
+ */
+
+ if(ht != NULL) {
+ comvar = ((char **)ht->variable)[count];
+ und_var[0] = '_';
+ und_var[1] = 0;
+ strcat(und_var,var);
+ strcpy(var_und,var);
+ strcat(var_und,"_");
+ strcpy(und_var_und,und_var);
+ strcat(und_var_und,"_");
+ }
+
+ if(ht == NULL) {
+ name_array[count] = (char *) f2jalloc( strlen(var) + 1 );
+ strcpy(name_array[count], var);
+ }
+ else {
+ if(!strcmp(var,comvar) ||
+ strstr(comvar,und_var_und) ||
+ (((t=strstr(comvar,var_und)) != NULL) && t == comvar) ||
+ (((t=strstr(comvar,und_var)) != NULL) &&
+ (t+strlen(t) == comvar+strlen(comvar))))
+ {
+ name_array[count] = (char *) f2jalloc( strlen(comvar) + 1 );
+ strcpy(name_array[count], comvar);
+ }
+ else {
+ name_array[count] = (char *) f2jalloc(strlen(temp->astnode.ident.name)
+ + strlen(((char **)ht->variable)[count]) + 2);
+
+ strcpy(name_array[count],temp->astnode.ident.name);
+ strcat(name_array[count],"_");
+ strcat(name_array[count],((char **)ht->variable)[count]);
+ }
+ }
+ }
+
+ type_insert(common_block_table, (AST *)name_array, Float,
+ Clist->astnode.common.name);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * addEquiv *
+ * *
+ * Insert the given node (which is itself a list of variables) into a list *
+ * of equivalences. We end up with a list of lists. *
+ * *
+ *****************************************************************************/
+
+void
+addEquiv(AST *node)
+{
+ static int id = 1;
+
+ /* if the list is NULL, create one */
+
+ if(equivList == NULL) {
+ equivList = addnode();
+ equivList->nodetype = Equivalence;
+ equivList->token = id++;
+ equivList->nextstmt = NULL;
+ equivList->prevstmt = NULL;
+ equivList->astnode.equiv.clist = node;
+ }
+ else {
+ AST *temp = addnode();
+
+ temp->nodetype = Equivalence;
+ temp->token = id++;
+ temp->astnode.equiv.clist = node;
+
+ temp->nextstmt = equivList;
+ temp->prevstmt = NULL;
+
+ equivList = temp;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * eval_const_expr *
+ * *
+ * This function evaluates a floating-point expression which should consist *
+ * of only parameters and constants. The floating-point result is returned. *
+ * *
+ *****************************************************************************/
+
+double
+eval_const_expr(AST *root)
+{
+ HASHNODE *p;
+ double result1, result2;
+
+ if(root == NULL)
+ return 0.0;
+
+ switch (root->nodetype)
+ {
+ case Identifier:
+ if(!strcmp(root->astnode.ident.name,"*"))
+ return 0.0;
+
+ p = type_lookup(parameter_table, root->astnode.ident.name);
+
+ if(p)
+ {
+ if(p->variable->nodetype == Constant) {
+ root->vartype = p->variable->vartype;
+ return ( atof(p->variable->astnode.constant.number) );
+ }
+ }
+
+ /* else p==NULL, then the array size is specified with a
+ * variable, but we cant find it in the parameter table.
+ * it is probably an argument to the function. do nothing
+ * here, just fall through and hit the 'return 0' below. --keith
+ */
+
+ return 0.0;
+
+ case Expression:
+ if (root->astnode.expression.lhs != NULL)
+ eval_const_expr (root->astnode.expression.lhs);
+
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+
+ root->token = root->astnode.expression.rhs->token;
+
+ root->vartype = root->astnode.expression.rhs->vartype;
+
+ return (result2);
+
+ case Power:
+ result1 = eval_const_expr (root->astnode.expression.lhs);
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ return( mypow(result1,result2) );
+
+ case Binaryop:
+ result1 = eval_const_expr (root->astnode.expression.lhs);
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ if(root->astnode.expression.optype == '-')
+ return (result1 - result2);
+ else if(root->astnode.expression.optype == '+')
+ return (result1 + result2);
+ else if(root->astnode.expression.optype == '*')
+ return (result1 * result2);
+ else if(root->astnode.expression.optype == '/')
+ return (result1 / result2);
+ else
+ fprintf(stderr,"eval_const_expr: Bad optype!\n");
+ return 0.0;
+
+ case Unaryop:
+ root->vartype = root->astnode.expression.rhs->vartype;
+ /*
+ result1 = eval_const_expr (root->astnode.expression.rhs);
+ if(root->astnode.expression.minus == '-')
+ return -result1;
+ */
+ break;
+ case Constant:
+ if(debug)
+ printf("### its a constant.. %s\n", root->astnode.constant.number);
+
+ if(root->token == STRING) {
+ if(!strcmp(root->astnode.ident.name,"*"))
+ return 0.0;
+ else
+ fprintf (stderr, "String in array dec (%s)!\n",
+ root->astnode.constant.number);
+ }
+ else
+ return( atof(root->astnode.constant.number) );
+ break;
+ case ArrayIdxRange:
+ /* I dont think it really matters what the type of this node is. --kgs */
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ return( eval_const_expr(root->astnode.expression.rhs) -
+ eval_const_expr(root->astnode.expression.lhs) );
+
+ case Logicalop:
+ {
+ int lhs=0, rhs;
+
+ root->nodetype = Constant;
+ root->vartype = Logical;
+
+ eval_const_expr(root->astnode.expression.lhs);
+ eval_const_expr(root->astnode.expression.rhs);
+
+ if(root->token != NOT)
+ lhs = root->astnode.expression.lhs->token == TrUE;
+ rhs = root->astnode.expression.rhs->token == TrUE;
+
+ switch (root->token) {
+ case EQV:
+ root->token = (lhs == rhs) ? TrUE : FaLSE;
+ break;
+ case NEQV:
+ root->token = (lhs != rhs) ? TrUE : FaLSE;
+ break;
+ case AND:
+ root->token = (lhs && rhs) ? TrUE : FaLSE;
+ break;
+ case OR:
+ root->token = (lhs || rhs) ? TrUE : FaLSE;
+ break;
+ case NOT:
+ root->token = (! rhs) ? TrUE : FaLSE;
+ break;
+ }
+ return (double)root->token;
+ }
+
+ default:
+ fprintf(stderr,"eval_const_expr(): bad nodetype!\n");
+ return 0.0;
+ }
+ return 0.0;
+}
+
+void
+printbits(char *header, void *var, int datalen)
+{
+ int i;
+
+ printf("%s: ", header);
+ for(i=0;i<datalen;i++) {
+ printf("%1x", ((unsigned char *)var)[i] >> 7 );
+ printf("%1x", ((unsigned char *)var)[i] >> 6 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 5 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 4 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 3 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 2 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 1 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] & 1 );
+ }
+ printf("\n");
+}
+
+/*****************************************************************************
+ * *
+ * unary_negate_string *
+ * *
+ * This function accepts a string and prepends a '-' in front of it. *
+ * *
+ *****************************************************************************/
+
+char *
+unary_negate_string(char *num)
+{
+ char *tempstr, *mchar;
+
+ /* allocate enough for the number, minus sign, and null char */
+ tempstr = (char *)f2jalloc(strlen(num) + 5);
+
+ if(!tempstr) return NULL;
+
+ strcpy(tempstr, num);
+
+ if((mchar = first_char_is_minus(tempstr)) != NULL) {
+ *mchar = ' ';
+ return tempstr;
+ }
+
+ strcpy(tempstr,"-");
+ strcat(tempstr,num);
+
+ return tempstr;
+}
+
+/*****************************************************************************
+ * *
+ * first_char_is_minus *
+ * *
+ * Determines whether the number represented by this string is negative. *
+ * If negative, this function returns a pointer to the minus sign. if non- *
+ * negative, returns NULL. *
+ * *
+ *****************************************************************************/
+
+char *
+first_char_is_minus(char *num)
+{
+ char *ptr = num;
+
+ while( *ptr ) {
+ if( *ptr == '-' )
+ return ptr;
+ if( *ptr != ' ' )
+ return NULL;
+ ptr++;
+ }
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * gen_incr_expr *
+ * *
+ * this function creates an AST sub-tree representing a calculation of the *
+ * increment for this loop. for null increments, add one. for non-null *
+ * increments, add the appropriate value.
+ * *
+ *****************************************************************************/
+
+AST *
+gen_incr_expr(AST *counter, AST *incr)
+{
+ AST *plus_node, *const_node, *assign_node, *lhs_copy, *rhs_copy, *incr_copy;
+
+ lhs_copy = addnode();
+ memcpy(lhs_copy, counter, sizeof(AST));
+ rhs_copy = addnode();
+ memcpy(rhs_copy, counter, sizeof(AST));
+
+ if(incr == NULL) {
+ const_node = addnode();
+ const_node->token = INTEGER;
+ const_node->nodetype = Constant;
+ const_node->astnode.constant.number = strdup("1");
+ const_node->vartype = Integer;
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ rhs_copy->parent = plus_node;
+ const_node->parent = plus_node;
+ plus_node->astnode.expression.lhs = rhs_copy;
+ plus_node->astnode.expression.rhs = const_node;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+ }
+ else {
+ incr_copy = addnode();
+ memcpy(incr_copy, incr, sizeof(AST));
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ rhs_copy->parent = plus_node;
+ incr_copy->parent = plus_node;
+ plus_node->astnode.expression.lhs = rhs_copy;
+ plus_node->astnode.expression.rhs = incr_copy;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+ }
+
+ assign_node = addnode();
+ assign_node->nodetype = Assignment;
+ lhs_copy->parent = assign_node;
+ plus_node->parent = assign_node;
+ assign_node->astnode.assignment.lhs = lhs_copy;
+ assign_node->astnode.assignment.rhs = plus_node;
+
+ return assign_node;
+}
+
+/*****************************************************************************
+ * *
+ * gen_iter_expr *
+ * *
+ * this function creates an AST sub-tree representing a calculation of the *
+ * number of iterations of a DO loop: *
+ * (stop-start+incr)/incr *
+ * the full expression is MAX(INT((stop-start+incr)/incr),0) but we will *
+ * worry about the rest of it at code generation time. *
+ * *
+ *****************************************************************************/
+
+AST *
+gen_iter_expr(AST *start, AST *stop, AST *incr)
+{
+ AST *minus_node, *plus_node, *div_node, *expr_node, *incr_node;
+
+ minus_node = addnode();
+ minus_node->token = MINUS;
+ minus_node->astnode.expression.lhs = stop;
+ minus_node->astnode.expression.rhs = start;
+ minus_node->nodetype = Binaryop;
+ minus_node->astnode.expression.optype = '-';
+
+ if(incr == NULL) {
+ incr_node = addnode();
+ incr_node->token = INTEGER;
+ incr_node->nodetype = Constant;
+ incr_node->astnode.constant.number = strdup("1");
+ incr_node->vartype = Integer;
+ }
+ else
+ incr_node = incr;
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ plus_node->astnode.expression.lhs = minus_node;
+ plus_node->astnode.expression.rhs = incr_node;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+
+ if(incr == NULL)
+ return plus_node;
+
+ expr_node = addnode();
+ expr_node->nodetype = Expression;
+ expr_node->astnode.expression.parens = TRUE;
+ expr_node->astnode.expression.rhs = plus_node;
+ expr_node->astnode.expression.lhs = NULL;
+
+ div_node = addnode();
+ div_node->token = DIV;
+ div_node->astnode.expression.lhs = expr_node;
+ div_node->astnode.expression.rhs = incr_node;
+ div_node->nodetype = Binaryop;
+ div_node->astnode.expression.optype = '/';
+
+ return div_node;
+}
+
+/*****************************************************************************
+ * *
+ * initialize_name *
+ * *
+ * this function initializes an Identifier node with the given name. *
+ * *
+ *****************************************************************************/
+
+AST *
+initialize_name(char *id)
+{
+ HASHNODE *hashtemp;
+ AST *tmp, *tnode;
+ char *tempname;
+
+ if(debug)
+ printf("initialize_name: '%s'\n",id);
+
+ tmp=addnode();
+ tmp->token = NAME;
+ tmp->nodetype = Identifier;
+
+ tmp->astnode.ident.needs_declaration = FALSE;
+ tmp->astnode.ident.explicit = FALSE;
+ tmp->astnode.ident.which_implicit = INTRIN_NOT_NAMED;
+ tmp->astnode.ident.localvnum = -1;
+ tmp->astnode.ident.array_len = -1;
+
+ if(omitWrappers)
+ tmp->astnode.ident.passByRef = FALSE;
+
+ if(type_lookup(java_keyword_table,id))
+ id[0] = toupper(id[0]);
+
+ strcpy(tmp->astnode.ident.name, id);
+ tempname = strdup(tmp->astnode.ident.name);
+ uppercase(tempname);
+
+ if((type_lookup(parameter_table, tmp->astnode.ident.name) == NULL) &&
+ (in_dlist(subroutine_names, tmp->astnode.ident.name) == 0))
+ {
+ if(type_table) {
+ hashtemp = type_lookup(type_table, tmp->astnode.ident.name);
+ if(hashtemp)
+ {
+ if(debug)
+ printf("initialize_name:'%s' in already hash table (type=%s)..\n",
+ id, returnstring[hashtemp->variable->vartype]);
+
+ tmp->vartype = hashtemp->variable->vartype;
+
+ if(debug)
+ printf("now type is %s\n", returnstring[tmp->vartype]);
+
+ tmp->astnode.ident.len = hashtemp->variable->astnode.ident.len;
+ }
+ else
+ {
+ enum returntype ret;
+
+ if(debug)
+ printf("initialize_name:cannot find name %s in hash table..\n",id);
+
+ if(methodscan(intrinsic_toks, tempname) != NULL) {
+ tmp->astnode.ident.which_implicit =
+ intrinsic_or_implicit(tmp->astnode.ident.name);
+ }
+
+ ret = implicit_table[tolower(id[0]) - 'a'].type;
+
+ if(debug)
+ printf("initialize_name:insert with default implicit type %s\n",
+ returnstring[ret]);
+
+ tmp->vartype = ret;
+
+ if(debug)
+ printf("type_insert: %s %d\n", tmp->astnode.ident.name,
+ tmp->nodetype);
+
+ /* clone the ast node before inserting into the table */
+ tnode = clone_ident(tmp);
+ tnode->nodetype = Identifier;
+
+ if(tmp->astnode.ident.which_implicit !=
+ INTRIN_NAMED_ARRAY_OR_FUNC_CALL)
+ {
+ if(debug)
+ printf("insert typetable init name\n");
+
+ type_insert(type_table, tnode, ret, tnode->astnode.ident.name);
+ }
+ }
+ }
+ }
+
+ return tmp;
+}
+
+/*****************************************************************************
+* *
+* intrinsic_or_implict *
+* *
+* Only gets called if it is an intrinsic name. *
+* *
+* this functions tries to figure out if it's intrinsic call, array *
+* or variable. *
+* *
+******************************************************************************/
+
+int
+intrinsic_or_implicit(char *name)
+{
+ char *p, *tempname, *space_buffer, *clean_buffer, *tmp_spot;
+ char *words[12] = {"INTEGER", "DOUBLEPRECISION", "CHARACTER", "DATA",
+ "PARAMETER", "LOGICAL", "INTRINSIC", "EXTERNAL",
+ "SAVE", "IMPLICIT", "DIMENSION", "CALL"};
+ int i, ret_val = INTRIN_NAMED_VARIABLE;
+
+ tempname = (char *)malloc((strlen(name)+2)*sizeof(char));
+ space_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char));
+ clean_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char));
+
+ strcpy(tempname, name);
+ uppercase(tempname);
+ strcat(tempname, "(");
+
+ uppercase(line_buffer);
+
+ tmp_spot = line_buffer;
+ for(i=0; i<12; i++) {
+ if(!strncmp(line_buffer, words[i], strlen(words[i]))) {
+ tmp_spot = line_buffer + strlen(words[i]);
+ break;
+ }
+ }
+ strcpy(clean_buffer, " \0");
+ strcat(clean_buffer, tmp_spot);
+
+ p = strstr(clean_buffer, tempname);
+ while(p) {
+ if((p)&&(!isalpha((int)*(p-1)))) {
+ ret_val=INTRIN_NAMED_ARRAY_OR_FUNC_CALL;
+ break;
+ }
+ for(i=0; i< strlen(tempname); i++)
+ p++;
+ strcpy(space_buffer, " \0");
+ strcat(space_buffer, p);
+ p = strstr(space_buffer, tempname);
+ }
+
+ free(space_buffer);
+ free(clean_buffer);
+ free(tempname);
+
+ return ret_val;
+}
+
+/*****************************************************************************
+ * *
+ * print_sym_table_names *
+ * *
+ * Routine to see what's in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+print_sym_table_names(SYMTABLE *table){
+ Dlist t_table, tmp;
+ AST *node;
+
+ t_table = enumerate_symtable(table);
+ dl_traverse(tmp, t_table){
+
+ node = (AST *)dl_val(tmp);
+ printf("sym_table %s\n", node->astnode.ident.name);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * insert_name *
+ * *
+ * this function inserts the given node into the symbol table, if it is not *
+ * already there. *
+ * *
+ *****************************************************************************/
+
+void
+insert_name(SYMTABLE * tt, AST *node, enum returntype ret)
+{
+ HASHNODE *hash_entry;
+
+ hash_entry = type_lookup(tt,node->astnode.ident.name);
+
+ if(hash_entry == NULL)
+ node->vartype = ret;
+ else
+ node->vartype = hash_entry->variable->vartype;
+
+ type_insert(tt, node, node->vartype, node->astnode.ident.name);
+}
+
+
+/*****************************************************************************
+ * *
+ * initialize_implicit_table *
+ * *
+ * this function the implicit table, which indicates the implicit typing for *
+ * the current program unit (i.e. which letters correspond to which data *
+ * type). *
+ * *
+ *****************************************************************************/
+
+void
+initialize_implicit_table(ITAB_ENTRY *itab)
+{
+ int i;
+
+ /* first initialize everything to float */
+ for(i = 0; i < 26; i++) {
+ itab[i].type = Float;
+ itab[i].declared = FALSE;
+ }
+
+ /* then change 'i' through 'n' to Integer */
+ for(i = 'i' - 'a'; i <= 'n' - 'a'; i++)
+ itab[i].type = Integer;
+}
+
+/*****************************************************************************
+ * *
+ * add_implicit_to_tree *
+ * *
+ * this adds a node for an implicit variable to typedec *
+ * *
+ *****************************************************************************/
+
+void
+add_implicit_to_tree(AST *typedec)
+{
+ Dlist t_table, tmp;
+ AST *ast, *new_node, *last_typedec;
+
+ last_typedec = typedec;
+ while(last_typedec->nextstmt!=NULL) {
+ last_typedec = last_typedec->nextstmt;
+ }
+
+ t_table = enumerate_symtable(type_table);
+ dl_traverse(tmp, t_table) {
+ ast = (AST *)dl_val(tmp);
+ if(ast->astnode.ident.explicit == FALSE) {
+ if(debug)printf("implicit name=%s\n", ast->astnode.ident.name);
+
+ new_node = addnode();
+ new_node->astnode.typeunit.returns = ast->vartype;
+ new_node->nodetype = Typedec;
+ ast->parent = new_node;
+ new_node->astnode.typeunit.declist = clone_ident(ast);
+ last_typedec->nextstmt = new_node;
+ last_typedec = last_typedec->nextstmt;
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * clone_ident *
+ * *
+ * this function clones an astnode(ident) and passes back the new node *
+ * *
+ *****************************************************************************/
+
+AST *
+clone_ident(AST *ast)
+{
+ AST *new_node;
+ int i;
+
+ new_node = addnode();
+
+ new_node->parent = ast->parent;
+ new_node->vartype = ast->vartype;
+
+ new_node->astnode.ident.dim = ast->astnode.ident.dim;
+ new_node->astnode.ident.position = ast->astnode.ident.position;
+ new_node->astnode.ident.len = ast->astnode.ident.len;
+ new_node->astnode.ident.localvnum = ast->astnode.ident.localvnum;
+ new_node->astnode.ident.which_implicit = ast->astnode.ident.which_implicit;
+
+ new_node->astnode.ident.passByRef = ast->astnode.ident.passByRef;
+ new_node->astnode.ident.needs_declaration =
+ ast->astnode.ident.needs_declaration;
+ new_node->astnode.ident.explicit = FALSE;
+
+ for(i=0; i<=MAX_ARRAY_DIM; i++) {
+ new_node->astnode.ident.startDim[i] = ast->astnode.ident.startDim[i];
+ new_node->astnode.ident.endDim[i] = ast->astnode.ident.endDim[i];
+ }
+
+ new_node->astnode.ident.arraylist = ast->astnode.ident.arraylist;
+
+ if(ast->astnode.ident.leaddim)
+ new_node->astnode.ident.leaddim = strdup(ast->astnode.ident.leaddim);
+
+ if(ast->astnode.ident.opcode)
+ new_node->astnode.ident.opcode = strdup(ast->astnode.ident.opcode);
+
+ if(ast->astnode.ident.commonBlockName)
+ new_node->astnode.ident.commonBlockName =
+ strdup(ast->astnode.ident.commonBlockName);
+
+ strcpy(new_node->astnode.ident.name, ast->astnode.ident.name);
+
+ if(ast->astnode.ident.merged_name)
+ new_node->astnode.ident.merged_name =
+ strdup(ast->astnode.ident.merged_name);
+
+ if(ast->astnode.ident.descriptor)
+ new_node->astnode.ident.descriptor =
+ strdup(ast->astnode.ident.descriptor);
+
+ return new_node;
+}
+
+/*****************************************************************************
+ * *
+ * in_dlist *
+ * *
+ * Returns 1 if the given name is in the list, returns 0 otherwise. *
+ * Assumes that the list contains char pointers. *
+ * *
+ *****************************************************************************/
+
+int
+in_dlist(Dlist list, char *name)
+{
+ Dlist ptr;
+ char *list_name;
+
+ dl_traverse(ptr, list){
+ list_name = (char *)dl_val(ptr);
+ if(!strcmp(list_name, name))
+ return 1;
+ }
+
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * in_dlist_stmt_label *
+ * *
+ * Returns 1 if the given label is in the list, returns 0 otherwise. *
+ * Assumes that the list contains AST pointers. *
+ * *
+ *****************************************************************************/
+
+int
+in_dlist_stmt_label(Dlist list, AST *label)
+{
+ Dlist ptr;
+ AST *tmp;
+
+ dl_traverse(ptr, list){
+ tmp = (AST *)dl_val(ptr);
+
+ if(!strcmp(tmp->astnode.constant.number, label->astnode.constant.number))
+ return 1;
+ }
+
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * process_typestmt *
+ * *
+ * Performs processing to handle a list of variable declarations. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_typestmt(enum returntype this_type, AST *tvlist)
+{
+ AST *temp, *new;
+ enum returntype ret;
+ HASHNODE *hashtemp, *hashtemp2;
+
+ new = addnode();
+ free_ast_node(tvlist->parent);
+ tvlist = switchem(tvlist);
+ new->nodetype = Typedec;
+
+ for(temp = tvlist; temp != NULL; temp = temp->nextstmt)
+ {
+ temp->vartype = this_type;
+ ret = this_type;
+ if(temp->astnode.ident.len < 0)
+ temp->astnode.ident.len = len;
+ temp->parent = new;
+
+ hashtemp = type_lookup(args_table, temp->astnode.ident.name);
+ if(hashtemp)
+ hashtemp->variable->vartype = this_type;
+
+ hashtemp2 = type_lookup(type_table, temp->astnode.ident.name);
+ if(hashtemp2) {
+ temp->vartype = this_type;
+ temp->astnode.ident.explicit = TRUE;
+ hashtemp2->variable = temp;
+ if(debug) printf("explicit: %s\n",
+ hashtemp2->variable->astnode.ident.name);
+ }
+
+ if(hashtemp) {
+ if(temp->vartype != hashtemp->variable->vartype){
+ if(debug) printf("different vartypes\n");
+ hashtemp->variable->vartype=temp->vartype;
+ hashtemp2->variable->vartype=temp->vartype;
+ }
+ }
+ }
+
+ new->astnode.typeunit.declist = tvlist;
+ new->astnode.typeunit.returns = this_type;
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * process_array_declaration *
+ * *
+ * Performs processing to handle an array declaration. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_array_declaration(AST *varname, AST *dimlist)
+{
+ AST *new, *temp, *tmp, *tnode;
+ int count, i, alen;
+ char *tempname, *id;
+ enum returntype ret;
+
+ if(debug)
+ printf("we have an array declaration %s\n", varname->astnode.ident.name);
+
+ tempname = strdup(varname->astnode.ident.name);
+ uppercase(tempname);
+
+ /* put in type table. we now know this intrinsic name is an array */
+ if(methodscan(intrinsic_toks, tempname) != NULL) {
+ tmp=addnode();
+
+ tmp->token = NAME;
+ tmp->nodetype = Identifier;
+ tmp->astnode.ident.needs_declaration = FALSE;
+ tmp->astnode.ident.explicit = FALSE;
+ tmp->astnode.ident.localvnum = -1;
+
+ id = strdup(varname->astnode.ident.name);
+ strcpy(tmp->astnode.ident.name, id);
+
+ ret = implicit_table[tolower(id[0]) - 'a'].type;
+ tmp->vartype = ret;
+
+ tnode = clone_ident(tmp);
+ tnode->nodetype = Identifier;
+ tnode->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY;
+
+ type_insert(type_table, tnode, ret, tnode->astnode.ident.name);
+ }
+
+ new = varname;
+
+ if(debug)
+ printf("reduced arraydeclaration... calling switchem\n");
+ new->astnode.ident.arraylist = switchem(dimlist);
+
+ count = 0;
+ for(temp=new->astnode.ident.arraylist; temp != NULL; temp=temp->nextstmt)
+ count++;
+
+ if(count > MAX_ARRAY_DIM) {
+ fprintf(stderr,"Error: array %s exceeds max ", new->astnode.ident.name);
+ fprintf(stderr,"number of dimensions: %d\n", MAX_ARRAY_DIM);
+ exit(EXIT_FAILURE);
+ }
+
+ new->astnode.ident.dim = count;
+
+ /*
+ * If this is a one-dimensional one-length character array, for example:
+ * character foo(12)
+ * character*1 bar(12)
+ * then don't treat as an array. Set dimension to zero and arraylist
+ * to NULL. Save the arraylist in startDim[2] since we will need it
+ * during code generation.
+ */
+
+ if((typedec_context == String) && (len == 1) && (count == 1)) {
+ new->astnode.ident.dim = 0;
+ new->astnode.ident.startDim[2] = new->astnode.ident.arraylist;
+ new->astnode.ident.arraylist = NULL;
+ return new;
+ }
+
+ alen = 1;
+
+ for(temp = new->astnode.ident.arraylist, i = 0;
+ temp != NULL;
+ temp=temp->nextstmt, i++)
+ {
+ /* if this dimension is an implied size, then set both
+ * start and end to NULL.
+ */
+
+ if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.name[0] == '*'))
+ {
+ new->astnode.ident.startDim[i] = NULL;
+ new->astnode.ident.endDim[i] = NULL;
+ alen = 0;
+ }
+ else if(temp->nodetype == ArrayIdxRange) {
+ new->astnode.ident.startDim[i] = temp->astnode.expression.lhs;
+ new->astnode.ident.endDim[i] = temp->astnode.expression.rhs;
+ alen *= (int)(eval_const_expr(new->astnode.ident.endDim[i]) -
+ eval_const_expr(new->astnode.ident.startDim[i])) + 1;
+ }
+ else {
+ new->astnode.ident.startDim[i] = NULL;
+ new->astnode.ident.endDim[i] = temp;
+ alen *= (int) eval_const_expr(new->astnode.ident.endDim[i]);
+ }
+ }
+
+ if(alen)
+ new->astnode.ident.array_len = alen;
+ else
+ new->astnode.ident.array_len = -1;
+
+ new->astnode.ident.leaddim = NULL;
+
+ /* leaddim might be a constant, so check for that. --keith */
+ if(new->astnode.ident.arraylist->nodetype == Constant)
+ {
+ new->astnode.ident.leaddim =
+ strdup(new->astnode.ident.arraylist->astnode.constant.number);
+ }
+ else {
+ new->astnode.ident.leaddim =
+ strdup(new->astnode.ident.arraylist->astnode.ident.name);
+ }
+
+ store_array_var(new);
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * process_subroutine_call *
+ * *
+ * Performs processing to handle a subroutine/function call or array access. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_subroutine_call(AST *varname, AST *explist)
+{
+ char *tempname;
+ AST *new;
+
+ new = addnode();
+ varname->parent = new;
+
+ if(explist != NULL)
+ strcpy(explist->parent->astnode.ident.name,
+ varname->astnode.ident.name);
+
+ /*
+ * Here we could look up the name in the array table and set
+ * the nodetype to ArrayAccess if it is found. Then the code
+ * generator could easily distinguish between array accesses
+ * and function calls. I'll have to implement the rest of
+ * this soon. -- Keith
+ *
+ * if(type_lookup(array_table, varname->astnode.ident.name))
+ * new->nodetype = ArrayAccess;
+ * else
+ * new->nodetype = Identifier;
+ */
+
+ new->nodetype = Identifier;
+
+ strcpy(new->astnode.ident.name, varname->astnode.ident.name);
+
+ /* We don't switch index order. */
+ if(explist == NULL) {
+ new->astnode.ident.arraylist = addnode();
+ new->astnode.ident.arraylist->nodetype = EmptyArgList;
+ }
+ else
+ new->astnode.ident.arraylist = switchem(explist);
+
+ tempname = strdup(new->astnode.ident.name);
+ uppercase(tempname);
+
+ if(!type_lookup(external_table, new->astnode.ident.name) &&
+ !type_lookup(array_table, new->astnode.ident.name) &&
+ methodscan(intrinsic_toks, tempname))
+ {
+ HASHNODE *ife;
+
+ /* this must be an intrinsic function call, so remove
+ * the entry from the type table (because the code
+ * generator checks whether something is an intrinsic
+ * or not by checking whether it's in the type table).
+ */
+ ife = type_lookup(type_table, new->astnode.ident.name);
+ if(ife)
+ ife = hash_delete(type_table, new->astnode.ident.name);
+ }
+
+ free_ast_node(varname);
+ free(tempname);
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * assign_function_return_type *
+ * *
+ * This function scans the type declarations to see if this function was *
+ * declared. If so, we reset the return type of the function to the *
+ * type declared here. e.g.: *
+ * function dlaneg(n) *
+ * integer n *
+ * integer dlaneg *
+ * Normally the function would have an implicit type of REAL, but it *
+ * will be set to INTEGER in this case. *
+ * *
+ *****************************************************************************/
+
+void
+assign_function_return_type(AST *func, AST *specs)
+{
+ AST *temp, *dec_temp;
+ HASHNODE *ht;
+
+ for(temp = specs; temp; temp=temp->nextstmt) {
+
+ if(temp->nodetype == Typedec) {
+ for(dec_temp = temp->astnode.typeunit.declist; dec_temp;
+ dec_temp = dec_temp->nextstmt)
+ {
+ if(!strcmp(dec_temp->astnode.ident.name,
+ func->astnode.source.name->astnode.ident.name))
+ {
+ func->astnode.source.returns = temp->astnode.typeunit.returns;
+ func->vartype = temp->astnode.typeunit.returns;
+ func->astnode.source.name->vartype = temp->astnode.typeunit.returns;
+
+ ht = type_lookup(type_table, dec_temp->astnode.ident.name);
+
+ /* the else case shouldn't be hit since the implied variable
+ * should have been inserted already.
+ */
+
+ if(ht)
+ ht->variable->vartype = temp->astnode.typeunit.returns;
+ else
+ insert_name(type_table, dec_temp, temp->astnode.typeunit.returns);
+ }
+ }
+ }
+ }
+}
diff --git a/src/getopt.c b/src/getopt.c
new file mode 100644
index 0000000..f6ae70e
--- /dev/null
+++ b/src/getopt.c
@@ -0,0 +1,104 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/getopt.c,v $
+ * $Revision: 1.3 $
+ * $Date: 2004/02/04 06:25:43 $
+ * $Author: keithseymour $
+ */
+
+
+/*
+** GETOPT PROGRAM AND LIBRARY ROUTINE
+**
+** I wrote main() and AT&T wrote getopt() and we both put our efforts into
+** the public domain via mod.sources.
+** Rich $alz
+** Mirror Systems
+** (mirror!rs, rs at mirror.TMC.COM)
+** August 10, 1986
+*/
+
+#include <stdio.h>
+#include <string.h>
+#include <io.h>
+
+/*
+** This is the public-domain AT&T getopt(3) code. I added the
+** #ifndef stuff because I include <stdio.h> for the program;
+** getopt, per se, doesn't need it. I also added the INDEX/index
+** hack (the original used strchr, of course). And, note that
+** technically the casts in the write(2) calls shouldn't be there.
+*/
+
+#ifndef NULL
+#define NULL 0
+#endif
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef INDEX
+#define INDEX strchr
+#endif
+
+
+#define ERR(s, c) if(opterr){\
+ char errbuf[2];\
+ errbuf[0] = c; errbuf[1] = '\n';\
+ (void) write(2, argv[0], (unsigned)strlen(argv[0]));\
+ (void) write(2, s, (unsigned)strlen(s));\
+ (void) write(2, errbuf, 2);}
+
+extern int strcmp();
+extern char *INDEX(const char *, int);
+
+int opterr = 1;
+int optind = 1;
+int optopt;
+char *optarg;
+
+int
+getopt(argc, argv, opts)
+int argc;
+char **argv, *opts;
+{
+ static int sp = 1;
+ register int c;
+ register char *cp;
+
+ if(sp == 1)
+ if(optind >= argc ||
+ argv[optind][0] != '-' || argv[optind][1] == '\0')
+ return(EOF);
+ else if(strcmp(argv[optind], "--") == NULL) {
+ optind++;
+ return(EOF);
+ }
+ optopt = c = argv[optind][sp];
+ if(c == ':' || (cp=INDEX(opts, c)) == NULL) {
+ ERR(": illegal option -- ", c);
+ if(argv[optind][++sp] == '\0') {
+ optind++;
+ sp = 1;
+ }
+ return('?');
+ }
+ if(*++cp == ':') {
+ if(argv[optind][sp+1] != '\0')
+ optarg = &argv[optind++][sp+1];
+ else if(++optind >= argc) {
+ ERR(": option requires an argument -- ", c);
+ sp = 1;
+ return('?');
+ } else
+ optarg = argv[optind++];
+ sp = 1;
+ } else {
+ if(argv[optind][++sp] == '\0') {
+ sp = 1;
+ optind++;
+ }
+ optarg = NULL;
+ }
+ return(c);
+}
+
+
diff --git a/src/globals.c b/src/globals.c
new file mode 100644
index 0000000..17d8de9
--- /dev/null
+++ b/src/globals.c
@@ -0,0 +1,916 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/globals.c,v $
+ * $Revision: 1.30 $
+ * $Date: 2007/07/30 20:52:25 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * globals.c *
+ * *
+ * This file contains a lot of globals that are common to many parts of the *
+ * f2java system. *
+ * *
+ * The following several tables have their last entry initialized *
+ * to `NULL'. This allows each table to be traversed by a while() *
+ * loop: 'while (tab->entry)' loops until entry is NULL, then *
+ * gracefully exits. Similarly, a for() loop can be used, for example: *
+ * 'for (tab;tab;tab++)' traverses tab until the NULL last entry is *
+ * reached. See the 'keyscan()' and 'methodscan()' procedures. *
+ * *
+ *****************************************************************************/
+
+#include"f2j.h"
+#include"codegen.h"
+#include"y.tab.h"
+
+int
+ lineno, /* current line number */
+ statementno, /* current statement number */
+ func_stmt_num, /* current statement number within this function */
+ ignored_formatting, /* number of format statements ignored */
+ bad_format_count; /* number of invalid format stmts encountered */
+
+FILE
+ *ifp, /* input file pointer */
+ *vcgfp, /* VCG output file pointer */
+ *indexfp; /* method and descriptor index for all prog units */
+
+char
+ *inputfilename, /* name of the input file */
+ *package_name, /* what to name the package, e.g. org.netlib.blas */
+ *output_dir; /* path to which f2java should store class files */
+
+BOOL
+ strictFp, /* should we declare generated code as strictfp */
+ strictMath, /* should we use Java's StrictMath library */
+ omitWrappers, /* should we try to optimize use of wrappers */
+ genInterfaces, /* should we generate simplified interfaces */
+ genJavadoc, /* should we generate javadoc-compatible comments */
+ noOffset, /* should we generate offset args in interfaces */
+ f2j_arrays_static, /* force all arrays to be declared static. */
+ save_all_override; /* force all variables to be declared static. */
+
+SYMTABLE
+ *type_table, /* General symbol table */
+ *external_table, /* external functions */
+ *intrinsic_table, /* intrinsic functions */
+ *args_table, /* arguments to the current unit */
+ *array_table, /* array variables */
+ *format_table, /* format statements */
+ *data_table, /* variables contained in DATA statements */
+ *save_table, /* variables contained in SAVE statements */
+ *common_table, /* variables contained in COMMON statements */
+ *parameter_table, /* PARAMETER variables */
+ *function_table, /* table of functions */
+ *java_keyword_table, /* table of Java reserved words */
+ *blas_routine_table, /* table of BLAS routines */
+ *common_block_table, /* COMMON blocks */
+ *global_func_table, /* Global function table */
+ *global_common_table, /* Global COMMON table */
+ *generic_table; /* table of the generic intrinsic functions */
+
+Dlist
+ constants_table, /* constants (for bytecode constant pool gen.) */
+ descriptor_table, /* list of method descriptors from *.f2j files */
+ include_paths, /* list of paths to search for included files */
+ file_stack; /* file stack for handling include statements */
+
+INCLUDED_FILE
+ *current_file_info; /* lexer information about the current file */
+
+/*****************************************************************************
+ * Statement starting keywords. The only violation of this *
+ * in fortran 77 is the keyword THEN following a closing *
+ * parentheses (')'). *
+ *****************************************************************************/
+
+KWDTAB tab_stmt[] =
+{
+ {"CALL", CALL, 0},
+ {"CLOSE", CLOSE, 0},
+ {"COMMON", COMMON, 0},
+ {"CONTINUE", CONTINUE, 0},
+ {"DATA", DATA, 0},
+ {"DIMENSION", DIMENSION, 0},
+ {"DO", DO, 0},
+ {"ENDDO", ENDDO, 0},
+ {"ENDIF", ENDIF, 0},
+ {"END", END, 0},
+ {"ELSEIF", ELSEIF, 0},
+ {"ELSE", ELSE, 0},
+ {"ENTRY", ENTRY, 0},
+ {"EQUIVALENCE", EQUIVALENCE, 0},
+ {"EXTERNAL", EXTERNAL, 0},
+ {"FORMAT", FORMAT, 0},
+ {"FUNCTION", FUNCTION, 0},
+ {"GOTO", GOTO, 0},
+ {"IF", IF, 0},
+ {"NONE", NONE, 0},
+ {"OPEN", OPEN, 0},
+ {"IMPLICIT", IMPLICIT, 0},
+ {"INTRINSIC", INTRINSIC, 0},
+ {"PARAMETER", PARAMETER, 0},
+ {"PROGRAM", PROGRAM, 0},
+ {"READ", READ, 0},
+ {"RETURN", RETURN, 0},
+ {"REWIND", REWIND, 0},
+ {"SAVE", SAVE, 0},
+ {"STOP", STOP, 0},
+ {"PAUSE", PAUSE, 0},
+ {"SUBROUTINE", SUBROUTINE, 0},
+ {"THEN", THEN, 0},
+ {"WRITE", WRITE, 0},
+ {"PRINT", PRINT, 0},
+ {"ASSIGN", ASSIGN, 0},
+ { NULL, 0, 0} /* Ends a scanning loop. See comment above. */
+};
+
+/*****************************************************************************
+ * The type tokens MUST appear at the beginning of a *
+ * statement, and must occur before any of the *
+ * executable statements. *
+ *****************************************************************************/
+
+KWDTAB tab_type[] =
+{
+ {"DOUBLEPRECISION", ARITH_TYPE, Double},
+ {"REAL*8", ARITH_TYPE, Double},
+ {"REAL*4", ARITH_TYPE, Float},
+ {"REAL", ARITH_TYPE, Float},
+
+ {"INTEGER*4", ARITH_TYPE, Integer},
+ {"INTEGER", ARITH_TYPE, Integer},
+
+ {"LOGICAL*4", ARITH_TYPE, Logical},
+ {"LOGICAL", ARITH_TYPE, Logical},
+
+ {"DOUBLECOMPLEX", ARITH_TYPE, Complex},
+ {"COMPLEX*16", ARITH_TYPE, Complex},
+ {"COMPLEX*8", ARITH_TYPE, Complex},
+ {"COMPLEX", ARITH_TYPE, Complex},
+
+ {"CHARACTER", CHAR_TYPE, String},
+ { NULL, 0, 0} /* Ends a scanning loop. See comment above. */
+};
+
+/*****************************************************************************
+ * Miscellaneous tokens. None of these tokens may *
+ * appear at the beginning fo a statement. *
+ *****************************************************************************/
+
+KWDTAB tab_toks[] =
+{
+ {"\n", NL, 0}, /* Statement separator. */
+ {"+", PLUS, 0},
+ {"-", MINUS, 0},
+ {"(", OP, 0},
+ {")", CP, 0},
+ {"**", POW, 0},
+ {"*", STAR, 0},
+ {"//", CAT, 0},
+ {"/", DIV, 0},
+ {",", CM, 0},
+ {"=", EQ, 0},
+ {":", COLON, 0},
+ {".NOT.", NOT, 0},
+ {".AND.", AND, 0},
+ {".OR.", OR, 0},
+ {".EQV.", EQV, 0},
+ {".NEQV.", NEQV, 0},
+ {".EQ.", RELOP, rel_eq},
+ {".NE.", RELOP, rel_ne},
+ {".LT.", RELOP, rel_lt},
+ {".LE.", RELOP, rel_le},
+ {".GT.", RELOP, rel_gt},
+ {".GE.", RELOP, rel_ge},
+ {".TRUE.", TrUE, 1},
+ {".FALSE.", FaLSE, 0},
+ {"FMT", FMT, 0},
+ { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */
+};
+
+/*****************************************************************************
+ * Tokens found within a READ statement. There are probably more that *
+ * should be here, but so far I just have END. *
+ *****************************************************************************/
+
+KWDTAB read_toks[] =
+{
+ {"END", END, 0},
+ { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */
+};
+
+/*****************************************************************************
+ * Tokens found within an OPEN statement. There are probably more that *
+ * should be here. *
+ *****************************************************************************/
+
+KWDTAB open_toks[] =
+{
+ {"IOSTAT", OPEN_IOSTAT, 0},
+ {"ERR", OPEN_ERR, 0},
+ {"FILE", OPEN_FILE, 0},
+ {"STATUS", OPEN_STATUS, 0},
+ {"ACCESS", OPEN_ACCESS, 0},
+ {"FORM", OPEN_FORM, 0},
+ {"UNIT", OPEN_UNIT, 0},
+ {"RECL", OPEN_RECL, 0},
+ {"BLANK", OPEN_BLANK, 0},
+ { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */
+};
+
+/*****************************************************************************
+ * Tokens found within an ASSIGN statement. *
+ *****************************************************************************/
+
+KWDTAB assign_toks[] =
+{
+ {"TO", TO, 0},
+ { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */
+};
+
+/*****************************************************************************
+ * This table lists stuff that can be handled with java methods. The *
+ * pattern is {"fortran name", "java method"}. Some of the fortran names *
+ * are intrinsic to fortran and java, others are intrinsic only to java and *
+ * replace function or sub-routine calls in the lapack or blas source. *
+ *****************************************************************************/
+
+METHODTAB intrinsic_toks[]=
+{
+ /* Type conversion intrinsics */
+ {ifunc_INT, "INT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Integer},
+ {ifunc_IFIX, "IFIX", "(int)", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Integer},
+ {ifunc_IDINT, "IDINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Integer},
+ {ifunc_REAL, "REAL", "(float)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Float},
+ {ifunc_FLOAT, "FLOAT", "(float)", NULL, "Unused", NULL, "Unused", "Unused", INT_ARG, Float},
+ {ifunc_SNGL, "SNGL", "(float)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Float},
+ {ifunc_DBLE, "DBLE", "(double)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Double},
+ {ifunc_CMPLX, "CMPLX", "(Complex)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Complex},
+ {ifunc_ICHAR, "ICHAR", "(int)", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer},
+ {ifunc_CHAR, "CHAR", "(char)", NULL, "Unused", NULL, "Unused", "Unused", INT_ARG, Character},
+
+ /* Truncation */
+ {ifunc_AINT, "AINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", RD_ARGS, Float},
+ {ifunc_DINT, "DINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Double},
+
+ /* Nearest Whole Number - call NINT/IDNINT and then cast to Float/Double */
+ {ifunc_ANINT, "ANINT", "Util.nint", "StrictUtil.nint", UTIL_CLASS, STRICT_UTIL_CLASS, "nint", "(F)I", RD_ARGS, Float},
+ {ifunc_DNINT, "DNINT", "Util.idnint", "StrictUtil.idnint", UTIL_CLASS, STRICT_UTIL_CLASS, "idnint", "(D)I", DOUBLE_ARG, Double},
+
+ /* Nearest Integer */
+ {ifunc_NINT, "NINT", "Util.nint", "StrictUtil.nint", UTIL_CLASS, STRICT_UTIL_CLASS, "nint", "(F)I", RD_ARGS, Integer},
+ {ifunc_IDNINT, "IDNINT", "Util.idnint", "StrictUtil.idnint", UTIL_CLASS, STRICT_UTIL_CLASS, "idnint", "(D)I", DOUBLE_ARG, Integer},
+
+ /* Absolute Value */
+ {ifunc_ABS, "ABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(F)F", IRDC_ARGS, Double},
+ {ifunc_IABS, "IABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(I)I", INT_ARG, Integer},
+ {ifunc_DABS, "DABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CABS, "CABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(F)F", COMPLEX_ARG, Float},
+
+ /* Remaindering - directly supported in bytecode by irem, drem, etc */
+ {ifunc_MOD, "MOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", IRD_ARGS, Integer},
+ {ifunc_AMOD, "AMOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Float},
+ {ifunc_DMOD, "DMOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Double},
+
+ /* Transfer of Sign */
+ {ifunc_SIGN, "SIGN", "Util.sign", "StrictUtil.sign", UTIL_CLASS, STRICT_UTIL_CLASS, "sign", "(FF)F", IRD_ARGS, Float},
+ {ifunc_ISIGN, "ISIGN", "Util.isign", "StrictUtil.isign", UTIL_CLASS, STRICT_UTIL_CLASS, "isign", "(II)I", INT_ARG, Integer},
+ {ifunc_DSIGN, "DSIGN", "Util.dsign", "StrictUtil.dsign", UTIL_CLASS, STRICT_UTIL_CLASS, "dsign", "(DD)D", DOUBLE_ARG, Double},
+
+ /* Positive Difference */
+ {ifunc_DIM, "DIM", "Util.dim", "StrictUtil.dim", UTIL_CLASS, STRICT_UTIL_CLASS, "dim", "(FF)F", IRD_ARGS, Float},
+ {ifunc_IDIM, "IDIM", "Util.idim", "StrictUtil.idim", UTIL_CLASS, STRICT_UTIL_CLASS, "idim", "(II)I", INT_ARG, Integer},
+ {ifunc_DDIM, "DDIM", "Util.ddim", "StrictUtil.ddim", UTIL_CLASS, STRICT_UTIL_CLASS, "ddim", "(DD)D", DOUBLE_ARG, Double},
+
+ /* Double Precision Product of two reals. implement as (double)a1 * (double)a2 */
+ {ifunc_DPROD, "DPROD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Double},
+
+ /* Choosing Largest Value */
+ {ifunc_MAX, "MAX", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(DD)D", IRD_ARGS, Double},
+ {ifunc_MAX0, "MAX0", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(II)I", INT_ARG, Integer},
+ {ifunc_AMAX1, "AMAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", REAL_ARG, Float},
+ {ifunc_DMAX1, "DMAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(DD)D", DOUBLE_ARG, Double},
+ {ifunc_AMAX0, "AMAX0", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", INT_ARG, Float},
+ {ifunc_MAX1, "MAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", REAL_ARG, Integer},
+
+ /* Choosing Smallest Value */
+ {ifunc_MIN, "MIN", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(DD)D", IRD_ARGS, Double},
+ {ifunc_MIN0, "MIN0", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(II)I", INT_ARG, Integer},
+ {ifunc_AMIN1, "AMIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", REAL_ARG, Float},
+ {ifunc_DMIN1, "DMIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(DD)D", DOUBLE_ARG, Double},
+ {ifunc_AMIN0, "AMIN0", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", INT_ARG, Float},
+ {ifunc_MIN1, "MIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", REAL_ARG, Integer},
+
+ /* Length of Character Entity */
+ {ifunc_LEN, "LEN", "Unused", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer},
+
+ /* Location of Substring a2 in String a1 */
+ {ifunc_INDEX, "INDEX", "(int)", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer},
+
+ /* Imaginary Part of Complex Arg */
+ {ifunc_AIMAG, "AIMAG", "(int)", NULL, "Unused", NULL, "Unused", "Unused", COMPLEX_ARG, Float},
+
+ /* Conjuagate of Complex Argument */
+ {ifunc_CONJG, "CONJG", "(int)", NULL, "Unused", NULL, "Unused", "Unused", COMPLEX_ARG, Complex},
+
+ /* Sqare Root */
+ {ifunc_SQRT, "SQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(F)F", RDC_ARGS, Double},
+ {ifunc_DSQRT, "DSQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CSQRT, "CSQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(D)D", COMPLEX_ARG, Complex},
+
+ /* Exponential */
+ {ifunc_EXP, "EXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", RDC_ARGS, Double},
+ {ifunc_DEXP, "DEXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CEXP, "CEXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", COMPLEX_ARG, Complex},
+
+ /* Natural Logarithm */
+ {ifunc_LOG, "LOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", RDC_ARGS, Double},
+ {ifunc_ALOG, "ALOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", REAL_ARG, Double},
+ {ifunc_DLOG, "DLOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CLOG, "CLOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", COMPLEX_ARG, Complex},
+
+ /* Common Logarithm - use java's log function then divide by 2.30258509 */
+ {ifunc_LOG10, "LOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", RD_ARGS, Double},
+ {ifunc_ALOG10, "ALOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", REAL_ARG, Double},
+ {ifunc_DLOG10, "DLOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", DOUBLE_ARG, Double},
+
+ /* Sine */
+ {ifunc_SIN, "SIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", RDC_ARGS, Double},
+ {ifunc_DSIN, "DSIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CSIN, "CSIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", COMPLEX_ARG, Complex},
+
+ /* Cosine */
+ {ifunc_COS, "COS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", RDC_ARGS, Double},
+ {ifunc_DCOS, "DCOS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_CCOS, "CCOS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", COMPLEX_ARG, Complex},
+
+ /* Tangent */
+ {ifunc_TAN, "TAN", "Math.tan", "StrictMath.tan", "java/lang/Math", "java/lang/StrictMath", "tan", "(D)D", RD_ARGS, Double},
+ {ifunc_DTAN, "DTAN", "Math.tan", "StrictMath.tan", "java/lang/Math", "java/lang/StrictMath", "tan", "(D)D", DOUBLE_ARG, Double},
+
+ /* Arcsine */
+ {ifunc_ASIN, "ASIN", "Math.asin", "StrictMath.asin", "java/lang/Math", "java/lang/StrictMath", "asin", "(D)D", RD_ARGS, Double},
+ {ifunc_DASIN, "DASIN", "Math.asin", "StrictMath.asin", "java/lang/Math", "java/lang/StrictMath", "asin", "(D)D", DOUBLE_ARG, Double},
+
+ /* Arccosine */
+ {ifunc_ACOS, "ACOS", "Math.acos", "StrictMath.acos", "java/lang/Math", "java/lang/StrictMath", "acos", "(D)D", RD_ARGS, Double},
+ {ifunc_DACOS, "DACOS", "Math.acos", "StrictMath.acos", "java/lang/Math", "java/lang/StrictMath", "acos", "(D)D", DOUBLE_ARG, Double},
+
+ /* Arctangent */
+ {ifunc_ATAN, "ATAN", "Math.atan", "StrictMath.atan", "java/lang/Math", "java/lang/StrictMath", "atan", "(D)D", RD_ARGS, Double},
+ {ifunc_DATAN, "DATAN", "Math.atan", "StrictMath.atan", "java/lang/Math", "java/lang/StrictMath", "atan", "(D)D", DOUBLE_ARG, Double},
+ {ifunc_ATAN2, "ATAN2", "Math.atan2", "StrictMath.atan2", "java/lang/Math", "java/lang/StrictMath", "atan2", "(DD)D", RD_ARGS, Double},
+ {ifunc_DATAN2, "DATAN2", "Math.atan2", "StrictMath.atan2", "java/lang/Math", "java/lang/StrictMath", "atan2", "(DD)D", DOUBLE_ARG, Double},
+
+ /* Hyperbolic Sine */
+ {ifunc_SINH, "SINH", "Util.sinh", "StrictUtil.sinh", UTIL_CLASS, STRICT_UTIL_CLASS, "sinh", "(D)D", RD_ARGS, Double},
+ {ifunc_DSINH, "DSINH", "Util.sinh", "StrictUtil.sinh", UTIL_CLASS, STRICT_UTIL_CLASS, "sinh", "(D)D", DOUBLE_ARG, Double},
+
+ /* Hyperbolic Cosine */
+ {ifunc_COSH, "COSH", "Util.cosh", "StrictUtil.cosh", UTIL_CLASS, STRICT_UTIL_CLASS, "cosh", "(D)D", RD_ARGS, Double},
+ {ifunc_DCOSH, "DCOSH", "Util.cosh", "StrictUtil.cosh", UTIL_CLASS, STRICT_UTIL_CLASS, "cosh", "(D)D", DOUBLE_ARG, Double},
+
+ /* Hyperbolic Tangent */
+ {ifunc_TANH, "TANH", "Util.tanh", "StrictUtil.tanh", UTIL_CLASS, STRICT_UTIL_CLASS, "tanh", "(D)D", RD_ARGS, Double},
+ {ifunc_DTANH, "DTANH", "Util.tanh", "StrictUtil.tanh", UTIL_CLASS, STRICT_UTIL_CLASS, "tanh", "(D)D", DOUBLE_ARG, Double},
+
+ /* Lexically Greater than or Equal to */
+ {ifunc_LGE, "LGE", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical},
+
+ /* Lexically Greater than */
+ {ifunc_LGT, "LGT", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical},
+
+ /* Lexically Less than or Equal to */
+ {ifunc_LLE, "LLE", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical},
+
+ /* Lexically Less than */
+ {ifunc_LLT, "LLT", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical},
+
+ /* fortran pseudo intrinsic */
+ {ifunc_ETIME, "ETIME", ".etime", NULL, ETIME_CLASS, NULL, "etime", "([FI)F", IRDC_ARGS, Float},
+
+ {ifunc_SECOND, "SECOND", ".second", NULL, SECOND_CLASS, NULL, "second", "()F", NO_ARG, Float},
+
+ /* Ends a scanning loop. See comment above. */
+ {0, NULL , NULL, NULL, NULL, NULL, NULL, NULL, 0, 0}
+};
+
+/*****************************************************************************
+ * Fortran intrinsics have "generic" versions which can take several data *
+ * types. we search this list before generating code so that we know *
+ * whether to set the return type based on the arguments. *
+ *****************************************************************************/
+
+char *generic_intrinsics[] =
+{
+ "INT", "REAL", "DBLE", "CMPLX", "AINT", "ANINT", "NINT", "ABS", "MOD",
+ "SIGN", "DIM", "MAX", "MIN", "SQRT", "EXP", "LOG", "LOG10", "SIN",
+ "COS", "TAN", "ASIN", "ACOS", "ATAN", "ATAN2", "SINH", "COSH", "TANH", 0
+};
+
+/*****************************************************************************
+ * This is a list of Java reserved words. If a variable in *
+ * the Fortran source matches one of these words, it must be *
+ * transformed before generating the Java source. *
+ * *
+ * This list comes from p. 181 of Java in a Nutshell (David *
+ * Flanagan) so it should be fairly complete for Java versions *
+ * 1.0.x. There will probably need to be some added to comply *
+ * with versions 1.1.x. *
+ *****************************************************************************/
+
+char *java_reserved_words[] =
+{
+ "abstract" , "boolean" , "break" , "byte" , "byvalue" ,
+ "cast" , "catch" , "char" , "class" , "const" ,
+ "default" , "do" , "double" , "else" , "extends" ,
+ "final" , "finally" , "float" , "for" , "future" ,
+ "goto" , "implements", "if" , "import" , "inner" ,
+ "int" , "interface" , "long" , "native" , "new" ,
+ "operator" , "outer" , "package" , "private" , "protected" ,
+ "rest" , "return" , "short" , "static" , "super" ,
+ "synchronized" , "this" , "throw" ,"transient" , "true" ,
+ "var" , "void" ,"volatile" , "while" , "null" ,
+ "continue" , "false" , "case" , "generic" ,"instanceof" ,
+ "public" , "switch" , "try" , 0
+};
+
+/*****************************************************************************
+ * This is a list of the BLAS routines. When translating *
+ * some code, we need to know whether to import the blas *
+ * library or not. so we can use this list to determine *
+ * whether a call is to a BLAS routine or not. *
+ *****************************************************************************/
+
+char *blas_routines[] =
+{
+ "dasum", "daxpy", "dcopy", "ddot", "dgbmv", "dgemm",
+ "dgemv", "dger", "dnrm2", "drot", "drotg", "dsbmv",
+ "dscal", "dspmv", "dspr", "dspr2", "dswap", "dsymm",
+ "dsymv", "dsyr", "dsyr2", "dsyr2k", "dsyrk", "dtbmv",
+ "dtbsv", "dtpmv", "dtpsv", "dtrmm", "dtrmv", "dtrsm",
+ "dtrsv", "idamax", 0
+};
+
+/* data types for f2java primitives: */
+
+char *returnstring[MAX_RETURNS+1] =
+{
+ "String",
+ "String",
+ "complex",
+ "double",
+ "float",
+ "int",
+ "boolean",
+ "Object"
+};
+
+/* Mapping between f2java data types and array data types.. used when */
+/* issuing the newarray opcode: */
+
+u2 jvm_array_type[MAX_RETURNS+1] = {
+ JVM_T_UNUSED,
+ JVM_T_UNUSED,
+ JVM_T_DOUBLE,
+ JVM_T_DOUBLE,
+ JVM_T_FLOAT,
+ JVM_T_INT,
+ JVM_T_BOOLEAN,
+ JVM_T_UNUSED
+};
+
+/* The jvm_data_types array maps from the f2j data types to the Java Virtual */
+/* Machine data types. */
+
+enum jvm_data_type jvm_data_types[MAX_RETURNS+1] = {
+ jvm_Object, /* String */
+ jvm_Object, /* Character */
+ jvm_Object, /* Complex */
+ jvm_Double, /* Double */
+ jvm_Float, /* Float */
+ jvm_Int, /* Integer */
+ jvm_Byte, /* Logical */
+ jvm_Object /* Object */
+};
+
+/* descriptors for the valueOf() method for the various wrapper classes. */
+char * wrapper_valueOf_descriptor[MAX_RETURNS+1] = {
+ "(Ljava/lang/Object;)Ljava/lang/String;",
+ "(Ljava/lang/Object;)Ljava/lang/String;",
+ "(Ljava/lang/String;)Ljava/lang/Double;",
+ "(Ljava/lang/String;)Ljava/lang/Double;",
+ "(Ljava/lang/String;)Ljava/lang/Float;",
+ "(Ljava/lang/String;)Ljava/lang/Integer;",
+ "(Ljava/lang/String;)Ljava/lang/Boolean;",
+ "(Ljava/lang/Object;)Ljava/lang/Object;" /* invalid, but not used */
+};
+
+/* descriptors for java/lang/String's valueOf() methods */
+char * string_valueOf_descriptor[MAX_RETURNS+1] = {
+ "asdfjklasdfjkldjf", /* not used */
+ "asdfjklasdfjkldjf", /* not used */
+ "(D)Ljava/lang/String;",
+ "(D)Ljava/lang/String;",
+ "(F)Ljava/lang/String;",
+ "(I)Ljava/lang/String;",
+ "(Z)Ljava/lang/String;",
+ "asdfjklasdfjkldjf" /* not used */
+};
+
+/* descriptors for the StringBuffer.append() methods */
+char * append_descriptor[MAX_RETURNS+1] = {
+ "(Ljava/lang/String;)Ljava/lang/StringBuffer;",
+ "(Ljava/lang/String;)Ljava/lang/StringBuffer;",
+ "(D)Ljava/lang/StringBuffer;",
+ "(D)Ljava/lang/StringBuffer;",
+ "(F)Ljava/lang/StringBuffer;",
+ "(I)Ljava/lang/StringBuffer;",
+ "(Z)Ljava/lang/StringBuffer;",
+ "(Ljava/lang/Object;)Ljava/lang/StringBuffer;",
+};
+
+/* descriptors for the numeric wrapper classes' toString() methods */
+char * toString_descriptor[MAX_RETURNS+1] = {
+ "()Ljava/lang/String;",
+ "()Ljava/lang/String;",
+ "(D)Ljava/lang/String;",
+ "(D)Ljava/lang/String;",
+ "(F)Ljava/lang/String;",
+ "(I)Ljava/lang/String;",
+ "(Z)Ljava/lang/String;",
+ "()Ljava/lang/String;"
+};
+
+/* descriptors of PrintStream's print() and println() methods */
+char * println_descriptor[MAX_RETURNS+1] = {
+ "(Ljava/lang/String;)V",
+ "(Ljava/lang/String;)V",
+ "(D)V",
+ "(D)V",
+ "(F)V",
+ "(I)V",
+ "(Z)V",
+ "(Ljava/lang/Object;)V",
+};
+
+/* descriptors of ArraySpec constructors */
+char * array_spec_descriptor[MAX_RETURNS+1] = {
+ "([Ljava/lang/String;II)V",
+ "([Ljava/lang/String;II)V",
+ "()V", /* not implemented */
+ "([DII)V",
+ "([FII)V",
+ "([III)V",
+ "([ZII)V",
+ "()V" /* not implemented */
+};
+
+/* table of numericValue methods (e.g. doubleValue(), intValue(), etc.
+ * again, we do not expect to look up String data types in this table,
+ * so those values may be invalid.
+ */
+char * numericValue_method[MAX_RETURNS+1] = {
+ "toString",
+ "toString",
+ "doubleValue",
+ "doubleValue",
+ "floatValue",
+ "intValue",
+ "booleanValue",
+ "toString"
+};
+
+/* method descriptors corresponding to the above methods. */
+char * numericValue_descriptor[MAX_RETURNS+1] = {
+ "()Ljava/lang/String;",
+ "()Ljava/lang/String;",
+ "()D",
+ "()D",
+ "()F",
+ "()I",
+ "()Z",
+ "()Ljava/lang/String;"
+};
+
+#define JSTR "Ljava/lang/String;"
+#define JSTR_ARR "[Ljava/lang/String;"
+#define JOBJ "Ljava/lang/Object;"
+#define JOBJ_ARR "[Ljava/lang/Object;"
+
+/* you'll notice that both the 1D and 2D descriptors are both actually
+ * declared 1D. if we want to implement 'real' 2D arrays, then this
+ * matrix (and the following wrapped_field_descriptor) should be updated.
+ */
+
+char *field_descriptor[MAX_RETURNS+1][2] = {
+ {JSTR, JSTR_ARR},
+ {JSTR, JSTR_ARR},
+ {"D", "[D"},
+ {"D", "[D"},
+ {"F", "[F"},
+ {"I", "[I"},
+ {"Z", "[Z"},
+ {JOBJ, JOBJ_ARR}
+};
+
+char *wrapped_field_descriptor[MAX_RETURNS+1][2] = {
+ {"Lorg/netlib/util/StringW;",
+ "[Ljava/lang/String;"},
+ {"Lorg/netlib/util/StringW;",
+ "[Ljava/lang/String;"},
+ {"Lorg/netlib/util/complexW;",
+ "[Lorg/netlib/util/complexW;"},
+ {"Lorg/netlib/util/doubleW;",
+ "[D"},
+ {"Lorg/netlib/util/floatW;",
+ "[F"},
+ {"Lorg/netlib/util/intW;",
+ "[I"},
+ {"Lorg/netlib/util/booleanW;",
+ "[Z"},
+ {"Ljava/lang/Object;",
+ "[Ljava/lang/Object;"}
+};
+
+/* types for scalars passed by reference: */
+char *wrapper_returns[MAX_RETURNS+1] =
+{
+ "StringW",
+ "StringW",
+ "complexW",
+ "doubleW",
+ "floatW",
+ "intW",
+ "booleanW",
+ "Object"
+};
+
+/* fully qualified wrapper names: */
+char *full_wrappername[MAX_RETURNS+1] =
+{
+ "org/netlib/util/StringW",
+ "org/netlib/util/StringW",
+ "org/netlib/util/complexW",
+ "org/netlib/util/doubleW",
+ "org/netlib/util/floatW",
+ "org/netlib/util/intW",
+ "org/netlib/util/booleanW",
+ "java/lang/Object"
+};
+
+/* descriptors of the wrappers' .val fields */
+char *val_descriptor[MAX_RETURNS+1] =
+{
+ "Ljava/lang/String;",
+ "Ljava/lang/String;",
+ "D",
+ "D",
+ "F",
+ "I",
+ "Z",
+ "Ljava/lang/Object;"
+};
+
+/* names of the standard Java wrappers: */
+char *java_wrapper[MAX_RETURNS+1] =
+{
+ "String",
+ "String",
+ "Complex",
+ "Double",
+ "Float",
+ "Integer",
+ "Boolean",
+ "Object"
+};
+
+/* descriptors for the wrapper classes' constructors: */
+char *wrapper_descriptor[MAX_RETURNS+1] =
+{
+ "(Ljava/lang/String;)V",
+ "(Ljava/lang/String;)V",
+ "(Lorg/netlib/Complex;)V",
+ "(D)V",
+ "(F)V",
+ "(I)V",
+ "(Z)V",
+ "(Ljava/lang/Object;)V",
+};
+
+/* table of Java's wrapper classes. we only expect to use the numeric ones */
+char * numeric_wrapper[MAX_RETURNS+1] = {
+ "java/lang/String",
+ "java/lang/String",
+ "java/lang/Double",
+ "java/lang/Double",
+ "java/lang/Float",
+ "java/lang/Integer",
+ "java/lang/Boolean",
+ "java/lang/Object"
+};
+
+/* opcodes to push initial primitive values: */
+enum _opcode init_opcodes[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_dconst_0,
+ jvm_dconst_0,
+ jvm_fconst_0,
+ jvm_iconst_0,
+ jvm_iconst_0,
+ jvm_aconst_null
+};
+
+/* opcodes to return a value from a function: */
+enum _opcode return_opcodes[MAX_RETURNS+1] =
+{
+ jvm_areturn,
+ jvm_areturn,
+ jvm_dreturn,
+ jvm_dreturn,
+ jvm_freturn,
+ jvm_ireturn,
+ jvm_ireturn,
+ jvm_areturn
+};
+
+/* initial values for above data types: */
+char *init_vals[MAX_RETURNS+1] =
+{
+ "\" \"",
+ "\" \"",
+ "0",
+ "0.0d",
+ "0.0f",
+ "0",
+ "false"
+};
+
+/* descriptors for EasyIn's read methods */
+char *input_descriptors[MAX_RETURNS+1] =
+{
+ "(I)Ljava/lang/String;",
+ "(I)Ljava/lang/String;",
+ "Unimplemented",
+ "()D",
+ "()F",
+ "()I",
+ "()Z"
+};
+
+/* input functions to read various data types: */
+char *input_func[MAX_RETURNS+1] =
+{
+ "readChars",
+ "readChars",
+ "readComplex",
+ "readDouble",
+ "readFloat",
+ "readInt",
+ "readBoolean"
+};
+
+/* input functions that detect EOF: */
+char *input_func_eof[MAX_RETURNS+1] =
+{
+ "readchars",
+ "readchars",
+ "readcomplex",
+ "readdouble",
+ "readfloat",
+ "readint",
+ "readboolean"
+};
+
+/* addition opcodes, indexed by vartype: */
+enum _opcode add_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_dadd,
+ jvm_fadd,
+ jvm_iadd,
+ jvm_nop
+};
+
+/* subtraction opcodes, indexed by vartype: */
+enum _opcode sub_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_dsub,
+ jvm_fsub,
+ jvm_isub,
+ jvm_nop
+};
+
+/* division opcodes, indexed by vartype: */
+enum _opcode div_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_ddiv,
+ jvm_fdiv,
+ jvm_idiv,
+ jvm_nop
+};
+
+/* multiplication opcodes, indexed by vartype: */
+enum _opcode mul_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_dmul,
+ jvm_fmul,
+ jvm_imul,
+ jvm_nop
+};
+
+/* negation opcodes, indexed by vartype: */
+enum _opcode neg_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_dneg,
+ jvm_fneg,
+ jvm_ineg,
+ jvm_nop
+};
+
+/* integer comparison opcodes, indexed by vartype. *
+ * first entry is unused because enum _relop starts at 1 */
+enum _opcode icmp_opcode[] = {
+ jvm_nop,
+ jvm_if_icmpeq,
+ jvm_if_icmpne,
+ jvm_if_icmplt,
+ jvm_if_icmple,
+ jvm_if_icmpgt,
+ jvm_if_icmpge,
+ jvm_if_icmpge
+};
+
+/* comparison ops for relational expressions. note that the logic is
+ * reversed.. that is, this array is indexed by the relops, but each entry
+ * contains the reverse relop (e.g. .lt. -> ifgt) except for .eq. and .ne.
+ * first entry is unused because enum _relop starts at 1
+ */
+
+enum _opcode dcmp_opcode[] = {
+ jvm_nop,
+ jvm_ifeq,
+ jvm_ifne,
+ jvm_iflt,
+ jvm_ifle,
+ jvm_ifgt,
+ jvm_ifge
+};
+
+/*
+ * Comparison ops for floating point. I'm adding this to support
+ * code gen for "Arithmetic IF" statements, which is already split
+ * into integer and non-integer cases, so here I only put the single
+ * and double versions.
+ */
+
+enum _opcode cmpg_opcode[MAX_RETURNS+1] =
+{
+ jvm_nop,
+ jvm_nop,
+ jvm_nop,
+ jvm_dcmpg,
+ jvm_fcmpg,
+ jvm_nop,
+ jvm_nop
+};
+
+/* The following is a table of type conversion opcodes. to find the
+ * appropriate opcode for the conversion, go to the row of the type to
+ * convert FROM and scan across to the column of the type to convert TO.
+ * most of these entries are blank (NOP) because type promotion does not
+ * apply to strings, booleans, etc. note: most of these are nop because
+ * we dont intend to encounter such conversions (or they are unsupported).
+ */
+enum _opcode typeconv_matrix[MAX_RETURNS+1][MAX_RETURNS+1] =
+{
+ /* char |string |complex|double |float |integer|logical|obj */
+/* char */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop},
+/* string */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop},
+/* complex */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop},
+/* double */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_d2f,jvm_d2i,jvm_nop,jvm_nop},
+/* float */ {jvm_nop,jvm_nop,jvm_nop,jvm_f2d,jvm_nop,jvm_f2i,jvm_nop,jvm_nop},
+/* integer */ {jvm_nop,jvm_nop,jvm_nop,jvm_i2d,jvm_i2f,jvm_nop,jvm_nop,jvm_nop},
+/* logical */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop},
+/* object */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop}
+
+};
diff --git a/src/initialize.h b/src/initialize.h
new file mode 100644
index 0000000..7a9768a
--- /dev/null
+++ b/src/initialize.h
@@ -0,0 +1,48 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/initialize.h,v $
+ * $Revision: 1.31 $
+ * $Date: 2007/07/30 20:52:25 $
+ * $Author: keithseymour $
+ */
+
+
+#ifndef _INITIALIZE_H
+#define _INITIALIZE_H
+
+/*****************************************************************************
+ * initialize.h *
+ * *
+ * Header file containing initialization of f2java's translation tables. *
+ * See globals.c for more detailed descriptions of each table. *
+ * *
+ *****************************************************************************/
+
+
+#include<stdio.h>
+#include<string.h>
+#include"f2j.h"
+#include"y.tab.h"
+
+extern KWDTAB tab_stmt[]; /* statement starting keywords */
+
+extern KWDTAB tab_type[]; /* TYPE tokens */
+
+extern KWDTAB tab_toks[]; /* misc tokens */
+
+extern KWDTAB read_toks[]; /* tokens found in read stmts */
+
+extern KWDTAB open_toks[]; /* tokens found in open stmts */
+
+extern KWDTAB assign_toks[]; /* tokens found in ASSIGN stmts */
+
+extern METHODTAB intrinsic_toks[]; /* fortran intrinsic functions */
+
+extern char *generic_intrinsics[]; /* table of 'generic' intrinsics */
+
+extern char *java_reserved_words[]; /* list of Java reserved words */
+
+extern char *blas_routines[]; /* list of the routines in BLAS */
+
+extern enum returntype default_implicit_table[]; /* letters -> data types */
+
+#endif
diff --git a/src/make.def.in b/src/make.def.in
new file mode 100644
index 0000000..8867c64
--- /dev/null
+++ b/src/make.def.in
@@ -0,0 +1,18 @@
+
+CC=@CC@
+YACC=@YACC@
+PURIFY=@PURIFY@
+BYTE_DIR=@BYTE_DIR@
+LIBS=@LIBS@
+INCLUDES=-I $(BYTE_DIR)
+
+F2J_BINDIR=@F2J_INSTALL_PREFIX@/bin
+
+# defining DEBUG_MEM includes some code that will
+# trash any freed memory, thus helping to expose
+# some memory-related bugs in f2j.
+#
+
+CFLAGS=-Wall -DDEBUG_MEM @CFLAGS@
+PFLAGS=-cache-dir=/tmp
+YFLAGS=-t --debug --defines --verbose
diff --git a/src/opcodes.h b/src/opcodes.h
new file mode 100644
index 0000000..8ce4fe8
--- /dev/null
+++ b/src/opcodes.h
@@ -0,0 +1,129 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/opcodes.h,v $
+ * $Revision: 1.13 $
+ * $Date: 2007/04/19 20:25:49 $
+ * $Author: keithseymour $
+ */
+
+/*****************************************************************************
+ * opcodes.h *
+ * *
+ * Definitions of opcodes related to code generation. *
+ * *
+ *****************************************************************************/
+
+#ifndef _OPCODES_H
+#define _OPCODES_H
+
+/*****************************************************************************
+ * MAX_RETURNS is the number of data types. *
+ * OBJECT_TYPE identifies the type 'Object'. *
+ *****************************************************************************/
+
+#define OBJECT_TYPE 7
+#define MAX_RETURNS 7
+
+#define JSTR "Ljava/lang/String;"
+#define JSTR_ARR "[Ljava/lang/String;"
+#define JOBJ "Ljava/lang/Object;"
+#define JOBJ_ARR "[Ljava/lang/Object;"
+
+/* data types for f2java primitives: */
+extern char *returnstring[MAX_RETURNS+1];
+
+/* Mapping between f2java data types and array data types.. */
+extern u2 jvm_array_type[MAX_RETURNS+1];
+
+/* descriptors for the valueOf() method for the various wrapper classes. */
+extern char * wrapper_valueOf_descriptor[MAX_RETURNS+1];
+
+/* descriptors for java/lang/String's valueOf() methods */
+extern char * string_valueOf_descriptor[MAX_RETURNS+1];
+
+/* descriptors for the StringBuffer.append() methods */
+extern char * append_descriptor[MAX_RETURNS+1];
+
+/* descriptors for the numeric wrapper classes' toString() methods */
+extern char * toString_descriptor[MAX_RETURNS+1];
+
+/* descriptors for the ArraySpec class */
+char * array_spec_descriptor[MAX_RETURNS+1];
+
+/* descriptors of PrintStream's print() and println() methods */
+extern char * println_descriptor[MAX_RETURNS+1];
+
+/* table of numericValue methods (e.g. doubleValue(), intValue(), etc. */
+extern char * numericValue_method[MAX_RETURNS+1];
+
+/* method descriptors corresponding to the above methods. */
+extern char * numericValue_descriptor[MAX_RETURNS+1];
+extern char *field_descriptor[MAX_RETURNS+1][2];
+extern char *wrapped_field_descriptor[MAX_RETURNS+1][2];
+
+/* types for scalars passed by reference: */
+extern char *wrapper_returns[MAX_RETURNS+1];
+
+/* fully qualified wrapper names: */
+extern char *full_wrappername[MAX_RETURNS+1];
+
+/* descriptors of the wrappers' .val fields */
+extern char *val_descriptor[MAX_RETURNS+1];
+
+/* descriptors for the wrapper classes' constructors: */
+extern char *wrapper_descriptor[MAX_RETURNS+1];
+
+/* names of the standard Java wrappers: */
+extern char *java_wrapper[MAX_RETURNS+1];
+
+/* opcodes to push initial primitive values: */
+extern enum _opcode init_opcodes[MAX_RETURNS+1];
+
+/* opcodes to return a value from a function: */
+extern enum _opcode return_opcodes[MAX_RETURNS+1];
+
+/* initial values for above data types: */
+extern char *init_vals[MAX_RETURNS+1];
+
+/* descriptors for EasyIn's read methods */
+extern char *input_descriptors[MAX_RETURNS+1];
+
+/* input functions to read various data types: */
+extern char *input_func[MAX_RETURNS+1];
+
+/* input functions that detect EOF: */
+extern char *input_func_eof[MAX_RETURNS+1];
+
+/* addition opcodes, indexed by vartype: */
+extern enum _opcode add_opcode[MAX_RETURNS+1];
+
+/* subtraction opcodes, indexed by vartype: */
+extern enum _opcode sub_opcode[MAX_RETURNS+1];
+
+/* division opcodes, indexed by vartype: */
+extern enum _opcode div_opcode[MAX_RETURNS+1];
+
+/* multiplication opcodes, indexed by vartype: */
+extern enum _opcode mul_opcode[MAX_RETURNS+1];
+
+/* negation opcodes, indexed by vartype: */
+extern enum _opcode neg_opcode[MAX_RETURNS+1];
+
+/* integer comparison opcodes, indexed by vartype. */
+extern enum _opcode icmp_opcode[];
+
+/* comparison ops for relational expressions. */
+extern enum _opcode dcmp_opcode[];
+
+/* comparison ops for floating point comparison. */
+extern enum _opcode cmpg_opcode[];
+
+/* The following is a table of type conversion opcodes. */
+extern enum _opcode typeconv_matrix[MAX_RETURNS+1][MAX_RETURNS+1];
+
+/* mapping of f2j data types to jvm data types. */
+extern enum jvm_data_type jvm_data_types[MAX_RETURNS+1];
+
+/* table of Java's wrapper classes. we only expect to use the numeric ones */
+extern char * numeric_wrapper[MAX_RETURNS+1];
+
+#endif
diff --git a/src/optimize.c b/src/optimize.c
new file mode 100644
index 0000000..0c9d290
--- /dev/null
+++ b/src/optimize.c
@@ -0,0 +1,1429 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/optimize.c,v $
+ * $Revision: 1.57 $
+ * $Date: 2007/04/10 04:48:57 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * optimize.c *
+ * *
+ * Determines which scalars really need to be wrapped in objects *
+ * for emulation of pass-by-reference. For the most part, this file *
+ * mimics codegen.c since we must traverse the AST in the same way *
+ * for both operations. *
+ * *
+ * Basically, all we're doing here is trying to determine which variables *
+ * are modified within this function (and functions called from this one). *
+ * So, we are looking for three cases: *
+ * *
+ * 1. the variable is an argument to this function and it is on the LHS *
+ * of an assignment *
+ * 2. the variable is an argument to this function and it is an argument *
+ * to a READ statement *
+ * 3. the variable is passed to a function/subroutine that modifies it *
+ * *
+ * If any of the three cases are met, we classify the variable as a *
+ * 'pass by reference' variable, meaning that it must be wrapped in an *
+ * object. *
+ * *
+ *****************************************************************************/
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<string.h>
+#include<ctype.h>
+#include"f2j.h"
+#include"codegen.h"
+#include"f2jmem.h"
+#include"f2j_externs.h"
+
+/*****************************************************************************
+ * Set optdebug to TRUE to get debugging output from the optimization *
+ * routines. *
+ *****************************************************************************/
+
+int optdebug = FALSE;
+
+char *unit_name; /* name of this function/subroutine */
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+char
+ * lowercase ( char * );
+
+METHODTAB
+ * methodscan (METHODTAB * , char * );
+
+void
+ external_optimize(AST *, AST *),
+ expr_optimize (AST *, AST *),
+ args_optimize(AST *, AST *),
+ optimize (AST *, AST *),
+ optScalar(AST *),
+ assign_optimize(AST *, AST*),
+ call_optimize(AST *, AST*),
+ forloop_optimize(AST *, AST*),
+ blockif_optimize(AST *, AST*),
+ elseif_optimize(AST *, AST*),
+ else_optimize(AST *, AST*),
+ logicalif_optimize(AST *, AST*),
+ read_optimize(AST *, AST*),
+ write_optimize(AST *, AST*),
+ spec_optimize(AST *, AST*),
+ read_implied_loop_optimize(AST *, AST *),
+ name_optimize (AST *, AST *),
+ subcall_optimize(AST *, AST *),
+ while_optimize(AST *, AST *),
+ set_passByRef(AST *, AST *);
+
+extern METHODTAB intrinsic_toks[];
+
+/*****************************************************************************
+ * *
+ * optScalar *
+ * *
+ * This is the main entry point for the optimization routines. Here we look *
+ * up the current function name to determine whether it has been optimized *
+ * yet. If so, skip it - otherwise, optimize. *
+ * *
+ *****************************************************************************/
+
+void
+optScalar(AST *root)
+{
+ AST *temp;
+ HASHNODE *ht;
+ SYMTABLE *opt_type_table = root->astnode.source.type_table;
+ SYMTABLE *opt_common_table = root->astnode.source.common_table;
+ SYMTABLE *opt_external_table = root->astnode.source.external_table;
+
+ /* look up this function name */
+
+ ht = type_lookup(global_func_table,
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+
+ if(!ht) {
+ fprintf(stderr,"optScalar: Cant find %s in global function table\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+ return;
+ }
+
+ if(optdebug) {
+ printf("attempting to optimize %s\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+
+ if(ht->variable->astnode.source.scalarOptStatus == NOT_VISITED)
+ printf("%s has not been visited yet\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+ else if(ht->variable->astnode.source.scalarOptStatus == VISITED)
+ printf("%s has been visited but not finished\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+ else if(ht->variable->astnode.source.scalarOptStatus == FINISHED)
+ printf("%s has been finished\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+ else
+ printf("%s has an invalid status field\n",
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+ }
+
+ /* if this function hasn't been visited yet, set the status to 'VISITED'
+ * and start optimizing it.
+ */
+
+ if(ht->variable->astnode.source.scalarOptStatus == NOT_VISITED) {
+ ht->variable->astnode.source.scalarOptStatus = VISITED;
+ optimize(root, root);
+ }
+
+ /* afterwards, make sure the status is set to 'FINISHED' */
+
+ ht->variable->astnode.source.scalarOptStatus = FINISHED;
+
+ /* for each argument in the function, set its passByRef field from
+ * the values in the symbol table. This saves some time later on
+ * when we want to know which arguments are pass by reference and
+ * which aren't. we wont have to do symbol table lookups - just
+ * loop through each arg in the function.
+ */
+
+ temp = root->astnode.source.progtype->astnode.source.args;
+
+ for(;temp != NULL;temp = temp->nextstmt)
+ if((ht = type_lookup(opt_type_table,temp->astnode.ident.name)) != NULL)
+ if(ht->variable->astnode.ident.passByRef)
+ temp->astnode.ident.passByRef = TRUE;
+
+ ht = type_lookup(function_table,
+ root->astnode.source.progtype->astnode.source.name->astnode.ident.name);
+
+ if(ht) {
+ if(ht->variable->astnode.source.descriptor)
+ f2jfree(ht->variable->astnode.source.descriptor,
+ strlen(ht->variable->astnode.source.descriptor)+1);
+
+ ht->variable->astnode.source.descriptor =
+ get_method_descriptor(root->astnode.source.progtype,
+ opt_type_table, opt_common_table, opt_external_table);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * optimize *
+ * *
+ * This is the main optimization routine. It just determines what kind of *
+ * node we're looking at and calls the appropriate function to handle it. *
+ * *
+ *****************************************************************************/
+
+void
+optimize (AST * root, AST * rptr)
+{
+ switch (root->nodetype)
+ {
+ case 0:
+ if (optdebug)
+ fprintf (stderr,"Bad node\n");
+
+ optimize (root->nextstmt, rptr);
+ break;
+ case Progunit:
+ if (optdebug)
+ printf ("Source.\n");
+
+ optimize(root->astnode.source.typedecs, rptr);
+ optimize(root->astnode.source.progtype, rptr);
+ optimize(root->astnode.source.statements, rptr);
+
+ break;
+ case Subroutine:
+ case Function:
+ case Program:
+ unit_name = root->astnode.source.name->astnode.ident.name;
+ if (optdebug)
+ printf ("Unit name: %s\n",
+ root->astnode.source.name->astnode.ident.name);
+ break;
+ case Assignment:
+ if (optdebug)
+ printf ("Assignment.\n");
+
+ assign_optimize (root, rptr);
+
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case Call:
+ if (optdebug)
+ printf ("Call.\n");
+
+ call_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Forloop:
+ if (optdebug)
+ printf ("Forloop.\n");
+
+ forloop_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Blockif:
+ if (optdebug)
+ printf ("Blockif.\n");
+
+ blockif_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Elseif:
+ if (optdebug)
+ printf ("Elseif.\n");
+
+ elseif_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Else:
+ if (optdebug)
+ printf ("Else.\n");
+
+ else_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Logicalif:
+ if (optdebug)
+ printf ("Logicalif.\n");
+
+ logicalif_optimize (root, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Arithmeticif:
+ if (optdebug)
+ printf ("ArithmeticIf.\n");
+
+ if (root->astnode.arithmeticif.cond != NULL)
+ expr_optimize (root->astnode.arithmeticif.cond, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Label:
+ if (optdebug)
+ printf ("Label.\n");
+
+ if((root->astnode.label.stmt != NULL) &&
+ (root->astnode.label.stmt->nodetype != Format))
+ optimize(root->astnode.label.stmt, rptr);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ optimize (root->nextstmt, rptr);
+ break;
+ case Write:
+ if (optdebug)
+ printf ("Write statement.\n");
+
+ write_optimize(root, rptr);
+
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case Read:
+ if (optdebug)
+ printf ("Read statement.\n");
+
+ read_optimize (root, rptr);
+
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case StmtLabelAssign:
+ if (optdebug)
+ printf ("StmtLabelAssign.\n");
+
+ assign_optimize (root, rptr);
+
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case Format:
+ case Stop:
+ case Pause:
+ case Save:
+ case CommonList:
+ case ComputedGoto:
+ case AssignedGoto:
+ case Dimension:
+ case Goto:
+ case Return:
+ case Statement:
+ case Comment:
+ case MainComment:
+ case DataList:
+ case Equivalence:
+ case Typedec:
+ case Unimplemented:
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case Specification:
+ spec_optimize(root, rptr);
+ if (root->nextstmt != NULL)
+ optimize (root->nextstmt, rptr);
+ break;
+ case End:
+ break;
+ case Constant:
+ default:
+ fprintf(stderr,"optimize(): Error, bad nodetype (%s)\n",
+ print_nodetype(root));
+ } /* switch on nodetype. */
+}
+
+/*****************************************************************************
+ * *
+ * spec_optimize *
+ * *
+ * The only Specification we really care about here is the EXTERNAL *
+ * declaration. For each function declared external, we attempt to *
+ * optimize that function. This way we can be assured that when we're *
+ * optimizing the executable code for this function, we already know *
+ * which args to each function must be passed by reference. *
+ * *
+ *****************************************************************************/
+
+void
+spec_optimize(AST *root, AST *rptr)
+{
+ SYMTABLE *opt_external_table = rptr->astnode.source.external_table;
+ AST *temp;
+ HASHNODE *ht;
+
+ switch (root->astnode.typeunit.specification)
+ {
+ case Parameter:
+ case Implicit:
+ break;
+ case Intrinsic:
+ /* name_optimize will ignore Intrinsics */
+ name_optimize (root,rptr);
+ break;
+ case External:
+ temp = root->astnode.typeunit.declist;
+ for(;temp != NULL;temp = temp->nextstmt) {
+
+ if(optdebug)
+ printf("external %s\n", temp->astnode.ident.name);
+
+ if(type_lookup(opt_external_table,temp->astnode.ident.name))
+ {
+ if(optdebug)
+ printf("going to optimize external %s\n",temp->astnode.ident.name);
+
+ ht = type_lookup(global_func_table,temp->astnode.ident.name);
+ if(!ht)
+ continue;
+
+ optScalar(ht->variable);
+ }
+ }
+ break;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * external_optimize *
+ * *
+ * This function is called when we're looking at a name that is declared *
+ * EXTERNAL. Normally, this corresponds to a function/subroutine call. *
+ * *
+ *****************************************************************************/
+
+void
+external_optimize(AST *root, AST *rptr)
+{
+ char *tempname;
+
+ if(optdebug) {
+ printf("here we are in external_optimize\n");
+ printf("nodetype = %s, parent nodetype = %s\n",
+ print_nodetype(root),print_nodetype(root->parent));
+ }
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ /*
+ * This block of code is only called if the identifier
+ * absolutely does not have an entry in any table,
+ * and corresponds to a method invocation of
+ * something in the blas or lapack packages.
+ */
+
+ if (methodscan(intrinsic_toks,tempname) == NULL)
+ {
+ if (root->astnode.ident.arraylist != NULL)
+ call_optimize (root, rptr);
+
+ f2jfree(tempname, strlen(tempname)+1);
+ return;
+ }
+
+ f2jfree(tempname, strlen(tempname)+1);
+}
+
+/*****************************************************************************
+ * *
+ * name_optimize *
+ * *
+ * Surprisingly, we dont do much here in name_optimze. If the name looks *
+ * like an EXTERNAL, call external_optimize. If it looks like a call of *
+ * some sort, but we didn't find it in the external or intrinsic tables, *
+ * call subcall_optimize. *
+ * *
+ *****************************************************************************/
+
+void
+name_optimize (AST * root, AST *rptr)
+{
+ HASHNODE *hashtemp;
+ char * tempname;
+ SYMTABLE *opt_external_table = rptr->astnode.source.external_table;
+ SYMTABLE *opt_intrinsic_table = rptr->astnode.source.intrinsic_table;
+ SYMTABLE *opt_type_table = rptr->astnode.source.type_table;
+ SYMTABLE *opt_array_table = rptr->astnode.source.array_table;
+
+
+ if(optdebug) {
+ printf("here in name_optimize... %s\n",print_nodetype(root));
+ if(root->nodetype == Identifier)
+ printf("name is %s\n",root->astnode.ident.name);
+ }
+
+ /*
+ * Check to see whether name is in external table. Names are
+ * loaded into the external table from the parser.
+ */
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+
+ hashtemp = type_lookup (opt_array_table, root->astnode.ident.name);
+ if(root->astnode.ident.arraylist == NULL){
+ return;
+ }
+ else if(hashtemp){
+ return;
+ }
+
+
+ /*
+ * If the name is in the external table, then check to see if
+ * it is an intrinsic function instead (e.g. SQRT, ABS, etc).
+ */
+
+ hashtemp = type_lookup (global_func_table, root->astnode.ident.name);
+ if ((hashtemp != NULL)||(type_lookup(opt_external_table, root->astnode.ident.name))
+ ||(find_method(root->astnode.ident.name, descriptor_table)))
+ {
+ if(hashtemp){
+ optScalar(hashtemp->variable);
+ if(optdebug)
+ printf("going to external_optimize\n");
+ }
+ external_optimize(root, rptr);
+ }
+ else if(( methodscan (intrinsic_toks, tempname) != NULL)
+ && ( (type_lookup(opt_intrinsic_table, root->astnode.ident.name) != NULL)
+ || (type_lookup(opt_type_table, root->astnode.ident.name) == NULL)))
+ {
+ if(optdebug)
+ printf("looks like an intrinsic\n");
+ }
+ else
+ switch (root->token)
+ {
+ case STRING:
+ case CHAR:
+ case INTRINSIC:
+ /* do nothing */
+ break;
+ case NAME:
+ default:
+
+ if(optdebug)
+ printf("going to subcall_optimize\n");
+
+ subcall_optimize(root, rptr);
+ break;
+ }
+
+ f2jfree(tempname, strlen(tempname) +1);
+}
+
+/*****************************************************************************
+ * *
+ * subcall_optimize *
+ * *
+ * This function optimizes a function call. I think this function *
+ * is only called in cases where the function or subroutine is *
+ * not declared external or intrinsic and we dont know what *
+ * else to do with it. in that case, we may not have visited the *
+ * function yet, so we do that if necessary. *
+ * *
+ *****************************************************************************/
+
+void
+subcall_optimize(AST *root, AST *rptr)
+{
+ AST *temp;
+ char *tempstr;
+
+ tempstr = strdup (root->astnode.ident.name);
+ *tempstr = toupper (*tempstr);
+
+ temp = root->astnode.ident.arraylist;
+
+ if(temp->nodetype != EmptyArgList)
+ args_optimize(root,rptr);
+ /*
+ for (; temp != NULL; temp = temp->nextstmt)
+ {
+ if (*temp->astnode.ident.name != '*')
+ expr_optimize (temp, rptr);
+ }
+ */
+}
+
+/*****************************************************************************
+ * *
+ * expr_optimize *
+ * *
+ * All this will do is optimize an expression. *
+ * Needs to be extended for arrays, etc. Consider using *
+ * a switch/case structure for this. *
+ * *
+ *****************************************************************************/
+
+void
+expr_optimize (AST * root, AST *rptr)
+{
+ if(root == NULL)
+ {
+ fprintf(stderr,"Warning: NULL root in expr_optimize\n");
+ return;
+ }
+
+ switch (root->nodetype)
+ {
+ case Identifier:
+ name_optimize (root, rptr);
+ break;
+ case Unaryop:
+ expr_optimize (root->astnode.expression.rhs, rptr);
+ break;
+ case Constant:
+
+ /*
+ * here we need to determine if this is a parameter to a function
+ * or subroutine. if so, and we are using wrappers, then we need
+ * to create a temporary wrapper and pass that in instead of the
+ * constant. 10/9/97 -- Keith
+ */
+
+/*
+ * if(root->parent != NULL)
+ * {
+ * tempname = strdup(root->parent->astnode.ident.name);
+ * uppercase(tempname);
+ * }
+ */
+ break;
+ case Expression:
+ case Logicalop:
+ if (root->astnode.expression.lhs != NULL)
+ expr_optimize (root->astnode.expression.lhs, rptr);
+ expr_optimize (root->astnode.expression.rhs, rptr);
+ break;
+ case Power:
+ case Binaryop:
+ case Relationalop:
+
+ expr_optimize (root->astnode.expression.lhs, rptr);
+ expr_optimize (root->astnode.expression.rhs, rptr);
+ break;
+ case Substring:
+ if(root->astnode.ident.startDim[0])
+ expr_optimize(root->astnode.ident.startDim[0], rptr);
+ if(root->astnode.ident.endDim[0])
+ expr_optimize(root->astnode.ident.endDim[0], rptr);
+ if(root->astnode.ident.startDim[1])
+ expr_optimize(root->astnode.ident.startDim[1], rptr);
+ break;
+ default:
+ fprintf(stderr,"Warning: Unknown nodetype in expr_optimize(): %s\n",
+ print_nodetype(root));
+ }
+}
+
+
+/*****************************************************************************
+ * *
+ * forloop_optimize *
+ * *
+ * This function traverses forloops. Nothing much happens here. *
+ * *
+ *****************************************************************************/
+
+void
+forloop_optimize (AST * root, AST *rptr)
+{
+/*
+ * char *indexname;
+ * int *tmp_int;
+ *
+ * tmp_int = (int*)f2jalloc(sizeof(int));
+ *
+ * *tmp_int = atoi(root->astnode.forloop.Label->astnode.constant.number);
+ */
+
+ /*
+ * Some point I will need to test whether this is really a name
+ * because it will crash if not.
+ *
+ * indexname =
+ * root->astnode.forloop.start->astnode.assignment.lhs->astnode.ident.name;
+ */
+
+ if(root->astnode.forloop.incr != NULL)
+ expr_optimize (root->astnode.forloop.incr, rptr);
+
+ assign_optimize (root->astnode.forloop.start, rptr);
+
+ if(root->astnode.forloop.incr == NULL)
+ {
+ name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr);
+
+ expr_optimize (root->astnode.forloop.stop, rptr);
+
+
+ name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr);
+
+ }
+ else
+ {
+ name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr);
+ expr_optimize (root->astnode.forloop.stop, rptr);
+ name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr);
+ expr_optimize (root->astnode.forloop.stop, rptr);
+
+ name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * logicalif_optimize *
+ * *
+ * Optimize a logical if statement. *
+ * *
+ *****************************************************************************/
+
+void
+logicalif_optimize (AST * root, AST *rptr)
+{
+ if (root->astnode.logicalif.conds != NULL)
+ expr_optimize (root->astnode.logicalif.conds, rptr);
+ optimize (root->astnode.logicalif.stmts, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * write_optimize *
+ * *
+ * Optimize a WRITE statement. *
+ * *
+ *****************************************************************************/
+
+void
+write_optimize (AST * root, AST *rptr)
+{
+ AST *temp;
+
+ for(temp = root->astnode.io_stmt.arg_list; temp!=NULL;temp=temp->nextstmt)
+ if(temp->nodetype != IoImpliedLoop)
+ expr_optimize(temp, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * read_optimize *
+ * *
+ * Optimize a READ statement. Here we examine each argument of the READ *
+ * statement to determine whether it's an argument to the current function. *
+ * If so, we must mark it as pass by reference.
+ * *
+ *****************************************************************************/
+
+void
+read_optimize (AST * root, AST *rptr)
+{
+ SYMTABLE *opt_args_table = rptr->astnode.source.args_table;
+ SYMTABLE *opt_type_table = rptr->astnode.source.type_table;
+ SYMTABLE *opt_common_table = rptr->astnode.source.common_table;
+ SYMTABLE *opt_array_table = rptr->astnode.source.array_table;
+ HASHNODE *ht;
+ AST *temp;
+
+ if(root->astnode.io_stmt.arg_list == NULL) {
+ return;
+ }
+
+ /* for each arg... */
+ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(temp->nodetype == IoImpliedLoop)
+ read_implied_loop_optimize(temp, rptr);
+ else if(temp->nodetype == Identifier)
+ {
+ name_optimize(temp, rptr);
+
+ ht = type_lookup(opt_type_table,temp->astnode.ident.name);
+ if(ht) {
+ if((type_lookup(opt_args_table, temp->astnode.ident.name) != NULL) &&
+ (type_lookup(opt_common_table, temp->astnode.ident.name) == NULL) &&
+ (type_lookup(opt_array_table, temp->astnode.ident.name) == NULL))
+ ht->variable->astnode.ident.passByRef = TRUE;
+ }
+ }
+ else
+ {
+ fprintf(stderr,"Read list must consist of idents or implied loops\n");
+ fprintf(stderr," nodetype is %s\n", print_nodetype(temp));
+ continue;
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * read_implied_loop_optimize *
+ * *
+ * We're looking at an implied loop in a READ statement. The only time we *
+ * care about arrays being 'pass by reference' is when we're generating *
+ * the front-end inteerface. In that case, we use the passByRef field *
+ * to determine which arrays must be copied back after the call. *
+ * *
+ *****************************************************************************/
+
+void
+read_implied_loop_optimize(AST *node, AST *rptr)
+{
+ AST *temp;
+
+ /* NOTE: we need to set the passByRef field of the array somewhere in here */
+
+ expr_optimize(node->astnode.forloop.start, rptr);
+ expr_optimize(node->astnode.forloop.stop, rptr);
+ if(node->astnode.forloop.incr != NULL)
+ expr_optimize(node->astnode.forloop.incr, rptr);
+
+ for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt)
+ {
+ if(temp->nodetype != Identifier) {
+ fprintf(stderr,"Cant handle this nodetype (%s) ",
+ print_nodetype(temp));
+ fprintf(stderr," in implied loop (read stmt)\n");
+ }
+ else {
+ name_optimize(temp, rptr);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * blockif_optimize *
+ * *
+ * Here we have a block IF statement. We should optimize the expression *
+ * and the statements.
+ * *
+ *****************************************************************************/
+
+void
+blockif_optimize (AST * root, AST *rptr)
+{
+ AST *prev = root->prevstmt;
+ AST *temp;
+/* int *tmp_int; */
+
+ /* This function could probably be simplified by getting rid of all the
+ * while detection code. It isn't really necessary here.
+ */
+
+/* tmp_int = (int*)f2jalloc(sizeof(int)); */
+
+ /* if the previous node was a label, this could be a simulated
+ * while loop.
+ */
+ if(prev != NULL)
+ if(prev->nodetype == Label)
+ {
+/* *tmp_int = root->prevstmt->astnode.label.number; */
+
+ if(prev->astnode.label.stmt == NULL)
+ if((root->astnode.blockif.elseifstmts == NULL) &&
+ (root->astnode.blockif.elsestmts == NULL))
+ {
+ /* it appears that we are looking at a simulated while loop.
+ * bypass all the statements in the body of this if block
+ * and look at the last one. if it is a goto and the
+ * target is the label of the current if statement, then
+ * we generate a Java while loop. otherwise, we generate
+ * an if statement.
+ */
+ for
+ (
+ temp=root->astnode.blockif.stmts;
+ temp->nextstmt!=NULL;
+ temp = temp->nextstmt
+ )
+ ; /* do nothing */
+ if(temp->nodetype == Goto)
+ if(temp->astnode.go_to.label == prev->astnode.label.number) {
+ while_optimize(root, rptr);
+ return;
+ }
+ }
+
+ }
+
+ if (root->astnode.blockif.conds != NULL)
+ expr_optimize (root->astnode.blockif.conds, rptr);
+
+ if (root->astnode.blockif.stmts != NULL)
+ optimize (root->astnode.blockif.stmts, rptr);
+
+ for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt)
+ elseif_optimize (temp, rptr);
+
+ if (root->astnode.blockif.elsestmts != NULL)
+ else_optimize (root->astnode.blockif.elsestmts, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * while_optimize *
+ * *
+ * while_optimize() is called when an if statement has been identified *
+ * as a simulated while loop. This could probably be inlined into the *
+ * block if routine. *
+ * *
+ *****************************************************************************/
+
+void
+while_optimize(AST *root, AST *rptr)
+{
+
+ if (root->astnode.blockif.conds != NULL)
+ expr_optimize (root->astnode.blockif.conds, rptr);
+ optimize (root->astnode.blockif.stmts, rptr);
+
+}
+
+/*****************************************************************************
+ * *
+ * elseif_optimize *
+ * *
+ * Nothing special here. we examine the elseif portion of a block if. *
+ * *
+ *****************************************************************************/
+
+void
+elseif_optimize (AST * root, AST *rptr)
+{
+ if (root->astnode.blockif.conds != NULL)
+ expr_optimize (root->astnode.blockif.conds, rptr);
+ optimize (root->astnode.blockif.stmts, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * else_optimize *
+ * *
+ * Here we examine the else portion of a block if. *
+ * *
+ *****************************************************************************/
+
+void
+else_optimize (AST * root, AST *rptr)
+{
+ optimize (root->astnode.blockif.stmts, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * call_optimize *
+ * *
+ * Handles external calls. What we really want to know is whether any of *
+ * the arguments to the function we're calling are passed by reference. *
+ * If so, we must wrap the corresponding variable in this function. *
+ * *
+ *****************************************************************************/
+
+void
+call_optimize (AST * root, AST *rptr)
+{
+ SYMTABLE *opt_args_table = rptr->astnode.source.args_table;
+ AST *temp;
+ HASHNODE *hashtemp;
+
+ if(optdebug)
+ printf("enter call_optimize\n");
+
+ assert (root != NULL);
+
+ /* If this function was passed in as an argument, we call an
+ * 'adapter' which performs the reflective method invocation..
+ */
+
+ if(root->astnode.ident.arraylist->nodetype == EmptyArgList){
+ hashtemp = type_lookup(global_func_table, root->astnode.ident.name);
+ if(hashtemp)
+ optScalar(hashtemp->variable);
+ return;
+ }
+
+
+ if(type_lookup(opt_args_table, root->astnode.ident.name)) {
+
+ /* if this function has no args, we can simplify the calling
+ * process by not creating an argument array or calling a
+ * method adapter.
+ */
+
+ if((root->astnode.ident.arraylist->nodetype == EmptyArgList) ||
+ (root->astnode.ident.arraylist == NULL)) {
+
+ /* no args. either function or subroutine. */
+
+ return;
+ }
+ else if (root->nodetype == Call) {
+
+ /* subroutine with args. */
+
+ for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt)
+ expr_optimize (temp, rptr);
+
+ return;
+ }
+ }
+
+ if(root->astnode.ident.arraylist->nodetype == EmptyArgList)
+ return;
+
+ /* look up the function name so that we may compare the parameters */
+
+ if(optdebug)
+ printf("looking up %s in the global func table\n",root->astnode.ident.name);
+
+ args_optimize(root, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * args_optimize *
+ * *
+ * this function handles the args to a function/subroutine call. If the *
+ * arguments to the function we're calling are passed by reference, then *
+ * we must wrap the corresponding variable in this function. *
+ * *
+ *****************************************************************************/
+
+void
+args_optimize(AST *root, AST *rptr)
+{
+ SYMTABLE *opt_array_table = rptr->astnode.source.array_table;
+ HASHNODE *hashtemp;
+ JVM_METHODREF *mref;
+ AST *temp;
+
+ if((hashtemp=type_lookup(global_func_table,root->astnode.ident.name))!=NULL)
+ {
+ AST *t2;
+
+ if(optdebug)
+ printf("call_optimize(): found %s in global function table.\n",
+ root->astnode.ident.name);
+
+ if(hashtemp->variable->astnode.source.scalarOptStatus == NOT_VISITED)
+ optScalar(hashtemp->variable);
+
+ temp = root->astnode.ident.arraylist;
+ t2=hashtemp->variable->astnode.source.progtype->astnode.source.args;
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ {
+ expr_optimize(temp, rptr);
+
+ if(temp->nodetype == Identifier)
+ {
+ /* now we check whether the function/subroutine expects this
+ * to be passed by reference.
+ */
+
+ if(t2->astnode.ident.passByRef) {
+ if(optdebug)
+ printf("call_optimize(): '%s' is pass by ref.\n",
+ temp->astnode.ident.name);
+
+ if((!temp->astnode.ident.arraylist) &&
+ !type_lookup(opt_array_table, temp->astnode.ident.name))
+ set_passByRef(temp, rptr);
+ }
+ else {
+ if(optdebug)
+ printf("call_optimize(): '%s' is NOT pass by ref.\n",
+ temp->astnode.ident.name);
+ }
+ }
+
+ /* if the function/subroutine expects an array, but
+ * the arg is a scalar, then pass by reference.
+ */
+
+ if( !type_lookup(opt_array_table,temp->astnode.ident.name) &&
+ t2->astnode.ident.arraylist )
+ {
+ set_passByRef(temp, rptr);
+ }
+
+ if(t2 != NULL)
+ t2 = t2->nextstmt;
+ }
+ }
+ else if((mref=find_method(root->astnode.ident.name,descriptor_table))!=NULL)
+ {
+ char *p;
+
+ if(optdebug) {
+ printf("call_optimize(): found %s in descriptor table.\n",
+ root->astnode.ident.name);
+ printf("call_optimize() - class: %s\n", mref->classname);
+ printf("call_optimize() - method: %s\n", mref->methodname);
+ printf("call_optimize() - desc: %s\n", mref->descriptor);
+ }
+
+ temp = root->astnode.ident.arraylist;
+ p = mref->descriptor;
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ {
+ expr_optimize(temp, rptr);
+
+ p = bc_next_desc_token(p);
+
+ if(optdebug)
+ printf("call_optimize() - p = %s\n",p);
+
+ if(temp->nodetype == Identifier)
+ {
+ /* now we check whether the function/subroutine expects this
+ * to be passed by reference. in this case, we check the first
+ * character of the argument descriptor. if it's 'L', then it
+ * must be an object reference.
+ */
+
+ if(isPassByRef_desc(p))
+ if((!temp->astnode.ident.arraylist) &&
+ !type_lookup(opt_array_table, temp->astnode.ident.name))
+ set_passByRef(temp, rptr);
+ }
+
+ /* skip extra element to compensate for array offset arg */
+ if(p[0] == '[') {
+ if(!type_lookup(opt_array_table, temp->astnode.ident.name))
+ set_passByRef(temp, rptr);
+
+ p = bc_next_desc_token(p);
+ }
+ }
+ }
+ else
+ {
+ if(optdebug)
+ printf("call_optimize(): %s not found in global function table.\n",
+ root->astnode.ident.name);
+
+ temp = root->astnode.ident.arraylist;
+
+ for( ; temp != NULL; temp = temp->nextstmt)
+ expr_optimize (temp, rptr);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * isPassByRef_desc *
+ * *
+ * given the field descriptor for a method argument, determine whether this *
+ * arg is passed by reference. returns BOOL. *
+ * *
+ *****************************************************************************/
+
+BOOL
+isPassByRef_desc(char *desc)
+{
+ char *desc_copy, *dptr;
+
+ if(optdebug)
+ printf("isPassByRef_desc, desc = %s\n", desc);
+
+ /* quick check.. if the first char is not L then this can't be
+ * pass by reference.
+ */
+ if(desc[0] != 'L') {
+ if(optdebug)
+ printf("returning FALSE\n");
+ return FALSE;
+ }
+
+ /* copy the descriptor and chop off the remainder. */
+ desc_copy = strdup(desc);
+ dptr = bc_next_desc_token(desc_copy);
+ if(dptr != NULL)
+ *dptr = '\0';
+
+ /* if the data type is String or Object, then it's not really
+ * pass by reference, even though it's a reference data type.
+ */
+ if(!strcmp(desc_copy,"Ljava/lang/String;") ||
+ !strcmp(desc_copy,"Ljava/lang/Object;"))
+ {
+ if(optdebug)
+ printf("returning FALSE\n");
+ f2jfree(desc_copy, strlen(desc_copy)+1);
+ return FALSE;
+ }
+
+ f2jfree(desc_copy, strlen(desc_copy)+1);
+
+ /* didn't hit any of the above cases, so this must be
+ * pass by reference.
+ */
+
+ return TRUE;
+}
+
+/*****************************************************************************
+ * *
+ * set_passByRef *
+ * *
+ * this function sets the passByRef field of this ident & any corresponding *
+ * COMMON block to TRUE. *
+ * *
+ *****************************************************************************/
+
+void
+set_passByRef(AST *temp, AST *rptr)
+{
+ SYMTABLE *opt_common_table = rptr->astnode.source.common_table;
+ SYMTABLE *opt_type_table = rptr->astnode.source.type_table;
+ HASHNODE *ht, *ht2, *ht3;
+ AST *temp2;
+ int cnt;
+
+ ht = type_lookup(opt_type_table,temp->astnode.ident.name);
+ if(ht) {
+ ht->variable->astnode.ident.passByRef = TRUE;
+
+ ht2 = type_lookup(opt_common_table,temp->astnode.ident.name);
+ if(ht2) {
+ ht3 = type_lookup(global_common_table,
+ ht2->variable->astnode.ident.commonBlockName);
+
+ if(ht3) {
+
+ /* special handling for COMMON variables */
+
+ temp2 = ht3->variable->astnode.common.nlist;
+ cnt = 0;
+
+ while((cnt < ht2->variable->astnode.ident.position) &&
+ (temp2 != NULL))
+ {
+ cnt++;
+ temp2 = temp2->nextstmt;
+ }
+
+ if(temp2 != NULL) {
+ temp2->astnode.ident.passByRef = TRUE;
+ }
+ else {
+ fprintf(stderr, "optimize(): Common block length ");
+ fprintf(stderr, "does not match position of ident\n");
+ }
+ }
+ else {
+ fprintf(stderr,"Cant find common block %s\n",
+ ht2->variable->astnode.ident.commonBlockName);
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * assign_optimize *
+ * *
+ * We're looking at an assignment statement. If the LHS of this assignment *
+ * is an argument to the current function, then it must be classified as *
+ * pass by reference. *
+ * *
+ *****************************************************************************/
+
+void
+assign_optimize (AST * root, AST *rptr)
+{
+ SYMTABLE *opt_args_table = rptr->astnode.source.args_table;
+ SYMTABLE *opt_type_table = rptr->astnode.source.type_table;
+ SYMTABLE *opt_common_table = rptr->astnode.source.common_table;
+ SYMTABLE *opt_array_table = rptr->astnode.source.array_table;
+ HASHNODE *ht;
+ AST *lhs;
+
+ lhs = root->astnode.assignment.lhs;
+
+ name_optimize (lhs, rptr);
+
+ ht=type_lookup(opt_type_table,lhs->astnode.ident.name);
+
+ if(ht) {
+ /* check if the LHS is an array access. if so, then we really
+ * should not set passByRef to TRUE here because setting an array
+ * element does not require wrapping the array (not that we support
+ * wrapping array references anyway).
+ *
+ * also check if the LHS is in a common block. shouldn't need to
+ * wrap common variables.
+ */
+
+ if(lhs->astnode.ident.arraylist == NULL)
+ if((type_lookup(opt_args_table, lhs->astnode.ident.name) != NULL) &&
+ (type_lookup(opt_common_table, lhs->astnode.ident.name) == NULL) &&
+ (type_lookup(opt_array_table, lhs->astnode.ident.name) == NULL))
+ ht->variable->astnode.ident.passByRef = TRUE;
+
+ if( optdebug )
+ if( ht->variable->astnode.ident.passByRef == TRUE )
+ printf("set passByRef for '%s'\n", lhs->astnode.ident.name);
+ }
+ else
+ fprintf(stderr,"Can't find lhs of assignment: %s\n",
+ root->astnode.assignment.lhs->astnode.ident.name);
+
+ expr_optimize (root->astnode.assignment.rhs, rptr);
+}
+
+/*****************************************************************************
+ * *
+ * get_method_descriptor *
+ * *
+ * this returns the method descriptor for this program unit. *
+ * *
+ *****************************************************************************/
+
+char *
+get_method_descriptor(AST *root, SYMTABLE *ttable, SYMTABLE *ctable,
+ SYMTABLE *etable)
+{
+ struct _str * temp_desc = NULL;
+ enum returntype returns;
+ HASHNODE *hashtemp;
+ AST * tempnode;
+ int isArray;
+ char *ret_desc;
+ char *p;
+
+ temp_desc = strAppend(temp_desc, "(");
+
+ if (root->nodetype == Function)
+ {
+ returns = root->astnode.source.returns;
+ ret_desc = field_descriptor[returns][0];
+ }
+ else /* Program or Subroutine */
+ ret_desc = "V";
+
+ /*
+ * Now traverse the list of constructor arguments for either
+ * functions or subroutines. This is where I will
+ * have to check what the variable type is in the
+ * symbol table.
+ */
+
+ tempnode = root->astnode.source.args;
+
+ for (; tempnode != NULL; tempnode = tempnode->nextstmt)
+ {
+ hashtemp = type_lookup (ttable, tempnode->astnode.ident.name);
+ if (hashtemp == NULL)
+ {
+ if(type_lookup(etable, tempnode->astnode.ident.name) != NULL) {
+ temp_desc = strAppend(temp_desc, field_descriptor[Object][0]);
+ continue;
+ }
+ else {
+ fprintf (stderr,"Type table is screwed (optimize.c).\n");
+ fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name);
+ exit(EXIT_FAILURE);
+ }
+ }
+
+ isArray = hashtemp->variable->astnode.ident.arraylist != NULL;
+
+ /* If this variable is declared external and it is an argument to
+ * this program unit, it must be declared as Object in Java.
+ */
+
+ if(type_lookup(etable, tempnode->astnode.ident.name) != NULL)
+ returns = OBJECT_TYPE;
+ else
+ returns = hashtemp->variable->vartype;
+
+ /*
+ * Check the numerical value returns. It should not
+ * exceed the value of the enum returntypes.
+ */
+
+ if (returns > MAX_RETURNS)
+ fprintf (stderr,"Bad return value, check types.\n");
+
+ if(optdebug)
+ printf("@#OPTIMIZE(%s) - arg = '%s'\n",
+ root->astnode.source.name->astnode.ident.name,
+ tempnode->astnode.ident.name);
+
+ if(omitWrappers) {
+ if((hashtemp->variable->astnode.ident.arraylist == NULL) &&
+ isPassByRef(tempnode->astnode.ident.name,ttable,ctable,etable))
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[returns][isArray]);
+ else
+ temp_desc = strAppend(temp_desc, field_descriptor[returns][isArray]);
+ }
+ else
+ {
+ if (hashtemp->variable->astnode.ident.arraylist == NULL)
+ temp_desc = strAppend(temp_desc,
+ wrapped_field_descriptor[returns][isArray]);
+ else
+ temp_desc = strAppend(temp_desc, field_descriptor[returns][isArray]);
+ }
+ /* if this is an array, then append an I to the descriptor to
+ * represent the integer offset arg.
+ */
+
+ if(isArray)
+ temp_desc = strAppend(temp_desc, "I");
+ }
+
+ /* finish off the method descriptor.
+ * for Functions, use the return descriptor calculated above.
+ * for Programs, the descriptor must be ([Ljava/lang/String;)V.
+ * for Subroutines, use void as the return type.
+ */
+
+ if(root->nodetype == Function) {
+ temp_desc = strAppend(temp_desc, ")");
+ temp_desc = strAppend(temp_desc, ret_desc);
+ }
+ else if(root->nodetype == Program) {
+ temp_desc = strAppend(temp_desc, "[Ljava/lang/String;)V");
+ }
+ else {
+ temp_desc = strAppend(temp_desc, ")V");
+ }
+
+ p = temp_desc->val;
+
+ f2jfree(temp_desc, sizeof(struct _str));
+
+ return p;
+}
diff --git a/src/symtab.c b/src/symtab.c
new file mode 100644
index 0000000..f6ac21f
--- /dev/null
+++ b/src/symtab.c
@@ -0,0 +1,291 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/symtab.c,v $
+ * $Revision: 1.23 $
+ * $Date: 2007/01/18 22:02:37 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * symtab.c *
+ * *
+ * Contains routines for creating and manipulating symbol tables. *
+ * *
+ *****************************************************************************/
+
+#include<stdio.h>
+#include<stdlib.h>
+#include"string.h"
+#include"f2j.h"
+#include"symtab.h"
+#include"f2jmem.h"
+
+/*****************************************************************************
+ * Globals and Function prototypes: *
+ *****************************************************************************/
+
+BOOL symdebug = FALSE; /* set TRUE for debugging output */
+
+/* define which of three possible hashing functions to use. */
+
+#define HASH(x) hash(x)
+
+unsigned int HashPJW (const char *);
+unsigned int hash (const char *);
+
+SYMTABLE * new_symtable (unsigned int);
+void type_insert (SYMTABLE *, AST *, enum returntype, char *);
+HASHNODE * format_lookup(SYMTABLE *, char *);
+
+/*****************************************************************************
+ * *
+ * new_symtable *
+ * *
+ * Create a new symbol table with the given number of entries. Return a *
+ * pointer to the table. *
+ * *
+ *****************************************************************************/
+
+SYMTABLE *
+new_symtable (unsigned int numentries)
+{
+ SYMTABLE *newtable;
+ newtable = (SYMTABLE *) f2jalloc (sizeof (SYMTABLE));
+
+ newtable->num_entries = numentries;
+ newtable->num_items = 0;
+ newtable->entry = (HASHNODE **) f2jcalloc (numentries, sizeof (HASHNODE *));
+
+ return (newtable);
+} /* Close new_symtable(). */
+
+/*****************************************************************************
+ * *
+ * type_insert *
+ * *
+ * Insert a node into the given table. *
+ * *
+ * now accepts entire symbol table as argument instead of just one entry. *
+ * this allows removing a lot of redundant code throughout the parser... *
+ * e.g. computing the hash index. kgs 3/30/00 *
+ * *
+ *****************************************************************************/
+
+void
+type_insert (SYMTABLE * table, AST * node_val, enum returntype rt, char *tag)
+{
+ HASHNODE *newnode;
+ int idx;
+
+
+ idx = HASH(tag) % table->num_entries;
+
+ /*fprintf(stderr,"type_insert(): table = %p, tag = '%s', idx = %d\n", table, tag, idx);*/
+ newnode = (HASHNODE *) f2jalloc (sizeof (HASHNODE));
+
+ newnode->ident = tag;
+ newnode->type = rt;
+ newnode->variable = node_val;
+ newnode->next = table->entry[idx];
+ table->entry[idx] = newnode;
+
+ table->num_items++;
+}
+
+
+/*****************************************************************************
+ * *
+ * type_lookup *
+ * *
+ * This is a specific lookup routine to match an id with *
+ * its associated type. I will need others for matching *
+ * externals, intrinsics, etc. *
+ * *
+ *****************************************************************************/
+
+HASHNODE *
+type_lookup (SYMTABLE * table, char *id)
+{
+ int index;
+ HASHNODE *hash_entry;
+
+ if((table == NULL) || (id == NULL)) {
+ return NULL;
+ }
+
+ index = HASH (id) % table->num_entries;
+
+ hash_entry = search_hashlist (table->entry[index], id);
+ if (hash_entry == NULL)
+ {
+ if(symdebug)
+ printf("Not in table.\n");
+ return NULL;
+ }
+ else /* Attempt to return the value pointed to by "type". */
+ {
+ if(symdebug)
+ printf("In table.\n");
+ return (hash_entry);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * format_lookup *
+ * *
+ * Look for a FORMAT statement in the given table. *
+ * *
+ *****************************************************************************/
+
+HASHNODE * format_lookup(SYMTABLE *table, char *label)
+{
+ /* why does this function exist?? kgs */
+
+ return type_lookup(table,label);
+}
+
+/*****************************************************************************
+ * *
+ * search_hashlist *
+ * *
+ * If there is an entry corresponding to the given id in this list, return *
+ * a pointer to it. otherwise return NULL. *
+ * *
+ *****************************************************************************/
+
+HASHNODE *
+search_hashlist (HASHNODE * list, char *id)
+{
+ if(id == NULL)
+ return NULL;
+
+ for (; list; list = list->next)
+ {
+ if(list->ident){
+ if(!strcmp(list->ident, id))
+ return (list);
+ }
+ }
+
+ return NULL; /* Not in list. */
+}
+
+
+/*****************************************************************************
+ * *
+ * hash *
+ * *
+ * Simple hash function: just add the ascii integer *
+ * values of each character in the string. *
+ * *
+ * Added error check for null string and made some *
+ * other minor changes. 12/5/97 --Keith *
+ * *
+ *****************************************************************************/
+
+unsigned int
+hash (const char *str)
+{
+ int sum = 0;
+
+ if(str == NULL)
+ return 0;
+
+ while(*str)
+ sum += *str++;
+
+ return sum;
+}
+
+/*****************************************************************************
+ * HashPJW *
+ * *
+ * An adaptation of Peter Weinberger's (PJW) generic hashing *
+ * algorithm based on Allen Holub's version. Accepts a pointer *
+ * to a datum to be hashed and returns an unsigned integer. *
+ * *
+ *****************************************************************************/
+#include <limits.h>
+#define BITS_IN_int ( sizeof(int) * CHAR_BIT )
+#define THREE_QUARTERS ((int) ((BITS_IN_int * 3) / 4))
+#define ONE_EIGHTH ((int) (BITS_IN_int / 8))
+#define HIGH_BITS ( ~((unsigned int)(~0) >> ONE_EIGHTH ))
+
+unsigned int HashPJW ( const char * datum )
+{
+ unsigned int hash_value, i;
+ for ( hash_value = 0; *datum; ++datum )
+ {
+ hash_value = ( hash_value << ONE_EIGHTH ) + *datum;
+ if (( i = hash_value & HIGH_BITS ) != 0 )
+ hash_value =
+ ( hash_value ^ ( i >> THREE_QUARTERS )) &
+ ~HIGH_BITS;
+ }
+ return ( hash_value );
+}
+
+/*****************************************************************************
+ * *
+ * enumerate_symtable *
+ * *
+ * Create a doubly linked list containing all entries in the given *
+ * symbol table. *
+ * *
+ *****************************************************************************/
+
+Dlist
+enumerate_symtable(SYMTABLE *table)
+{
+ Dlist newList = make_dl();
+ HASHNODE *tmp;
+ int i;
+
+ for(i=0;i<table->num_entries;i++){
+ for(tmp = table->entry[i]; tmp != NULL; tmp = tmp->next){
+ dl_insert_b(newList,tmp->variable);
+ }
+ }
+
+ return newList;
+}
+
+/******************************************************************************
+* *
+* hash_delete *
+* *
+* This function removes the entry corresponding to the given tag. The *
+* deleted node is returned if found, otherwise return NULL. *
+* *
+*******************************************************************************/
+HASHNODE *
+hash_delete(SYMTABLE *table, char *tag)
+{
+ HASHNODE *list, *prev;
+ int idx;
+
+ if((table == NULL) || (tag == NULL))
+ return NULL;
+
+ idx = HASH (tag) % table->num_entries;
+ list = table->entry[idx];
+
+ for (prev = NULL; list; list = list->next)
+ {
+ if(list->ident == NULL)
+ prev = list;
+ else if (!strcmp (list->ident, tag)) {
+ if(prev)
+ prev->next = list->next;
+ else
+ table->entry[idx] = list->next;
+
+ return (list);
+ }
+
+ prev = list;
+ }
+
+ return NULL; /* Not in list. */
+}
diff --git a/src/symtab.h b/src/symtab.h
new file mode 100644
index 0000000..dacaac7
--- /dev/null
+++ b/src/symtab.h
@@ -0,0 +1,67 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/symtab.h,v $
+ * $Revision: 1.12 $
+ * $Date: 2004/02/04 06:25:44 $
+ * $Author: keithseymour $
+ */
+
+
+#ifndef _SYMTAB_H
+#define _SYMTAB_H
+
+/*****************************************************************************
+ * symtab.h *
+ * *
+ * Header file for the symbol table routines. *
+ * *
+ *****************************************************************************/
+
+#include<string.h>
+#include "dlist.h"
+
+/* Enumeration of the different return types */
+
+enum returntype
+{
+ String, Character, Complex, Double, Float, Integer, Logical, Object
+};
+
+/*****************************************************************************
+ * Structure of a hash table node. *
+ *****************************************************************************/
+
+typedef struct hash_node
+{
+ struct ast_node *variable; /* The variable corresponding to this entry */
+ char *ident; /* String tag */
+ enum returntype type; /* The variable's data type */
+ struct hash_node *next; /* Next node */
+}
+HASHNODE;
+
+/*****************************************************************************
+ * Function prototypes to keep the compiler from complaining. *
+ *****************************************************************************/
+
+typedef struct sym_table
+{
+ int num_entries, /* Number of entries in this hash table */
+ num_items; /* Number of items stored in hash table */
+
+ HASHNODE **entry; /* Pointer to the entries */
+}
+SYMTABLE;
+
+/*****************************************************************************
+ * Function prototypes to keep the compiler from complaining. *
+ *****************************************************************************/
+
+HASHNODE
+ * search_hashlist(HASHNODE *, char *),
+ * type_lookup(SYMTABLE *, char *),
+ * hash_delete(SYMTABLE *, char *);
+
+Dlist enumerate_symtable(SYMTABLE *);
+
+
+#endif
diff --git a/src/typecheck.c b/src/typecheck.c
new file mode 100644
index 0000000..95f8a4f
--- /dev/null
+++ b/src/typecheck.c
@@ -0,0 +1,1499 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/typecheck.c,v $
+ * $Revision: 1.75 $
+ * $Date: 2007/12/14 20:56:39 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * typecheck.c *
+ * *
+ * Traverses the AST to determine the data type for all expressions. *
+ * *
+ *****************************************************************************/
+
+
+#include<stdio.h>
+#include<string.h>
+#include<ctype.h>
+#include"f2j.h"
+#include"y.tab.h"
+#include"f2jmem.h"
+#include"f2j_externs.h"
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+char
+ * merge_names(AST *);
+
+METHODTAB
+ * methodscan (METHODTAB *, char *);
+
+void
+ print_eqv_list(AST *, FILE *),
+ remove_duplicates(AST *),
+ typecheck (AST *),
+ elseif_check(AST *),
+ func_array_check(AST *),
+ else_check (AST *),
+ expr_check (AST *),
+ assign_check (AST *),
+ name_check (AST *),
+ data_check(AST *),
+ common_check(AST *),
+ call_check (AST *),
+ forloop_check (AST *),
+ blockif_check (AST *),
+ logicalif_check (AST *),
+ check_implied_loop(AST *),
+ read_write_check (AST *),
+ merge_equivalences(AST *),
+ check_equivalences(AST *),
+ insertEquivalences(AST *),
+ type_insert(SYMTABLE *, AST *, enum returntype, char *),
+ external_check(AST *),
+ typedec_check(AST *),
+ intrinsic_check(AST *),
+ array_check(AST *),
+ subcall_check(AST *);
+
+SYMTABLE
+ * new_symtable(int);
+
+extern METHODTAB intrinsic_toks[];
+
+/*****************************************************************************
+ * Global variables. *
+ *****************************************************************************/
+
+int checkdebug = FALSE; /* set to TRUE for debugging output */
+
+AST *cur_check_unit; /* program unit currently being checked */
+
+SYMTABLE
+ * chk_type_table, /* ptr to this unit's symbol table */
+ * chk_external_table, /* ptr to table of external functions */
+ * chk_intrinsic_table, /* ptr to table of intrinsics */
+ * chk_array_table; /* ptr to array table */
+
+char bitfields[] = { /* for typechecking intrinsics */
+ STRING_ARG,CHAR_ARG,COMPLEX_ARG,DOUBLE_ARG,REAL_ARG,INT_ARG,LOGICAL_ARG
+};
+
+/*****************************************************************************
+ * *
+ * typecheck *
+ * *
+ * This is the main typechecking function. We traverse the *
+ * AST and recursively call typecheck() on each node. This *
+ * function figures out what kind of node it's looking at and *
+ * calls the appropriate function to handle the typechecking. *
+ * *
+ *****************************************************************************/
+
+void
+typecheck (AST * root)
+{
+ switch (root->nodetype)
+ {
+ case 0:
+ if (checkdebug)
+ printf ("typecheck(): Bad node\n");
+ typecheck (root->nextstmt);
+ break;
+ case Progunit:
+ if (checkdebug)
+ printf ("typecheck(): Source.\n");
+
+ chk_type_table = root->astnode.source.type_table;
+ chk_external_table = root->astnode.source.external_table;
+ chk_intrinsic_table = root->astnode.source.intrinsic_table;
+ chk_array_table = root->astnode.source.array_table;
+
+ /* if there is a block of prologue comments, count the
+ * number of lines here and set it in the comment node.
+ */
+
+ if(root->astnode.source.prologComments) {
+ int prolog_len = 0;
+ AST *pltemp;
+
+ pltemp = root->astnode.source.prologComments;
+
+ while(pltemp != NULL && pltemp->nodetype == Comment) {
+ prolog_len++;
+ pltemp = pltemp->nextstmt;
+ }
+
+ root->astnode.source.prologComments->astnode.ident.len = prolog_len;
+ }
+
+ merge_equivalences(root->astnode.source.equivalences);
+
+ /* now that the equivalences have been merged and duplicates
+ * removed, we insert the variable names into a symbol table.
+ */
+
+ root->astnode.source.equivalence_table = new_symtable(211);
+ insertEquivalences(root);
+
+ check_equivalences(root->astnode.source.equivalences);
+
+ typecheck (root->astnode.source.progtype);
+ typecheck (root->astnode.source.typedecs);
+ typecheck (root->astnode.source.statements);
+
+ break;
+ case Subroutine:
+ case Function:
+ case Program:
+ {
+ AST *temp;
+
+ cur_check_unit = root;
+
+ for(temp = root->astnode.source.args;temp!=NULL;temp=temp->nextstmt)
+ if(type_lookup(chk_external_table,temp->astnode.ident.name) != NULL)
+ cur_check_unit->astnode.source.needs_reflection = TRUE;
+
+ }
+ break;
+ case End:
+ if (checkdebug)
+ printf ("typecheck(): %s.\n", print_nodetype(root));
+ break;
+ case DataList:
+ data_check(root);
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case Label:
+ if(root->astnode.label.stmt != NULL)
+ typecheck(root->astnode.label.stmt);
+
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case Equivalence:
+ if(checkdebug)
+ printf("ignoring equivalence in typechecking\n");
+
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case Arithmeticif:
+ if(checkdebug)
+ printf("typecheck(): ArithmeticIf.\n");
+
+ if (root->astnode.arithmeticif.cond != NULL)
+ expr_check (root->astnode.arithmeticif.cond);
+
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case ComputedGoto:
+ if (root->astnode.computed_goto.name)
+ expr_check(root->astnode.computed_goto.name);
+
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case AssignedGoto:
+ if (root->astnode.computed_goto.name)
+ expr_check(root->astnode.computed_goto.name);
+
+ if(root->nextstmt != NULL)
+ typecheck(root->nextstmt);
+ break;
+ case StmtLabelAssign:
+ if (checkdebug)
+ printf ("typecheck(): StmtLabelAssign.\n");
+
+ assign_check (root);
+
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Typedec:
+ typedec_check(root);
+
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Specification:
+ case Dimension:
+ case Statement:
+ case Return:
+ case Goto:
+ case Format:
+ case Stop:
+ case Pause:
+ case Save:
+ case MainComment:
+ case Unimplemented:
+
+ if (checkdebug)
+ printf ("typecheck(): %s.\n", print_nodetype(root));
+
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Comment:
+ /* we're looking at a comment - possibly several lines
+ * of comments. Here we count the number of lines in
+ * this comment. If this is the biggest (ie, longest
+ * in terms of number of lines), then we make it the
+ * MainComment which is generated in javadoc format.
+ *
+ * Deciding that the longest comment must be the description
+ * of the function is definitely a hack and is specific to
+ * BLAS/LAPACK. we should find a more elegant solution.
+ */
+
+ /* if the previous statement is NULL (and we already know
+ * that the current statement is a comment) then this must
+ * be the first line of the comment block.
+ * OR
+ * if the previous statement is non-NULL and is not Comment,
+ * then this must be the first line of the comment block.
+ */
+ if(genJavadoc) {
+ if( (root->prevstmt == NULL) ||
+ (root->prevstmt != NULL &&
+ root->prevstmt->nodetype != Comment &&
+ root->prevstmt->nodetype != MainComment))
+ {
+ AST *ctemp;
+
+ ctemp = root;
+ root->astnode.ident.len = 0;
+
+ while(ctemp != NULL && ctemp->nodetype == Comment) {
+ root->astnode.ident.len++;
+ ctemp = ctemp->nextstmt;
+ }
+
+ ctemp = cur_check_unit->astnode.source.javadocComments;
+
+ if(ctemp == NULL) {
+ root->nodetype = MainComment;
+ cur_check_unit->astnode.source.javadocComments = root;
+ } else if(root->astnode.ident.len > ctemp->astnode.ident.len) {
+ ctemp->nodetype = Comment;
+ root->nodetype = MainComment;
+ cur_check_unit->astnode.source.javadocComments = root;
+ }
+ }
+ }
+
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Common:
+ fprintf(stderr,"Warning: hit case Common in typecheck()\n");
+ case CommonList:
+ common_check(root);
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Assignment:
+ if (checkdebug)
+ printf ("typecheck(): Assignment.\n");
+
+ assign_check (root);
+
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Call:
+ if (checkdebug)
+ printf ("typecheck(): Call.\n");
+
+ call_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+ case Forloop:
+ if (checkdebug)
+ printf ("typecheck(): Forloop.\n");
+
+ forloop_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+
+ case Blockif:
+ if (checkdebug)
+ printf ("typecheck(): Blockif.\n");
+
+ blockif_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+ case Elseif:
+ if (checkdebug)
+ printf ("typecheck(): Elseif.\n");
+
+ elseif_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+ case Else:
+ if (checkdebug)
+ printf ("typecheck(): Else.\n");
+
+ else_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+ case Logicalif:
+ if (checkdebug)
+ printf ("typecheck(): Logicalif.\n");
+
+ logicalif_check (root);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ typecheck (root->nextstmt);
+ break;
+ case Write:
+ if (checkdebug)
+ printf ("typecheck(): Write statement.\n");
+
+ cur_check_unit->astnode.source.needs_output = TRUE;
+
+ read_write_check (root);
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Read:
+ if (checkdebug)
+ printf ("typecheck(): Read statement.\n");
+
+ cur_check_unit->astnode.source.needs_input = TRUE;
+
+ read_write_check (root);
+ if (root->nextstmt != NULL)
+ typecheck (root->nextstmt);
+ break;
+ case Constant:
+ default:
+ fprintf(stderr,"typecheck(): Error, bad nodetype (%s)\n",
+ print_nodetype(root));
+ } /* switch on nodetype. */
+}
+
+void
+typedec_check (AST * root)
+{
+ AST *temp, *temp2;
+
+ for(temp=root->astnode.typeunit.declist; temp != NULL; temp = temp->nextstmt)
+ {
+ if(temp->astnode.ident.arraylist != NULL) {
+ temp2 = temp->astnode.ident.arraylist;
+ for( ;temp2!=NULL;temp2=temp2->nextstmt) {
+ if(temp2->nodetype == ArrayIdxRange) {
+ expr_check(temp2->astnode.expression.lhs);
+ expr_check(temp2->astnode.expression.rhs);
+ }
+ else
+ expr_check(temp2);
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * merge_equivalences *
+ * *
+ * ok, this is a very poorly written subroutine. I admit it. *
+ * but I dont think that most programs will have a ton of equivalences *
+ * to merge, so it should not impose too much of a performance *
+ * penalty. basically what we're doing here is looking at all *
+ * the equivalences in the unit and determining if some variable *
+ * is contained within more than one equivalence. If so, we *
+ * merge those two equivalence statements. *
+ * *
+ *****************************************************************************/
+
+void
+merge_equivalences(AST *root)
+{
+ AST *temp, *ctemp;
+ AST *temp2, *ctemp2;
+ int needsMerge = FALSE;
+
+ if(checkdebug)
+ printf("M_EQV Equivalences:\n");
+
+ /* foreach equivalence statement... */
+ for(temp=root; temp != NULL; temp = temp->nextstmt) {
+
+ if(checkdebug)
+ printf("M_EQV (%d)", temp->token);
+
+ /* foreach variable in the equivalence statement... */
+ for(ctemp=temp->astnode.equiv.clist;ctemp!=NULL;ctemp=ctemp->nextstmt) {
+ if(checkdebug)
+ printf(" %s, ", ctemp->astnode.ident.name);
+
+ /* foreach equivalence statement (again)... */
+ for(temp2=root;temp2!=NULL;temp2=temp2->nextstmt) {
+
+ /* foreach variable in the second equivalence statement... */
+ for(ctemp2=temp2->astnode.equiv.clist;ctemp2!=NULL;ctemp2=ctemp2->nextstmt) {
+
+ if(!strcmp(ctemp->astnode.ident.name,ctemp2->astnode.ident.name) &&
+ temp->token != temp2->token)
+ {
+ /* the two names are the same, but arent in the same node.
+ * the two equivalences pointed to by temp and temp2 should
+ * be merged.
+ */
+
+ temp2->token = temp->token;
+ needsMerge = TRUE;
+ }
+ }
+ }
+ }
+ if(checkdebug)
+ printf("\n");
+ }
+
+ /* if we dont need to merge anything, go ahead and return, skipping
+ * this last chunk of code.
+ */
+
+ if(!needsMerge)
+ return;
+
+ /*
+ * Now we do the actual merging.
+ */
+
+ /* foreach equivalence statement... */
+
+ for(temp=root; temp != NULL; temp = temp->nextstmt) {
+
+ /* foreach equivalence statement (again)... */
+ for(temp2=root;temp2!=NULL;temp2=temp2->nextstmt) {
+
+ if((temp->token == temp2->token) && (temp != temp2)) {
+
+ /* the token pointers are equal and the nodes are distinct */
+
+ /* loop until the end of the first equivalence list */
+
+ ctemp=temp->astnode.equiv.clist;
+ while(ctemp->nextstmt != NULL)
+ ctemp = ctemp->nextstmt;
+
+ /* add the second equivalence list to the end of the first */
+
+ ctemp->nextstmt = temp2->astnode.equiv.clist;
+
+ /* now remove the second equivalence list from the list of
+ * equivalences.
+ */
+
+ ctemp = root;
+ while(ctemp->nextstmt != temp2)
+ ctemp = ctemp->nextstmt;
+
+ ctemp->nextstmt = temp2->nextstmt;
+
+ }
+ }
+
+ /* the merging process may produce duplicate entries. remove
+ * them now.
+ */
+
+ remove_duplicates(temp->astnode.equiv.clist);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * remove_duplicates *
+ * *
+ * This function removes duplicate names from a list of idents. *
+ * *
+ *****************************************************************************/
+
+void remove_duplicates(AST *root)
+{
+ AST *temp, *temp2, *prev;
+
+ for(temp = root; temp != NULL; temp = temp->nextstmt) {
+ prev = root;
+ for(temp2 = root; temp2 != NULL; temp2 = temp2->nextstmt) {
+ if(!strcmp(temp->astnode.ident.name,temp2->astnode.ident.name) &&
+ temp != temp2) {
+ prev->nextstmt = temp2->nextstmt;
+ }
+ prev = temp2;
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * insertEquivalences *
+ * *
+ * This function inserts the equivalenced variable names into the symbol *
+ * table. *
+ * *
+ *****************************************************************************/
+
+void
+insertEquivalences(AST *root)
+{
+ AST *temp, *ctemp;
+ AST *eqvList = root->astnode.source.equivalences;
+ SYMTABLE *eqvSymTab = root->astnode.source.equivalence_table;
+ char *merged_name;
+
+ /* foreach equivalence statement... */
+ for(temp = eqvList; temp != NULL; temp = temp->nextstmt) {
+
+ /* merge the names in this list into one name */
+ merged_name = merge_names(temp->astnode.equiv.clist);
+
+ for(ctemp = temp->astnode.equiv.clist;ctemp!=NULL;ctemp = ctemp->nextstmt) {
+
+ /* store the merged name into the node before sticking the node into
+ * the symbol table.
+ */
+
+ ctemp->astnode.ident.merged_name = merged_name;
+
+ type_insert(eqvSymTab, ctemp, Float, ctemp->astnode.ident.name);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * merge_names *
+ * *
+ * This function merges a list of variable names into one name. Basically *
+ * it just concatenates the names together, separated by an underscore. *
+ * *
+ *****************************************************************************/
+
+char *
+merge_names(AST *root)
+{
+ AST *temp;
+ char *newName;
+ unsigned int len = 0, num = 0;
+
+ /* determine how long the merged name will be */
+
+ for(temp = root;temp != NULL;temp=temp->nextstmt, num++)
+ len += strlen(temp->astnode.ident.name);
+
+ /* the length of the merged name is the sum of:
+ *
+ * - the sum of the lengths of the variable names
+ * - the number of variables
+ * - one
+ */
+
+ newName = (char *)f2jalloc(len + num + 1);
+
+ newName[0] = 0;
+
+ /* foreach name in the list... */
+ for(temp = root;temp != NULL;temp=temp->nextstmt, num++) {
+ strcat(newName,temp->astnode.ident.name);
+ if(temp->nextstmt != NULL)
+ strcat(newName,"_");
+ }
+
+ return newName;
+}
+
+/*****************************************************************************
+ * *
+ * check_equivalences *
+ * *
+ * Perform typechecking on equivalences. Loop through the equivalences and *
+ * look up the type in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+check_equivalences(AST *root)
+{
+ AST *temp, *ctemp;
+ enum returntype curType;
+ HASHNODE *hashtemp;
+ int mismatch = FALSE;
+
+ for(temp=root; temp != NULL; temp = temp->nextstmt) {
+ if(temp->astnode.equiv.clist != NULL) {
+ hashtemp = type_lookup(chk_type_table,
+ temp->astnode.equiv.clist->astnode.ident.name);
+ if(hashtemp)
+ curType = hashtemp->variable->vartype;
+ else
+ continue;
+ }
+ else
+ continue;
+
+ for(ctemp=temp->astnode.equiv.clist;ctemp!=NULL;ctemp=ctemp->nextstmt) {
+ hashtemp = type_lookup(chk_type_table,ctemp->astnode.ident.name);
+ if(hashtemp) {
+ if(hashtemp->variable->vartype != curType)
+ mismatch = TRUE;
+ }
+ else
+ continue;
+
+ curType = hashtemp->variable->vartype;
+ }
+
+ if(mismatch) {
+ fprintf(stderr, "Error with equivalenced variables: ");
+ print_eqv_list(temp,stderr);
+ fprintf(stderr,
+ "...I can't handle equivalenced variables with differing types.\n");
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * data_check *
+ * *
+ * Perform typechecking of DATA statements. Set the needs_declaration flag *
+ * of the node depending on whether it is an array or not. *
+ * *
+ *****************************************************************************/
+
+void
+data_check(AST * root)
+{
+ HASHNODE *hashtemp;
+ AST *Dtemp, *Ntemp, *var;
+
+ for(Dtemp = root->astnode.label.stmt; Dtemp != NULL; Dtemp = Dtemp->prevstmt)
+ {
+ for(Ntemp = Dtemp->astnode.data.nlist;Ntemp != NULL;Ntemp=Ntemp->nextstmt)
+ {
+ if(Ntemp->nodetype == DataImpliedLoop)
+ var = Ntemp->astnode.forloop.Label;
+ else
+ var = Ntemp;
+
+ name_check(var);
+
+ hashtemp = type_lookup(chk_type_table,var->astnode.ident.name);
+
+ if(hashtemp != NULL)
+ {
+ if((var->astnode.ident.arraylist != NULL) &&
+ (type_lookup(chk_array_table,var->astnode.ident.name) != NULL))
+ hashtemp->variable->astnode.ident.needs_declaration = TRUE;
+ else
+ hashtemp->variable->astnode.ident.needs_declaration = FALSE;
+
+ var->vartype = hashtemp->variable->vartype;
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * common_check *
+ * *
+ * Perform typechecking of COMMON statements. *
+ * *
+ *****************************************************************************/
+
+void
+common_check(AST *root)
+{
+ HASHNODE *ht;
+ AST *Ctemp, *Ntemp;
+ int i;
+ char **names;
+
+ for(Ctemp=root->astnode.common.nlist;Ctemp!=NULL;Ctemp=Ctemp->nextstmt)
+ {
+ if(Ctemp->astnode.common.name != NULL)
+ {
+ if((ht=type_lookup(common_block_table, Ctemp->astnode.common.name))==NULL)
+ {
+ fprintf(stderr,"typecheck: can't find common block %s in table\n",
+ Ctemp->astnode.common.name);
+ continue;
+ }
+
+ names = (char **)ht->variable;
+
+ i=0;
+ for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt,i++)
+ {
+ if (checkdebug)
+ {
+ printf("typecheck:Common block %s -- %s\n",Ctemp->astnode.common.name,
+ Ntemp->astnode.ident.name);
+ printf("typecheck:Looking up %s in the type table\n",
+ Ntemp->astnode.ident.name);
+ }
+
+ if((ht=type_lookup(chk_type_table,Ntemp->astnode.ident.name)) == NULL)
+ {
+ fprintf(stderr,"typecheck Error: can't find type for common %s\n",
+ Ntemp->astnode.ident.name);
+ if (checkdebug)
+ printf("Not Found\n");
+ continue;
+ }
+
+ ht->variable->astnode.ident.merged_name = names[i];
+
+ if(checkdebug)
+ printf("# @#Typecheck: inserting %s into the type table, merged = %s\n",
+ ht->variable->astnode.ident.name,
+ ht->variable->astnode.ident.merged_name);
+
+ ht->variable->astnode.ident.passByRef = TRUE;
+
+ type_insert(chk_type_table,ht->variable,ht->variable->vartype,
+ ht->variable->astnode.ident.name);
+ }
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * name_check *
+ * *
+ * Perform typechecking of identifiers. *
+ * *
+ *****************************************************************************/
+
+void
+name_check (AST * root)
+{
+ HASHNODE *hashtemp;
+ HASHNODE *ht;
+ char * tempname;
+
+ if (checkdebug)
+ printf("here checking name %s, type is %s\n",root->astnode.ident.name,
+ returnstring[root->vartype]);
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ /* If the name is in the external table, then check to see if
+ it is an intrinsic function instead (e.g. SQRT, ABS, etc). */
+
+ if (checkdebug)
+ printf("tempname = %s\n", tempname);
+
+ if (type_lookup (chk_external_table, root->astnode.ident.name) != NULL)
+ {
+ if (checkdebug)
+ printf("going to external_check\n");
+ external_check(root);
+ }
+ else if(( methodscan (intrinsic_toks, tempname) != NULL)
+ && ((type_lookup(chk_intrinsic_table,root->astnode.ident.name) != NULL)
+ || (type_lookup(chk_type_table,root->astnode.ident.name) == NULL)))
+ {
+ if (checkdebug)
+ printf("going to intrinsic_check\n");
+ intrinsic_check(root);
+ }
+ else
+ {
+ if (checkdebug)
+ printf("NOt intrinsic or external (%s)\n", root->astnode.ident.name);
+
+ switch (root->token)
+ {
+ case STRING:
+ case CHAR:
+ if(checkdebug)
+ printf("typecheck(): ** I am going to check a String/char literal!\n");
+ break;
+ case INTRINSIC:
+ /* do nothing */
+ break;
+ case NAME:
+ default:
+ hashtemp = type_lookup (chk_array_table, root->astnode.ident.name);
+
+ if(checkdebug)
+ printf("looking for %s in the type table\n",root->astnode.ident.name);
+
+ if((ht = type_lookup(chk_type_table,root->astnode.ident.name)) != NULL)
+ {
+ if(checkdebug)
+ printf("@# Found! setting type to %s\n",
+ returnstring[ht->variable->vartype]);
+ root->vartype = ht->variable->vartype;
+ }
+ else if( (cur_check_unit->nodetype == Function) &&
+ !strcmp(cur_check_unit->astnode.source.name->astnode.ident.name,
+ root->astnode.ident.name))
+ {
+ if(checkdebug)
+ {
+ printf("@# this is the implicit function var\n");
+ printf("@# ...setting vartype = %s\n",
+ returnstring[cur_check_unit->astnode.source.returns]);
+ }
+ root->vartype = cur_check_unit->astnode.source.returns;
+ }
+ else
+ {
+ /* this is a hack for typechecking expressions within
+ * an array declaration - just set type of * to Integer.
+ */
+ if(!strcmp(root->astnode.ident.name,"*")) {
+ root->vartype = Integer;
+ }
+ else {
+ fprintf(stderr,"Undeclared variable: %s\n",root->astnode.ident.name);
+ root->vartype = 0;
+ }
+ }
+
+ if (root->astnode.ident.arraylist == NULL)
+ ; /* nothin for now */
+ else if ((hashtemp != NULL) || ((root->vartype == String) &&
+ root->astnode.ident.arraylist != NULL))
+ array_check(root);
+ else if (root->nodetype == Substring)
+ root->vartype = String;
+ else
+ subcall_check(root);
+ }
+ }
+ f2jfree(tempname, strlen(tempname)+1);
+}
+
+/*****************************************************************************
+ * *
+ * subcall_check *
+ * *
+ * This function checks a subroutine call. *
+ * *
+ *****************************************************************************/
+
+void
+subcall_check(AST *root)
+{
+ AST *temp;
+ char *tempstr;
+
+ tempstr = strdup (root->astnode.ident.name);
+ *tempstr = toupper (*tempstr);
+
+ temp = root->astnode.ident.arraylist;
+
+ for (; temp != NULL; temp = temp->nextstmt)
+ if (*temp->astnode.ident.name != '*')
+ {
+ if(temp == NULL)
+ fprintf(stderr,"subcall_check: calling expr_check with null pointer!\n");
+ expr_check (temp);
+ }
+
+ /*
+ * here we need to figure out if this is a function
+ * call and if so, what the return type is. this will
+ * require keeping track of all the functions/subroutines
+ * during parsing. and there will still be some that
+ * we can't figure out.
+ *
+ * for now, we'll just assign integer to every call
+ */
+
+ root->vartype = Integer;
+}
+
+/*****************************************************************************
+ * *
+ * func_array_check *
+ * *
+ * Typecheck an array access. This could be merged with array_check()... *
+ * *
+ *****************************************************************************/
+
+void
+func_array_check(AST *root)
+{
+ AST *tmp;
+
+ if(root == NULL)
+ fprintf(stderr,"func_array_check1: calling expr_check with null pointer!\n");
+
+ for(tmp = root; tmp != NULL; tmp = tmp->nextstmt)
+ expr_check(tmp);
+
+/*
+* expr_check (root);
+*
+* if( (hashtemp->variable->astnode.ident.leaddim != NULL)
+* && (hashtemp->variable->astnode.ident.leaddim[0] != '*')
+* && (root->nextstmt != NULL))
+* {
+* expr_check (root->nextstmt);
+*
+* if(root->nextstmt->nextstmt)
+* expr_check (root->nextstmt->nextstmt);
+* }
+*/
+
+}
+
+/*****************************************************************************
+ * *
+ * array_check *
+ * *
+ * Typecheck an array access. *
+ * *
+ *****************************************************************************/
+
+void
+array_check(AST *root)
+{
+ AST *temp;
+
+ if (checkdebug)
+ printf ("typecheck(): Array... %s, My node type is %s\n",
+ root->astnode.ident.name,
+ print_nodetype(root));
+
+ temp = root->astnode.ident.arraylist;
+
+ func_array_check(temp);
+}
+
+/*****************************************************************************
+ * *
+ * external_check *
+ * *
+ * Check an external variable. *
+ * *
+ *****************************************************************************/
+
+void
+external_check(AST *root)
+{
+ char *tempname;
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ /* first, make sure this isn't in the list of intrinsic functions... */
+
+ if (methodscan(intrinsic_toks,tempname) == NULL)
+ {
+ if (root->astnode.ident.arraylist != NULL)
+ call_check (root);
+ f2jfree(tempname,strlen(tempname)+1);
+ return;
+ }
+
+ if (root->astnode.ident.arraylist != NULL)
+ {
+ /* this is some sort of intrinsic. maybe it's ETIME or SECOND, which
+ * are declared EXTERNAL since they really aren't intrinsics, but we
+ * treat them as such since there is a corresponding Java function to
+ * handle them.
+ */
+
+ if( !strcmp(tempname, "ETIME") ) {
+ expr_check (root->astnode.ident.arraylist);
+ root->vartype = Float;
+ }
+ else if( !strcmp(tempname, "SECOND") ) {
+ root->vartype = Float;
+ }
+ }
+
+ f2jfree(tempname,strlen(tempname)+1);
+}
+
+/*****************************************************************************
+ * *
+ * intrinsic_check *
+ * *
+ * Here we have an intrinsic to check. We have to explicitly handle all *
+ * the intrinsics that we know about. First determine which one we're *
+ * looking at and then assign a type depending on the return type of the *
+ * actual Java function (e.g. SQRT will return double because Math.sqrt() *
+ * returns double). *
+ * *
+ *****************************************************************************/
+
+void
+intrinsic_check(AST *root)
+{
+ AST *temp;
+ METHODTAB *entry;
+ char *tempname;
+ enum _intrinsics id;
+ enum returntype min_type = Integer;
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ entry = methodscan (intrinsic_toks, tempname);
+ if(checkdebug)
+ printf("Tempname=%s\n", tempname);
+ f2jfree(tempname, strlen(tempname)+1);
+
+ if(!entry) {
+ fprintf(stderr,"Error: not expecting null entry at this point.\n");
+ exit(EXIT_FAILURE);
+ }
+
+ id = entry->intrinsic;
+
+ if(root->astnode.ident.arraylist == NULL)
+ fprintf(stderr,"WARNING: intrinsic with no args!\n");
+
+ /* check each argument to this intrinsic and determine the widest type
+ * in case this is a generic intrinsic (so we may correctly determine
+ * which typecasts to make).
+ */
+ if(root->astnode.ident.arraylist->nodetype != EmptyArgList) {
+ for(temp = root->astnode.ident.arraylist;temp != NULL;temp=temp->nextstmt) {
+
+ expr_check (temp);
+
+ if(temp->vartype < min_type)
+ min_type = temp->vartype;
+
+/*
+ * printbits("This is the bitmask ", &bitfields[temp->vartype], 1);
+ * printbits("This is the entry-args ", &entry->args, 1);
+ */
+ if(checkdebug)
+ printf("temp->vartype=%s\n", returnstring[temp->vartype]);
+
+ if(! (bitfields[temp->vartype] & entry->args)) {
+ fprintf(stderr, "++%s %s\n", temp->astnode.ident.name, returnstring[temp->vartype]);
+ fprintf(stderr, "--%s\n", cur_check_unit->astnode.source.name->astnode.ident.name);
+ fprintf(stderr,"Error: bad argument type to intrinsic %s\n",
+ entry->fortran_name);
+ exit(EXIT_FAILURE);
+ }
+ }
+ }
+
+ /* if this is a generic intrinsic, then set the return type of the
+ * intrinsic to the type of the widest argument.
+ */
+
+ if(type_lookup(generic_table, intrinsic_toks[id].fortran_name) != NULL) {
+
+ /* we must make a special case for type conversion intrinsics because
+ * they always have the same return type regardless of whether the
+ * generic form is used.
+ */
+
+ switch(id) {
+ case ifunc_INT:
+ root->vartype = Integer;
+ break;
+ case ifunc_REAL:
+ root->vartype = Float;
+ break;
+ case ifunc_DBLE:
+ root->vartype = Double;
+ break;
+ case ifunc_CMPLX:
+ root->vartype = Complex;
+ break;
+ case ifunc_NINT:
+ root->vartype = Integer;
+ break;
+ default:
+ root->vartype = min_type;
+ break; /* ansi c */
+ }
+
+ }
+ else
+ root->vartype = intrinsic_toks[id].ret;
+}
+
+/*****************************************************************************
+ * *
+ * expr_check *
+ * *
+ * Recursive procedure to check expressions. *
+ * *
+ *****************************************************************************/
+
+void
+expr_check (AST * root)
+{
+ if(root == NULL) {
+ fprintf(stderr,"expr_check(): NULL root!\n");
+ return;
+ }
+
+ switch (root->nodetype)
+ {
+ /*if (checkdebug)
+ printf("before hit case identifier (%s), now type is %s\n",
+ root->astnode.ident.name,returnstring[root->vartype]); */
+ case Identifier:
+ name_check (root);
+
+ if (checkdebug)
+ printf("after hit case identifier (%s), now type is %s\n",
+ root->astnode.ident.name,returnstring[root->vartype]);
+ break;
+ case Expression:
+ if (root->astnode.expression.lhs != NULL)
+ expr_check (root->astnode.expression.lhs);
+
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ root->vartype = root->astnode.expression.rhs->vartype;
+ break;
+ case Power:
+ if(root->astnode.expression.lhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.lhs);
+
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ /*
+ * if the exponent is integer, the expression type should inherit the
+ * type of the LHS, otherwise it would be the wider of the two.
+ */
+ if(root->astnode.expression.rhs->vartype == Integer)
+ root->vartype = root->astnode.expression.lhs->vartype;
+ else
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+
+ break;
+ case Binaryop:
+ if(root->astnode.expression.lhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null LHS!\n");
+
+ expr_check (root->astnode.expression.lhs);
+
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null RHS!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ if (checkdebug) {
+ printf("here checking binaryOp, optype = '%c'\n",
+ root->astnode.expression.optype);
+ printf("lhs type: %s\n", returnstring[root->astnode.expression.lhs->vartype]);
+ printf("rhs type: %s\n", returnstring[root->astnode.expression.rhs->vartype]);
+ }
+
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ break;
+ case Unaryop:
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ root->vartype = root->astnode.expression.rhs->vartype;
+ break;
+ case Constant:
+ /* constant's type is already known */
+ break;
+ case Logicalop:
+ if (root->astnode.expression.lhs != NULL)
+ expr_check (root->astnode.expression.lhs);
+
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ root->vartype = Logical;
+ break;
+ case Relationalop:
+ if(root->astnode.expression.lhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.lhs);
+
+ if(root->astnode.expression.rhs == NULL)
+ fprintf(stderr,"expr_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.expression.rhs);
+
+ root->vartype = Logical;
+ break;
+ case Substring:
+
+ if(root->astnode.ident.startDim[0])
+ expr_check(root->astnode.ident.startDim[0]);
+
+ if(root->astnode.ident.endDim[0])
+ expr_check(root->astnode.ident.endDim[0]);
+
+ if(root->astnode.ident.startDim[1])
+ expr_check(root->astnode.ident.startDim[1]);
+
+ root->vartype = String;
+ break;
+ case EmptyArgList:
+ /* do nothing */
+ break;
+ default:
+ fprintf(stderr,"Warning: Unknown nodetype in expr_check(): %s\n",
+ print_nodetype(root));
+ }
+}
+
+/*****************************************************************************
+ * *
+ * forloop_check *
+ * *
+ * Check a DO loop. *
+ * *
+ *****************************************************************************/
+
+void
+forloop_check (AST * root)
+{
+
+ expr_check (root->astnode.forloop.iter_expr);
+ assign_check (root->astnode.forloop.incr_expr);
+
+ assign_check (root->astnode.forloop.start);
+
+ if(root->astnode.forloop.stop == NULL)
+ fprintf(stderr,"forloop_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.forloop.stop);
+
+ if (root->astnode.forloop.incr != NULL)
+ expr_check (root->astnode.forloop.incr);
+}
+
+
+/*****************************************************************************
+ * *
+ * logicalif_check *
+ * *
+ * Check a Logical IF statement. *
+ * *
+ *****************************************************************************/
+
+void
+logicalif_check (AST * root)
+{
+ if (root->astnode.logicalif.conds != NULL)
+ expr_check (root->astnode.logicalif.conds);
+
+ typecheck (root->astnode.logicalif.stmts);
+}
+
+/*****************************************************************************
+ * *
+ * read_write_check *
+ * *
+ * Performs typechecking on READ and WRITE statements. *
+ * *
+ *****************************************************************************/
+
+void
+read_write_check (AST * root)
+{
+ AST *temp;
+
+ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ {
+ if(temp->nodetype == IoImpliedLoop)
+ check_implied_loop(temp);
+ else
+ expr_check (temp);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * check_implied_loop *
+ * *
+ * Performs typechecking on an implied DO loop. *
+ * *
+ *****************************************************************************/
+
+void
+check_implied_loop(AST *node)
+{
+ AST *temp;
+
+ for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt)
+ expr_check(temp);
+ expr_check(node->astnode.forloop.iter_expr);
+ assign_check(node->astnode.forloop.incr_expr);
+}
+
+/*****************************************************************************
+ * *
+ * blockif_check *
+ * *
+ * Check a block IF statement, including elseif and else blocks. *
+ * *
+ *****************************************************************************/
+
+void
+blockif_check (AST * root)
+{
+ AST *temp;
+
+ if (root->astnode.blockif.conds != NULL)
+ expr_check (root->astnode.blockif.conds);
+
+ if (root->astnode.blockif.stmts != NULL)
+ typecheck (root->astnode.blockif.stmts);
+
+ for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt)
+ elseif_check (temp);
+
+ if (root->astnode.blockif.elsestmts != NULL)
+ else_check (root->astnode.blockif.elsestmts);
+}
+
+/*****************************************************************************
+ * *
+ * elseif_check *
+ * *
+ * Check the "else if" of a block IF statement. This is short enough to *
+ * be inlined with blockif_check at some point. *
+ * *
+ *****************************************************************************/
+
+void
+elseif_check (AST * root)
+{
+ if (root->astnode.blockif.conds != NULL)
+ expr_check (root->astnode.blockif.conds);
+ typecheck (root->astnode.blockif.stmts);
+}
+
+/*****************************************************************************
+ * *
+ * elseif_check *
+ * *
+ * Check the "else if" of a block IF statement. This is definitely short *
+ * enough to be inlined with blockif_check at some point. *
+ * *
+ *****************************************************************************/
+
+void
+else_check (AST * root)
+{
+ typecheck (root->astnode.blockif.stmts);
+}
+
+/*****************************************************************************
+ * *
+ * call_check *
+ * *
+ * Check a function/subroutine call. This node's type is based on the *
+ * declaration in the original Fortran code. *
+ * *
+ *****************************************************************************/
+
+void
+call_check (AST * root)
+{
+ AST *temp;
+ HASHNODE *ht;
+
+ assert (root != NULL);
+ if(root->astnode.ident.arraylist == NULL)
+ return;
+
+ if(checkdebug)
+ printf("the name of this function/subroutine is %s\n",
+ root->astnode.ident.name);
+
+ /* now is a convenient time to determine whether we should import the
+ * BLAS library.
+ */
+
+ if(type_lookup(blas_routine_table,root->astnode.ident.name))
+ cur_check_unit->astnode.source.needs_blas = TRUE;
+
+ if( (ht = type_lookup(chk_type_table,root->astnode.ident.name)) != NULL)
+ {
+ if(checkdebug)
+ printf("SETting type to %s\n", returnstring[ht->variable->vartype]);
+
+ root->vartype = ht->variable->vartype;
+ }
+
+ temp = root->astnode.ident.arraylist;
+ while (temp->nextstmt != NULL)
+ {
+ if(temp == NULL)
+ fprintf(stderr,"call_check: calling expr_check with null pointer!\n");
+
+ expr_check (temp);
+ temp = temp->nextstmt;
+ }
+
+ if(temp == NULL)
+ fprintf(stderr,"call_check: calling expr_check with null pointer!\n");
+
+ expr_check (temp);
+}
+
+/*****************************************************************************
+ * *
+ * assign_check *
+ * *
+ * Check an assignment statement. This info is very important to the code *
+ * generator. *
+ * *
+ *****************************************************************************/
+
+void
+assign_check (AST * root)
+{
+ name_check (root->astnode.assignment.lhs);
+
+ if(root->astnode.assignment.rhs == NULL)
+ fprintf(stderr,"assign_check: calling expr_check with null pointer!\n");
+
+ expr_check (root->astnode.assignment.rhs);
+}
diff --git a/src/vcg_emitter.c b/src/vcg_emitter.c
new file mode 100644
index 0000000..99bcc5f
--- /dev/null
+++ b/src/vcg_emitter.c
@@ -0,0 +1,958 @@
+/*
+ * $Source: /cvsroot/f2j/f2j/src/vcg_emitter.c,v $
+ * $Revision: 1.16 $
+ * $Date: 2007/01/18 22:02:38 $
+ * $Author: keithseymour $
+ */
+
+
+/*****************************************************************************
+ * vcg_emitter.c *
+ * *
+ * Emits a graph representing the syntax tree for the *
+ * fortran program. The file is compatible with the *
+ * VCG tool (Visualization of Compiler Graphs). *
+ * I'm afraid this routine is horribly out of date. *
+ * *
+ *****************************************************************************/
+
+
+#include<stdio.h>
+#include<string.h>
+#include<ctype.h>
+#include"f2j.h"
+#include"y.tab.h"
+#include"f2j_externs.h"
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+char
+ * lowercase(char *);
+
+void
+ start_vcg(AST *),
+ emit_vcg(AST *,int),
+ vcg_elseif_emit(AST *,int),
+ vcg_else_emit(AST *,int),
+ vcg_typedec_emit (AST *, int),
+ vcg_spec_emit (AST *, int),
+ vcg_assign_emit (AST *, int),
+ vcg_call_emit (AST *, int),
+ vcg_forloop_emit (AST *, int),
+ vcg_blockif_emit (AST *, int),
+ vcg_logicalif_emit (AST *, int),
+ vcg_label_emit (AST *, int),
+ vcg_expr_emit (AST *, int);
+
+int
+ vcg_name_emit (AST *);
+
+METHODTAB
+ * methodscan (METHODTAB *, char *);
+
+/*****************************************************************************
+ * Global variables. *
+ *****************************************************************************/
+
+int
+ vcg_debug = FALSE, /* set to TRUE to get debugging output */
+ node_num = 1; /* initialize node counter */
+
+char
+ temp_buf[200], /* temporary buffer for node titles */
+ *vcg_returns; /* return type of the current program unit */
+
+extern METHODTAB intrinsic_toks[];
+
+/*****************************************************************************
+ * *
+ * start_vcg *
+ * *
+ * Print graph header (width, height, etc.) and call emit_vcg() to generate *
+ * the rest of the graph. *
+ * *
+ *****************************************************************************/
+
+void
+start_vcg(AST *root)
+{
+ /* print header information */
+ print_vcg_header(vcgfp, "SYNTAX TREE");
+
+ emit_vcg(root, 0);
+
+ print_vcg_trailer(vcgfp);
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_header *
+ * *
+ * this function prints the VCG header, with the given title. *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_header(FILE *gfp, char *title)
+{
+ fprintf(gfp,"graph: { title: \"%s\"\n", title);
+
+ fprintf(gfp,"x: 30\n");
+ fprintf(gfp,"y: 30\n");
+ fprintf(gfp,"width: 850\n");
+ fprintf(gfp,"height: 800\n");
+ fprintf(gfp,"color: lightcyan\n");
+
+ fprintf(gfp,"stretch: 4\n");
+ fprintf(gfp,"shrink: 10\n");
+ fprintf(gfp,"layout_upfactor: 10\n");
+ fprintf(gfp,"manhatten_edges: yes\n");
+ fprintf(gfp,"smanhatten_edges: yes\n");
+ fprintf(gfp,"layoutalgorithm: tree\n\n");
+
+ fprintf(gfp,"node: {color: black textcolor: white title:\"f2j\"\n");
+ fprintf(gfp,"label: \"Nothing should hang here\"\n");
+ fprintf(gfp,"}\n\n");
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_trailer *
+ * *
+ * this function prints the VCG trailer. *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_trailer(FILE *gfp)
+{
+ fprintf(gfp,"}\n");
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_node *
+ * *
+ * Given a number and a label, this function prints a node specification. *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_node(FILE *gfp, int num, char *label)
+{
+ if(vcg_debug)
+ printf("creating node \"%s\"\n",label);
+
+ fprintf(gfp,
+ "node: {color: black textcolor: white title:\"%d\"\n",num);
+
+ fprintf(gfp,
+ "label: \"%s\"\n",label);
+
+ fprintf(gfp,
+ "}\n\n");
+
+ node_num++;
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_typenode *
+ * *
+ * Similar to print_vcg_node except that this function prints a special *
+ * "typenode", which acts as as annotation to the graph (showing type info). *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_typenode(FILE *gfp, int num, char *label)
+{
+ if(vcg_debug)
+ printf("creating typenode \"%s\"\n",label);
+
+ fprintf(gfp, "node: { title: \"%d\"\n",num);
+ fprintf(gfp, " label: \"%s\"\n",label);
+ fprintf(gfp, "}\n\n");
+
+ node_num++;
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_edge *
+ * *
+ * Given the source and destination node numbers, this function emits an *
+ * edge to connect them. *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_edge(FILE *gfp, int source, int dest)
+{
+ fprintf(gfp,
+ "edge: { thickness: 6 color: red sourcename: \"%d\" targetname: \"%d\"}\n\n",
+ source, dest);
+}
+
+/*****************************************************************************
+ * *
+ * print_vcg_nearedge *
+ * *
+ * Similar to print_vcg_edge except that this function emits a "nearedge", *
+ * which tells VCG to try to keep the nodes close together. *
+ * *
+ *****************************************************************************/
+
+void
+print_vcg_nearedge(FILE *gfp, int source, int dest)
+{
+ fprintf(gfp,"nearedge: { sourcename: \"%d\" targetname: \"%d\"\n",
+ source, dest);
+ fprintf(gfp,"color: blue thickness: 6\n}\n\n");
+}
+
+/*****************************************************************************
+ * *
+ * emit_vcg *
+ * *
+ * This is the main VCG generation function. We traverse the *
+ * AST and recursively call emit_vcg() on each node. This *
+ * function figures out what kind of node it's looking at and *
+ * calls the appropriate function to handle the graph generation. *
+ * *
+ *****************************************************************************/
+
+void
+emit_vcg (AST * root, int parent)
+{
+ int my_node = node_num;
+
+ switch (root->nodetype)
+ {
+ case 0:
+ fprintf(stderr,"Bad node in emit_vcg()\n");
+ emit_vcg (root->nextstmt,node_num);
+ case Progunit:
+ if(vcg_debug)
+ printf("case Source\n");
+
+ print_vcg_node(vcgfp, node_num,"Progunit");
+
+ if(vcg_debug)
+ printf("case Source: Going to emit PROGTYPE\n");
+
+ emit_vcg (root->astnode.source.progtype, my_node);
+
+ if(vcg_debug)
+ printf("case Source: Going to emit TYPEDECS\n");
+
+ emit_vcg (root->astnode.source.typedecs, my_node);
+
+ if(vcg_debug)
+ printf("case Source: Going to emit STATEMENTS\n");
+
+ emit_vcg (root->astnode.source.statements, my_node);
+
+ break;
+ case Subroutine:
+ if(vcg_debug)
+ printf("case Subroutine\n");
+
+ print_vcg_node(vcgfp, node_num,"Subroutine");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_returns = NULL; /* Subroutines return void. */
+ break;
+ case Function:
+ if(vcg_debug)
+ printf("case Function\n");
+
+ sprintf (temp_buf,"Function: %s\n",
+ root->astnode.source.name->astnode.ident.name);
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+ vcg_returns = root->astnode.source.name->astnode.ident.name;
+ break;
+ case Typedec:
+ if(vcg_debug)
+ printf("case Typedec\n");
+
+ vcg_typedec_emit (root, parent);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Specification:
+ if(vcg_debug)
+ printf("case Specification\n");
+
+ vcg_spec_emit (root, parent);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Statement:
+ if(vcg_debug)
+ printf("case Statement\n");
+
+ print_vcg_node(vcgfp, node_num,"Statement");
+ print_vcg_edge(vcgfp, parent, my_node);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+
+ case Assignment:
+ print_vcg_node(vcgfp, node_num,"Assignment");
+ print_vcg_edge(vcgfp, parent, my_node);
+ vcg_assign_emit (root, my_node);
+ if (root->nextstmt != NULL)
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Call:
+ vcg_call_emit (root, parent);
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Forloop:
+ print_vcg_node(vcgfp, node_num,"For loop");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_forloop_emit (root, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Blockif:
+ print_vcg_node(vcgfp, node_num,"Block if");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_blockif_emit (root, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Elseif:
+ print_vcg_node(vcgfp, node_num,"Else if");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_elseif_emit (root, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Else:
+ print_vcg_node(vcgfp, node_num,"Else");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_else_emit (root, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Logicalif:
+ print_vcg_node(vcgfp, node_num,"Logical If");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ vcg_logicalif_emit (root, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Return:
+ if (vcg_returns != NULL)
+ sprintf (temp_buf, "Return (%s)", vcg_returns);
+ else
+ sprintf (temp_buf, "Return");
+
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Goto:
+ sprintf (temp_buf,"Goto (%d)", root->astnode.go_to.label);
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ if (root->nextstmt != NULL)
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Label:
+ vcg_label_emit (root, parent);
+
+ if (root->nextstmt != NULL) /* End of typestmt list. */
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case End:
+ print_vcg_node(vcgfp, node_num,"End");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ /* end of the program */
+ break;
+ case Unimplemented:
+ print_vcg_node(vcgfp, node_num,"UNIMPLEMENTED");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ if (root->nextstmt != NULL)
+ emit_vcg (root->nextstmt, my_node);
+ break;
+ case Constant:
+ sprintf(temp_buf,"Constant(%s)",
+ root->astnode.constant.number);
+
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+ default:
+ fprintf (stderr,"vcg_emitter: Default case reached!\n");
+ } /* switch on nodetype. */
+}
+
+/*****************************************************************************
+ * *
+ * vcg_typedec_emit *
+ * *
+ * Emit all the type declaration nodes. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_typedec_emit (AST * root, int parent)
+{
+ AST *temp;
+ enum returntype returns;
+ int my_node = node_num;
+ int name_nodenum;
+ int prev_node;
+
+ if(vcg_debug)
+ printf("in vcg_typedec_emit\n");
+
+ temp = root->astnode.typeunit.declist;
+
+ /* This may have to be moved into the looop also. Could be
+ * why I have had problems with this stuff.
+ */
+
+ if(type_lookup (external_table, temp->astnode.ident.name))
+ {
+ if(vcg_debug) {
+ printf("returning from vcg_typedec_emit,");
+ printf(" found something in hash table\n");
+ }
+ print_vcg_node(vcgfp, node_num,"External");
+ print_vcg_edge(vcgfp, parent, my_node);
+ return;
+ }
+
+ returns = root->astnode.typeunit.returns;
+
+ sprintf(temp_buf,"TypeDec (%s)", returnstring[returns]);
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ prev_node = my_node;
+
+ for (; temp != NULL; temp = temp->nextstmt) {
+ if(vcg_debug)
+ printf("in the loop\n");
+ name_nodenum = vcg_name_emit (temp);
+ print_vcg_nearedge(vcgfp, prev_node,name_nodenum);
+ prev_node = name_nodenum;
+ }
+ if(vcg_debug)
+ printf("leaving vcg_typdec_emit\n");
+}
+
+/*****************************************************************************
+ * *
+ * vcg_name_emit *
+ * *
+ * Generate an identifier node. *
+ * *
+ *****************************************************************************/
+
+int
+vcg_name_emit (AST * root)
+{
+ AST *temp;
+ HASHNODE *hashtemp;
+ char *javaname, * tempname;
+ int my_node = node_num;
+ METHODTAB *entry;
+
+ if(vcg_debug)
+ printf("in vcg_name_emit\n");
+
+ sprintf(temp_buf,"Name (%s)",root->astnode.ident.name);
+ print_vcg_node(vcgfp, my_node,temp_buf);
+
+ /* Check to see whether name is in external table. Names are
+ * loaded into the external table from the parser.
+ */
+
+ /* If the name is in the external table, then check to see if
+ * is an intrinsic function instead.
+ */
+
+ if(type_lookup (external_table, root->astnode.ident.name))
+ {
+
+ /* This block of code is only called if the identifier
+ * absolutely does not have an entry in any table,
+ * and corresponds to a method invocation of
+ * something in the blas or lapack packages.
+ */
+
+ if (methodscan(intrinsic_toks,root->astnode.ident.name) == NULL) {
+ if (root->astnode.ident.arraylist != NULL) {
+ vcg_call_emit (root, my_node);
+ return my_node;
+ }
+ return my_node;
+ }
+ }
+
+ tempname = strdup(root->astnode.ident.name);
+ uppercase(tempname);
+
+ if(vcg_debug)
+ printf ("Tempname %s\n", tempname);
+
+ entry = methodscan (intrinsic_toks, tempname);
+ javaname = entry->java_method;
+
+ if (javaname != NULL) {
+ if (!strcmp (root->astnode.ident.name, "MAX")) {
+ temp = root->astnode.ident.arraylist;
+
+ vcg_expr_emit (temp, my_node);
+ vcg_expr_emit (temp->nextstmt, my_node);
+ return my_node;
+ }
+
+ if (!strcmp (root->astnode.ident.name, "MIN")) {
+ temp = root->astnode.ident.arraylist;
+ vcg_expr_emit (temp, my_node);
+ vcg_expr_emit (temp->nextstmt, my_node);
+ return my_node;
+ }
+
+ if (!strcmp (root->astnode.ident.name, "ABS")) {
+ temp = root->astnode.ident.arraylist;
+ vcg_expr_emit (temp, my_node);
+ return my_node;
+ }
+
+ if (!strcmp (tempname, "DABS")) {
+ temp = root->astnode.ident.arraylist;
+ vcg_expr_emit (temp, my_node);
+ return my_node;
+ }
+
+ if (!strcmp (tempname, "DSQRT")) {
+ temp = root->astnode.ident.arraylist;
+ vcg_expr_emit (temp, my_node);
+ return my_node;
+ }
+ }
+
+ hashtemp = type_lookup (array_table, root->astnode.ident.name);
+
+ switch (root->token)
+ {
+ case STRING:
+ /*fprintf (javafp, "\"%s\"", root->astnode.ident.name); */
+ break;
+
+ case CHAR:
+ /*fprintf (javafp, "\"%s\"", root->astnode.ident.name); */
+ break;
+
+ case NAME:
+
+ default:
+ /* At some point in here I will have to switch on the
+ token type check whether it is a variable or
+ string or character literal. Also have to look up whether
+ name is intrinsic or external. */
+
+ if (root->astnode.ident.arraylist == NULL) {
+ /* null */ ;
+ /* fprintf (javafp, "%s", root->astnode.ident.name); */
+ }
+ else if (hashtemp != NULL) {
+ if(vcg_debug)
+ printf ("Array... %s\n", root->astnode.ident.name);
+
+ temp = root->astnode.ident.arraylist;
+
+ /* Now, what needs to happen here is the context of the
+ * array needs to be determined. If the array is being
+ * passed as a parameter to a method, then the array index
+ * needs to be passed separately and the array passed as
+ * itself. If not, then an array value is being set,
+ * so dereference with index arithmetic.
+ */
+
+ /*fprintf (javafp, "["); */
+
+ vcg_expr_emit (temp, my_node);
+
+/*
+ * if (hashtemp->variable->astnode.ident.leaddim[0] != '*' &&
+ * temp->nextstmt != NULL) {
+ * temp = temp->nextstmt;
+ *
+ * vcg_expr_emit (temp, my_node);
+ * }
+ */
+ }
+ else {
+ /*fprintf (javafp, "%s", root->astnode.ident.name); */
+ temp = root->astnode.ident.arraylist;
+
+ for (; temp != NULL; temp = temp->nextstmt) {
+ /*fprintf (javafp, "["); */
+
+ if (*temp->astnode.ident.name != '*')
+ vcg_expr_emit (temp, my_node);
+
+ /*fprintf (javafp, "]"); */
+ }
+ }
+ break;
+ }
+ return my_node;
+}
+
+/*****************************************************************************
+ * *
+ * vcg_expr_emit *
+ * *
+ * Recursive function to generate an expression graph. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_expr_emit (AST * root, int parent)
+{
+ int my_node = node_num;
+ int temp_num;
+
+ switch (root->nodetype)
+ {
+ case Identifier:
+ print_vcg_node(vcgfp, my_node,"Ident");
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ temp_num = vcg_name_emit (root);
+
+ print_vcg_edge(vcgfp, my_node,temp_num);
+ break;
+ case Expression:
+ if (root->astnode.expression.lhs != NULL)
+ vcg_expr_emit (root->astnode.expression.lhs, parent);
+
+ vcg_expr_emit (root->astnode.expression.rhs, parent);
+ break;
+ case Power:
+ print_vcg_node(vcgfp, my_node,"pow()");
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ vcg_expr_emit (root->astnode.expression.lhs, my_node);
+ vcg_expr_emit (root->astnode.expression.rhs, my_node);
+ break;
+ case Binaryop:
+ sprintf(temp_buf,"%c", root->astnode.expression.optype);
+
+ print_vcg_node(vcgfp, my_node,temp_buf);
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ vcg_expr_emit (root->astnode.expression.lhs, my_node);
+ vcg_expr_emit (root->astnode.expression.rhs, my_node);
+ break;
+ case Unaryop:
+ sprintf(temp_buf,"%c", root->astnode.expression.minus);
+
+ print_vcg_node(vcgfp, my_node,temp_buf);
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ vcg_expr_emit (root->astnode.expression.rhs, my_node);
+ break;
+ case Constant:
+ sprintf(temp_buf,"Constant(%s)", root->astnode.constant.number);
+
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+ break;
+ case Logicalop:
+ if(root->token == AND)
+ print_vcg_node(vcgfp, my_node,"AND");
+ else if(root->token == OR)
+ print_vcg_node(vcgfp, my_node,"OR");
+
+ if (root->astnode.expression.lhs == NULL)
+ print_vcg_node(vcgfp, my_node,"NOT");
+
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ if (root->astnode.expression.lhs != NULL)
+ vcg_expr_emit (root->astnode.expression.lhs, my_node);
+
+ vcg_expr_emit (root->astnode.expression.rhs, my_node);
+ break;
+ case Relationalop:
+ switch (root->token)
+ {
+ case rel_eq:
+ print_vcg_node(vcgfp, my_node,"==");
+ break;
+ case rel_ne:
+ print_vcg_node(vcgfp, my_node,"!=");
+ break;
+ case rel_lt:
+ print_vcg_node(vcgfp, my_node,"<");
+ break;
+ case rel_le:
+ print_vcg_node(vcgfp, my_node,"<=");
+ break;
+ case rel_gt:
+ print_vcg_node(vcgfp, my_node,">");
+ break;
+ case rel_ge:
+ print_vcg_node(vcgfp, my_node,">=");
+ break;
+ default:
+ print_vcg_node(vcgfp, my_node,"Unknown RelationalOp");
+ }
+ print_vcg_edge(vcgfp, parent,my_node);
+
+ vcg_expr_emit (root->astnode.expression.lhs, my_node);
+ vcg_expr_emit (root->astnode.expression.rhs, my_node);
+ break;
+ default:
+ fprintf(stderr,"vcg_emitter: Bad node in vcg_expr_emit\n");
+ }
+}
+
+/*****************************************************************************
+ * *
+ * vcg_forloop_emit *
+ * *
+ * Generate the graph for a DO loop. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_forloop_emit (AST * root, int parent)
+{
+ vcg_assign_emit (root->astnode.forloop.start, parent);
+ vcg_expr_emit (root->astnode.forloop.stop, parent);
+
+ if (root->astnode.forloop.incr != NULL) {
+ vcg_expr_emit (root->astnode.forloop.incr, parent);
+ }
+
+/* emit_vcg (root->astnode.forloop.stmts, parent); */
+}
+
+/*****************************************************************************
+ * *
+ * vcg_logicalif_emit *
+ * *
+ * Generates the graph nodes for a logical IF statement. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_logicalif_emit (AST * root, int parent)
+{
+ if (root->astnode.logicalif.conds != NULL)
+ vcg_expr_emit (root->astnode.logicalif.conds, parent);
+
+ emit_vcg (root->astnode.logicalif.stmts,parent);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_label_emit *
+ * *
+ * Generate the node for a label. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_label_emit (AST * root, int parent)
+{
+ int my_node = node_num;
+
+ sprintf(temp_buf,"Label (%d)",root->astnode.label.number);
+
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ if (root->astnode.label.stmt != NULL)
+ emit_vcg (root->astnode.label.stmt,my_node);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_blockif_emit *
+ * *
+ * Generates the nodes for a Block IF statement. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_blockif_emit (AST * root, int parent)
+{
+ AST *temp;
+
+ if (root->astnode.blockif.conds != NULL)
+ vcg_expr_emit (root->astnode.blockif.conds, parent);
+
+ if (root->astnode.blockif.stmts != NULL)
+ emit_vcg (root->astnode.blockif.stmts,parent);
+
+ for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt)
+ vcg_elseif_emit (root->astnode.blockif.elseifstmts,parent);
+
+ if (root->astnode.blockif.elsestmts != NULL)
+ vcg_else_emit (root->astnode.blockif.elsestmts,parent);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_elseif_emit *
+ * *
+ * Generates the nodes for an else if block. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_elseif_emit (AST * root, int parent)
+{
+ if (root->astnode.blockif.conds != NULL)
+ vcg_expr_emit (root->astnode.blockif.conds, parent);
+
+ emit_vcg (root->astnode.blockif.stmts,parent);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_else_emit *
+ * *
+ * Generates the nodes for an else if block. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_else_emit (AST * root, int parent)
+{
+ emit_vcg (root->astnode.blockif.stmts,parent);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_call_emit *
+ * *
+ * Generate the nodes for a function/subroutine call. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_call_emit (AST * root, int parent)
+{
+ AST *temp;
+ char *tempname;
+ int my_node = node_num;
+
+ assert (root != NULL);
+
+ lowercase (root->astnode.ident.name);
+ tempname = strdup (root->astnode.ident.name);
+ *tempname = toupper (*tempname);
+
+ sprintf(temp_buf,"Call (%s)",root->astnode.ident.name);
+ print_vcg_node(vcgfp, node_num,temp_buf);
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ assert (root->astnode.ident.arraylist != NULL);
+
+ temp = root->astnode.ident.arraylist;
+
+ while (temp->nextstmt != NULL) {
+ vcg_expr_emit (temp, parent);
+ temp = temp->nextstmt;
+ }
+
+ vcg_expr_emit (temp, parent);
+}
+
+/*****************************************************************************
+ * *
+ * vcg_spec_emit *
+ * *
+ * Generate the nodes for a specification statement. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_spec_emit (AST * root, int parent)
+{
+ AST *assigntemp;
+ int my_node = node_num;
+ int temp_num;
+
+ if(vcg_debug)
+ printf("in vcg_spec_emit, my_node = %d, parent = %d\n",
+ my_node,parent);
+
+ print_vcg_node(vcgfp, node_num,"Specification");
+ print_vcg_edge(vcgfp, parent, my_node);
+
+ /* I am reaching every case in this switch. */
+ switch (root->astnode.typeunit.specification)
+ {
+ /* PARAMETER in fortran corresponds to a class
+ * constant in java, that has to be declared
+ * class wide outside of any method. This is
+ * currently not implemented, but the assignment
+ * is made.
+ */
+
+ case Parameter:
+ assigntemp = root->astnode.typeunit.declist;
+ for (; assigntemp; assigntemp = assigntemp->nextstmt)
+ vcg_assign_emit (assigntemp, parent);
+ break;
+
+ case Intrinsic:
+ temp_num = vcg_name_emit (root);
+ print_vcg_edge(vcgfp, my_node, temp_num);
+ break;
+ case External:
+ case Implicit:
+ /* do nothing */
+ break;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * vcg_assign_emit *
+ * *
+ * Generate the nodes for an assignment statement. *
+ * *
+ *****************************************************************************/
+
+void
+vcg_assign_emit (AST * root, int parent)
+{
+ int temp_num;
+
+ temp_num = vcg_name_emit (root->astnode.assignment.lhs);
+ print_vcg_edge(vcgfp, parent,temp_num);
+ vcg_expr_emit (root->astnode.assignment.rhs, parent);
+}
diff --git a/src/y.tab.c b/src/y.tab.c
new file mode 100644
index 0000000..6e51541
--- /dev/null
+++ b/src/y.tab.c
@@ -0,0 +1,7700 @@
+/* A Bison parser, made by GNU Bison 2.0. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004 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. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Written by Richard Stallman by simplifying the original so called
+ ``semantic'' parser. */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+ infringing on user name space. This should be done even for local
+ variables, as they might otherwise be expanded by user macros.
+ There are some unavoidable exceptions within include files to
+ define necessary library symbols; they are noted "INFRINGES ON
+ USER NAME SPACE" below. */
+
+/* Identify Bison output. */
+#define YYBISON 1
+
+/* Skeleton name. */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers. */
+#define YYPURE 0
+
+/* Using locations. */
+#define YYLSP_NEEDED 0
+
+
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ PLUS = 258,
+ MINUS = 259,
+ OP = 260,
+ CP = 261,
+ STAR = 262,
+ POW = 263,
+ DIV = 264,
+ CAT = 265,
+ CM = 266,
+ EQ = 267,
+ COLON = 268,
+ NL = 269,
+ NOT = 270,
+ AND = 271,
+ OR = 272,
+ RELOP = 273,
+ EQV = 274,
+ NEQV = 275,
+ NAME = 276,
+ DOUBLE = 277,
+ INTEGER = 278,
+ E_EXPONENTIAL = 279,
+ D_EXPONENTIAL = 280,
+ CONST_EXP = 281,
+ TrUE = 282,
+ FaLSE = 283,
+ ICON = 284,
+ RCON = 285,
+ LCON = 286,
+ CCON = 287,
+ FLOAT = 288,
+ CHARACTER = 289,
+ LOGICAL = 290,
+ COMPLEX = 291,
+ NONE = 292,
+ IF = 293,
+ THEN = 294,
+ ELSE = 295,
+ ELSEIF = 296,
+ ENDIF = 297,
+ DO = 298,
+ GOTO = 299,
+ ASSIGN = 300,
+ TO = 301,
+ CONTINUE = 302,
+ STOP = 303,
+ RDWR = 304,
+ END = 305,
+ ENDDO = 306,
+ STRING = 307,
+ CHAR = 308,
+ PAUSE = 309,
+ OPEN = 310,
+ CLOSE = 311,
+ BACKSPACE = 312,
+ REWIND = 313,
+ ENDFILE = 314,
+ FORMAT = 315,
+ PROGRAM = 316,
+ FUNCTION = 317,
+ SUBROUTINE = 318,
+ ENTRY = 319,
+ CALL = 320,
+ RETURN = 321,
+ ARITH_TYPE = 322,
+ CHAR_TYPE = 323,
+ DIMENSION = 324,
+ INCLUDE = 325,
+ COMMON = 326,
+ EQUIVALENCE = 327,
+ EXTERNAL = 328,
+ PARAMETER = 329,
+ INTRINSIC = 330,
+ IMPLICIT = 331,
+ SAVE = 332,
+ DATA = 333,
+ COMMENT = 334,
+ READ = 335,
+ WRITE = 336,
+ PRINT = 337,
+ FMT = 338,
+ EDIT_DESC = 339,
+ REPEAT = 340,
+ OPEN_IOSTAT = 341,
+ OPEN_ERR = 342,
+ OPEN_FILE = 343,
+ OPEN_STATUS = 344,
+ OPEN_ACCESS = 345,
+ OPEN_FORM = 346,
+ OPEN_UNIT = 347,
+ OPEN_RECL = 348,
+ OPEN_BLANK = 349,
+ LOWER_THAN_COMMENT = 350
+ };
+#endif
+#define PLUS 258
+#define MINUS 259
+#define OP 260
+#define CP 261
+#define STAR 262
+#define POW 263
+#define DIV 264
+#define CAT 265
+#define CM 266
+#define EQ 267
+#define COLON 268
+#define NL 269
+#define NOT 270
+#define AND 271
+#define OR 272
+#define RELOP 273
+#define EQV 274
+#define NEQV 275
+#define NAME 276
+#define DOUBLE 277
+#define INTEGER 278
+#define E_EXPONENTIAL 279
+#define D_EXPONENTIAL 280
+#define CONST_EXP 281
+#define TrUE 282
+#define FaLSE 283
+#define ICON 284
+#define RCON 285
+#define LCON 286
+#define CCON 287
+#define FLOAT 288
+#define CHARACTER 289
+#define LOGICAL 290
+#define COMPLEX 291
+#define NONE 292
+#define IF 293
+#define THEN 294
+#define ELSE 295
+#define ELSEIF 296
+#define ENDIF 297
+#define DO 298
+#define GOTO 299
+#define ASSIGN 300
+#define TO 301
+#define CONTINUE 302
+#define STOP 303
+#define RDWR 304
+#define END 305
+#define ENDDO 306
+#define STRING 307
+#define CHAR 308
+#define PAUSE 309
+#define OPEN 310
+#define CLOSE 311
+#define BACKSPACE 312
+#define REWIND 313
+#define ENDFILE 314
+#define FORMAT 315
+#define PROGRAM 316
+#define FUNCTION 317
+#define SUBROUTINE 318
+#define ENTRY 319
+#define CALL 320
+#define RETURN 321
+#define ARITH_TYPE 322
+#define CHAR_TYPE 323
+#define DIMENSION 324
+#define INCLUDE 325
+#define COMMON 326
+#define EQUIVALENCE 327
+#define EXTERNAL 328
+#define PARAMETER 329
+#define INTRINSIC 330
+#define IMPLICIT 331
+#define SAVE 332
+#define DATA 333
+#define COMMENT 334
+#define READ 335
+#define WRITE 336
+#define PRINT 337
+#define FMT 338
+#define EDIT_DESC 339
+#define REPEAT 340
+#define OPEN_IOSTAT 341
+#define OPEN_ERR 342
+#define OPEN_FILE 343
+#define OPEN_STATUS 344
+#define OPEN_ACCESS 345
+#define OPEN_FORM 346
+#define OPEN_UNIT 347
+#define OPEN_RECL 348
+#define OPEN_BLANK 349
+#define LOWER_THAN_COMMENT 350
+
+
+
+
+/* Copy the first part of user declarations. */
+#line 8 "f2jparse.y"
+
+
+/*****************************************************************************
+ * f2jparse *
+ * *
+ * This is a yacc parser for a subset of Fortran 77. It builds an AST *
+ * which is used by codegen() to generate Java code. *
+ * *
+ *****************************************************************************/
+
+#include<stdio.h>
+#include<stdlib.h>
+#include<ctype.h>
+#include<string.h>
+#include"f2j.h"
+#include"f2j_externs.h"
+#include"f2jmem.h"
+
+/*****************************************************************************
+ * Define YYDEBUG as 1 to get debugging output from yacc. *
+ *****************************************************************************/
+
+#define YYDEBUG 0
+
+/*****************************************************************************
+ * Global variables. *
+ *****************************************************************************/
+
+int
+ debug = FALSE, /* set to TRUE for debugging output */
+ emittem = 1, /* set to 1 to emit Java, 0 to just parse */
+ len = 1, /* keeps track of the size of a data type */
+ temptok, /* temporary token for an inline expr */
+ save_all, /* is there a SAVE stmt without a var list */
+ cur_do_label; /* current 'do..end do' loop label */
+
+AST
+ * unit_args = NULL, /* pointer to args for this program unit */
+ * equivList = NULL; /* list to keep track of equivalences */
+
+Dlist
+ assign_labels, /* labels used in ASSIGN TO statements */
+ subroutine_names, /* holds the names of subroutines */
+ do_labels; /* generated labels for 'do..end do' loops */
+
+enum returntype
+ typedec_context = Object; /* what kind of type dec we are parsing */
+
+/*****************************************************************************
+ * Function prototypes: *
+ *****************************************************************************/
+
+METHODTAB
+ * methodscan (METHODTAB *, char *);
+
+int
+ yylex(void),
+ intrinsic_or_implicit(char *),
+ in_dlist_stmt_label(Dlist, AST *),
+ in_dlist(Dlist, char *);
+
+double
+ eval_const_expr(AST *);
+
+char
+ * lowercase(char * ),
+ * first_char_is_minus(char *),
+ * unary_negate_string(char *),
+ * tok2str(int );
+
+void
+ yyerror(char *),
+ start_vcg(AST *),
+ emit(AST *),
+ jas_emit(AST *),
+ init_tables(void),
+ addEquiv(AST *),
+ assign(AST *),
+ typecheck(AST *),
+ optScalar(AST *),
+ type_insert (SYMTABLE * , AST * , enum returntype , char *),
+ type_hash(AST *),
+ merge_common_blocks(AST *),
+ arg_table_load(AST *),
+ exp_to_double (char *, char *),
+ assign_function_return_type(AST *, AST *),
+ insert_name(SYMTABLE *, AST *, enum returntype),
+ store_array_var(AST *),
+ initialize_implicit_table(ITAB_ENTRY *),
+ printbits(char *, void *, int),
+ print_sym_table_names(SYMTABLE *);
+
+AST
+ * dl_astnode_examine(Dlist l),
+ * addnode(void),
+ * switchem(AST *),
+ * gen_incr_expr(AST *, AST *),
+ * gen_iter_expr(AST *, AST *, AST *),
+ * initialize_name(char *),
+ * process_typestmt(enum returntype, AST *),
+ * process_array_declaration(AST *, AST *),
+ * process_subroutine_call(AST *, AST *);
+
+SYMTABLE
+ * new_symtable (int );
+
+extern METHODTAB intrinsic_toks[];
+
+ITAB_ENTRY implicit_table[26];
+
+
+
+/* Enabling traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+
+/* Enabling verbose error messages. */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+#line 120 "f2jparse.y"
+typedef union YYSTYPE {
+ struct ast_node *ptnode;
+ int tok;
+ enum returntype type;
+ char lexeme[YYTEXTLEN];
+} YYSTYPE;
+/* Line 190 of yacc.c. */
+#line 385 "y.tab.c"
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations. */
+
+
+/* Line 213 of yacc.c. */
+#line 397 "y.tab.c"
+
+#if ! defined (yyoverflow) || YYERROR_VERBOSE
+
+# ifndef YYFREE
+# define YYFREE free
+# endif
+# ifndef YYMALLOC
+# define YYMALLOC malloc
+# endif
+
+/* The parser invokes alloca or malloc; define the necessary symbols. */
+
+# ifdef YYSTACK_USE_ALLOCA
+# if YYSTACK_USE_ALLOCA
+# ifdef __GNUC__
+# define YYSTACK_ALLOC __builtin_alloca
+# else
+# define YYSTACK_ALLOC alloca
+# endif
+# endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+ /* Pacify GCC's `empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
+# else
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+# define YYSTACK_ALLOC YYMALLOC
+# define YYSTACK_FREE YYFREE
+# endif
+#endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */
+
+
+#if (! defined (yyoverflow) \
+ && (! defined (__cplusplus) \
+ || (defined (YYSTYPE_IS_TRIVIAL) && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member. */
+union yyalloc
+{
+ short int yyss;
+ YYSTYPE yyvs;
+ };
+
+/* The size of the maximum gap between one aligned stack and the next. */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+ N elements. */
+# define YYSTACK_BYTES(N) \
+ ((N) * (sizeof (short int) + sizeof (YYSTYPE)) \
+ + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if defined (__GNUC__) && 1 < __GNUC__
+# define YYCOPY(To, From, Count) \
+ __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+# else
+# define YYCOPY(To, From, Count) \
+ do \
+ { \
+ register YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (To)[yyi] = (From)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+
+/* Relocate STACK from its old location to the new one. The
+ local variables YYSIZE and YYSTACKSIZE give the old and new number of
+ elements in the stack, and YYPTR gives the new location of the
+ stack. Advance YYPTR to a properly aligned location for the next
+ stack. */
+# define YYSTACK_RELOCATE(Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack, Stack, yysize); \
+ Stack = &yyptr->Stack; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
+
+#endif
+
+#if defined (__STDC__) || defined (__cplusplus)
+ typedef signed char yysigned_char;
+#else
+ typedef short int yysigned_char;
+#endif
+
+/* YYFINAL -- State number of the termination state. */
+#define YYFINAL 25
+/* YYLAST -- Last index in YYTABLE. */
+#define YYLAST 1202
+
+/* YYNTOKENS -- Number of terminals. */
+#define YYNTOKENS 97
+/* YYNNTS -- Number of nonterminals. */
+#define YYNNTS 136
+/* YYNRULES -- Number of rules. */
+#define YYNRULES 305
+/* YYNRULES -- Number of states. */
+#define YYNSTATES 583
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+#define YYUNDEFTOK 2
+#define YYMAXUTOK 350
+
+#define YYTRANSLATE(YYX) \
+ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+static const unsigned char yytranslate[] =
+{
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 96, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 1, 2, 3, 4,
+ 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
+ 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
+ 45, 46, 47, 48, 49, 50, 51, 52, 53, 54,
+ 55, 56, 57, 58, 59, 60, 61, 62, 63, 64,
+ 65, 66, 67, 68, 69, 70, 71, 72, 73, 74,
+ 75, 76, 77, 78, 79, 80, 81, 82, 83, 84,
+ 85, 86, 87, 88, 89, 90, 91, 92, 93, 94,
+ 95
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+ YYRHS. */
+static const unsigned short int yyprhs[] =
+{
+ 0, 0, 3, 5, 7, 10, 12, 14, 16, 18,
+ 23, 28, 33, 37, 42, 46, 52, 57, 59, 61,
+ 64, 66, 68, 70, 72, 74, 76, 78, 80, 82,
+ 85, 87, 91, 95, 97, 101, 105, 111, 113, 117,
+ 121, 123, 126, 131, 134, 137, 143, 147, 151, 155,
+ 157, 161, 166, 168, 172, 174, 178, 181, 183, 187,
+ 192, 194, 198, 200, 204, 206, 208, 211, 213, 217,
+ 219, 227, 231, 237, 239, 242, 245, 247, 249, 251,
+ 253, 255, 257, 259, 261, 263, 265, 267, 269, 271,
+ 273, 275, 277, 279, 281, 283, 285, 287, 290, 296,
+ 300, 302, 306, 308, 312, 316, 320, 324, 328, 332,
+ 336, 340, 342, 344, 346, 348, 350, 355, 361, 365,
+ 368, 372, 373, 378, 381, 383, 387, 391, 395, 397,
+ 401, 403, 405, 409, 415, 417, 419, 421, 423, 425,
+ 427, 431, 433, 437, 439, 441, 445, 447, 451, 457,
+ 459, 461, 463, 465, 469, 471, 473, 478, 480, 484,
+ 486, 488, 492, 494, 500, 504, 506, 511, 513, 515,
+ 519, 522, 525, 529, 531, 536, 543, 546, 550, 555,
+ 557, 560, 562, 564, 566, 568, 570, 574, 578, 580,
+ 582, 584, 586, 588, 590, 592, 595, 599, 602, 611,
+ 616, 621, 626, 629, 630, 632, 634, 638, 640, 644,
+ 646, 650, 652, 656, 665, 676, 678, 682, 683, 685,
+ 695, 707, 711, 723, 724, 726, 727, 729, 732, 740,
+ 741, 745, 748, 750, 756, 767, 772, 779, 785, 791,
+ 796, 798, 802, 803, 807, 811, 813, 817, 821, 823,
+ 827, 829, 833, 835, 838, 840, 841, 846, 848, 851,
+ 854, 858, 862, 864, 868, 872, 874, 878, 880, 884,
+ 886, 888, 890, 892, 896, 898, 900, 902, 904, 906,
+ 908, 910, 912, 914, 916, 918, 920, 922, 925, 928,
+ 932, 935, 939, 943, 950, 958, 965, 973, 977, 979,
+ 983, 989, 991, 995, 997, 1001
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS. */
+static const short int yyrhs[] =
+{
+ 98, 0, -1, 99, -1, 100, -1, 99, 100, -1,
+ 101, -1, 102, -1, 103, -1, 135, -1, 104, 107,
+ 133, 144, -1, 105, 107, 133, 144, -1, 106, 107,
+ 133, 144, -1, 61, 160, 14, -1, 63, 160, 145,
+ 14, -1, 63, 160, 14, -1, 153, 62, 160, 145,
+ 14, -1, 62, 160, 145, 14, -1, 108, -1, 109,
+ -1, 108, 109, -1, 110, -1, 112, -1, 115, -1,
+ 118, -1, 232, -1, 148, -1, 231, -1, 228, -1,
+ 119, -1, 124, 14, -1, 135, -1, 69, 111, 14,
+ -1, 111, 11, 163, -1, 163, -1, 72, 113, 14,
+ -1, 5, 114, 6, -1, 113, 11, 5, 114, 6,
+ -1, 169, -1, 114, 11, 169, -1, 71, 116, 14,
+ -1, 117, -1, 116, 117, -1, 9, 160, 9, 155,
+ -1, 10, 155, -1, 77, 14, -1, 77, 9, 147,
+ 9, 14, -1, 77, 147, 14, -1, 76, 120, 14,
+ -1, 76, 37, 14, -1, 121, -1, 120, 11, 121,
+ -1, 154, 5, 122, 6, -1, 123, -1, 122, 11,
+ 123, -1, 160, -1, 160, 4, 160, -1, 78, 125,
+ -1, 126, -1, 125, 11, 126, -1, 130, 9, 127,
+ 9, -1, 128, -1, 127, 11, 128, -1, 129, -1,
+ 129, 7, 129, -1, 216, -1, 160, -1, 4, 216,
+ -1, 131, -1, 130, 11, 131, -1, 169, -1, 5,
+ 169, 11, 160, 12, 132, 6, -1, 217, 11, 217,
+ -1, 217, 11, 217, 11, 217, -1, 134, -1, 133,
+ 134, -1, 168, 14, -1, 203, -1, 167, -1, 198,
+ -1, 199, -1, 192, -1, 171, -1, 221, -1, 226,
+ -1, 225, -1, 224, -1, 174, -1, 183, -1, 182,
+ -1, 184, -1, 188, -1, 223, -1, 222, -1, 136,
+ -1, 142, -1, 135, -1, 143, -1, 79, 14, -1,
+ 55, 5, 137, 6, 14, -1, 137, 11, 138, -1,
+ 138, -1, 92, 12, 139, -1, 139, -1, 86, 12,
+ 141, -1, 87, 12, 217, -1, 88, 12, 140, -1,
+ 89, 12, 140, -1, 90, 12, 140, -1, 91, 12,
+ 140, -1, 93, 12, 204, -1, 94, 12, 140, -1,
+ 204, -1, 7, -1, 160, -1, 162, -1, 160, -1,
+ 160, 5, 170, 6, -1, 56, 5, 160, 6, 14,
+ -1, 58, 160, 14, -1, 50, 14, -1, 217, 50,
+ 14, -1, -1, 5, 146, 147, 6, -1, 5, 6,
+ -1, 159, -1, 147, 11, 159, -1, 149, 155, 14,
+ -1, 151, 157, 14, -1, 150, -1, 150, 166, 217,
+ -1, 67, -1, 152, -1, 152, 166, 217, -1, 152,
+ 166, 5, 166, 6, -1, 68, -1, 150, -1, 152,
+ -1, 149, -1, 151, -1, 156, -1, 155, 11, 156,
+ -1, 159, -1, 159, 166, 217, -1, 163, -1, 158,
+ -1, 157, 11, 158, -1, 159, -1, 159, 166, 217,
+ -1, 159, 166, 5, 166, 6, -1, 163, -1, 21,
+ -1, 21, -1, 160, -1, 161, 11, 160, -1, 52,
+ -1, 53, -1, 159, 5, 164, 6, -1, 165, -1,
+ 164, 11, 165, -1, 204, -1, 166, -1, 204, 13,
+ 204, -1, 7, -1, 45, 217, 46, 159, 14, -1,
+ 169, 12, 204, -1, 159, -1, 159, 5, 170, 6,
+ -1, 201, -1, 204, -1, 170, 11, 204, -1, 172,
+ 173, -1, 43, 217, -1, 43, 217, 11, -1, 43,
+ -1, 168, 11, 204, 14, -1, 168, 11, 204, 11,
+ 204, 14, -1, 217, 134, -1, 217, 175, 14, -1,
+ 60, 5, 176, 6, -1, 177, -1, 176, 177, -1,
+ 178, -1, 179, -1, 180, -1, 84, -1, 160, -1,
+ 160, 96, 216, -1, 5, 176, 6, -1, 162, -1,
+ 181, -1, 11, -1, 9, -1, 10, -1, 13, -1,
+ 217, -1, 3, 217, -1, 217, 47, 14, -1, 51,
+ 14, -1, 81, 5, 186, 11, 187, 6, 189, 14,
+ -1, 82, 217, 185, 14, -1, 82, 7, 185, 14,
+ -1, 82, 162, 185, 14, -1, 11, 189, -1, -1,
+ 204, -1, 7, -1, 83, 12, 217, -1, 217, -1,
+ 83, 12, 7, -1, 7, -1, 83, 12, 162, -1,
+ 162, -1, 83, 12, 160, -1, 80, 5, 186, 11,
+ 187, 6, 189, 14, -1, 80, 5, 186, 11, 187,
+ 11, 191, 6, 189, 14, -1, 190, -1, 189, 11,
+ 190, -1, -1, 204, -1, 5, 202, 11, 159, 12,
+ 204, 11, 204, 6, -1, 5, 202, 11, 159, 12,
+ 204, 11, 204, 11, 204, 6, -1, 50, 12, 217,
+ -1, 38, 5, 204, 6, 39, 14, 193, 194, 196,
+ 197, 14, -1, -1, 133, -1, -1, 195, -1, 194,
+ 195, -1, 41, 5, 204, 6, 39, 14, 133, -1,
+ -1, 40, 14, 133, -1, 40, 14, -1, 42, -1,
+ 38, 5, 204, 6, 134, -1, 38, 5, 204, 6,
+ 217, 11, 217, 11, 217, 14, -1, 159, 5, 202,
+ 6, -1, 159, 5, 204, 13, 204, 6, -1, 159,
+ 5, 13, 204, 6, -1, 159, 5, 204, 13, 6,
+ -1, 159, 5, 13, 6, -1, 204, -1, 202, 11,
+ 204, -1, -1, 65, 200, 14, -1, 65, 160, 14,
+ -1, 205, -1, 204, 19, 205, -1, 204, 20, 205,
+ -1, 206, -1, 205, 17, 206, -1, 207, -1, 206,
+ 16, 207, -1, 208, -1, 15, 208, -1, 210, -1,
+ -1, 208, 18, 209, 208, -1, 211, -1, 4, 211,
+ -1, 3, 211, -1, 210, 3, 211, -1, 210, 4,
+ 211, -1, 212, -1, 211, 9, 212, -1, 211, 7,
+ 212, -1, 213, -1, 213, 8, 212, -1, 214, -1,
+ 213, 10, 214, -1, 159, -1, 216, -1, 200, -1,
+ 201, -1, 5, 204, 6, -1, 27, -1, 28, -1,
+ 217, -1, 219, -1, 218, -1, 220, -1, 215, -1,
+ 162, -1, 23, -1, 22, -1, 33, -1, 24, -1,
+ 25, -1, 66, 14, -1, 54, 14, -1, 54, 162,
+ 14, -1, 48, 14, -1, 48, 162, 14, -1, 44,
+ 217, 14, -1, 44, 5, 227, 6, 204, 14, -1,
+ 44, 5, 227, 6, 11, 204, 14, -1, 44, 159,
+ 5, 227, 6, 14, -1, 44, 159, 11, 5, 227,
+ 6, 14, -1, 44, 159, 14, -1, 217, -1, 227,
+ 11, 217, -1, 74, 5, 229, 6, 14, -1, 230,
+ -1, 229, 11, 230, -1, 168, -1, 73, 161, 14,
+ -1, 75, 161, 14, -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+static const unsigned short int yyrline[] =
+{
+ 0, 200, 200, 244, 263, 285, 291, 297, 303, 311,
+ 370, 445, 522, 543, 562, 582, 612, 639, 667, 671,
+ 678, 682, 686, 690, 694, 698, 702, 706, 710, 714,
+ 718, 724, 735, 741, 752, 762, 777, 794, 798, 805,
+ 816, 820, 827, 863, 898, 910, 929, 950, 956, 965,
+ 969, 975, 1014, 1018, 1025, 1032, 1041, 1050, 1054, 1061,
+ 1089, 1093, 1100, 1104, 1120, 1124, 1141, 1159, 1163, 1170,
+ 1174, 1184, 1194, 1213, 1217, 1224, 1229, 1234, 1239, 1244,
+ 1249, 1254, 1259, 1264, 1269, 1274, 1279, 1284, 1289, 1294,
+ 1299, 1304, 1309, 1314, 1319, 1324, 1329, 1336, 1346, 1355,
+ 1357, 1361, 1366, 1371, 1376, 1381, 1386, 1391, 1396, 1401,
+ 1406, 1413, 1418, 1425, 1427, 1431, 1433, 1437, 1444, 1451,
+ 1458, 1488, 1488, 1497, 1508, 1515, 1532, 1536, 1542, 1547,
+ 1556, 1563, 1568, 1575, 1584, 1591, 1595, 1601, 1605, 1617,
+ 1624, 1632, 1637, 1642, 1649, 1656, 1664, 1669, 1674, 1679,
+ 1699, 1759, 1779, 1783, 1790, 1801, 1814, 1820, 1834, 1846,
+ 1850, 1854, 1868, 1876, 1901, 1914, 1920, 1956, 1962, 1969,
+ 1981, 1990, 1995, 1999, 2024, 2038, 2060, 2070, 2100, 2108,
+ 2118, 2140, 2144, 2148, 2154, 2160, 2164, 2171, 2182, 2186,
+ 2193, 2198, 2203, 2208, 2215, 2219, 2234, 2245, 2259, 2301,
+ 2316, 2330, 2346, 2351, 2359, 2364, 2376, 2380, 2384, 2392,
+ 2400, 2404, 2408, 2420, 2462, 2508, 2515, 2522, 2527, 2531,
+ 2552, 2576, 2590, 2617, 2618, 2624, 2625, 2629, 2637, 2649,
+ 2650, 2657, 2663, 2676, 2686, 2719, 2725, 2740, 2754, 2768,
+ 2793, 2803, 2810, 2818, 2840, 2856, 2860, 2872, 2886, 2890,
+ 2904, 2908, 2922, 2926, 2937, 2941, 2941, 2955, 2959, 2986,
+ 3001, 3015, 3031, 3035, 3049, 3066, 3070, 3082, 3086, 3102,
+ 3103, 3108, 3109, 3110, 3130, 3138, 3150, 3154, 3158, 3162,
+ 3166, 3170, 3176, 3187, 3197, 3216, 3230, 3245, 3251, 3257,
+ 3264, 3270, 3277, 3289, 3300, 3313, 3324, 3335, 3347, 3351,
+ 3358, 3368, 3372, 3379, 3471, 3482
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE
+/* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+ First, the terminals, then, starting at YYNTOKENS, nonterminals. */
+static const char *const yytname[] =
+{
+ "$end", "error", "$undefined", "PLUS", "MINUS", "OP", "CP", "STAR",
+ "POW", "DIV", "CAT", "CM", "EQ", "COLON", "NL", "NOT", "AND", "OR",
+ "RELOP", "EQV", "NEQV", "NAME", "DOUBLE", "INTEGER", "E_EXPONENTIAL",
+ "D_EXPONENTIAL", "CONST_EXP", "TrUE", "FaLSE", "ICON", "RCON", "LCON",
+ "CCON", "FLOAT", "CHARACTER", "LOGICAL", "COMPLEX", "NONE", "IF", "THEN",
+ "ELSE", "ELSEIF", "ENDIF", "DO", "GOTO", "ASSIGN", "TO", "CONTINUE",
+ "STOP", "RDWR", "END", "ENDDO", "STRING", "CHAR", "PAUSE", "OPEN",
+ "CLOSE", "BACKSPACE", "REWIND", "ENDFILE", "FORMAT", "PROGRAM",
+ "FUNCTION", "SUBROUTINE", "ENTRY", "CALL", "RETURN", "ARITH_TYPE",
+ "CHAR_TYPE", "DIMENSION", "INCLUDE", "COMMON", "EQUIVALENCE", "EXTERNAL",
+ "PARAMETER", "INTRINSIC", "IMPLICIT", "SAVE", "DATA", "COMMENT", "READ",
+ "WRITE", "PRINT", "FMT", "EDIT_DESC", "REPEAT", "OPEN_IOSTAT",
+ "OPEN_ERR", "OPEN_FILE", "OPEN_STATUS", "OPEN_ACCESS", "OPEN_FORM",
+ "OPEN_UNIT", "OPEN_RECL", "OPEN_BLANK", "LOWER_THAN_COMMENT", "'.'",
+ "$accept", "F2java", "Sourcecodes", "Sourcecode", "Fprogram",
+ "Fsubroutine", "Ffunction", "Program", "Subroutine", "Function",
+ "Specstmts", "SpecStmtList", "Specstmt", "Dimension", "ArraydecList",
+ "EquivalenceStmt", "EquivalenceList", "EquivalenceItem", "Common",
+ "CommonList", "CommonSpec", "Save", "Implicit", "ImplicitSpecList",
+ "ImplicitSpecItem", "ImplicitLetterList", "ImplicitLetter", "Data",
+ "DataList", "DataItem", "DataConstantList", "DataConstantExpr",
+ "DataConstant", "LhsList", "DataLhs", "LoopBounds", "Statements",
+ "Statement", "Comment", "Open", "Olist", "OlistItem", "UnitSpec",
+ "CharExp", "Ios", "Close", "Rewind", "End", "Functionargs", "@1",
+ "Namelist", "Typestmt", "ArithTypes", "ArithSimpleType", "CharTypes",
+ "CharSimpleType", "AnySimpleType", "AnyTypes", "ArithTypevarlist",
+ "ArithTypevar", "CharTypevarlist", "CharTypevar", "Name",
+ "UndeclaredName", "UndeclaredNamelist", "String", "Arraydeclaration",
+ "Arraynamelist", "Arrayname", "Star", "StmtLabelAssign", "Assignment",
+ "Lhs", "Arrayindexlist", "Doloop", "Do_incr", "Do_vals", "Label",
+ "Format", "FormatExplist", "FormatExp", "RepeatableItem",
+ "UnRepeatableItem", "FormatSeparator", "RepeatSpec", "Continue", "EndDo",
+ "Write", "PrintIoList", "WriteFileDesc", "FormatSpec", "Read",
+ "IoExplist", "IoExp", "EndSpec", "Blockif", "IfBlock", "Elseifs",
+ "Elseif", "Else", "EndIf", "Logicalif", "Arithmeticif", "Subroutinecall",
+ "SubstringOp", "Explist", "Call", "Exp", "log_disjunct", "log_term",
+ "log_factor", "log_primary", "@2", "arith_expr", "term", "factor",
+ "char_expr", "primary", "Boolean", "Constant", "Integer", "Double",
+ "Float", "Exponential", "Return", "Pause", "Stop", "Goto",
+ "ComputedGoto", "AssignedGoto", "Intlist", "Parameter", "Pdecs", "Pdec",
+ "External", "Intrinsic", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+ token YYLEX-NUM. */
+static const unsigned short int yytoknum[] =
+{
+ 0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
+ 265, 266, 267, 268, 269, 270, 271, 272, 273, 274,
+ 275, 276, 277, 278, 279, 280, 281, 282, 283, 284,
+ 285, 286, 287, 288, 289, 290, 291, 292, 293, 294,
+ 295, 296, 297, 298, 299, 300, 301, 302, 303, 304,
+ 305, 306, 307, 308, 309, 310, 311, 312, 313, 314,
+ 315, 316, 317, 318, 319, 320, 321, 322, 323, 324,
+ 325, 326, 327, 328, 329, 330, 331, 332, 333, 334,
+ 335, 336, 337, 338, 339, 340, 341, 342, 343, 344,
+ 345, 346, 347, 348, 349, 350, 46
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const unsigned char yyr1[] =
+{
+ 0, 97, 98, 99, 99, 100, 100, 100, 100, 101,
+ 102, 103, 104, 105, 105, 106, 106, 107, 108, 108,
+ 109, 109, 109, 109, 109, 109, 109, 109, 109, 109,
+ 109, 110, 111, 111, 112, 113, 113, 114, 114, 115,
+ 116, 116, 117, 117, 118, 118, 118, 119, 119, 120,
+ 120, 121, 122, 122, 123, 123, 124, 125, 125, 126,
+ 127, 127, 128, 128, 129, 129, 129, 130, 130, 131,
+ 131, 132, 132, 133, 133, 134, 134, 134, 134, 134,
+ 134, 134, 134, 134, 134, 134, 134, 134, 134, 134,
+ 134, 134, 134, 134, 134, 134, 134, 135, 136, 137,
+ 137, 138, 138, 138, 138, 138, 138, 138, 138, 138,
+ 138, 139, 139, 140, 140, 141, 141, 142, 143, 144,
+ 144, 146, 145, 145, 147, 147, 148, 148, 149, 149,
+ 150, 151, 151, 151, 152, 153, 153, 154, 154, 155,
+ 155, 156, 156, 156, 157, 157, 158, 158, 158, 158,
+ 159, 160, 161, 161, 162, 162, 163, 164, 164, 165,
+ 165, 165, 166, 167, 168, 169, 169, 169, 170, 170,
+ 171, 172, 172, 172, 173, 173, 174, 174, 175, 176,
+ 176, 177, 177, 177, 178, 178, 178, 178, 179, 179,
+ 180, 180, 180, 180, 181, 181, 182, 183, 184, 184,
+ 184, 184, 185, 185, 186, 186, 187, 187, 187, 187,
+ 187, 187, 187, 188, 188, 189, 189, 189, 190, 190,
+ 190, 191, 192, 193, 193, 194, 194, 194, 195, 196,
+ 196, 196, 197, 198, 199, 200, 201, 201, 201, 201,
+ 202, 202, 202, 203, 203, 204, 204, 204, 205, 205,
+ 206, 206, 207, 207, 208, 209, 208, 210, 210, 210,
+ 210, 210, 211, 211, 211, 212, 212, 213, 213, 214,
+ 214, 214, 214, 214, 215, 215, 216, 216, 216, 216,
+ 216, 216, 217, 218, 219, 220, 220, 221, 222, 222,
+ 223, 223, 224, 225, 225, 226, 226, 226, 227, 227,
+ 228, 229, 229, 230, 231, 232
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
+static const unsigned char yyr2[] =
+{
+ 0, 2, 1, 1, 2, 1, 1, 1, 1, 4,
+ 4, 4, 3, 4, 3, 5, 4, 1, 1, 2,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 2,
+ 1, 3, 3, 1, 3, 3, 5, 1, 3, 3,
+ 1, 2, 4, 2, 2, 5, 3, 3, 3, 1,
+ 3, 4, 1, 3, 1, 3, 2, 1, 3, 4,
+ 1, 3, 1, 3, 1, 1, 2, 1, 3, 1,
+ 7, 3, 5, 1, 2, 2, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 2, 5, 3,
+ 1, 3, 1, 3, 3, 3, 3, 3, 3, 3,
+ 3, 1, 1, 1, 1, 1, 4, 5, 3, 2,
+ 3, 0, 4, 2, 1, 3, 3, 3, 1, 3,
+ 1, 1, 3, 5, 1, 1, 1, 1, 1, 1,
+ 3, 1, 3, 1, 1, 3, 1, 3, 5, 1,
+ 1, 1, 1, 3, 1, 1, 4, 1, 3, 1,
+ 1, 3, 1, 5, 3, 1, 4, 1, 1, 3,
+ 2, 2, 3, 1, 4, 6, 2, 3, 4, 1,
+ 2, 1, 1, 1, 1, 1, 3, 3, 1, 1,
+ 1, 1, 1, 1, 1, 2, 3, 2, 8, 4,
+ 4, 4, 2, 0, 1, 1, 3, 1, 3, 1,
+ 3, 1, 3, 8, 10, 1, 3, 0, 1, 9,
+ 11, 3, 11, 0, 1, 0, 1, 2, 7, 0,
+ 3, 2, 1, 5, 10, 4, 6, 5, 5, 4,
+ 1, 3, 0, 3, 3, 1, 3, 3, 1, 3,
+ 1, 3, 1, 2, 1, 0, 4, 1, 2, 2,
+ 3, 3, 1, 3, 3, 1, 3, 1, 3, 1,
+ 1, 1, 1, 3, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 2, 2, 3,
+ 2, 3, 3, 6, 7, 6, 7, 3, 1, 3,
+ 5, 1, 3, 1, 3, 3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+ STATE-NUM when YYTABLE doesn't specify something else to do. Zero
+ means the default is an error. */
+static const unsigned short int yydefact[] =
+{
+ 0, 0, 0, 0, 130, 134, 0, 0, 2, 3,
+ 5, 6, 7, 0, 0, 0, 8, 135, 136, 0,
+ 151, 0, 0, 0, 97, 1, 4, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 17, 18, 20,
+ 21, 22, 23, 28, 0, 30, 25, 0, 128, 0,
+ 131, 27, 26, 24, 0, 0, 0, 12, 121, 0,
+ 14, 0, 150, 0, 0, 33, 0, 0, 0, 40,
+ 0, 0, 152, 0, 0, 0, 0, 0, 49, 137,
+ 138, 0, 0, 44, 0, 124, 0, 56, 57, 0,
+ 67, 165, 69, 167, 282, 0, 173, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 73, 95, 93, 94, 96, 77, 0, 0, 81,
+ 0, 86, 88, 87, 89, 90, 80, 78, 79, 76,
+ 0, 82, 92, 91, 85, 84, 83, 19, 29, 0,
+ 139, 141, 143, 162, 0, 0, 144, 146, 149, 0,
+ 0, 0, 0, 123, 0, 16, 13, 0, 31, 0,
+ 0, 43, 39, 41, 0, 37, 0, 34, 0, 304,
+ 303, 0, 301, 305, 48, 0, 47, 0, 0, 0,
+ 46, 0, 0, 0, 0, 0, 0, 171, 0, 0,
+ 0, 0, 290, 154, 155, 0, 197, 288, 0, 0,
+ 0, 0, 150, 0, 0, 0, 287, 0, 0, 203,
+ 203, 203, 0, 74, 9, 0, 75, 0, 0, 170,
+ 0, 0, 176, 0, 0, 126, 0, 129, 0, 127,
+ 0, 0, 132, 10, 11, 0, 0, 32, 0, 0,
+ 0, 0, 283, 285, 286, 274, 275, 284, 269, 281,
+ 0, 157, 160, 271, 272, 159, 245, 248, 250, 252,
+ 254, 257, 262, 265, 267, 280, 270, 276, 278, 277,
+ 279, 0, 35, 0, 0, 153, 0, 0, 50, 0,
+ 52, 54, 0, 125, 0, 58, 0, 0, 60, 62,
+ 65, 64, 68, 0, 0, 168, 0, 172, 298, 0,
+ 0, 0, 297, 292, 0, 291, 289, 112, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 100, 102,
+ 111, 0, 118, 242, 244, 243, 205, 0, 204, 0,
+ 217, 0, 0, 0, 119, 0, 164, 0, 196, 0,
+ 177, 140, 142, 145, 0, 147, 0, 15, 122, 259,
+ 258, 0, 253, 242, 156, 0, 0, 0, 0, 0,
+ 0, 255, 0, 0, 0, 0, 0, 0, 42, 38,
+ 0, 300, 302, 51, 0, 0, 45, 0, 66, 59,
+ 0, 0, 239, 0, 166, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 240, 0, 0, 242,
+ 202, 215, 218, 200, 201, 199, 120, 0, 0, 0,
+ 191, 192, 190, 193, 184, 185, 188, 0, 179, 181,
+ 182, 183, 189, 194, 0, 133, 273, 240, 158, 161,
+ 246, 247, 249, 251, 0, 260, 261, 264, 263, 266,
+ 268, 36, 53, 55, 0, 61, 63, 237, 169, 238,
+ 0, 0, 233, 0, 0, 0, 299, 0, 0, 163,
+ 103, 115, 104, 105, 113, 114, 106, 107, 108, 101,
+ 109, 110, 98, 99, 117, 235, 0, 209, 0, 211,
+ 0, 207, 0, 0, 240, 0, 0, 174, 195, 0,
+ 0, 178, 180, 148, 256, 0, 0, 236, 223, 0,
+ 0, 293, 295, 0, 0, 241, 0, 217, 0, 217,
+ 0, 216, 0, 187, 186, 70, 0, 224, 225, 0,
+ 294, 296, 0, 168, 208, 212, 210, 206, 0, 0,
+ 0, 0, 269, 175, 71, 0, 229, 226, 0, 116,
+ 213, 0, 217, 198, 0, 0, 0, 0, 227, 0,
+ 0, 221, 0, 0, 72, 0, 231, 232, 0, 234,
+ 214, 0, 0, 230, 222, 0, 0, 219, 0, 0,
+ 0, 228, 220
+};
+
+/* YYDEFGOTO[NTERM-NUM]. */
+static const short int yydefgoto[] =
+{
+ -1, 7, 8, 9, 10, 11, 12, 13, 14, 15,
+ 36, 37, 38, 39, 63, 40, 71, 164, 41, 68,
+ 69, 42, 43, 77, 78, 279, 280, 44, 87, 88,
+ 287, 288, 289, 89, 90, 505, 110, 111, 112, 113,
+ 317, 318, 319, 473, 470, 114, 115, 214, 59, 154,
+ 84, 46, 47, 48, 49, 50, 19, 81, 139, 140,
+ 145, 146, 248, 474, 73, 249, 142, 250, 251, 252,
+ 116, 117, 118, 294, 119, 120, 219, 121, 223, 427,
+ 428, 429, 430, 431, 432, 122, 123, 124, 331, 327,
+ 490, 125, 410, 411, 540, 126, 528, 546, 547, 559,
+ 568, 127, 128, 253, 254, 405, 129, 412, 256, 257,
+ 258, 259, 444, 260, 261, 262, 263, 264, 265, 266,
+ 267, 268, 269, 270, 131, 132, 133, 134, 135, 136,
+ 299, 51, 171, 172, 52, 53
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
+#define YYPACT_NINF -452
+static const short int yypact[] =
+{
+ 150, 17, 17, 17, -452, -452, 80, 114, 150, -452,
+ -452, -452, -452, 1116, 1116, 1116, -452, -452, -452, 44,
+ -452, 112, 131, 106, -452, -452, -452, 125, 323, 165,
+ 17, 171, 17, 96, 135, 20, 783, 1116, -452, -452,
+ -452, -452, -452, -452, 184, -452, -452, 125, 198, 125,
+ 198, -452, -452, -452, 783, 783, 17, -452, 177, 205,
+ -452, 222, -452, 51, 220, -452, 17, 125, 320, -452,
+ 125, 70, -452, 231, 125, 294, 254, 298, -452, -452,
+ -452, 274, 125, -452, 328, -452, 125, 330, -452, 313,
+ -452, 301, -452, -452, -452, 354, 332, 84, 332, 21,
+ 359, 47, 378, 403, 17, 345, 443, 456, 465, 27,
+ 737, -452, -452, -452, -452, -452, -452, 460, 468, -452,
+ 125, -452, -452, -452, -452, -452, -452, -452, -452, -452,
+ 718, -452, -452, -452, -452, -452, -452, -452, -452, 410,
+ -452, 384, -452, -452, 332, 416, -452, 384, -452, 40,
+ 737, 737, 131, -452, 125, -452, -452, 125, -452, 851,
+ 481, 483, -452, -452, 81, -452, 487, -452, 17, -452,
+ -452, 232, -452, -452, -452, 355, -452, 17, 389, 125,
+ -452, 486, 20, 157, 20, 884, 1082, 488, 332, 111,
+ 484, 461, -452, -452, -452, 494, -452, -452, 495, 661,
+ 17, 500, 501, 496, 504, 505, -452, 917, 917, 509,
+ 509, 509, 507, -452, -452, 216, -452, 1082, 511, -452,
+ 510, 518, -452, 513, 125, -452, 332, -452, 125, -452,
+ 92, 198, -452, -452, -452, 514, 247, -452, 1149, 1149,
+ 1082, 1128, -452, -452, -452, -452, -452, -452, 520, -452,
+ 269, -452, -452, -452, -452, 176, 515, 517, -452, 512,
+ 435, 453, -452, 455, -452, -452, -452, -452, -452, -452,
+ -452, 125, -452, 125, 125, -452, 521, 125, -452, 329,
+ -452, 530, 522, -452, 17, -452, 357, 458, -452, 531,
+ -452, -452, -452, 950, 342, 211, 134, -452, -452, 350,
+ 332, 532, -452, -452, 125, -452, -452, -452, 529, 533,
+ 536, 538, 541, 544, 546, 548, 549, 352, -452, -452,
+ 428, 537, -452, 1082, -452, -452, -452, 551, 428, 555,
+ 1115, 528, 554, 558, -452, 559, 428, 1082, -452, 392,
+ -452, -452, -452, -452, 198, -452, 569, -452, -452, 453,
+ 453, 152, 512, 884, -452, 851, 1082, 1082, 1082, 1082,
+ 1082, -452, 1149, 1149, 1149, 1149, 1149, 1149, 483, -452,
+ 361, -452, -452, -452, 17, 17, -452, 566, -452, -452,
+ 157, 157, -452, 214, -452, 1082, 983, 526, 1016, 332,
+ 381, 332, 565, 17, 332, 33, 33, 33, 33, 1049,
+ 1082, 33, 573, 661, 574, 393, 428, 19, 19, 1082,
+ 572, -452, 428, -452, -452, -452, -452, 180, 332, 392,
+ -452, -452, -452, -452, -452, 498, -452, 341, -452, -452,
+ -452, -452, -452, -452, 584, -452, -452, 211, -452, 428,
+ 515, 515, 517, -452, 1128, 453, 453, -452, -452, -452,
+ -452, -452, -452, -452, 332, -452, -452, -452, 428, -452,
+ 229, 581, -452, 652, 1082, 264, -452, 582, 400, -452,
+ -452, 592, -452, -452, -452, -452, -452, -452, -452, -452,
+ 428, -452, -452, -452, -452, -452, 1082, -452, 586, -452,
+ 401, -452, 594, 590, 152, 1115, 1082, -452, -452, 365,
+ 357, -452, -452, -452, 591, 596, 599, -452, 783, 332,
+ 271, -452, -452, 597, 1082, 428, 23, 1115, 562, 1115,
+ 1082, -452, 280, -452, -452, -452, 332, 783, 575, 602,
+ -452, -452, 408, 428, -452, -452, -452, -452, 417, 603,
+ 608, 421, 55, -452, 607, 614, 402, -452, 332, -452,
+ -452, 332, 1115, -452, 1082, 332, 1082, 606, -452, 579,
+ 610, -452, 423, 203, -452, 267, 783, -452, 612, -452,
+ -452, 1082, 583, 783, -452, 71, 613, -452, 1082, 783,
+ 295, 783, -452
+};
+
+/* YYPGOTO[NTERM-NUM]. */
+static const short int yypgoto[] =
+{
+ -452, -452, -452, 621, -452, -452, -452, -452, -452, -452,
+ 439, -452, 593, -452, -452, -452, -452, 360, -452, -452,
+ 563, -452, -452, -452, 462, -452, 259, -452, -452, 454,
+ -452, 258, 260, -452, 463, -452, -53, -94, 104, -452,
+ -452, 236, 241, -80, -452, -452, -452, 322, -2, -452,
+ -59, -452, -28, 143, -16, 169, -452, -452, -63, 418,
+ -452, 420, -27, 136, 617, -70, -12, -452, 289, 1,
+ -452, -62, -17, 132, -452, -452, -452, -452, -452, 226,
+ -403, -452, -452, -452, -452, -452, -452, -452, 272, 445,
+ 243, -452, -451, 159, -452, -452, -452, -452, 109, -452,
+ -452, -452, -452, 556, -22, 251, -452, 103, 120, 303,
+ 307, -238, -452, -452, -228, 86, -452, 302, -452, -177,
+ 77, -452, -452, -452, -452, -452, -452, -452, -452, -452,
+ -281, -452, -452, 394, -452, -452
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule which
+ number is the opposite. If zero, do what YYDEFACT says.
+ If YYTABLE_NINF, syntax error. */
+#define YYTABLE_NINF -152
+static const short int yytable[] =
+{
+ 64, 150, 151, 352, 161, 79, 291, 85, 91, 91,
+ 349, 350, 170, 93, 93, 65, 213, 80, 92, 390,
+ 141, 61, 147, 178, 502, 86, 487, 91, 91, 195,
+ 534, 198, 93, 93, 209, 192, 222, 148, 20, 210,
+ 141, 62, 94, 91, 20, 231, 94, 91, 93, 144,
+ 94, 149, 93, 165, 20, 85, 213, 213, 218, 91,
+ 353, 197, 157, 94, 93, 158, 538, 554, 541, 181,
+ 189, 193, 194, 193, 194, 193, 194, 577, 203, 193,
+ 194, 166, 578, 91, 167, 193, 194, 272, 93, 188,
+ 357, 358, 273, 91, 24, 236, 502, 344, 93, 193,
+ 194, 562, 488, 91, 16, 62, 56, 94, 93, 378,
+ 468, 58, 16, 130, 25, 94, 300, 45, 45, 45,
+ 60, 222, 301, 91, 91, 302, 57, 85, 93, 93,
+ 64, 130, 130, 76, 445, 446, 58, 21, 22, 23,
+ 387, 45, 226, 17, 82, 237, 62, 79, 230, 83,
+ 235, 17, 283, 357, 358, 91, 62, 91, 436, 80,
+ 93, 286, 93, 4, 5, 92, 72, 92, 72, 18,
+ 70, 357, 358, 187, 190, 191, 74, 18, 20, 242,
+ 94, 243, 244, 153, 245, 246, 211, 215, 91, 356,
+ 247, 496, 152, 93, 497, 357, 358, 141, 138, 357,
+ 358, 147, 160, 291, 291, 143, 504, 130, 368, 193,
+ 194, 1, 2, 3, 571, 170, 148, 4, 5, 155,
+ 457, 227, 357, 358, 386, 159, 232, 215, 215, 6,
+ 357, 358, 346, 357, 358, 507, 156, 62, 276, 94,
+ 201, 204, 168, 277, 141, 169, 91, 91, 357, 358,
+ 91, 93, 93, 348, 95, 93, 369, 165, 179, 96,
+ 97, 98, 255, 220, 99, 298, 335, 100, 174, 426,
+ 101, 102, 103, 572, 104, 354, 221, 392, 511, 177,
+ 355, 105, 106, 357, 358, 530, 357, 358, 295, 296,
+ 357, 358, 130, 462, 543, 6, 107, 108, 109, 357,
+ 358, 582, 320, 342, 275, 168, 185, 345, 173, 175,
+ 328, 328, 176, 281, 357, 358, 476, 477, 478, 290,
+ 336, 481, 183, 524, 184, 475, 475, 475, 475, 66,
+ 67, 475, 66, 67, 162, 373, 321, 489, 489, 179,
+ 374, 182, 180, 351, 418, 434, 419, 501, 384, 426,
+ 420, 421, 422, 385, 423, 94, 388, 426, 402, 186,
+ 91, 389, 20, 403, 94, 93, 202, 451, 418, 222,
+ 419, 523, 273, 196, 420, 421, 422, 298, 423, 242,
+ 94, 243, 244, 199, 245, 246, 20, 467, 94, 159,
+ 247, 143, 389, 193, 194, 418, 383, 419, 282, 485,
+ 179, 420, 421, 422, 486, 423, 513, 517, 200, 193,
+ 194, 389, 518, 20, 549, 94, 433, 193, 194, 385,
+ 377, 224, 4, 5, 225, 424, 406, 228, 495, 426,
+ 229, 550, 495, 213, 495, 553, 91, 570, 362, 363,
+ 417, 93, 557, 545, 193, 194, 536, 357, 358, 424,
+ 447, 448, 449, 54, 55, 527, 437, 206, 255, 439,
+ 364, 207, 365, 366, 463, 367, 466, 379, 298, 380,
+ 208, 472, 233, 234, 216, 425, 424, 440, 441, 213,
+ 217, 91, 332, 333, 491, 491, 93, 213, 458, 460,
+ 271, 465, 274, 542, 224, 498, 433, 284, 303, 297,
+ 91, 323, 320, 480, 433, 93, 320, 304, 305, 306,
+ 281, 453, 494, 573, 322, -151, 290, 290, 324, 325,
+ 330, 334, 337, 339, 338, 353, 581, 340, 347, 471,
+ 361, 506, 359, 360, 375, 371, 376, 391, 381, 91,
+ 130, 393, 413, 404, 93, 394, 91, 62, 395, 94,
+ 396, 93, 91, 397, 91, 425, 398, 93, 399, 93,
+ 400, 401, 407, 425, 95, 461, 408, 510, 414, 96,
+ 97, 98, 415, 416, 99, 435, 433, 100, 454, 469,
+ 101, 102, 103, 495, 104, 130, 529, 482, 484, 515,
+ 503, 105, 106, 537, 500, 508, 512, 514, 516, 522,
+ 519, 520, 525, 544, 130, 6, 107, 108, 109, -152,
+ 526, 531, 539, 548, 552, 551, 545, 533, 555, 556,
+ 566, 567, 576, 515, 569, 560, 574, 579, 561, 26,
+ 137, 163, 564, 452, 370, 425, 285, 278, 455, 483,
+ 479, 456, 341, 130, 438, 499, 532, 292, 343, 75,
+ 130, 492, 535, 329, 521, 558, 130, 563, 130, 565,
+ 493, 205, 442, 509, 238, 239, 240, 443, 307, 450,
+ 0, 372, 0, 62, 575, 94, 241, 0, 0, 0,
+ 0, 580, 62, 242, 94, 243, 244, 0, 245, 246,
+ 95, 0, 0, 0, 247, 96, 97, 98, 0, 220,
+ 99, 0, 0, 100, 0, 0, 101, 102, 103, 0,
+ 104, 0, 221, 193, 194, 0, 0, 105, 106, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 6, 107, 108, 109, 0, 0, 0, 0, 62,
+ 0, 94, 0, 0, 0, 0, 0, 308, 309, 310,
+ 311, 312, 313, 314, 315, 316, 95, 0, 62, 0,
+ 94, 96, 97, 98, 0, 220, 99, 0, 0, 100,
+ 0, 0, 101, 102, 103, 95, 104, 0, 221, 0,
+ 96, 97, 98, 105, 106, 99, 0, 212, 100, 0,
+ 0, 101, 102, 103, 0, 104, 0, 6, 107, 108,
+ 109, 0, 105, 106, 62, 0, 94, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 6, 107, 108, 109,
+ 0, 95, 0, 0, 0, 0, 96, 97, 98, 0,
+ 0, 99, 0, 0, 100, 0, 0, 101, 102, 103,
+ 0, 104, 0, 0, 0, 0, 0, 0, 105, 106,
+ 0, 0, 0, 0, 238, 239, 240, 0, 143, 0,
+ 0, 0, 6, 107, 108, 109, 241, 0, 0, 0,
+ 0, 0, 62, 242, 94, 243, 244, 0, 245, 246,
+ 0, 0, 0, 0, 247, 0, 0, 238, 239, 240,
+ 0, 0, 0, 0, 0, 0, 0, 293, 0, 241,
+ 0, 0, 0, 193, 194, 62, 242, 94, 243, 244,
+ 0, 245, 246, 0, 0, 0, 0, 247, 0, 0,
+ 238, 239, 240, 0, 326, 0, 0, 0, 0, 0,
+ 0, 0, 241, 0, 0, 0, 193, 194, 62, 242,
+ 94, 243, 244, 0, 245, 246, 0, 0, 0, 0,
+ 247, 0, 0, 238, 239, 240, 382, 0, 0, 0,
+ 0, 0, 0, 0, 0, 241, 0, 0, 0, 193,
+ 194, 62, 242, 94, 243, 244, 0, 245, 246, 0,
+ 0, 0, 0, 247, 0, 0, 238, 239, 240, 459,
+ 0, 0, 0, 0, 0, 0, 0, 0, 241, 0,
+ 0, 0, 193, 194, 62, 242, 94, 243, 244, 0,
+ 245, 246, 0, 0, 0, 0, 247, 0, 0, 238,
+ 239, 240, 0, 0, 0, 0, 0, 464, 0, 0,
+ 0, 241, 0, 0, 0, 193, 194, 62, 242, 94,
+ 243, 244, 0, 245, 246, 0, 0, 0, 0, 247,
+ 0, 0, 238, 239, 240, 0, 307, 0, 0, 0,
+ 0, 0, 0, 0, 241, 0, 0, 0, 193, 194,
+ 62, 242, 94, 243, 244, 0, 245, 246, 0, 0,
+ 0, 0, 247, 0, 0, 238, 239, 240, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 241, 0, 0,
+ 0, 193, 194, 62, 242, 94, 243, 244, 0, 245,
+ 246, 0, 0, 0, 0, 247, 0, 0, 238, 239,
+ 409, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 241, 238, 239, 240, 193, 194, 62, 242, 94, 243,
+ 244, 0, 245, 246, 0, 0, 0, 0, 247, 62,
+ 242, 94, 243, 244, 240, 245, 246, 0, 0, 0,
+ 0, 247, 0, 0, 0, 0, 0, 193, 194, 0,
+ 62, 242, 94, 243, 244, 0, 245, 246, 0, 0,
+ 193, 194, 247, 4, 5, 27, 0, 28, 29, 30,
+ 31, 32, 33, 34, 35, 6, 0, 0, 0, 0,
+ 0, 193, 194
+};
+
+static const short int yycheck[] =
+{
+ 27, 54, 55, 241, 67, 33, 183, 34, 35, 36,
+ 238, 239, 74, 35, 36, 27, 110, 33, 35, 300,
+ 47, 23, 49, 82, 427, 5, 7, 54, 55, 99,
+ 7, 101, 54, 55, 7, 14, 130, 49, 21, 109,
+ 67, 21, 23, 70, 21, 5, 23, 74, 70, 48,
+ 23, 50, 74, 70, 21, 82, 150, 151, 120, 86,
+ 5, 14, 11, 23, 86, 14, 517, 12, 519, 86,
+ 97, 52, 53, 52, 53, 52, 53, 6, 105, 52,
+ 53, 11, 11, 110, 14, 52, 53, 6, 110, 5,
+ 19, 20, 11, 120, 14, 154, 499, 5, 120, 52,
+ 53, 552, 83, 130, 0, 21, 62, 23, 130, 286,
+ 391, 5, 8, 36, 0, 23, 5, 13, 14, 15,
+ 14, 215, 11, 150, 151, 14, 14, 154, 150, 151,
+ 157, 54, 55, 37, 362, 363, 5, 1, 2, 3,
+ 6, 37, 141, 0, 9, 157, 21, 175, 147, 14,
+ 152, 8, 179, 19, 20, 182, 21, 184, 6, 175,
+ 182, 4, 184, 67, 68, 182, 30, 184, 32, 0,
+ 5, 19, 20, 96, 97, 98, 5, 8, 21, 22,
+ 23, 24, 25, 6, 27, 28, 109, 110, 215, 13,
+ 33, 11, 56, 215, 14, 19, 20, 224, 14, 19,
+ 20, 228, 66, 380, 381, 7, 444, 130, 271, 52,
+ 53, 61, 62, 63, 11, 277, 228, 67, 68, 14,
+ 6, 144, 19, 20, 13, 5, 149, 150, 151, 79,
+ 19, 20, 231, 19, 20, 6, 14, 21, 6, 23,
+ 104, 105, 11, 11, 271, 14, 273, 274, 19, 20,
+ 277, 273, 274, 6, 38, 277, 273, 274, 11, 43,
+ 44, 45, 159, 47, 48, 188, 50, 51, 14, 339,
+ 54, 55, 56, 6, 58, 6, 60, 304, 14, 5,
+ 11, 65, 66, 19, 20, 14, 19, 20, 185, 186,
+ 19, 20, 215, 387, 14, 79, 80, 81, 82, 19,
+ 20, 6, 199, 226, 168, 11, 5, 230, 14, 11,
+ 207, 208, 14, 177, 19, 20, 396, 397, 398, 183,
+ 217, 401, 9, 500, 11, 395, 396, 397, 398, 9,
+ 10, 401, 9, 10, 14, 6, 200, 407, 408, 11,
+ 11, 11, 14, 240, 3, 344, 5, 6, 6, 419,
+ 9, 10, 11, 11, 13, 23, 6, 427, 6, 5,
+ 387, 11, 21, 11, 23, 387, 21, 6, 3, 463,
+ 5, 6, 11, 14, 9, 10, 11, 300, 13, 22,
+ 23, 24, 25, 5, 27, 28, 21, 6, 23, 5,
+ 33, 7, 11, 52, 53, 3, 293, 5, 9, 6,
+ 11, 9, 10, 11, 11, 13, 6, 6, 5, 52,
+ 53, 11, 11, 21, 6, 23, 339, 52, 53, 11,
+ 284, 11, 67, 68, 14, 84, 323, 11, 11, 499,
+ 14, 14, 11, 527, 11, 14, 463, 14, 3, 4,
+ 337, 463, 40, 41, 52, 53, 516, 19, 20, 84,
+ 364, 365, 366, 14, 15, 508, 353, 14, 355, 356,
+ 7, 5, 9, 8, 387, 10, 389, 9, 391, 11,
+ 5, 394, 150, 151, 14, 339, 84, 357, 358, 573,
+ 12, 508, 210, 211, 407, 408, 508, 581, 385, 386,
+ 9, 388, 5, 520, 11, 418, 419, 11, 14, 11,
+ 527, 5, 399, 400, 427, 527, 403, 46, 14, 14,
+ 374, 375, 409, 566, 14, 14, 380, 381, 14, 14,
+ 11, 14, 11, 5, 14, 5, 579, 14, 14, 393,
+ 18, 454, 17, 16, 4, 14, 14, 5, 7, 566,
+ 463, 12, 14, 6, 566, 12, 573, 21, 12, 23,
+ 12, 573, 579, 12, 581, 419, 12, 579, 12, 581,
+ 12, 12, 11, 427, 38, 39, 11, 464, 14, 43,
+ 44, 45, 14, 14, 48, 6, 499, 51, 12, 14,
+ 54, 55, 56, 11, 58, 508, 509, 14, 14, 486,
+ 6, 65, 66, 516, 96, 14, 14, 5, 12, 496,
+ 6, 11, 6, 526, 527, 79, 80, 81, 82, 18,
+ 11, 14, 50, 11, 6, 12, 41, 514, 11, 5,
+ 14, 42, 39, 520, 14, 548, 14, 14, 551, 8,
+ 37, 68, 555, 374, 274, 499, 182, 175, 380, 403,
+ 399, 381, 224, 566, 355, 419, 514, 184, 228, 32,
+ 573, 408, 516, 208, 495, 546, 579, 554, 581, 556,
+ 409, 105, 359, 11, 3, 4, 5, 360, 7, 367,
+ -1, 277, -1, 21, 571, 23, 15, -1, -1, -1,
+ -1, 578, 21, 22, 23, 24, 25, -1, 27, 28,
+ 38, -1, -1, -1, 33, 43, 44, 45, -1, 47,
+ 48, -1, -1, 51, -1, -1, 54, 55, 56, -1,
+ 58, -1, 60, 52, 53, -1, -1, 65, 66, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, 79, 80, 81, 82, -1, -1, -1, -1, 21,
+ -1, 23, -1, -1, -1, -1, -1, 86, 87, 88,
+ 89, 90, 91, 92, 93, 94, 38, -1, 21, -1,
+ 23, 43, 44, 45, -1, 47, 48, -1, -1, 51,
+ -1, -1, 54, 55, 56, 38, 58, -1, 60, -1,
+ 43, 44, 45, 65, 66, 48, -1, 50, 51, -1,
+ -1, 54, 55, 56, -1, 58, -1, 79, 80, 81,
+ 82, -1, 65, 66, 21, -1, 23, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, 79, 80, 81, 82,
+ -1, 38, -1, -1, -1, -1, 43, 44, 45, -1,
+ -1, 48, -1, -1, 51, -1, -1, 54, 55, 56,
+ -1, 58, -1, -1, -1, -1, -1, -1, 65, 66,
+ -1, -1, -1, -1, 3, 4, 5, -1, 7, -1,
+ -1, -1, 79, 80, 81, 82, 15, -1, -1, -1,
+ -1, -1, 21, 22, 23, 24, 25, -1, 27, 28,
+ -1, -1, -1, -1, 33, -1, -1, 3, 4, 5,
+ -1, -1, -1, -1, -1, -1, -1, 13, -1, 15,
+ -1, -1, -1, 52, 53, 21, 22, 23, 24, 25,
+ -1, 27, 28, -1, -1, -1, -1, 33, -1, -1,
+ 3, 4, 5, -1, 7, -1, -1, -1, -1, -1,
+ -1, -1, 15, -1, -1, -1, 52, 53, 21, 22,
+ 23, 24, 25, -1, 27, 28, -1, -1, -1, -1,
+ 33, -1, -1, 3, 4, 5, 6, -1, -1, -1,
+ -1, -1, -1, -1, -1, 15, -1, -1, -1, 52,
+ 53, 21, 22, 23, 24, 25, -1, 27, 28, -1,
+ -1, -1, -1, 33, -1, -1, 3, 4, 5, 6,
+ -1, -1, -1, -1, -1, -1, -1, -1, 15, -1,
+ -1, -1, 52, 53, 21, 22, 23, 24, 25, -1,
+ 27, 28, -1, -1, -1, -1, 33, -1, -1, 3,
+ 4, 5, -1, -1, -1, -1, -1, 11, -1, -1,
+ -1, 15, -1, -1, -1, 52, 53, 21, 22, 23,
+ 24, 25, -1, 27, 28, -1, -1, -1, -1, 33,
+ -1, -1, 3, 4, 5, -1, 7, -1, -1, -1,
+ -1, -1, -1, -1, 15, -1, -1, -1, 52, 53,
+ 21, 22, 23, 24, 25, -1, 27, 28, -1, -1,
+ -1, -1, 33, -1, -1, 3, 4, 5, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 15, -1, -1,
+ -1, 52, 53, 21, 22, 23, 24, 25, -1, 27,
+ 28, -1, -1, -1, -1, 33, -1, -1, 3, 4,
+ 5, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 15, 3, 4, 5, 52, 53, 21, 22, 23, 24,
+ 25, -1, 27, 28, -1, -1, -1, -1, 33, 21,
+ 22, 23, 24, 25, 5, 27, 28, -1, -1, -1,
+ -1, 33, -1, -1, -1, -1, -1, 52, 53, -1,
+ 21, 22, 23, 24, 25, -1, 27, 28, -1, -1,
+ 52, 53, 33, 67, 68, 69, -1, 71, 72, 73,
+ 74, 75, 76, 77, 78, 79, -1, -1, -1, -1,
+ -1, 52, 53
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
+static const unsigned char yystos[] =
+{
+ 0, 61, 62, 63, 67, 68, 79, 98, 99, 100,
+ 101, 102, 103, 104, 105, 106, 135, 150, 152, 153,
+ 21, 160, 160, 160, 14, 0, 100, 69, 71, 72,
+ 73, 74, 75, 76, 77, 78, 107, 108, 109, 110,
+ 112, 115, 118, 119, 124, 135, 148, 149, 150, 151,
+ 152, 228, 231, 232, 107, 107, 62, 14, 5, 145,
+ 14, 145, 21, 111, 159, 163, 9, 10, 116, 117,
+ 5, 113, 160, 161, 5, 161, 37, 120, 121, 149,
+ 151, 154, 9, 14, 147, 159, 5, 125, 126, 130,
+ 131, 159, 169, 201, 23, 38, 43, 44, 45, 48,
+ 51, 54, 55, 56, 58, 65, 66, 80, 81, 82,
+ 133, 134, 135, 136, 142, 143, 167, 168, 169, 171,
+ 172, 174, 182, 183, 184, 188, 192, 198, 199, 203,
+ 217, 221, 222, 223, 224, 225, 226, 109, 14, 155,
+ 156, 159, 163, 7, 166, 157, 158, 159, 163, 166,
+ 133, 133, 160, 6, 146, 14, 14, 11, 14, 5,
+ 160, 155, 14, 117, 114, 169, 11, 14, 11, 14,
+ 168, 229, 230, 14, 14, 11, 14, 5, 147, 11,
+ 14, 169, 11, 9, 11, 5, 5, 217, 5, 159,
+ 217, 217, 14, 52, 53, 162, 14, 14, 162, 5,
+ 5, 160, 21, 159, 160, 200, 14, 5, 5, 7,
+ 162, 217, 50, 134, 144, 217, 14, 12, 168, 173,
+ 47, 60, 134, 175, 11, 14, 166, 217, 11, 14,
+ 166, 5, 217, 144, 144, 145, 147, 163, 3, 4,
+ 5, 15, 22, 24, 25, 27, 28, 33, 159, 162,
+ 164, 165, 166, 200, 201, 204, 205, 206, 207, 208,
+ 210, 211, 212, 213, 214, 215, 216, 217, 218, 219,
+ 220, 9, 6, 11, 5, 160, 6, 11, 121, 122,
+ 123, 160, 9, 159, 11, 126, 4, 127, 128, 129,
+ 160, 216, 131, 13, 170, 204, 204, 11, 217, 227,
+ 5, 11, 14, 14, 46, 14, 14, 7, 86, 87,
+ 88, 89, 90, 91, 92, 93, 94, 137, 138, 139,
+ 204, 160, 14, 5, 14, 14, 7, 186, 204, 186,
+ 11, 185, 185, 185, 14, 50, 204, 11, 14, 5,
+ 14, 156, 217, 158, 5, 217, 166, 14, 6, 211,
+ 211, 204, 208, 5, 6, 11, 13, 19, 20, 17,
+ 16, 18, 3, 4, 7, 9, 8, 10, 155, 169,
+ 114, 14, 230, 6, 11, 4, 14, 160, 216, 9,
+ 11, 7, 6, 204, 6, 11, 13, 6, 6, 11,
+ 227, 5, 159, 12, 12, 12, 12, 12, 12, 12,
+ 12, 12, 6, 11, 6, 202, 204, 11, 11, 5,
+ 189, 190, 204, 14, 14, 14, 14, 204, 3, 5,
+ 9, 10, 11, 13, 84, 160, 162, 176, 177, 178,
+ 179, 180, 181, 217, 166, 6, 6, 204, 165, 204,
+ 205, 205, 206, 207, 209, 211, 211, 212, 212, 212,
+ 214, 6, 123, 160, 12, 128, 129, 6, 204, 6,
+ 204, 39, 134, 217, 11, 204, 217, 6, 227, 14,
+ 141, 160, 217, 140, 160, 162, 140, 140, 140, 139,
+ 204, 140, 14, 138, 14, 6, 11, 7, 83, 162,
+ 187, 217, 187, 202, 204, 11, 11, 14, 217, 176,
+ 96, 6, 177, 6, 208, 132, 217, 6, 14, 11,
+ 204, 14, 14, 6, 5, 204, 12, 6, 11, 6,
+ 11, 190, 204, 6, 216, 6, 11, 133, 193, 217,
+ 14, 14, 170, 204, 7, 160, 162, 217, 189, 50,
+ 191, 189, 159, 14, 217, 41, 194, 195, 11, 6,
+ 14, 12, 6, 14, 12, 11, 5, 40, 195, 196,
+ 217, 217, 189, 204, 217, 204, 14, 42, 197, 14,
+ 14, 11, 6, 133, 14, 204, 39, 6, 11, 14,
+ 204, 133, 6
+};
+
+#if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__)
+# define YYSIZE_T __SIZE_TYPE__
+#endif
+#if ! defined (YYSIZE_T) && defined (size_t)
+# define YYSIZE_T size_t
+#endif
+#if ! defined (YYSIZE_T)
+# if defined (__STDC__) || defined (__cplusplus)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# endif
+#endif
+#if ! defined (YYSIZE_T)
+# define YYSIZE_T unsigned int
+#endif
+
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror. This remains here temporarily
+ to ease the transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+
+#define YYFAIL goto yyerrlab
+
+#define YYRECOVERING() (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY && yylen == 1) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ yytoken = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else \
+ { \
+ yyerror ("syntax error: cannot back up");\
+ YYERROR; \
+ } \
+while (0)
+
+
+#define YYTERROR 1
+#define YYERRCODE 256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+ If N is 0, then set CURRENT to the empty location which ends
+ the previous symbol: RHS[0] (always defined). */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ do \
+ if (N) \
+ { \
+ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
+ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
+ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
+ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
+ } \
+ else \
+ { \
+ (Current).first_line = (Current).last_line = \
+ YYRHSLOC (Rhs, 0).last_line; \
+ (Current).first_column = (Current).last_column = \
+ YYRHSLOC (Rhs, 0).last_column; \
+ } \
+ while (0)
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+ This macro was not mandated originally: define only if we know
+ we won't break user code: when these are the locations we know. */
+
+#ifndef YY_LOCATION_PRINT
+# if YYLTYPE_IS_TRIVIAL
+# define YY_LOCATION_PRINT(File, Loc) \
+ fprintf (File, "%d.%d-%d.%d", \
+ (Loc).first_line, (Loc).first_column, \
+ (Loc).last_line, (Loc).last_column)
+# else
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments. */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yysymprint (stderr, \
+ Type, Value); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included). |
+`------------------------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_stack_print (short int *bottom, short int *top)
+#else
+static void
+yy_stack_print (bottom, top)
+ short int *bottom;
+ short int *top;
+#endif
+{
+ YYFPRINTF (stderr, "Stack now");
+ for (/* Nothing. */; bottom <= top; ++bottom)
+ YYFPRINTF (stderr, " %d", *bottom);
+ YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced. |
+`------------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yy_reduce_print (int yyrule)
+#else
+static void
+yy_reduce_print (yyrule)
+ int yyrule;
+#endif
+{
+ int yyi;
+ unsigned int yylno = yyrline[yyrule];
+ YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ",
+ yyrule - 1, yylno);
+ /* Print the symbols being reduced, and their result. */
+ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
+ YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]);
+ YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]);
+}
+
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (Rule); \
+} while (0)
+
+/* Nonzero means print parse trace. It is left uninitialized so that
+ multiple parsers can coexist. */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks. */
+#ifndef YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+ if the built-in stack extension method is used).
+
+ Do not make this value too large; the results are undefined if
+ SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH)
+ evaluated with infinite-precision integer arithmetic. */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+# if defined (__GLIBC__) && defined (_STRING_H)
+# define yystrlen strlen
+# else
+/* Return the length of YYSTR. */
+static YYSIZE_T
+# if defined (__STDC__) || defined (__cplusplus)
+yystrlen (const char *yystr)
+# else
+yystrlen (yystr)
+ const char *yystr;
+# endif
+{
+ register const char *yys = yystr;
+
+ while (*yys++ != '\0')
+ continue;
+
+ return yys - yystr - 1;
+}
+# endif
+# endif
+
+# ifndef yystpcpy
+# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# define yystpcpy stpcpy
+# else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+ YYDEST. */
+static char *
+# if defined (__STDC__) || defined (__cplusplus)
+yystpcpy (char *yydest, const char *yysrc)
+# else
+yystpcpy (yydest, yysrc)
+ char *yydest;
+ const char *yysrc;
+# endif
+{
+ register char *yyd = yydest;
+ register const char *yys = yysrc;
+
+ while ((*yyd++ = *yys++) != '\0')
+ continue;
+
+ return yyd - 1;
+}
+# endif
+# endif
+
+#endif /* !YYERROR_VERBOSE */
+
+
+
+#if YYDEBUG
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yysymprint (yyoutput, yytype, yyvaluep)
+ FILE *yyoutput;
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ if (yytype < YYNTOKENS)
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+ else
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+
+# ifdef YYPRINT
+ if (yytype < YYNTOKENS)
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# endif
+ switch (yytype)
+ {
+ default:
+ break;
+ }
+ YYFPRINTF (yyoutput, ")");
+}
+
+#endif /* ! YYDEBUG */
+/*-----------------------------------------------.
+| Release the memory associated to this symbol. |
+`-----------------------------------------------*/
+
+#if defined (__STDC__) || defined (__cplusplus)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+ const char *yymsg;
+ int yytype;
+ YYSTYPE *yyvaluep;
+#endif
+{
+ /* Pacify ``unused variable'' warnings. */
+ (void) yyvaluep;
+
+ if (!yymsg)
+ yymsg = "Deleting";
+ YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+ switch (yytype)
+ {
+
+ default:
+ break;
+ }
+}
+
+
+/* Prevent warnings from -Wmissing-prototypes. */
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM);
+# else
+int yyparse ();
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol. */
+int yychar;
+
+/* The semantic value of the look-ahead symbol. */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far. */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse. |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+# if defined (__STDC__) || defined (__cplusplus)
+int yyparse (void *YYPARSE_PARAM)
+# else
+int yyparse (YYPARSE_PARAM)
+ void *YYPARSE_PARAM;
+# endif
+#else /* ! YYPARSE_PARAM */
+#if defined (__STDC__) || defined (__cplusplus)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+
+ register int yystate;
+ register int yyn;
+ int yyresult;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
+ /* Look-ahead token as an internal (translated) token number. */
+ int yytoken = 0;
+
+ /* Three stacks and their tools:
+ `yyss': related to states,
+ `yyvs': related to semantic values,
+ `yyls': related to locations.
+
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
+
+ /* The state stack. */
+ short int yyssa[YYINITDEPTH];
+ short int *yyss = yyssa;
+ register short int *yyssp;
+
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs = yyvsa;
+ register YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK (yyvsp--, yyssp--)
+
+ YYSIZE_T yystacksize = YYINITDEPTH;
+
+ /* The variables used to return semantic value and location from the
+ action routines. */
+ YYSTYPE yyval;
+
+
+ /* When reducing, the number of symbols on the RHS of the reduced
+ rule. */
+ int yylen;
+
+ YYDPRINTF ((stderr, "Starting parse\n"));
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ yyssp = yyss;
+ yyvsp = yyvs;
+
+
+ yyvsp[0] = yylval;
+
+ goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate. |
+`------------------------------------------------------------*/
+ yynewstate:
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks.
+ */
+ yyssp++;
+
+ yysetstate:
+ *yyssp = yystate;
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ {
+ /* Get the current used size of the three stacks, in elements. */
+ YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+ {
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ short int *yyss1 = yyss;
+
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow ("parser stack overflow",
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+
+ &yystacksize);
+
+ yyss = yyss1;
+ yyvs = yyvs1;
+ }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+ goto yyoverflowlab;
+# else
+ /* Extend the stack our own way. */
+ if (YYMAXDEPTH <= yystacksize)
+ goto yyoverflowlab;
+ yystacksize *= 2;
+ if (YYMAXDEPTH < yystacksize)
+ yystacksize = YYMAXDEPTH;
+
+ {
+ short int *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyoverflowlab;
+ YYSTACK_RELOCATE (yyss);
+ YYSTACK_RELOCATE (yyvs);
+
+# undef YYSTACK_RELOCATE
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
+ }
+# endif
+#endif /* no yyoverflow */
+
+ yyssp = yyss + yysize - 1;
+ yyvsp = yyvs + yysize - 1;
+
+
+ YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+ (unsigned long int) yystacksize));
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ YYABORT;
+ }
+
+ YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+ goto yybackup;
+
+/*-----------.
+| yybackup. |
+`-----------*/
+yybackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a look-ahead token if we need one and don't already have one. */
+/* yyresume: */
+
+ /* First try to decide what to do without reference to look-ahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYPACT_NINF)
+ goto yydefault;
+
+ /* Not known => get a look-ahead token if don't already have one. */
+
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */
+ if (yychar == YYEMPTY)
+ {
+ YYDPRINTF ((stderr, "Reading a token: "));
+ yychar = YYLEX;
+ }
+
+ if (yychar <= YYEOF)
+ {
+ yychar = yytoken = YYEOF;
+ YYDPRINTF ((stderr, "Now at end of input.\n"));
+ }
+ else
+ {
+ yytoken = YYTRANSLATE (yychar);
+ YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+ }
+
+ /* If the proper action on seeing token YYTOKEN is to reduce or to
+ detect an error, take that action. */
+ yyn += yytoken;
+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+ goto yydefault;
+ yyn = yytable[yyn];
+ if (yyn <= 0)
+ {
+ if (yyn == 0 || yyn == YYTABLE_NINF)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ /* Shift the look-ahead token. */
+ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
+ *++yyvsp = yylval;
+
+
+ /* Count tokens shifted since error; after three, turn off error
+ status. */
+ if (yyerrstatus)
+ yyerrstatus--;
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state. |
+`-----------------------------------------------------------*/
+yydefault:
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+ goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction. |
+`-----------------------------*/
+yyreduce:
+ /* yyn is the number of a rule to reduce with. */
+ yylen = yyr2[yyn];
+
+ /* If YYLEN is nonzero, implement the default value of the action:
+ `$$ = $1'.
+
+ Otherwise, the following line sets YYVAL to garbage.
+ This behavior is undocumented and Bison
+ users should not rely upon it. Assigning to YYVAL
+ unconditionally makes the parser a bit smaller, and it avoids a
+ GCC warning that YYVAL may be used uninitialized. */
+ yyval = yyvsp[1-yylen];
+
+
+ YY_REDUCE_PRINT (yyn);
+ switch (yyn)
+ {
+ case 2:
+#line 201 "f2jparse.y"
+ {
+ AST *temp, *prev, *commentList = NULL;
+
+ if(debug)
+ printf("F2java -> Sourcecodes\n");
+ (yyval.ptnode) = switchem((yyvsp[0].ptnode));
+
+#if VCG
+ if(emittem) start_vcg((yyval.ptnode));
+#endif
+ prev = NULL;
+ for(temp=(yyval.ptnode);temp!=NULL;temp=temp->nextstmt)
+ {
+ if(emittem) {
+
+ if(temp->nodetype == Comment)
+ {
+ if((prev == NULL) ||
+ ((prev != NULL) && (prev->nodetype != Comment)))
+ commentList = temp;
+ }
+ else
+ {
+ /* commentList may be NULL here so we must check
+ * for that in codegen.
+ */
+ temp->astnode.source.prologComments = commentList;
+
+ typecheck(temp);
+
+ if(omitWrappers)
+ optScalar(temp);
+
+ emit(temp);
+
+ commentList = NULL;
+ }
+ }
+ prev = temp;
+ }
+ }
+ break;
+
+ case 3:
+#line 245 "f2jparse.y"
+ {
+ AST *temp;
+
+ if(debug)
+ printf("Sourcecodes -> Sourcecode\n");
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+
+ /* insert the name of the program unit into the
+ * global function table. this will allow optScalar()
+ * to easily get a pointer to a function.
+ */
+
+ if(omitWrappers && ((yyvsp[0].ptnode)->nodetype != Comment)) {
+ temp = (yyvsp[0].ptnode)->astnode.source.progtype->astnode.source.name;
+
+ type_insert(global_func_table, (yyvsp[0].ptnode), 0, temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 4:
+#line 264 "f2jparse.y"
+ {
+ AST *temp;
+
+ if(debug)
+ printf("Sourcecodes -> Sourcecodes Sourcecode\n");
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+
+ /* insert the name of the program unit into the
+ * global function table. this will allow optScalar()
+ * to easily get a pointer to a function.
+ */
+
+ if(omitWrappers && ((yyvsp[0].ptnode)->nodetype != Comment)) {
+ temp = (yyvsp[0].ptnode)->astnode.source.progtype->astnode.source.name;
+
+ type_insert(global_func_table, (yyvsp[0].ptnode), 0, temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 5:
+#line 286 "f2jparse.y"
+ {
+ if(debug)
+ printf("Sourcecode -> Fprogram\n");
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 6:
+#line 292 "f2jparse.y"
+ {
+ if(debug)
+ printf("Sourcecode -> Fsubroutine\n");
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 7:
+#line 298 "f2jparse.y"
+ {
+ if(debug)
+ printf("Sourcecode -> Ffunction\n");
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 8:
+#line 304 "f2jparse.y"
+ {
+ if(debug)
+ printf("Sourcecode -> Comment\n");
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 9:
+#line 312 "f2jparse.y"
+ {
+ if(debug)
+ printf("Fprogram -> Program Specstmts Statements End\n");
+
+ add_implicit_to_tree((yyvsp[-2].ptnode));
+
+ (yyval.ptnode) = addnode();
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ (yyval.ptnode)->astnode.source.type_table = type_table;
+ (yyval.ptnode)->astnode.source.external_table = external_table;
+ (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table;
+ (yyval.ptnode)->astnode.source.args_table = args_table;
+ (yyval.ptnode)->astnode.source.array_table = array_table;
+ (yyval.ptnode)->astnode.source.format_table = format_table;
+ (yyval.ptnode)->astnode.source.data_table = data_table;
+ (yyval.ptnode)->astnode.source.save_table = save_table;
+ (yyval.ptnode)->astnode.source.common_table = common_table;
+ (yyval.ptnode)->astnode.source.parameter_table = parameter_table;
+ (yyval.ptnode)->astnode.source.constants_table = constants_table;
+ (yyval.ptnode)->astnode.source.equivalences = equivList;
+ (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels;
+
+ (yyval.ptnode)->astnode.source.javadocComments = NULL;
+ (yyval.ptnode)->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ (yyval.ptnode)->astnode.source.needs_input = FALSE;
+ (yyval.ptnode)->astnode.source.needs_output = FALSE;
+ (yyval.ptnode)->astnode.source.needs_reflection = FALSE;
+ (yyval.ptnode)->astnode.source.needs_blas = FALSE;
+
+ if(omitWrappers)
+ (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Progunit;
+ (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode));
+
+ /* a PROGRAM has no args, so set the symbol table
+ to NULL */
+ args_table = NULL;
+
+ (yyvsp[-3].ptnode)->astnode.source.descriptor = MAIN_DESCRIPTOR;
+ }
+ break;
+
+ case 10:
+#line 371 "f2jparse.y"
+ {
+ HASHNODE *ht;
+ AST *temp;
+
+ if(debug)
+ printf("Fsubroutine -> Subroutine Specstmts Statements End\n");
+
+ add_implicit_to_tree((yyvsp[-2].ptnode));
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Progunit;
+ (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode);
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ (yyval.ptnode)->astnode.source.type_table = type_table;
+ (yyval.ptnode)->astnode.source.external_table = external_table;
+ (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table;
+ (yyval.ptnode)->astnode.source.args_table = args_table;
+ (yyval.ptnode)->astnode.source.array_table = array_table;
+ (yyval.ptnode)->astnode.source.format_table = format_table;
+ (yyval.ptnode)->astnode.source.data_table = data_table;
+ (yyval.ptnode)->astnode.source.save_table = save_table;
+ (yyval.ptnode)->astnode.source.common_table = common_table;
+ (yyval.ptnode)->astnode.source.parameter_table = parameter_table;
+ (yyval.ptnode)->astnode.source.constants_table = constants_table;
+ (yyval.ptnode)->astnode.source.equivalences = equivList;
+ (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels;
+
+ (yyval.ptnode)->astnode.source.javadocComments = NULL;
+ (yyval.ptnode)->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ (yyval.ptnode)->astnode.source.needs_input = FALSE;
+ (yyval.ptnode)->astnode.source.needs_output = FALSE;
+ (yyval.ptnode)->astnode.source.needs_reflection = FALSE;
+ (yyval.ptnode)->astnode.source.needs_blas = FALSE;
+
+ if(omitWrappers)
+ (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode));
+
+ /* foreach arg to this program unit, store the array
+ * size, if applicable, from the hash table into the
+ * node itself.
+ */
+
+ for(temp=(yyvsp[-3].ptnode)->astnode.source.args;temp!=NULL;temp=temp->nextstmt)
+ {
+ if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL)
+ {
+ temp->vartype=ht->variable->vartype;
+ temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist;
+ }
+ if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){
+ ht->variable->vartype=temp->vartype;
+ }
+ }
+
+ type_insert(function_table, (yyvsp[-3].ptnode), 0,
+ (yyvsp[-3].ptnode)->astnode.source.name->astnode.ident.name);
+ }
+ break;
+
+ case 11:
+#line 446 "f2jparse.y"
+ {
+ HASHNODE *ht;
+ AST *temp;
+
+ if(debug)
+ printf("Ffunction -> Function Specstmts Statements End\n");
+
+ assign_function_return_type((yyvsp[-3].ptnode), (yyvsp[-2].ptnode));
+
+ add_implicit_to_tree((yyvsp[-2].ptnode));
+
+ (yyval.ptnode) = addnode();
+
+ /* store the tables built during parsing into the
+ * AST node for access during code generation.
+ */
+
+ (yyval.ptnode)->astnode.source.type_table = type_table;
+ (yyval.ptnode)->astnode.source.external_table = external_table;
+ (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table;
+ (yyval.ptnode)->astnode.source.args_table = args_table;
+ (yyval.ptnode)->astnode.source.array_table = array_table;
+ (yyval.ptnode)->astnode.source.format_table = format_table;
+ (yyval.ptnode)->astnode.source.data_table = data_table;
+ (yyval.ptnode)->astnode.source.save_table = save_table;
+ (yyval.ptnode)->astnode.source.common_table = common_table;
+ (yyval.ptnode)->astnode.source.parameter_table = parameter_table;
+ (yyval.ptnode)->astnode.source.constants_table = constants_table;
+ (yyval.ptnode)->astnode.source.equivalences = equivList;
+ (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels;
+
+ (yyval.ptnode)->astnode.source.javadocComments = NULL;
+ (yyval.ptnode)->astnode.source.save_all = save_all;
+
+ /* initialize some values in this node */
+
+ (yyval.ptnode)->astnode.source.needs_input = FALSE;
+ (yyval.ptnode)->astnode.source.needs_output = FALSE;
+ (yyval.ptnode)->astnode.source.needs_reflection = FALSE;
+ (yyval.ptnode)->astnode.source.needs_blas = FALSE;
+ if(omitWrappers)
+ (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED;
+
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Progunit;
+ (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode));
+
+ /* foreach arg to this program unit, store the array
+ * size, if applicable, from the hash table into the
+ * node itself.
+ */
+
+ for(temp=(yyvsp[-3].ptnode)->astnode.source.args;temp!=NULL;temp=temp->nextstmt)
+ {
+ if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL)
+ {
+ temp->vartype=ht->variable->vartype;
+ temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist;
+ }
+ if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){
+ ht->variable->vartype=temp->vartype;
+ }
+ }
+
+ type_insert(function_table, (yyvsp[-3].ptnode), 0,
+ (yyvsp[-3].ptnode)->astnode.source.name->astnode.ident.name);
+ }
+ break;
+
+ case 12:
+#line 523 "f2jparse.y"
+ {
+ if(debug)
+ printf("Program -> PROGRAM UndeclaredName\n");
+
+ unit_args = NULL;
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ lowercase((yyvsp[-1].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->astnode.source.name = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Program;
+ (yyval.ptnode)->token = PROGRAM;
+ (yyval.ptnode)->astnode.source.args = NULL;
+
+ init_tables();
+
+ fprintf(stderr," MAIN %s:\n",(yyvsp[-1].ptnode)->astnode.ident.name);
+ }
+ break;
+
+ case 13:
+#line 544 "f2jparse.y"
+ {
+ if(debug)
+ printf("Subroutine -> SUBROUTINE UndeclaredName Functionargs NL\n");
+
+ unit_args = (yyvsp[-1].ptnode);
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ if((yyvsp[-1].ptnode) != NULL)
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+
+ (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->nodetype = Subroutine;
+ (yyval.ptnode)->token = SUBROUTINE;
+ (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode));
+
+ fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name);
+ }
+ break;
+
+ case 14:
+#line 563 "f2jparse.y"
+ {
+ if(debug)
+ printf("Subroutine -> SUBROUTINE UndeclaredName NL\n");
+
+ unit_args = NULL;
+
+ init_tables();
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+
+ (yyval.ptnode)->astnode.source.name = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Subroutine;
+ (yyval.ptnode)->token = SUBROUTINE;
+ (yyval.ptnode)->astnode.source.args = NULL;
+
+ fprintf(stderr,"\t%s:\n",(yyvsp[-1].ptnode)->astnode.ident.name);
+ }
+ break;
+
+ case 15:
+#line 583 "f2jparse.y"
+ {
+ if(debug)
+ printf("Function -> AnySimpleType FUNCTION UndeclaredName Functionargs NL\n");
+
+ unit_args = (yyvsp[-1].ptnode);
+
+ (yyval.ptnode) = addnode();
+
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ if((yyvsp[-1].ptnode) != NULL)
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->nodetype = Function;
+ (yyval.ptnode)->token = FUNCTION;
+ (yyval.ptnode)->astnode.source.returns = (yyvsp[-4].type);
+ (yyval.ptnode)->vartype = (yyvsp[-4].type);
+ (yyvsp[-2].ptnode)->vartype = (yyvsp[-4].type);
+ (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode));
+
+ /* since the function name is the implicit return value
+ * and it can be treated as a variable, we insert it into
+ * the hash table for lookup later.
+ */
+
+ (yyvsp[-2].ptnode)->astnode.ident.localvnum = -1;
+ insert_name(type_table, (yyvsp[-2].ptnode), (yyvsp[-4].type));
+
+ fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name);
+ }
+ break;
+
+ case 16:
+#line 613 "f2jparse.y"
+ {
+ enum returntype ret;
+
+ unit_args = (yyvsp[-1].ptnode);
+
+ (yyval.ptnode) = addnode();
+
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ if((yyvsp[-1].ptnode) != NULL)
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->nodetype = Function;
+ (yyval.ptnode)->token = FUNCTION;
+ ret = implicit_table[tolower((yyvsp[-2].ptnode)->astnode.ident.name[0]) - 'a'].type;
+ (yyval.ptnode)->astnode.source.returns = ret;
+ (yyval.ptnode)->vartype = ret;
+ (yyvsp[-2].ptnode)->vartype = ret;
+ (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode));
+
+ (yyvsp[-2].ptnode)->astnode.ident.localvnum = -1;
+ insert_name(type_table, (yyvsp[-2].ptnode), ret);
+
+ fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name);
+ }
+ break;
+
+ case 17:
+#line 640 "f2jparse.y"
+ {
+ AST *tmparg;
+
+ if(debug){
+ printf("Specstmts -> SpecStmtList\n");
+ }
+ (yyvsp[0].ptnode) = switchem((yyvsp[0].ptnode));
+ type_hash((yyvsp[0].ptnode));
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+
+ for(tmparg = unit_args; tmparg; tmparg=tmparg->nextstmt) {
+ HASHNODE *ht;
+
+ ht = type_lookup(type_table, tmparg->astnode.ident.name);
+
+ if(ht) {
+ if(!ht->variable->astnode.ident.explicit)
+ ht->variable->vartype =
+ implicit_table[tolower(tmparg->astnode.ident.name[0]) - 'a'].type;
+ }
+ else
+ fprintf(stderr, "warning: didn't find %s in symbol table\n",
+ tmparg->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 18:
+#line 668 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 19:
+#line 672 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 20:
+#line 679 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 21:
+#line 683 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 22:
+#line 687 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 23:
+#line 691 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 24:
+#line 695 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 25:
+#line 699 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 26:
+#line 703 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 27:
+#line 707 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 28:
+#line 711 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 29:
+#line 715 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 30:
+#line 719 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 31:
+#line 725 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode) = switchem((yyvsp[-1].ptnode));
+ (yyval.ptnode)->nodetype = Dimension;
+
+ (yyval.ptnode)->astnode.typeunit.declist = (yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 32:
+#line 736 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Dimension;
+ }
+ break;
+
+ case 33:
+#line 742 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Dimension;
+ }
+ break;
+
+ case 34:
+#line 753 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Equivalence;
+ (yyval.ptnode)->prevstmt = NULL;
+ (yyval.ptnode)->nextstmt = NULL;
+ (yyval.ptnode)->astnode.equiv.nlist = switchem((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 35:
+#line 763 "f2jparse.y"
+ {
+ AST *tmp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Equivalence;
+ (yyval.ptnode)->prevstmt = NULL;
+ (yyval.ptnode)->nextstmt = NULL;
+ (yyval.ptnode)->astnode.equiv.clist = switchem((yyvsp[-1].ptnode));
+
+ for(tmp=(yyvsp[-1].ptnode);tmp!=NULL;tmp=tmp->prevstmt)
+ tmp->parent = (yyval.ptnode);
+
+ addEquiv((yyval.ptnode)->astnode.equiv.clist);
+ }
+ break;
+
+ case 36:
+#line 778 "f2jparse.y"
+ {
+ AST *tmp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Equivalence;
+ (yyval.ptnode)->astnode.equiv.clist = switchem((yyvsp[-1].ptnode));
+ (yyval.ptnode)->prevstmt = (yyvsp[-4].ptnode);
+ (yyval.ptnode)->nextstmt = NULL;
+
+ for(tmp=(yyvsp[-1].ptnode);tmp!=NULL;tmp=tmp->prevstmt)
+ tmp->parent = (yyval.ptnode);
+
+ addEquiv((yyval.ptnode)->astnode.equiv.clist);
+ }
+ break;
+
+ case 37:
+#line 795 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 38:
+#line 799 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 39:
+#line 806 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = CommonList;
+ (yyval.ptnode)->astnode.common.name = NULL;
+
+ (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[-1].ptnode));
+ merge_common_blocks((yyval.ptnode)->astnode.common.nlist);
+ }
+ break;
+
+ case 40:
+#line 817 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 41:
+#line 821 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 42:
+#line 828 "f2jparse.y"
+ {
+ AST *temp;
+ int pos;
+
+ if(debug){
+ printf("CommonSpec -> DIV UndeclaredName DIV Namelist\n");
+ }
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Common;
+ (yyval.ptnode)->astnode.common.name = strdup((yyvsp[-2].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[0].ptnode));
+
+ pos = 0;
+
+ /* foreach variable in the COMMON block... */
+ for(temp=(yyval.ptnode)->astnode.common.nlist;temp!=NULL;temp=temp->nextstmt)
+ {
+ temp->astnode.ident.commonBlockName =
+ strdup((yyvsp[-2].ptnode)->astnode.ident.name);
+
+ if(omitWrappers)
+ temp->astnode.ident.position = pos++;
+
+ /* insert this name into the common table */
+ if(debug)
+ printf("@insert %s (block = %s) into common table\n",
+ temp->astnode.ident.name, (yyvsp[-2].ptnode)->astnode.ident.name);
+
+ type_insert(common_table, temp, Float, temp->astnode.ident.name);
+ }
+
+ type_insert(global_common_table, (yyval.ptnode), Float, (yyval.ptnode)->astnode.common.name);
+ free_ast_node((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 43:
+#line 864 "f2jparse.y"
+ {
+ AST *temp;
+
+ /* This is an unnamed common block */
+ if(debug){
+ printf("CommonSpec -> CAT Namelist\n");
+ }
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Common;
+ (yyval.ptnode)->astnode.common.name = strdup("Blank");
+ (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[0].ptnode));
+
+ /* foreach variable in the COMMON block... */
+ for(temp=(yyvsp[0].ptnode);temp!=NULL;temp=temp->prevstmt) {
+ temp->astnode.ident.commonBlockName = "Blank";
+
+ /* insert this name into the common table */
+
+ if(debug)
+ printf("@@insert %s (block = unnamed) into common table\n",
+ temp->astnode.ident.name);
+
+ type_insert(common_table, temp, Float, temp->astnode.ident.name);
+ }
+
+ type_insert(global_common_table, (yyval.ptnode), Float, (yyval.ptnode)->astnode.common.name);
+ }
+ break;
+
+ case 44:
+#line 899 "f2jparse.y"
+ {
+ /*
+ * I think in this case every variable is supposed to
+ * be saved, but we already emit every variable as
+ * static. do nothing here. --Keith
+ */
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Save;
+ save_all = TRUE;
+ }
+ break;
+
+ case 45:
+#line 911 "f2jparse.y"
+ {
+ AST *temp;
+
+ if(debug){
+ printf("Save -> SAVE DIV Namelist DIV NL\n");
+ }
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Save;
+
+ for(temp=(yyvsp[-2].ptnode);temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into save table\n",
+ temp->astnode.ident.name);
+
+ type_insert(save_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 46:
+#line 930 "f2jparse.y"
+ {
+ AST *temp;
+ if(debug){
+ printf("Save -> SAVE Namelist NL\n");
+ }
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Save;
+
+ for(temp=(yyvsp[-1].ptnode);temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into save table\n",
+ temp->astnode.ident.name);
+
+ type_insert(save_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 47:
+#line 951 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->nodetype = Specification;
+ (yyval.ptnode)->token = IMPLICIT;
+ }
+ break;
+
+ case 48:
+#line 957 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->nodetype = Specification;
+ (yyval.ptnode)->token = IMPLICIT;
+ fprintf(stderr,"Warning: IMPLICIT NONE ignored.\n");
+ }
+ break;
+
+ case 49:
+#line 966 "f2jparse.y"
+ {
+ /* I don't think anything needs to be done here */
+ }
+ break;
+
+ case 50:
+#line 970 "f2jparse.y"
+ {
+ /* or here either. */
+ }
+ break;
+
+ case 51:
+#line 976 "f2jparse.y"
+ {
+ AST *temp;
+
+ for(temp=(yyvsp[-1].ptnode);temp!=NULL;temp=temp->prevstmt) {
+ char *start_range, *end_range;
+ char start_char, end_char;
+ int i;
+
+ start_range = temp->astnode.expression.lhs->astnode.ident.name;
+ end_range = temp->astnode.expression.rhs->astnode.ident.name;
+
+ start_char = tolower(start_range[0]);
+ end_char = tolower(end_range[0]);
+
+ if((strlen(start_range) > 1) || (strlen(end_range) > 1)) {
+ yyerror("IMPLICIT spec must contain single character.");
+ exit(EXIT_FAILURE);
+ }
+
+ if(end_char < start_char) {
+ yyerror("IMPLICIT range in backwards order.");
+ exit(EXIT_FAILURE);
+ }
+
+ for(i=start_char - 'a'; i <= end_char - 'a'; i++) {
+ if(implicit_table[i].declared) {
+ yyerror("Duplicate letter specified in IMPLICIT statement.");
+ exit(EXIT_FAILURE);
+ }
+
+ implicit_table[i].type = (yyvsp[-3].type);
+ implicit_table[i].declared = TRUE;
+ implicit_table[i].len = len; /* global set in Types production */
+ }
+ }
+ }
+ break;
+
+ case 52:
+#line 1015 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 53:
+#line 1019 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 54:
+#line 1026 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Expression;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 55:
+#line 1033 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Expression;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 56:
+#line 1042 "f2jparse.y"
+ {
+ /* $$ = $2; */
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = DataList;
+ (yyval.ptnode)->astnode.label.stmt = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 57:
+#line 1051 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 58:
+#line 1055 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 59:
+#line 1062 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.data.nlist = switchem((yyvsp[-3].ptnode));
+ (yyval.ptnode)->astnode.data.clist = switchem((yyvsp[-1].ptnode));
+
+ (yyval.ptnode)->nodetype = DataStmt;
+ (yyval.ptnode)->prevstmt = NULL;
+ (yyval.ptnode)->nextstmt = NULL;
+
+ for(temp=(yyvsp[-3].ptnode);temp!=NULL;temp=temp->prevstmt) {
+ if(debug)
+ printf("@@insert %s into data table\n",
+ temp->astnode.ident.name);
+
+ temp->parent = (yyval.ptnode);
+
+ if(temp->nodetype == DataImpliedLoop)
+ type_insert(data_table, temp, Float,
+ temp->astnode.forloop.Label->astnode.ident.name);
+ else
+ type_insert(data_table, temp, Float, temp->astnode.ident.name);
+ }
+ }
+ break;
+
+ case 60:
+#line 1090 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 61:
+#line 1094 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 62:
+#line 1101 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 63:
+#line 1105 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-2].ptnode);
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->token = STAR;
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.expression.optype = '*';
+ }
+ break;
+
+ case 64:
+#line 1121 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 65:
+#line 1125 "f2jparse.y"
+ {
+ HASHNODE *hash_temp;
+ if((parameter_table != NULL) &&
+ ((hash_temp = type_lookup(parameter_table, yylval.lexeme)) != NULL))
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->vartype = hash_temp->variable->vartype;
+ (yyval.ptnode)->token = hash_temp->variable->token;
+ (yyval.ptnode)->astnode.constant.number = strdup(hash_temp->variable->astnode.constant.number);
+ }
+ else{
+ printf("Error: '%s' is not a constant\n",yylval.lexeme);
+ exit(EXIT_FAILURE);
+ }
+ }
+ break;
+
+ case 66:
+#line 1142 "f2jparse.y"
+ {
+ char *neg_string;
+
+ neg_string = unary_negate_string((yyvsp[0].ptnode)->astnode.constant.number);
+
+ if(!neg_string) {
+ fprintf(stderr, "Error generating negated string (DataConstant)\n");
+ exit(EXIT_FAILURE);
+ }
+
+ free((yyvsp[0].ptnode)->astnode.constant.number);
+ (yyvsp[0].ptnode)->astnode.constant.number = neg_string;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 67:
+#line 1160 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 68:
+#line 1164 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 69:
+#line 1171 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 70:
+#line 1175 "f2jparse.y"
+ {
+ (yyvsp[-1].ptnode)->astnode.forloop.counter = (yyvsp[-3].ptnode);
+ (yyvsp[-1].ptnode)->astnode.forloop.Label = (yyvsp[-5].ptnode);
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ }
+ break;
+
+ case 71:
+#line 1185 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = DataImpliedLoop;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = NULL;
+ }
+ break;
+
+ case 72:
+#line 1195 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = DataImpliedLoop;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-4].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 73:
+#line 1214 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 74:
+#line 1218 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 75:
+#line 1225 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Assignment;
+ }
+ break;
+
+ case 76:
+#line 1230 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Call;
+ }
+ break;
+
+ case 77:
+#line 1235 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = StmtLabelAssign;
+ }
+ break;
+
+ case 78:
+#line 1240 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Logicalif;
+ }
+ break;
+
+ case 79:
+#line 1245 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Arithmeticif;
+ }
+ break;
+
+ case 80:
+#line 1250 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Blockif;
+ }
+ break;
+
+ case 81:
+#line 1255 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Forloop;
+ }
+ break;
+
+ case 82:
+#line 1260 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Return;
+ }
+ break;
+
+ case 83:
+#line 1265 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = AssignedGoto;
+ }
+ break;
+
+ case 84:
+#line 1270 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = ComputedGoto;
+ }
+ break;
+
+ case 85:
+#line 1275 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Goto;
+ }
+ break;
+
+ case 86:
+#line 1280 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Label;
+ }
+ break;
+
+ case 87:
+#line 1285 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Label;
+ }
+ break;
+
+ case 88:
+#line 1290 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Label;
+ }
+ break;
+
+ case 89:
+#line 1295 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Write;
+ }
+ break;
+
+ case 90:
+#line 1300 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Read;
+ }
+ break;
+
+ case 91:
+#line 1305 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Stop;
+ }
+ break;
+
+ case 92:
+#line 1310 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Pause;
+ }
+ break;
+
+ case 93:
+#line 1315 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Unimplemented;
+ }
+ break;
+
+ case 94:
+#line 1320 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Unimplemented;
+ }
+ break;
+
+ case 95:
+#line 1325 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Comment;
+ }
+ break;
+
+ case 96:
+#line 1330 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Unimplemented;
+ }
+ break;
+
+ case 97:
+#line 1337 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = COMMENT;
+ (yyval.ptnode)->nodetype = Comment;
+ (yyval.ptnode)->astnode.ident.len = 0;
+ strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme);
+ }
+ break;
+
+ case 98:
+#line 1347 "f2jparse.y"
+ {
+ fprintf(stderr,"Warning: OPEN not implemented.. skipping.\n");
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Unimplemented;
+ }
+ break;
+
+ case 101:
+#line 1362 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 102:
+#line 1367 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 103:
+#line 1372 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 104:
+#line 1377 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 105:
+#line 1382 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 106:
+#line 1387 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 107:
+#line 1392 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 108:
+#line 1397 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 109:
+#line 1402 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 110:
+#line 1407 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 111:
+#line 1414 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 112:
+#line 1419 "f2jparse.y"
+ {
+ /* UNIMPLEMENTED */
+ (yyval.ptnode) = addnode();
+ }
+ break;
+
+ case 117:
+#line 1438 "f2jparse.y"
+ {
+ fprintf(stderr,"WArning: CLOSE not implemented.\n");
+ (yyval.ptnode) = (yyvsp[-2].ptnode);
+ }
+ break;
+
+ case 118:
+#line 1445 "f2jparse.y"
+ {
+ fprintf(stderr,"Warning: REWIND not implemented.\n");
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 119:
+#line 1452 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = END;
+ (yyval.ptnode)->nodetype = End;
+ }
+ break;
+
+ case 120:
+#line 1459 "f2jparse.y"
+ {
+ AST *end_temp;
+
+ end_temp = addnode();
+ end_temp->token = END;
+ end_temp->nodetype = End;
+
+ (yyval.ptnode) = addnode();
+ end_temp->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Label;
+ (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.label.stmt = end_temp;
+ free_ast_node((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 121:
+#line 1488 "f2jparse.y"
+ {init_tables();}
+ break;
+
+ case 122:
+#line 1489 "f2jparse.y"
+ {
+ if(debug){
+ printf("Functionargs -> OP Namelist CP\n");
+ }
+ (yyvsp[-1].ptnode) = switchem((yyvsp[-1].ptnode));
+ arg_table_load((yyvsp[-1].ptnode));
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 123:
+#line 1498 "f2jparse.y"
+ {
+ if(debug){
+ printf("Functionargs -> OP Namelist CP\n");
+ }
+ init_tables();
+ (yyval.ptnode) = NULL;
+ }
+ break;
+
+ case 124:
+#line 1509 "f2jparse.y"
+ {
+ if(debug){
+ printf("Namelist -> Name\n");
+ }
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 125:
+#line 1516 "f2jparse.y"
+ {
+ if(debug){
+ printf("Namelist -> Namelist CM Name\n");
+ }
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 126:
+#line 1533 "f2jparse.y"
+ {
+ (yyval.ptnode) = process_typestmt((yyvsp[-2].type), (yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 127:
+#line 1537 "f2jparse.y"
+ {
+ (yyval.ptnode) = process_typestmt((yyvsp[-2].type), (yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 128:
+#line 1543 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ len = 1;
+ }
+ break;
+
+ case 129:
+#line 1548 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[-2].type);
+ len = atoi((yyvsp[0].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-1].ptnode));
+ free_ast_node((yyvsp[0].ptnode));
+ }
+ break;
+
+ case 130:
+#line 1557 "f2jparse.y"
+ {
+ (yyval.type) = yylval.type;
+ typedec_context = (yyval.type);
+ }
+ break;
+
+ case 131:
+#line 1564 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ len = 1;
+ }
+ break;
+
+ case 132:
+#line 1569 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[-2].type);
+ len = atoi((yyvsp[0].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-1].ptnode));
+ free_ast_node((yyvsp[0].ptnode));
+ }
+ break;
+
+ case 133:
+#line 1576 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[-4].type);
+ len = -1;
+ free_ast_node((yyvsp[-3].ptnode));
+ free_ast_node((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 134:
+#line 1585 "f2jparse.y"
+ {
+ (yyval.type) = yylval.type;
+ typedec_context = (yyval.type);
+ }
+ break;
+
+ case 135:
+#line 1592 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ }
+ break;
+
+ case 136:
+#line 1596 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ }
+ break;
+
+ case 137:
+#line 1602 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ }
+ break;
+
+ case 138:
+#line 1606 "f2jparse.y"
+ {
+ (yyval.type) = (yyvsp[0].type);
+ }
+ break;
+
+ case 139:
+#line 1618 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->parent = addnode();
+ (yyvsp[0].ptnode)->parent->nodetype = Typedec;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 140:
+#line 1625 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 141:
+#line 1633 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.ident.len = -1;
+ }
+ break;
+
+ case 142:
+#line 1638 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.ident.len = atoi((yyvsp[0].ptnode)->astnode.constant.number);
+ }
+ break;
+
+ case 143:
+#line 1643 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.ident.len = -1;
+ }
+ break;
+
+ case 144:
+#line 1650 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->parent = addnode();
+ (yyvsp[0].ptnode)->parent->nodetype = Typedec;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 145:
+#line 1657 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 146:
+#line 1665 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.ident.len = -1;
+ }
+ break;
+
+ case 147:
+#line 1670 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.ident.len = atoi((yyvsp[0].ptnode)->astnode.constant.number);
+ }
+ break;
+
+ case 148:
+#line 1675 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-4].ptnode);
+ (yyval.ptnode)->astnode.ident.len = -1;
+ }
+ break;
+
+ case 149:
+#line 1680 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.ident.len = -1;
+ }
+ break;
+
+ case 150:
+#line 1700 "f2jparse.y"
+ {
+ HASHNODE *hashtemp;
+
+ lowercase(yylval.lexeme);
+
+ if(type_lookup(java_keyword_table,yylval.lexeme))
+ yylval.lexeme[0] = toupper(yylval.lexeme[0]);
+
+
+ /* check if the name we're looking at is defined as a parameter.
+ * if so, instead of inserting an Identifier node here, we're just
+ * going to insert the Constant node that corresponds to
+ * the parameter. normally the only time we'd worry about
+ * such a substitution would be when the ident was the lhs
+ * of some expression, but that should not happen with parameters.
+ *
+ * otherwise, if not a parameter, get a new AST node initialized
+ * with this name.
+ *
+ * added check for null parameter table because this Name could
+ * be reduced before we initialize the tables. that would mean
+ * that this name is the function name, so we dont want this to
+ * be a parameter anyway. kgs 11/7/00
+ *
+ */
+
+
+ if((parameter_table != NULL) &&
+ ((hashtemp = type_lookup(parameter_table,yylval.lexeme)) != NULL))
+ {
+ /* had a problem here just setting $$ = hashtemp->variable
+ * when there's an arraydec with two of the same PARAMETERS
+ * in the arraynamelist, e.g. A(NMAX,NMAX). so, instead we
+ * just copy the relevant fields from the constant node.
+ */
+ if(debug)
+ printf("not calling init name, param %s\n", yylval.lexeme);
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = hashtemp->variable->nodetype;
+ (yyval.ptnode)->vartype = hashtemp->variable->vartype;
+ (yyval.ptnode)->token = hashtemp->variable->token;
+ (yyval.ptnode)->astnode.constant.number =
+ strdup(hashtemp->variable->astnode.constant.number);
+ }
+ else{
+ if(debug)
+ printf("Name -> NAME\n");
+ (yyval.ptnode) = initialize_name(yylval.lexeme);
+ }
+ }
+ break;
+
+ case 151:
+#line 1760 "f2jparse.y"
+ {
+ lowercase(yylval.lexeme);
+
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->token = NAME;
+ (yyval.ptnode)->nodetype = Identifier;
+
+ (yyval.ptnode)->astnode.ident.needs_declaration = FALSE;
+
+ if(omitWrappers)
+ (yyval.ptnode)->astnode.ident.passByRef = FALSE;
+
+ if(type_lookup(java_keyword_table,yylval.lexeme))
+ yylval.lexeme[0] = toupper(yylval.lexeme[0]);
+
+ strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme);
+ }
+ break;
+
+ case 152:
+#line 1780 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 153:
+#line 1784 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 154:
+#line 1791 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->token = STRING;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme);
+
+ (yyval.ptnode)->vartype = String;
+ if(debug)
+ printf("**The string value is %s\n",(yyval.ptnode)->astnode.constant.number);
+ }
+ break;
+
+ case 155:
+#line 1802 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->token = STRING;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme);
+
+ (yyval.ptnode)->vartype = String;
+ if(debug)
+ printf("**The char value is %s\n",(yyval.ptnode)->astnode.constant.number);
+ }
+ break;
+
+ case 156:
+#line 1815 "f2jparse.y"
+ {
+ (yyval.ptnode) = process_array_declaration((yyvsp[-3].ptnode), (yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 157:
+#line 1821 "f2jparse.y"
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = ArrayDec;
+ (yyvsp[0].ptnode)->parent = temp;
+ if((yyvsp[0].ptnode)->nodetype == ArrayIdxRange) {
+ (yyvsp[0].ptnode)->astnode.expression.lhs->parent = temp;
+ (yyvsp[0].ptnode)->astnode.expression.rhs->parent = temp;
+ }
+
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 158:
+#line 1835 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ if((yyvsp[0].ptnode)->nodetype == ArrayIdxRange) {
+ (yyvsp[0].ptnode)->astnode.expression.lhs->parent = (yyvsp[-2].ptnode)->parent;
+ (yyvsp[0].ptnode)->astnode.expression.rhs->parent = (yyvsp[-2].ptnode)->parent;
+ }
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 159:
+#line 1847 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 160:
+#line 1851 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 161:
+#line 1855 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = ArrayIdxRange;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 162:
+#line 1869 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->nodetype = Identifier;
+ *(yyval.ptnode)->astnode.ident.name = '*';
+ }
+ break;
+
+ case 163:
+#line 1877 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = StmtLabelAssign;
+ (yyval.ptnode)->astnode.assignment.lhs = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.assignment.rhs = (yyvsp[-3].ptnode);
+
+ /* add this label to the list of assigned labels */
+
+ if(in_dlist_stmt_label(assign_labels, (yyvsp[-3].ptnode)) == 0) {
+ if(debug)
+ printf("inserting label num %s in assign_labels list\n",
+ (yyvsp[-3].ptnode)->astnode.constant.number);
+ dl_insert_b(assign_labels, (yyvsp[-3].ptnode));
+ }
+ }
+ break;
+
+ case 164:
+#line 1904 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Assignment;
+ (yyval.ptnode)->astnode.assignment.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.assignment.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 165:
+#line 1915 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ (yyval.ptnode)->nextstmt = NULL;
+ (yyval.ptnode)->prevstmt = NULL;
+ }
+ break;
+
+ case 166:
+#line 1921 "f2jparse.y"
+ {
+ AST *temp;
+
+ /* Use the following declaration in case we
+ * need to switch index order.
+ *
+ * HASHNODE * hashtemp;
+ */
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Identifier;
+ (yyval.ptnode)->prevstmt = NULL;
+ (yyval.ptnode)->nextstmt = NULL;
+
+ free_ast_node((yyvsp[-1].ptnode)->parent);
+ for(temp = (yyvsp[-1].ptnode); temp != NULL; temp = temp->prevstmt)
+ temp->parent = (yyval.ptnode);
+
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-3].ptnode)->astnode.ident.name);
+
+ /* This is in case we want to switch index order later.
+ *
+ * hashtemp = type_lookup(array_table, $1->astnode.ident.name);
+ * if(hashtemp)
+ * $$->astnode.ident.arraylist = $3;
+ * else
+ * $$->astnode.ident.arraylist = switchem($3);
+ */
+
+ /* We don't switch index order. */
+
+ (yyval.ptnode)->astnode.ident.arraylist = switchem((yyvsp[-1].ptnode));
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ break;
+
+ case 167:
+#line 1957 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 168:
+#line 1963 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->parent = addnode();
+ (yyvsp[0].ptnode)->parent->nodetype = Identifier;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 169:
+#line 1970 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 170:
+#line 1982 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Forloop;
+ (yyval.ptnode)->astnode.forloop.Label = (yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 171:
+#line 1991 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 172:
+#line 1996 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ }
+ break;
+
+ case 173:
+#line 2000 "f2jparse.y"
+ {
+ char *loop_label;
+
+ loop_label = (char *)malloc(32);
+ if(!loop_label) {
+ fprintf(stderr,"Malloc error\n");
+ exit(EXIT_FAILURE);
+ }
+ sprintf(loop_label,"%d", cur_do_label);
+ cur_do_label++;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup(loop_label);
+ (yyval.ptnode)->vartype = Integer;
+
+ dl_insert_b(do_labels, strdup((yyval.ptnode)->astnode.constant.number));
+
+ free(loop_label);
+ }
+ break;
+
+ case 174:
+#line 2025 "f2jparse.y"
+ {
+ AST *counter;
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ counter = (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-3].ptnode)->astnode.assignment.lhs;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = NULL;
+ (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-3].ptnode)->astnode.assignment.rhs,(yyvsp[-1].ptnode),NULL);
+ (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr(counter,NULL);
+ }
+ break;
+
+ case 175:
+#line 2039 "f2jparse.y"
+ {
+ AST *counter;
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ counter = (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-5].ptnode)->astnode.assignment.lhs;
+ (yyval.ptnode)->nodetype = Forloop;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-5].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-5].ptnode)->astnode.assignment.rhs,(yyvsp[-3].ptnode),(yyvsp[-1].ptnode));
+ (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr(counter,(yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 176:
+#line 2061 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Label;
+ (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-1].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.label.stmt = (yyvsp[0].ptnode);
+ free_ast_node((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 177:
+#line 2071 "f2jparse.y"
+ {
+ /* HASHNODE *newnode; */
+ char *tmpLabel;
+
+ tmpLabel = (char *) f2jalloc(10); /* plenty of space for a f77 label num */
+
+ /* newnode = (HASHNODE *) f2jalloc(sizeof(HASHNODE)); */
+
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Format;
+ (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.label.stmt = (yyvsp[-1].ptnode);
+ (yyvsp[-1].ptnode)->astnode.label.number = (yyval.ptnode)->astnode.label.number;
+ if(debug)
+ printf("@@ inserting format line num %d\n",(yyval.ptnode)->astnode.label.number);
+
+ sprintf(tmpLabel,"%d",(yyvsp[-1].ptnode)->astnode.label.number);
+
+ type_insert(format_table,(yyvsp[-1].ptnode),0,tmpLabel);
+ free_ast_node((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 178:
+#line 2101 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Format;
+ (yyval.ptnode)->astnode.label.stmt = switchem((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 179:
+#line 2109 "f2jparse.y"
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = Format;
+ (yyvsp[0].ptnode)->parent = temp;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 180:
+#line 2119 "f2jparse.y"
+ {
+ (yyvsp[-1].ptnode)->nextstmt = (yyvsp[0].ptnode);
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-1].ptnode)->parent;
+ if(((yyvsp[0].ptnode)->token == REPEAT) && ((yyvsp[-1].ptnode)->token == INTEGER)) {
+ (yyvsp[0].ptnode)->astnode.label.number = atoi((yyvsp[-1].ptnode)->astnode.constant.number);
+
+ if(debug)
+ printf("## setting number = %s\n", (yyvsp[-1].ptnode)->astnode.constant.number);
+ }
+ if(debug) {
+ if((yyvsp[0].ptnode)->token == REPEAT)
+ printf("## $2 is repeat token, $1 = %s ##\n",tok2str((yyvsp[-1].ptnode)->token));
+ if((yyvsp[-1].ptnode)->token == REPEAT)
+ printf("## $1 is repeat token, $2 = %s ##\n",tok2str((yyvsp[0].ptnode)->token));
+ }
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 181:
+#line 2141 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 182:
+#line 2145 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 183:
+#line 2149 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 184:
+#line 2155 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = EDIT_DESC;
+ strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme);
+ }
+ break;
+
+ case 185:
+#line 2161 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 186:
+#line 2165 "f2jparse.y"
+ {
+ /* ignore the constant part for now */
+ free_ast_node((yyvsp[0].ptnode));
+
+ (yyval.ptnode) = (yyvsp[-2].ptnode);
+ }
+ break;
+
+ case 187:
+#line 2172 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = REPEAT;
+ (yyval.ptnode)->astnode.label.stmt = switchem((yyvsp[-1].ptnode));
+ if(debug)
+ printf("## setting number = 1\n");
+ (yyval.ptnode)->astnode.label.number = 1;
+ }
+ break;
+
+ case 188:
+#line 2183 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 189:
+#line 2187 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 190:
+#line 2194 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = CM;
+ }
+ break;
+
+ case 191:
+#line 2199 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = DIV;
+ }
+ break;
+
+ case 192:
+#line 2204 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = CAT;
+ }
+ break;
+
+ case 193:
+#line 2209 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = COLON;
+ }
+ break;
+
+ case 194:
+#line 2216 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 195:
+#line 2220 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 196:
+#line 2235 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Label;
+ (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.label.stmt = NULL;
+ free_ast_node((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 197:
+#line 2246 "f2jparse.y"
+ {
+ char *loop_label;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Label;
+
+ loop_label = (char *)dl_pop(do_labels);
+
+ (yyval.ptnode)->astnode.label.number = atoi(loop_label);
+ (yyval.ptnode)->astnode.label.stmt = NULL;
+ }
+ break;
+
+ case 198:
+#line 2260 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Write;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL;
+
+ /* unimplemented
+ $$->astnode.io_stmt.file_desc = ;
+ */
+
+ if((yyvsp[-3].ptnode)->nodetype == Constant)
+ {
+ if((yyvsp[-3].ptnode)->astnode.constant.number[0] == '*') {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ else if((yyvsp[-3].ptnode)->token == STRING) {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode);
+ }
+ else {
+ (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode);
+ }
+
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+
+ /* currently ignoring the file descriptor.. */
+ free_ast_node((yyvsp[-5].ptnode));
+ }
+ break;
+
+ case 199:
+#line 2302 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Write;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL;
+
+ (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-2].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ free_ast_node((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 200:
+#line 2317 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Write;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL;
+
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ }
+ break;
+
+ case 201:
+#line 2331 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Write;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-2].ptnode);
+
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent->nodetype = Write;
+ }
+ break;
+
+ case 202:
+#line 2347 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 203:
+#line 2351 "f2jparse.y"
+ {
+ (yyval.ptnode) = NULL;
+ }
+ break;
+
+ case 204:
+#line 2360 "f2jparse.y"
+ {
+ /* do nothing for now */
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 205:
+#line 2365 "f2jparse.y"
+ {
+ /* do nothing for now */
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("*");
+ (yyval.ptnode)->vartype = Integer;
+ }
+ break;
+
+ case 206:
+#line 2377 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 207:
+#line 2381 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 208:
+#line 2385 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("*");
+ (yyval.ptnode)->vartype = Integer;
+ }
+ break;
+
+ case 209:
+#line 2393 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("*");
+ (yyval.ptnode)->vartype = Integer;
+ }
+ break;
+
+ case 210:
+#line 2401 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 211:
+#line 2405 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 212:
+#line 2409 "f2jparse.y"
+ {
+ fprintf(stderr,"Warning - ignoring FMT = %s\n",
+ (yyvsp[0].ptnode)->astnode.ident.name);
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("*");
+ (yyval.ptnode)->vartype = Integer;
+ }
+ break;
+
+ case 213:
+#line 2421 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Read;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL;
+ (yyval.ptnode)->astnode.io_stmt.end_num = -1;
+
+ if((yyvsp[-3].ptnode)->nodetype == Constant)
+ {
+ if((yyvsp[-3].ptnode)->astnode.constant.number[0] == '*') {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ else if((yyvsp[-3].ptnode)->token == STRING) {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode);
+ }
+ else {
+ (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode);
+ }
+
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ if((yyval.ptnode)->astnode.io_stmt.arg_list && (yyval.ptnode)->astnode.io_stmt.arg_list->parent)
+ free_ast_node((yyval.ptnode)->astnode.io_stmt.arg_list->parent);
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent = (yyval.ptnode);
+
+ /* currently ignoring the file descriptor and format spec. */
+ free_ast_node((yyvsp[-5].ptnode));
+ }
+ break;
+
+ case 214:
+#line 2463 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->astnode.io_stmt.io_type = Read;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL;
+
+ if((yyvsp[-5].ptnode)->nodetype == Constant)
+ {
+ if((yyvsp[-5].ptnode)->astnode.constant.number[0] == '*') {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ free_ast_node((yyvsp[-5].ptnode));
+ }
+ else if((yyvsp[-5].ptnode)->token == STRING) {
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-5].ptnode);
+ }
+ else {
+ (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-5].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-5].ptnode));
+ }
+ }
+ else
+ {
+ /* is this case ever reached?? i don't think so. --kgs */
+ (yyval.ptnode)->astnode.io_stmt.format_num = -1;
+ (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-5].ptnode);
+ }
+
+ (yyval.ptnode)->astnode.io_stmt.end_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-3].ptnode));
+
+ (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode));
+
+ if((yyval.ptnode)->astnode.io_stmt.arg_list && (yyval.ptnode)->astnode.io_stmt.arg_list->parent)
+ free_ast_node((yyval.ptnode)->astnode.io_stmt.arg_list->parent);
+
+ for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt)
+ temp->parent = (yyval.ptnode);
+
+ /* currently ignoring the file descriptor.. */
+ free_ast_node((yyvsp[-7].ptnode));
+ }
+ break;
+
+ case 215:
+#line 2509 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->parent = addnode();
+ (yyvsp[0].ptnode)->parent->nodetype = IoExplist;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 216:
+#line 2516 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 217:
+#line 2522 "f2jparse.y"
+ {
+ (yyval.ptnode) = NULL;
+ }
+ break;
+
+ case 218:
+#line 2528 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 219:
+#line 2532 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = IoImpliedLoop;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = NULL;
+ (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-5].ptnode);
+ (yyval.ptnode)->astnode.forloop.Label = switchem((yyvsp[-7].ptnode));
+ (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-3].ptnode),(yyvsp[-1].ptnode),NULL);
+ (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr((yyvsp[-5].ptnode),NULL);
+
+ (yyvsp[-7].ptnode)->parent = (yyval.ptnode);
+ for(temp = (yyvsp[-7].ptnode); temp != NULL; temp = temp->nextstmt)
+ temp->parent = (yyval.ptnode);
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ }
+ break;
+
+ case 220:
+#line 2553 "f2jparse.y"
+ {
+ AST *temp;
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = IoImpliedLoop;
+ (yyval.ptnode)->astnode.forloop.start = (yyvsp[-5].ptnode);
+ (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.forloop.incr = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-7].ptnode);
+ (yyval.ptnode)->astnode.forloop.Label = switchem((yyvsp[-9].ptnode));
+ (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-5].ptnode),(yyvsp[-3].ptnode),(yyvsp[-1].ptnode));
+ (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr((yyvsp[-7].ptnode),(yyvsp[-1].ptnode));
+
+ (yyvsp[-9].ptnode)->parent = (yyval.ptnode);
+ for(temp = (yyvsp[-9].ptnode); temp != NULL; temp = temp->nextstmt)
+ temp->parent = (yyval.ptnode);
+ (yyvsp[-7].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ }
+ break;
+
+ case 221:
+#line 2577 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 222:
+#line 2591 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-8].ptnode)->parent = (yyval.ptnode);
+ if((yyvsp[-4].ptnode) != NULL)
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ if((yyvsp[-3].ptnode) != NULL)
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ if((yyvsp[-2].ptnode) != NULL)
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Blockif;
+ (yyval.ptnode)->astnode.blockif.conds = (yyvsp[-8].ptnode);
+ (yyvsp[-4].ptnode) = switchem((yyvsp[-4].ptnode));
+ (yyval.ptnode)->astnode.blockif.stmts = (yyvsp[-4].ptnode);
+
+ /* If there are any `else if' statements,
+ * switchem. Otherwise, NULL pointer checked
+ * in code generating functions.
+ */
+ (yyvsp[-3].ptnode) = switchem((yyvsp[-3].ptnode));
+ (yyval.ptnode)->astnode.blockif.elseifstmts = (yyvsp[-3].ptnode); /* Might be NULL. */
+ (yyval.ptnode)->astnode.blockif.elsestmts = (yyvsp[-2].ptnode); /* Might be NULL. */
+
+ (yyval.ptnode)->astnode.blockif.endif_label = (yyvsp[-1].ptnode)->astnode.blockif.endif_label;
+ }
+ break;
+
+ case 223:
+#line 2617 "f2jparse.y"
+ {(yyval.ptnode)=0;}
+ break;
+
+ case 224:
+#line 2619 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 225:
+#line 2624 "f2jparse.y"
+ {(yyval.ptnode)=0;}
+ break;
+
+ case 226:
+#line 2626 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 227:
+#line 2630 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 228:
+#line 2638 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Elseif;
+ (yyval.ptnode)->astnode.blockif.conds = (yyvsp[-4].ptnode);
+ (yyval.ptnode)->astnode.blockif.stmts = switchem((yyvsp[0].ptnode));
+ }
+ break;
+
+ case 229:
+#line 2649 "f2jparse.y"
+ {(yyval.ptnode)=0;}
+ break;
+
+ case 230:
+#line 2651 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Else;
+ (yyval.ptnode)->astnode.blockif.stmts = switchem((yyvsp[0].ptnode));
+ }
+ break;
+
+ case 231:
+#line 2658 "f2jparse.y"
+ {
+ (yyval.ptnode) = 0;
+ }
+ break;
+
+ case 232:
+#line 2664 "f2jparse.y"
+ {
+ if(debug) printf("EndIf\n");
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Blockif;
+
+ if(strlen(yylval.lexeme) > 0)
+ (yyval.ptnode)->astnode.blockif.endif_label = atoi(yylval.lexeme);
+ else
+ (yyval.ptnode)->astnode.blockif.endif_label = -1;
+ }
+ break;
+
+ case 233:
+#line 2677 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->astnode.logicalif.conds = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.logicalif.stmts = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 234:
+#line 2687 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Arithmeticif;
+ (yyvsp[-7].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+
+ (yyval.ptnode)->astnode.arithmeticif.cond = (yyvsp[-7].ptnode);
+ (yyval.ptnode)->astnode.arithmeticif.neg_label = atoi((yyvsp[-5].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.arithmeticif.zero_label = atoi((yyvsp[-3].ptnode)->astnode.constant.number);
+ (yyval.ptnode)->astnode.arithmeticif.pos_label = atoi((yyvsp[-1].ptnode)->astnode.constant.number);
+ free_ast_node((yyvsp[-5].ptnode));
+ free_ast_node((yyvsp[-3].ptnode));
+ free_ast_node((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 235:
+#line 2720 "f2jparse.y"
+ {
+ (yyval.ptnode) = process_subroutine_call((yyvsp[-3].ptnode), (yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 236:
+#line 2726 "f2jparse.y"
+ {
+ if(debug)
+ printf("SubString! format = c(e1:e2)\n");
+ (yyval.ptnode) = addnode();
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-5].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->nodetype = Substring;
+ (yyval.ptnode)->token = NAME;
+ (yyval.ptnode)->astnode.ident.startDim[0] = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.ident.endDim[0] = (yyvsp[-1].ptnode);
+ free_ast_node((yyvsp[-5].ptnode));
+ }
+ break;
+
+ case 237:
+#line 2741 "f2jparse.y"
+ {
+ if(debug)
+ printf("SubString! format = c(:e2)\n");
+ (yyval.ptnode) = addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-4].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->nodetype = Substring;
+ (yyval.ptnode)->token = NAME;
+ (yyval.ptnode)->astnode.ident.startDim[0] = NULL;
+ (yyval.ptnode)->astnode.ident.endDim[0] = (yyvsp[-1].ptnode);
+ free_ast_node((yyvsp[-4].ptnode));
+ }
+ break;
+
+ case 238:
+#line 2755 "f2jparse.y"
+ {
+ if(debug)
+ printf("SubString! format = c(e1:)\n");
+ (yyval.ptnode) = addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-4].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->nodetype = Substring;
+ (yyval.ptnode)->token = NAME;
+ (yyval.ptnode)->astnode.ident.startDim[0] = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.ident.endDim[0] = NULL;
+ free_ast_node((yyvsp[-4].ptnode));
+ }
+ break;
+
+ case 239:
+#line 2769 "f2jparse.y"
+ {
+ if(debug)
+ printf("SubString! format = c(:)\n");
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-3].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->nodetype = Substring;
+ (yyval.ptnode)->token = NAME;
+ (yyval.ptnode)->astnode.ident.startDim[0] = NULL;
+ (yyval.ptnode)->astnode.ident.endDim[0] = NULL;
+ free_ast_node((yyvsp[-3].ptnode));
+ }
+ break;
+
+ case 240:
+#line 2794 "f2jparse.y"
+ {
+ AST *temp;
+
+ temp = addnode();
+ temp->nodetype = Call;
+ (yyvsp[0].ptnode)->parent = temp;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 241:
+#line 2804 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent;
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 242:
+#line 2810 "f2jparse.y"
+ {
+ (yyval.ptnode) = NULL;
+ }
+ break;
+
+ case 243:
+#line 2819 "f2jparse.y"
+ {
+ /* we don't want subroutines in the type_table
+ * make a dlist to stuff the names in and check
+ * them in initialize_name.
+ */
+
+ if(in_dlist(subroutine_names, (yyvsp[-1].ptnode)->astnode.ident.name)==0){
+ if(debug){
+ printf("inserting %s in dlist and del from type\n",
+ (yyvsp[-1].ptnode)->astnode.ident.name);
+ }
+ dl_insert_b(subroutine_names, strdup((yyvsp[-1].ptnode)->astnode.ident.name));
+ hash_delete(type_table, (yyvsp[-1].ptnode)->astnode.ident.name);
+ }
+ if(debug){
+ printf("call: %s\n", (yyvsp[-1].ptnode)->astnode.ident.name);
+ }
+
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Call;
+ }
+ break;
+
+ case 244:
+#line 2841 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Identifier;
+ strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-1].ptnode)->astnode.ident.name);
+ (yyval.ptnode)->astnode.ident.arraylist = addnode();
+ (yyval.ptnode)->astnode.ident.arraylist->nodetype = EmptyArgList;
+ free_ast_node((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 245:
+#line 2857 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 246:
+#line 2861 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->token = EQV;
+ (yyval.ptnode)->nodetype = Logicalop;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 247:
+#line 2873 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->token = NEQV;
+ (yyval.ptnode)->nodetype = Logicalop;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 248:
+#line 2887 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 249:
+#line 2891 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->token = OR;
+ (yyval.ptnode)->nodetype = Logicalop;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 250:
+#line 2905 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 251:
+#line 2909 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->token = AND;
+ (yyval.ptnode)->nodetype = Logicalop;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 252:
+#line 2923 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 253:
+#line 2927 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->token = NOT;
+ (yyval.ptnode)->nodetype = Logicalop;
+ (yyval.ptnode)->astnode.expression.lhs = 0;
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 254:
+#line 2938 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 255:
+#line 2941 "f2jparse.y"
+ {temptok = yylval.tok;}
+ break;
+
+ case 256:
+#line 2942 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-3].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Relationalop;
+ (yyval.ptnode)->token = temptok;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-3].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 257:
+#line 2956 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 258:
+#line 2960 "f2jparse.y"
+ {
+ if((yyvsp[0].ptnode)->nodetype == Constant) {
+ char *neg_string;
+
+ neg_string = unary_negate_string((yyvsp[0].ptnode)->astnode.constant.number);
+
+ if(!neg_string) {
+ fprintf(stderr, "Error generating negated string (arith_expr)\n");
+ exit(EXIT_FAILURE);
+ }
+
+ free((yyvsp[0].ptnode)->astnode.constant.number);
+ (yyvsp[0].ptnode)->astnode.constant.number = neg_string;
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ else {
+ (yyval.ptnode) = addnode();
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = 0;
+ (yyval.ptnode)->astnode.expression.minus = '-';
+ (yyval.ptnode)->nodetype = Unaryop;
+ (yyval.ptnode)->vartype = (yyvsp[0].ptnode)->vartype;
+ }
+ }
+ break;
+
+ case 259:
+#line 2987 "f2jparse.y"
+ {
+ if((yyvsp[0].ptnode)->nodetype == Constant) {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ else {
+ (yyval.ptnode) = addnode();
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = 0;
+ (yyval.ptnode)->astnode.expression.minus = '+';
+ (yyval.ptnode)->nodetype = Unaryop;
+ (yyval.ptnode)->vartype = (yyvsp[0].ptnode)->vartype;
+ }
+ }
+ break;
+
+ case 260:
+#line 3002 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyval.ptnode)->token = PLUS;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->astnode.expression.optype = '+';
+ }
+ break;
+
+ case 261:
+#line 3016 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->token = MINUS;
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->astnode.expression.optype = '-';
+ }
+ break;
+
+ case 262:
+#line 3032 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 263:
+#line 3036 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyval.ptnode)->token = DIV;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->astnode.expression.optype = '/';
+ }
+ break;
+
+ case 264:
+#line 3050 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+
+ (yyval.ptnode)->token = STAR;
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->astnode.expression.optype = '*';
+ }
+ break;
+
+ case 265:
+#line 3067 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 266:
+#line 3071 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = Power;
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ }
+ break;
+
+ case 267:
+#line 3083 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 268:
+#line 3087 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyval.ptnode)->token = CAT;
+ (yyvsp[-2].ptnode)->expr_side = left;
+ (yyvsp[0].ptnode)->expr_side = right;
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[0].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode);
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode);
+ (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype);
+ (yyval.ptnode)->nodetype = Binaryop;
+ (yyval.ptnode)->astnode.expression.optype = '+';
+ }
+ break;
+
+ case 269:
+#line 3102 "f2jparse.y"
+ {(yyval.ptnode)=(yyvsp[0].ptnode);}
+ break;
+
+ case 270:
+#line 3104 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 271:
+#line 3108 "f2jparse.y"
+ {(yyval.ptnode)=(yyvsp[0].ptnode);}
+ break;
+
+ case 272:
+#line 3109 "f2jparse.y"
+ {(yyval.ptnode)=(yyvsp[0].ptnode);}
+ break;
+
+ case 273:
+#line 3111 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Expression;
+ (yyval.ptnode)->astnode.expression.parens = TRUE;
+ (yyval.ptnode)->astnode.expression.rhs = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.expression.lhs = NULL;
+ (yyval.ptnode)->vartype = (yyvsp[-1].ptnode)->vartype;
+ }
+ break;
+
+ case 274:
+#line 3131 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = TrUE;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("true");
+ (yyval.ptnode)->vartype = Logical;
+ }
+ break;
+
+ case 275:
+#line 3139 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = FaLSE;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup("false");
+ (yyval.ptnode)->vartype = Logical;
+ }
+ break;
+
+ case 276:
+#line 3151 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 277:
+#line 3155 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 278:
+#line 3159 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 279:
+#line 3163 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 280:
+#line 3167 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 281:
+#line 3171 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 282:
+#line 3177 "f2jparse.y"
+ {
+ if(debug)printf("Integer\n");
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = INTEGER;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme);
+ (yyval.ptnode)->vartype = Integer;
+ }
+ break;
+
+ case 283:
+#line 3188 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = DOUBLE;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme);
+ (yyval.ptnode)->vartype = Double;
+ }
+ break;
+
+ case 284:
+#line 3198 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = FLOAT;
+ (yyval.ptnode)->nodetype = Constant;
+ (yyval.ptnode)->astnode.constant.number =
+ (char *)malloc(strlen(yylval.lexeme) + 2);
+ strcpy((yyval.ptnode)->astnode.constant.number, yylval.lexeme);
+ strcat((yyval.ptnode)->astnode.constant.number, "f");
+ (yyval.ptnode)->vartype = Float;
+ }
+ break;
+
+ case 285:
+#line 3217 "f2jparse.y"
+ {
+ char tempname[60];
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = E_EXPONENTIAL;
+ (yyval.ptnode)->nodetype = Constant;
+ exp_to_double(yylval.lexeme, tempname);
+ (yyval.ptnode)->astnode.constant.number =
+ (char *)malloc(strlen(tempname) + 2);
+ strcpy((yyval.ptnode)->astnode.constant.number, tempname);
+ strcat((yyval.ptnode)->astnode.constant.number, "f");
+ (yyval.ptnode)->vartype = Float;
+ }
+ break;
+
+ case 286:
+#line 3231 "f2jparse.y"
+ {
+ char tempname[60];
+
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->token = D_EXPONENTIAL;
+ (yyval.ptnode)->nodetype = Constant;
+ exp_to_double(yylval.lexeme, tempname);
+ (yyval.ptnode)->astnode.constant.number = strdup(tempname);
+ (yyval.ptnode)->vartype = Double;
+ }
+ break;
+
+ case 287:
+#line 3246 "f2jparse.y"
+ {
+ (yyval.ptnode)= addnode();
+ }
+ break;
+
+ case 288:
+#line 3252 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Pause;
+ (yyval.ptnode)->astnode.constant.number = strdup("");
+ }
+ break;
+
+ case 289:
+#line 3258 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Pause;
+ }
+ break;
+
+ case 290:
+#line 3265 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyval.ptnode)->nodetype = Stop;
+ (yyval.ptnode)->astnode.constant.number = strdup("");
+ }
+ break;
+
+ case 291:
+#line 3271 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->nodetype = Stop;
+ }
+ break;
+
+ case 292:
+#line 3278 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Goto;
+ if(debug)
+ printf("goto label: %d\n", atoi(yylval.lexeme));
+ (yyval.ptnode)->astnode.go_to.label = atoi(yylval.lexeme);
+ free_ast_node((yyvsp[-1].ptnode));
+ }
+ break;
+
+ case 293:
+#line 3290 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = ComputedGoto;
+ (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-3].ptnode));
+ if(debug)
+ printf("Computed go to,\n");
+ }
+ break;
+
+ case 294:
+#line 3301 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = ComputedGoto;
+ (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-4].ptnode));
+ if(debug)
+ printf("Computed go to,\n");
+ }
+ break;
+
+ case 295:
+#line 3314 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-4].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = AssignedGoto;
+ (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-4].ptnode);
+ (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-2].ptnode));
+ if(debug)
+ printf("Assigned go to,\n");
+ }
+ break;
+
+ case 296:
+#line 3325 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-5].ptnode)->parent = (yyval.ptnode);
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = AssignedGoto;
+ (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-5].ptnode);
+ (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-2].ptnode));
+ if(debug)
+ printf("Assigned go to,\n");
+ }
+ break;
+
+ case 297:
+#line 3336 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode);
+ (yyval.ptnode)->nodetype = AssignedGoto;
+ (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode);
+ (yyval.ptnode)->astnode.computed_goto.intlist = NULL;
+ if(debug)
+ printf("Assigned go to (no intlist)\n");
+ }
+ break;
+
+ case 298:
+#line 3348 "f2jparse.y"
+ {
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 299:
+#line 3352 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ }
+ break;
+
+ case 300:
+#line 3359 "f2jparse.y"
+ {
+ (yyval.ptnode) = addnode();
+ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */
+ (yyval.ptnode)->nodetype = Specification;
+ (yyval.ptnode)->astnode.typeunit.specification = Parameter;
+ (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-2].ptnode));
+ }
+ break;
+
+ case 301:
+#line 3369 "f2jparse.y"
+ {
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 302:
+#line 3373 "f2jparse.y"
+ {
+ (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode);
+ (yyval.ptnode)=(yyvsp[0].ptnode);
+ }
+ break;
+
+ case 303:
+#line 3380 "f2jparse.y"
+ {
+ void add_decimal_point(char *);
+ double constant_eval;
+ HASHNODE *ht;
+ char *cur_id;
+ AST *temp;
+
+ if(debug)
+ printf("Parameter...\n");
+
+ (yyval.ptnode) = (yyvsp[0].ptnode);
+ (yyval.ptnode)->nodetype = Assignment;
+
+ constant_eval = eval_const_expr((yyval.ptnode)->astnode.assignment.rhs);
+
+ if(debug) {
+ printf("### constant_eval is %.40g\n", constant_eval);
+ printf("### constant_eval is %.40e\n", constant_eval);
+ }
+
+ temp = addnode();
+ temp->nodetype = Constant;
+
+ ht = type_lookup(type_table, (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name);
+
+ if(ht)
+ temp->vartype = ht->variable->vartype;
+ else
+ temp->vartype = (yyval.ptnode)->astnode.assignment.rhs->vartype;
+
+ switch(temp->vartype) {
+ case String:
+ case Character:
+ temp->token = STRING;
+ temp->astnode.constant.number =
+ strdup((yyval.ptnode)->astnode.assignment.rhs->astnode.constant.number);
+ break;
+ case Complex:
+ fprintf(stderr,"Pdec: Complex not yet supported.\n");
+ break;
+ case Logical:
+ temp->token = (yyval.ptnode)->astnode.assignment.rhs->token;
+ temp->astnode.constant.number =
+ strdup(temp->token == TrUE ? "true" : "false");
+ break;
+ case Float:
+ temp->token = FLOAT;
+
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%.40g",constant_eval);
+ add_decimal_point(temp->astnode.constant.number);
+ strcat(temp->astnode.constant.number, "f");
+
+ break;
+ case Double:
+ temp->token = DOUBLE;
+
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%.40g",constant_eval);
+ add_decimal_point(temp->astnode.constant.number);
+
+ break;
+ case Integer:
+ temp->token = INTEGER;
+ temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN);
+ sprintf(temp->astnode.constant.number,"%d",(int)constant_eval);
+ break;
+ default:
+ fprintf(stderr,"Pdec: bad vartype!\n");
+ }
+
+ free_ast_node((yyval.ptnode)->astnode.assignment.rhs);
+ (yyval.ptnode)->astnode.assignment.rhs = temp;
+
+ if(debug)
+ printf("### the constant is '%s'\n",
+ temp->astnode.constant.number);
+
+ cur_id = strdup((yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name);
+
+ if(type_lookup(java_keyword_table,cur_id))
+ cur_id[0] = toupper(cur_id[0]);
+
+ if(debug)
+ printf("insert param_table %s\n", (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name);
+ hash_delete(type_table, (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name);
+ type_insert(parameter_table, temp, 0, cur_id);
+ free_ast_node((yyval.ptnode)->astnode.assignment.lhs);
+ }
+ break;
+
+ case 304:
+#line 3472 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-3-97 - Keith */
+ (yyval.ptnode)->nodetype = Specification;
+ (yyval.ptnode)->token = EXTERNAL;
+ (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-1].ptnode));
+ (yyval.ptnode)->astnode.typeunit.specification = External;
+ }
+ break;
+
+ case 305:
+#line 3483 "f2jparse.y"
+ {
+ (yyval.ptnode)=addnode();
+ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-3-97 - Keith */
+ (yyval.ptnode)->nodetype = Specification;
+ (yyval.ptnode)->token = INTRINSIC;
+ (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-1].ptnode));
+ (yyval.ptnode)->astnode.typeunit.specification = Intrinsic;
+ }
+ break;
+
+
+ }
+
+/* Line 1037 of yacc.c. */
+#line 5762 "y.tab.c"
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+
+
+ YY_STACK_PRINT (yyss, yyssp);
+
+ *++yyvsp = yyval;
+
+
+ /* Now `shift' the result of the reduction. Determine what state
+ that goes to, based on the state we popped back to and the rule
+ number reduced by. */
+
+ yyn = yyr1[yyn];
+
+ yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+ if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTOKENS];
+
+ goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+ /* If not already recovering from an error, report this error. */
+ if (!yyerrstatus)
+ {
+ ++yynerrs;
+#if YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (YYPACT_NINF < yyn && yyn < YYLAST)
+ {
+ YYSIZE_T yysize = 0;
+ int yytype = YYTRANSLATE (yychar);
+ const char* yyprefix;
+ char *yymsg;
+ int yyx;
+
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ int yyxbegin = yyn < 0 ? -yyn : 0;
+
+ /* Stay within bounds of both yycheck and yytname. */
+ int yychecklim = YYLAST - yyn;
+ int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+ int yycount = 0;
+
+ yyprefix = ", expecting ";
+ for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ yysize += yystrlen (yyprefix) + yystrlen (yytname [yyx]);
+ yycount += 1;
+ if (yycount == 5)
+ {
+ yysize = 0;
+ break;
+ }
+ }
+ yysize += (sizeof ("syntax error, unexpected ")
+ + yystrlen (yytname[yytype]));
+ yymsg = (char *) YYSTACK_ALLOC (yysize);
+ if (yymsg != 0)
+ {
+ char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ yyp = yystpcpy (yyp, yytname[yytype]);
+
+ if (yycount < 5)
+ {
+ yyprefix = ", expecting ";
+ for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ {
+ yyp = yystpcpy (yyp, yyprefix);
+ yyp = yystpcpy (yyp, yytname[yyx]);
+ yyprefix = " or ";
+ }
+ }
+ yyerror (yymsg);
+ YYSTACK_FREE (yymsg);
+ }
+ else
+ yyerror ("syntax error; also virtual memory exhausted");
+ }
+ else
+#endif /* YYERROR_VERBOSE */
+ yyerror ("syntax error");
+ }
+
+
+
+ if (yyerrstatus == 3)
+ {
+ /* If just tried and failed to reuse look-ahead token after an
+ error, discard it. */
+
+ if (yychar <= YYEOF)
+ {
+ /* If at end of input, pop the error token,
+ then the rest of the stack, then return failure. */
+ if (yychar == YYEOF)
+ for (;;)
+ {
+
+ YYPOPSTACK;
+ if (yyssp == yyss)
+ YYABORT;
+ yydestruct ("Error: popping",
+ yystos[*yyssp], yyvsp);
+ }
+ }
+ else
+ {
+ yydestruct ("Error: discarding", yytoken, &yylval);
+ yychar = YYEMPTY;
+ }
+ }
+
+ /* Else will try to reuse look-ahead token after shifting the error
+ token. */
+ goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR. |
+`---------------------------------------------------*/
+yyerrorlab:
+
+#ifdef __GNUC__
+ /* Pacify GCC when the user code never invokes YYERROR and the label
+ yyerrorlab therefore never appears in user code. */
+ if (0)
+ goto yyerrorlab;
+#endif
+
+yyvsp -= yylen;
+ yyssp -= yylen;
+ yystate = *yyssp;
+ goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR. |
+`-------------------------------------------------------------*/
+yyerrlab1:
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
+
+ for (;;)
+ {
+ yyn = yypact[yystate];
+ if (yyn != YYPACT_NINF)
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
+
+ /* Pop the current state because it cannot handle the error token. */
+ if (yyssp == yyss)
+ YYABORT;
+
+
+ yydestruct ("Error: popping", yystos[yystate], yyvsp);
+ YYPOPSTACK;
+ yystate = *yyssp;
+ YY_STACK_PRINT (yyss, yyssp);
+ }
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ *++yyvsp = yylval;
+
+
+ /* Shift the error token. */
+ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+ yystate = yyn;
+ goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here. |
+`-------------------------------------*/
+yyacceptlab:
+ yyresult = 0;
+ goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here. |
+`-----------------------------------*/
+yyabortlab:
+ yydestruct ("Error: discarding lookahead",
+ yytoken, &yylval);
+ yychar = YYEMPTY;
+ yyresult = 1;
+ goto yyreturn;
+
+#ifndef yyoverflow
+/*----------------------------------------------.
+| yyoverflowlab -- parser overflow comes here. |
+`----------------------------------------------*/
+yyoverflowlab:
+ yyerror ("parser stack overflow");
+ yyresult = 2;
+ /* Fall through. */
+#endif
+
+yyreturn:
+#ifndef yyoverflow
+ if (yyss != yyssa)
+ YYSTACK_FREE (yyss);
+#endif
+ return yyresult;
+}
+
+
+#line 3494 "f2jparse.y"
+
+
+
+/*****************************************************************************
+ * *
+ * yyerror *
+ * *
+ * The standard yacc error routine. *
+ * *
+ *****************************************************************************/
+
+void
+yyerror(char *s)
+{
+ extern Dlist file_stack;
+ INCLUDED_FILE *pfile;
+ Dlist tmp;
+
+ if(current_file_info)
+ printf("%s:%d: %s\n", current_file_info->name, lineno, s);
+ else
+ printf("line %d: %s\n", lineno, s);
+
+ dl_traverse_b(tmp, file_stack) {
+ pfile = (INCLUDED_FILE *)dl_val(tmp);
+
+ printf("\tincluded from: %s:%d\n", pfile->name, pfile->line_num);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * add_decimal_point *
+ * *
+ * this is just a hack to compensate for the fact that there's no printf *
+ * specifier that does exactly what we want. assume the given string *
+ * represents a floating point number. if there's no decimal point in the *
+ * string, then append ".0" to it. However, if there's an 'e' in the string *
+ * then javac will interpret it as floating point. The only real problem *
+ * that occurs is when the constant is too big to fit as an integer, but has *
+ * no decimal point, so javac flags it as an error (int constant too big). *
+ * *
+ *****************************************************************************/
+
+void
+add_decimal_point(char *str)
+{
+ BOOL found_dec = FALSE;
+ char *p = str;
+
+ while( *p != '\0' ) {
+ if( *p == '.' ) {
+ found_dec = TRUE;
+ break;
+ }
+
+ if( *p == 'e' )
+ return;
+
+ p++;
+ }
+
+ if(!found_dec)
+ strcat(str, ".0");
+}
+
+/*****************************************************************************
+ * *
+ * addnode *
+ * *
+ * To keep things simple, there is only one type of parse tree node. *
+ * *
+ *****************************************************************************/
+
+AST *
+addnode()
+{
+ return (AST*)f2jcalloc(1,sizeof(AST));
+}
+
+
+/*****************************************************************************
+ * *
+ * switchem *
+ * *
+ * Need to turn the linked list around, *
+ * so that it can traverse forward instead of in reverse. *
+ * What I do here is create a doubly linked list. *
+ * Note that there is no `sentinel' or `head' node *
+ * in this list. It is acyclic and terminates in *
+ * NULL pointers. *
+ * *
+ *****************************************************************************/
+
+AST *
+switchem(AST * root)
+{
+ if(root == NULL)
+ return NULL;
+
+ if (root->prevstmt == NULL)
+ return root;
+
+ while (root->prevstmt != NULL)
+ {
+ root->prevstmt->nextstmt = root;
+ root = root->prevstmt;
+ }
+
+ return root;
+}
+
+/*****************************************************************************
+ * *
+ * assign_array_dims *
+ * *
+ * This is used by DIMENSION and COMMON to set the specified array *
+ * dimensions, possibly in the absence of a type declaration. If we *
+ * haven't seen a delcaration for this variable yet, create a new node. *
+ * Otherwise, assign the array dimensions to the existing node. *
+ * *
+ *****************************************************************************/
+
+void
+assign_array_dims(AST *var)
+{
+ HASHNODE *hash_entry;
+ AST *node;
+ int i;
+
+ hash_entry = type_lookup(type_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ if(debug){
+ printf("Calling initalize name from assign_array_dims\n");
+ }
+
+ node = initialize_name(var->astnode.ident.name);
+
+ /* if it's an intrinsic_named array */
+ if(node->astnode.ident.which_implicit == INTRIN_NAMED_ARRAY_OR_FUNC_CALL){
+ node->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY;
+ type_insert(type_table, node, node->vartype, var->astnode.ident.name);
+ }
+
+ if(debug)
+ printf("assign_array_dims: %s\n", var->astnode.ident.name);
+ }
+
+ node->astnode.ident.localvnum = -1;
+ node->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ node->astnode.ident.dim = var->astnode.ident.dim;
+ node->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ node->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+
+ /* do the same for the array table */
+
+ hash_entry = type_lookup(array_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ node = initialize_name(var->astnode.ident.name);
+ type_insert(array_table, node, node->vartype, var->astnode.ident.name);
+ hash_entry = type_lookup(array_table, var->astnode.ident.name);
+ if(hash_entry)
+ node = hash_entry->variable;
+ else {
+ fprintf(stderr, "internal error: lookup failed after insert\n");
+ return;
+ }
+ }
+
+ node->astnode.ident.localvnum = -1;
+ node->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ node->astnode.ident.dim = var->astnode.ident.dim;
+ node->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ node->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+}
+
+/*****************************************************************************
+ * *
+ * assign_common_array_dims *
+ * *
+ * For arrays declared in COMMON blocks, we go ahead and assign the *
+ * dimensions in case they aren't dimensioned anywhere else. *
+ * *
+ *****************************************************************************/
+
+void
+assign_common_array_dims(AST *root)
+{
+ AST *Clist, *temp;
+
+ for(Clist = root->astnode.common.nlist; Clist != NULL; Clist = Clist->nextstmt)
+ {
+ for(temp=Clist->astnode.common.nlist; temp!=NULL; temp=temp->nextstmt)
+ {
+ if(temp->astnode.ident.arraylist)
+ assign_array_dims(temp);
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * type_hash *
+ * *
+ * For now, type_hash takes a tree (linked list) of type *
+ * declarations from the Decblock rule. It will need to *
+ * get those from Intrinsic, External, Parameter, etc. *
+ * *
+ *****************************************************************************/
+
+void
+type_hash(AST * types)
+{
+ HASHNODE *hash_entry;
+ AST * temptypes, * tempnames;
+ int return_type;
+
+ /* Outer for loop traverses typestmts, inner for()
+ * loop traverses declists. Code for stuffing symbol table is
+ * is in inner for() loop.
+ */
+ for (temptypes = types; temptypes; temptypes = temptypes->nextstmt)
+ {
+ /* Long assignment, set up the for() loop here instead of
+ the expression list. */
+ tempnames = temptypes->astnode.typeunit.declist;
+
+ /* Need to set the return value here before entering
+ the next for() loop. */
+ return_type = temptypes->astnode.typeunit.returns;
+
+ if(debug)
+ printf("type_hash(): type dec is %s\n", print_nodetype(temptypes));
+
+ if(temptypes->nodetype == CommonList) {
+ assign_common_array_dims(temptypes);
+ continue;
+ }
+
+ /* skip parameter statements and data statements */
+ if(( (temptypes->nodetype == Specification) &&
+ (temptypes->astnode.typeunit.specification == Parameter))
+ || (temptypes->nodetype == DataList))
+ continue;
+
+ for (; tempnames; tempnames = tempnames->nextstmt)
+ {
+ int i;
+
+ /* ignore parameter assignment stmts */
+ if((tempnames->nodetype == Assignment) ||
+ (tempnames->nodetype == DataStmt))
+ continue;
+
+ /* Stuff names and return types into the symbol table. */
+ if(debug)
+ printf("Type hash: '%s' (%s)\n", tempnames->astnode.ident.name,
+ print_nodetype(tempnames));
+
+ if(temptypes->nodetype == Dimension)
+ assign_array_dims(tempnames);
+ else {
+ /* check whether there is already an array declaration for this ident.
+ * this would be true in case of a normal type declaration with array
+ * declarator, in which case we'll do a little extra work here. but
+ * for idents that were previously dimensioned, we need to get this
+ * info out of the table.
+ */
+
+ hash_entry = type_lookup(array_table,tempnames->astnode.ident.name);
+ if(hash_entry) {
+ AST *var = hash_entry->variable;
+
+ tempnames->astnode.ident.localvnum = -1;
+ tempnames->astnode.ident.arraylist = var->astnode.ident.arraylist;
+ tempnames->astnode.ident.dim = var->astnode.ident.dim;
+ tempnames->astnode.ident.leaddim = var->astnode.ident.leaddim;
+ for(i=0;i<MAX_ARRAY_DIM;i++) {
+ tempnames->astnode.ident.startDim[i] = var->astnode.ident.startDim[i];
+ tempnames->astnode.ident.endDim[i] = var->astnode.ident.endDim[i];
+ }
+ }
+ if((temptypes->token != INTRINSIC) && (temptypes->token != EXTERNAL))
+ {
+ hash_entry = type_lookup(type_table,tempnames->astnode.ident.name);
+
+ if(hash_entry == NULL) {
+ tempnames->vartype = return_type;
+ tempnames->astnode.ident.localvnum = -1;
+
+ if(debug){
+ printf("hh type_insert: %s\n", tempnames->astnode.ident.name);
+ }
+
+ type_insert(type_table, tempnames, return_type,
+ tempnames->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (non-external): %s\n",
+ tempnames->astnode.ident.name);
+ }
+ else {
+ if(debug) {
+ printf("type_hash: Entry already exists...");
+ printf("going to override the type.\n");
+ }
+ hash_entry->variable->vartype = tempnames->vartype;
+ }
+ }
+ }
+
+ /* Now separate out the EXTERNAL from the INTRINSIC on the
+ * fortran side.
+ */
+
+ if(temptypes != NULL) {
+ AST *newnode;
+
+ /* create a new node to stick into the intrinsic/external table
+ * so that the type_table isn't pointing to the same node.
+ */
+ newnode = addnode();
+ strcpy(newnode->astnode.ident.name,tempnames->astnode.ident.name);
+ newnode->vartype = return_type;
+ newnode->nodetype = Identifier;
+
+ switch (temptypes->token)
+ {
+ case INTRINSIC:
+ type_insert(intrinsic_table,
+ newnode, return_type, newnode->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (INTRINSIC): %s\n",
+ newnode->astnode.ident.name);
+
+ break;
+ case EXTERNAL:
+ type_insert(external_table,
+ newnode, return_type, newnode->astnode.ident.name);
+
+ if(debug)
+ printf("Type hash (EXTERNAL): %s\n",
+ newnode->astnode.ident.name);
+
+ break;
+ default:
+ /* otherwise free the node that we didn't use. */
+ free_ast_node(newnode);
+ break; /* ansi thing */
+
+ } /* Close switch(). */
+ }
+ } /* Close inner for() loop. */
+ } /* Close outer for() loop. */
+} /* Close type_hash(). */
+
+
+/*****************************************************************************
+ * *
+ * exp_to_double *
+ * *
+ * Java recognizes numbers of the form 1.0e+1, so the `D' and `d' need *
+ * to be replaced with 'e'. *
+ * *
+ *****************************************************************************/
+
+void
+exp_to_double (char *lexeme, char *temp)
+{
+ char *cp = lexeme;
+
+ while (*cp) /* While *cp != '\0'... */
+ {
+ if (*cp == 'd' || /* sscanf can recognize 'E'. */
+ *cp == 'D')
+ {
+ *cp = 'e'; /* Replace the 'd' or 'D' with 'e'. */
+ break; /* Should be only one 'd', 'D', etc. */
+ }
+ cp++; /* Examine the next character. */
+ }
+
+ /* Java should be able to handle exponential notation as part
+ * of the float or double constant.
+ */
+
+ strcpy(temp,lexeme);
+} /* Close exp_to_double(). */
+
+
+/*****************************************************************************
+ * *
+ * arg_table_load *
+ * *
+ * Initialize and fill a table with the names of the *
+ * variables passed in as arguments to the function or *
+ * subroutine. This table is later checked when variable *
+ * types are declared so that variables are not declared *
+ * twice. *
+ * *
+ *****************************************************************************/
+
+void
+arg_table_load(AST * arglist)
+{
+ AST * temp;
+
+ /* We traverse down `prevstmt' because the arglist is
+ * built with right recursion, i.e. in reverse. This
+ * procedure, 'arg_table_load()' is called when the non-
+ * terminal `functionargs' is reduced, before the
+ * argument list is reversed. Note that a NULL pointer
+ * at either end of the list terminates the for() loop.
+ */
+
+ for(temp = arglist; temp; temp = temp->nextstmt)
+ {
+ type_insert(args_table, temp, 0, temp->astnode.ident.name);
+ if(debug)
+ printf("#@Arglist var. name: %s\n", temp->astnode.ident.name);
+ }
+}
+
+
+/*****************************************************************************
+ * *
+ * lowercase *
+ * *
+ * This function takes a string and converts all characters to *
+ * lowercase. *
+ * *
+ *****************************************************************************/
+
+char * lowercase(char * name)
+{
+ char *ptr = name;
+
+ while (*name)
+ {
+ *name = tolower(*name);
+ name++;
+ }
+
+ return ptr;
+}
+
+/*****************************************************************************
+ * *
+ * store_array_var *
+ * *
+ * We need to make a table of array variables, because *
+ * fortran accesses arrays by columns instead of rows *
+ * as C and java does. During code generation, the array *
+ * variables are emitted in reverse to get row order. *
+ * *
+ *****************************************************************************/
+
+void
+store_array_var(AST * var)
+{
+
+ if(type_lookup(array_table, var->astnode.ident.name) != NULL)
+ fprintf(stderr,"Error: more than one array declarator for array '%s'\n",
+ var->astnode.ident.name);
+ else
+ type_insert(array_table, var, 0, var->astnode.ident.name);
+
+ if(debug)
+ printf("Array name: %s\n", var->astnode.ident.name);
+}
+
+/*****************************************************************************
+ * *
+ * mypow *
+ * *
+ * Double power function. writing this here so that we *
+ * dont have to link in the math library. *
+ * *
+ *****************************************************************************/
+
+double
+mypow(double x, double y)
+{
+ double result;
+ int i;
+
+ if(y < 0)
+ {
+ fprintf(stderr,"Warning: got negative exponent in mypow!\n");
+ return 0.0;
+ }
+
+ if(y == 0)
+ return 1.0;
+
+ if(y == 1)
+ return x;
+
+ result = x;
+
+ for(i=0;i<y-1;i++)
+ result *= x;
+
+ return result;
+}
+
+/*****************************************************************************
+ * *
+ * init_tables *
+ * *
+ * This function initializes all the symbol tables we'll need during *
+ * parsing and code generation. *
+ * *
+ *****************************************************************************/
+
+void
+init_tables()
+{
+ if(debug)
+ printf("Initializing tables.\n");
+
+ initialize_implicit_table(implicit_table);
+ array_table = (SYMTABLE *) new_symtable(211);
+ format_table = (SYMTABLE *) new_symtable(211);
+ data_table = (SYMTABLE *) new_symtable(211);
+ save_table = (SYMTABLE *) new_symtable(211);
+ common_table = (SYMTABLE *) new_symtable(211);
+ parameter_table = (SYMTABLE *) new_symtable(211);
+ type_table = (SYMTABLE *) new_symtable(211);
+ intrinsic_table = (SYMTABLE *) new_symtable(211);
+ external_table = (SYMTABLE *) new_symtable(211);
+ args_table = (SYMTABLE *) new_symtable(211);
+ constants_table = make_dl();
+ assign_labels = make_dl();
+ equivList = NULL;
+ save_all = FALSE;
+
+ cur_do_label = 1000000;
+
+ subroutine_names = make_dl();
+ do_labels = make_dl();
+}
+
+/*****************************************************************************
+ * *
+ * merge_common_blocks *
+ * *
+ * In Fortran, different declarations of the same COMMON block may use *
+ * differently named variables. Since f2j is going to generate only one *
+ * class file to represent the COMMON block, we can only use one of these *
+ * variable names. What we attempt to do here is take the different names *
+ * and merge them into one name, which we use wherever that common variable *
+ * is used. *
+ * *
+ *****************************************************************************/
+
+void
+merge_common_blocks(AST *root)
+{
+ HASHNODE *ht;
+ AST *Clist, *temp;
+ int count;
+ char ** name_array;
+ char *comvar = NULL, *var, und_var[80],
+ var_und[80], und_var_und[80], *t;
+
+ for(Clist = root; Clist != NULL; Clist = Clist->nextstmt)
+ {
+ /*
+ * First check whether this common block is already in
+ * the table.
+ */
+
+ ht=type_lookup(common_block_table,Clist->astnode.common.name);
+
+ for(temp=Clist->astnode.common.nlist, count = 0;
+ temp!=NULL; temp=temp->nextstmt)
+ count++;
+
+ name_array = (char **) f2jalloc( count * sizeof(name_array) );
+
+ /* foreach COMMON variable */
+
+ for(temp=Clist->astnode.common.nlist, count = 0;
+ temp!=NULL; temp=temp->nextstmt, count++)
+ {
+ var = temp->astnode.ident.name;
+
+ /* to merge two names we concatenate the second name
+ * to the first name, separated by an underscore.
+ */
+
+ if(ht != NULL) {
+ comvar = ((char **)ht->variable)[count];
+ und_var[0] = '_';
+ und_var[1] = 0;
+ strcat(und_var,var);
+ strcpy(var_und,var);
+ strcat(var_und,"_");
+ strcpy(und_var_und,und_var);
+ strcat(und_var_und,"_");
+ }
+
+ if(ht == NULL) {
+ name_array[count] = (char *) f2jalloc( strlen(var) + 1 );
+ strcpy(name_array[count], var);
+ }
+ else {
+ if(!strcmp(var,comvar) ||
+ strstr(comvar,und_var_und) ||
+ (((t=strstr(comvar,var_und)) != NULL) && t == comvar) ||
+ (((t=strstr(comvar,und_var)) != NULL) &&
+ (t+strlen(t) == comvar+strlen(comvar))))
+ {
+ name_array[count] = (char *) f2jalloc( strlen(comvar) + 1 );
+ strcpy(name_array[count], comvar);
+ }
+ else {
+ name_array[count] = (char *) f2jalloc(strlen(temp->astnode.ident.name)
+ + strlen(((char **)ht->variable)[count]) + 2);
+
+ strcpy(name_array[count],temp->astnode.ident.name);
+ strcat(name_array[count],"_");
+ strcat(name_array[count],((char **)ht->variable)[count]);
+ }
+ }
+ }
+
+ type_insert(common_block_table, (AST *)name_array, Float,
+ Clist->astnode.common.name);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * addEquiv *
+ * *
+ * Insert the given node (which is itself a list of variables) into a list *
+ * of equivalences. We end up with a list of lists. *
+ * *
+ *****************************************************************************/
+
+void
+addEquiv(AST *node)
+{
+ static int id = 1;
+
+ /* if the list is NULL, create one */
+
+ if(equivList == NULL) {
+ equivList = addnode();
+ equivList->nodetype = Equivalence;
+ equivList->token = id++;
+ equivList->nextstmt = NULL;
+ equivList->prevstmt = NULL;
+ equivList->astnode.equiv.clist = node;
+ }
+ else {
+ AST *temp = addnode();
+
+ temp->nodetype = Equivalence;
+ temp->token = id++;
+ temp->astnode.equiv.clist = node;
+
+ temp->nextstmt = equivList;
+ temp->prevstmt = NULL;
+
+ equivList = temp;
+ }
+}
+
+/*****************************************************************************
+ * *
+ * eval_const_expr *
+ * *
+ * This function evaluates a floating-point expression which should consist *
+ * of only parameters and constants. The floating-point result is returned. *
+ * *
+ *****************************************************************************/
+
+double
+eval_const_expr(AST *root)
+{
+ HASHNODE *p;
+ double result1, result2;
+
+ if(root == NULL)
+ return 0.0;
+
+ switch (root->nodetype)
+ {
+ case Identifier:
+ if(!strcmp(root->astnode.ident.name,"*"))
+ return 0.0;
+
+ p = type_lookup(parameter_table, root->astnode.ident.name);
+
+ if(p)
+ {
+ if(p->variable->nodetype == Constant) {
+ root->vartype = p->variable->vartype;
+ return ( atof(p->variable->astnode.constant.number) );
+ }
+ }
+
+ /* else p==NULL, then the array size is specified with a
+ * variable, but we cant find it in the parameter table.
+ * it is probably an argument to the function. do nothing
+ * here, just fall through and hit the 'return 0' below. --keith
+ */
+
+ return 0.0;
+
+ case Expression:
+ if (root->astnode.expression.lhs != NULL)
+ eval_const_expr (root->astnode.expression.lhs);
+
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+
+ root->token = root->astnode.expression.rhs->token;
+
+ root->vartype = root->astnode.expression.rhs->vartype;
+
+ return (result2);
+
+ case Power:
+ result1 = eval_const_expr (root->astnode.expression.lhs);
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ return( mypow(result1,result2) );
+
+ case Binaryop:
+ result1 = eval_const_expr (root->astnode.expression.lhs);
+ result2 = eval_const_expr (root->astnode.expression.rhs);
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ if(root->astnode.expression.optype == '-')
+ return (result1 - result2);
+ else if(root->astnode.expression.optype == '+')
+ return (result1 + result2);
+ else if(root->astnode.expression.optype == '*')
+ return (result1 * result2);
+ else if(root->astnode.expression.optype == '/')
+ return (result1 / result2);
+ else
+ fprintf(stderr,"eval_const_expr: Bad optype!\n");
+ return 0.0;
+
+ case Unaryop:
+ root->vartype = root->astnode.expression.rhs->vartype;
+ /*
+ result1 = eval_const_expr (root->astnode.expression.rhs);
+ if(root->astnode.expression.minus == '-')
+ return -result1;
+ */
+ break;
+ case Constant:
+ if(debug)
+ printf("### its a constant.. %s\n", root->astnode.constant.number);
+
+ if(root->token == STRING) {
+ if(!strcmp(root->astnode.ident.name,"*"))
+ return 0.0;
+ else
+ fprintf (stderr, "String in array dec (%s)!\n",
+ root->astnode.constant.number);
+ }
+ else
+ return( atof(root->astnode.constant.number) );
+ break;
+ case ArrayIdxRange:
+ /* I dont think it really matters what the type of this node is. --kgs */
+ root->vartype = MIN(root->astnode.expression.lhs->vartype,
+ root->astnode.expression.rhs->vartype);
+ return( eval_const_expr(root->astnode.expression.rhs) -
+ eval_const_expr(root->astnode.expression.lhs) );
+
+ case Logicalop:
+ {
+ int lhs=0, rhs;
+
+ root->nodetype = Constant;
+ root->vartype = Logical;
+
+ eval_const_expr(root->astnode.expression.lhs);
+ eval_const_expr(root->astnode.expression.rhs);
+
+ if(root->token != NOT)
+ lhs = root->astnode.expression.lhs->token == TrUE;
+ rhs = root->astnode.expression.rhs->token == TrUE;
+
+ switch (root->token) {
+ case EQV:
+ root->token = (lhs == rhs) ? TrUE : FaLSE;
+ break;
+ case NEQV:
+ root->token = (lhs != rhs) ? TrUE : FaLSE;
+ break;
+ case AND:
+ root->token = (lhs && rhs) ? TrUE : FaLSE;
+ break;
+ case OR:
+ root->token = (lhs || rhs) ? TrUE : FaLSE;
+ break;
+ case NOT:
+ root->token = (! rhs) ? TrUE : FaLSE;
+ break;
+ }
+ return (double)root->token;
+ }
+
+ default:
+ fprintf(stderr,"eval_const_expr(): bad nodetype!\n");
+ return 0.0;
+ }
+ return 0.0;
+}
+
+void
+printbits(char *header, void *var, int datalen)
+{
+ int i;
+
+ printf("%s: ", header);
+ for(i=0;i<datalen;i++) {
+ printf("%1x", ((unsigned char *)var)[i] >> 7 );
+ printf("%1x", ((unsigned char *)var)[i] >> 6 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 5 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 4 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 3 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 2 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] >> 1 & 1 );
+ printf("%1x", ((unsigned char *)var)[i] & 1 );
+ }
+ printf("\n");
+}
+
+/*****************************************************************************
+ * *
+ * unary_negate_string *
+ * *
+ * This function accepts a string and prepends a '-' in front of it. *
+ * *
+ *****************************************************************************/
+
+char *
+unary_negate_string(char *num)
+{
+ char *tempstr, *mchar;
+
+ /* allocate enough for the number, minus sign, and null char */
+ tempstr = (char *)f2jalloc(strlen(num) + 5);
+
+ if(!tempstr) return NULL;
+
+ strcpy(tempstr, num);
+
+ if((mchar = first_char_is_minus(tempstr)) != NULL) {
+ *mchar = ' ';
+ return tempstr;
+ }
+
+ strcpy(tempstr,"-");
+ strcat(tempstr,num);
+
+ return tempstr;
+}
+
+/*****************************************************************************
+ * *
+ * first_char_is_minus *
+ * *
+ * Determines whether the number represented by this string is negative. *
+ * If negative, this function returns a pointer to the minus sign. if non- *
+ * negative, returns NULL. *
+ * *
+ *****************************************************************************/
+
+char *
+first_char_is_minus(char *num)
+{
+ char *ptr = num;
+
+ while( *ptr ) {
+ if( *ptr == '-' )
+ return ptr;
+ if( *ptr != ' ' )
+ return NULL;
+ ptr++;
+ }
+
+ return NULL;
+}
+
+/*****************************************************************************
+ * *
+ * gen_incr_expr *
+ * *
+ * this function creates an AST sub-tree representing a calculation of the *
+ * increment for this loop. for null increments, add one. for non-null *
+ * increments, add the appropriate value.
+ * *
+ *****************************************************************************/
+
+AST *
+gen_incr_expr(AST *counter, AST *incr)
+{
+ AST *plus_node, *const_node, *assign_node, *lhs_copy, *rhs_copy, *incr_copy;
+
+ lhs_copy = addnode();
+ memcpy(lhs_copy, counter, sizeof(AST));
+ rhs_copy = addnode();
+ memcpy(rhs_copy, counter, sizeof(AST));
+
+ if(incr == NULL) {
+ const_node = addnode();
+ const_node->token = INTEGER;
+ const_node->nodetype = Constant;
+ const_node->astnode.constant.number = strdup("1");
+ const_node->vartype = Integer;
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ rhs_copy->parent = plus_node;
+ const_node->parent = plus_node;
+ plus_node->astnode.expression.lhs = rhs_copy;
+ plus_node->astnode.expression.rhs = const_node;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+ }
+ else {
+ incr_copy = addnode();
+ memcpy(incr_copy, incr, sizeof(AST));
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ rhs_copy->parent = plus_node;
+ incr_copy->parent = plus_node;
+ plus_node->astnode.expression.lhs = rhs_copy;
+ plus_node->astnode.expression.rhs = incr_copy;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+ }
+
+ assign_node = addnode();
+ assign_node->nodetype = Assignment;
+ lhs_copy->parent = assign_node;
+ plus_node->parent = assign_node;
+ assign_node->astnode.assignment.lhs = lhs_copy;
+ assign_node->astnode.assignment.rhs = plus_node;
+
+ return assign_node;
+}
+
+/*****************************************************************************
+ * *
+ * gen_iter_expr *
+ * *
+ * this function creates an AST sub-tree representing a calculation of the *
+ * number of iterations of a DO loop: *
+ * (stop-start+incr)/incr *
+ * the full expression is MAX(INT((stop-start+incr)/incr),0) but we will *
+ * worry about the rest of it at code generation time. *
+ * *
+ *****************************************************************************/
+
+AST *
+gen_iter_expr(AST *start, AST *stop, AST *incr)
+{
+ AST *minus_node, *plus_node, *div_node, *expr_node, *incr_node;
+
+ minus_node = addnode();
+ minus_node->token = MINUS;
+ minus_node->astnode.expression.lhs = stop;
+ minus_node->astnode.expression.rhs = start;
+ minus_node->nodetype = Binaryop;
+ minus_node->astnode.expression.optype = '-';
+
+ if(incr == NULL) {
+ incr_node = addnode();
+ incr_node->token = INTEGER;
+ incr_node->nodetype = Constant;
+ incr_node->astnode.constant.number = strdup("1");
+ incr_node->vartype = Integer;
+ }
+ else
+ incr_node = incr;
+
+ plus_node = addnode();
+ plus_node->token = PLUS;
+ plus_node->astnode.expression.lhs = minus_node;
+ plus_node->astnode.expression.rhs = incr_node;
+ plus_node->nodetype = Binaryop;
+ plus_node->astnode.expression.optype = '+';
+
+ if(incr == NULL)
+ return plus_node;
+
+ expr_node = addnode();
+ expr_node->nodetype = Expression;
+ expr_node->astnode.expression.parens = TRUE;
+ expr_node->astnode.expression.rhs = plus_node;
+ expr_node->astnode.expression.lhs = NULL;
+
+ div_node = addnode();
+ div_node->token = DIV;
+ div_node->astnode.expression.lhs = expr_node;
+ div_node->astnode.expression.rhs = incr_node;
+ div_node->nodetype = Binaryop;
+ div_node->astnode.expression.optype = '/';
+
+ return div_node;
+}
+
+/*****************************************************************************
+ * *
+ * initialize_name *
+ * *
+ * this function initializes an Identifier node with the given name. *
+ * *
+ *****************************************************************************/
+
+AST *
+initialize_name(char *id)
+{
+ HASHNODE *hashtemp;
+ AST *tmp, *tnode;
+ char *tempname;
+
+ if(debug)
+ printf("initialize_name: '%s'\n",id);
+
+ tmp=addnode();
+ tmp->token = NAME;
+ tmp->nodetype = Identifier;
+
+ tmp->astnode.ident.needs_declaration = FALSE;
+ tmp->astnode.ident.explicit = FALSE;
+ tmp->astnode.ident.which_implicit = INTRIN_NOT_NAMED;
+ tmp->astnode.ident.localvnum = -1;
+ tmp->astnode.ident.array_len = -1;
+
+ if(omitWrappers)
+ tmp->astnode.ident.passByRef = FALSE;
+
+ if(type_lookup(java_keyword_table,id))
+ id[0] = toupper(id[0]);
+
+ strcpy(tmp->astnode.ident.name, id);
+ tempname = strdup(tmp->astnode.ident.name);
+ uppercase(tempname);
+
+ if((type_lookup(parameter_table, tmp->astnode.ident.name) == NULL) &&
+ (in_dlist(subroutine_names, tmp->astnode.ident.name) == 0))
+ {
+ if(type_table) {
+ hashtemp = type_lookup(type_table, tmp->astnode.ident.name);
+ if(hashtemp)
+ {
+ if(debug)
+ printf("initialize_name:'%s' in already hash table (type=%s)..\n",
+ id, returnstring[hashtemp->variable->vartype]);
+
+ tmp->vartype = hashtemp->variable->vartype;
+
+ if(debug)
+ printf("now type is %s\n", returnstring[tmp->vartype]);
+
+ tmp->astnode.ident.len = hashtemp->variable->astnode.ident.len;
+ }
+ else
+ {
+ enum returntype ret;
+
+ if(debug)
+ printf("initialize_name:cannot find name %s in hash table..\n",id);
+
+ if(methodscan(intrinsic_toks, tempname) != NULL) {
+ tmp->astnode.ident.which_implicit =
+ intrinsic_or_implicit(tmp->astnode.ident.name);
+ }
+
+ ret = implicit_table[tolower(id[0]) - 'a'].type;
+
+ if(debug)
+ printf("initialize_name:insert with default implicit type %s\n",
+ returnstring[ret]);
+
+ tmp->vartype = ret;
+
+ if(debug)
+ printf("type_insert: %s %d\n", tmp->astnode.ident.name,
+ tmp->nodetype);
+
+ /* clone the ast node before inserting into the table */
+ tnode = clone_ident(tmp);
+ tnode->nodetype = Identifier;
+
+ if(tmp->astnode.ident.which_implicit !=
+ INTRIN_NAMED_ARRAY_OR_FUNC_CALL)
+ {
+ if(debug)
+ printf("insert typetable init name\n");
+
+ type_insert(type_table, tnode, ret, tnode->astnode.ident.name);
+ }
+ }
+ }
+ }
+
+ return tmp;
+}
+
+/*****************************************************************************
+* *
+* intrinsic_or_implict *
+* *
+* Only gets called if it is an intrinsic name. *
+* *
+* this functions tries to figure out if it's intrinsic call, array *
+* or variable. *
+* *
+******************************************************************************/
+
+int
+intrinsic_or_implicit(char *name)
+{
+ char *p, *tempname, *space_buffer, *clean_buffer, *tmp_spot;
+ char *words[12] = {"INTEGER", "DOUBLEPRECISION", "CHARACTER", "DATA",
+ "PARAMETER", "LOGICAL", "INTRINSIC", "EXTERNAL",
+ "SAVE", "IMPLICIT", "DIMENSION", "CALL"};
+ int i, ret_val = INTRIN_NAMED_VARIABLE;
+
+ tempname = (char *)malloc((strlen(name)+2)*sizeof(char));
+ space_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char));
+ clean_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char));
+
+ strcpy(tempname, name);
+ uppercase(tempname);
+ strcat(tempname, "(");
+
+ uppercase(line_buffer);
+
+ tmp_spot = line_buffer;
+ for(i=0; i<12; i++) {
+ if(!strncmp(line_buffer, words[i], strlen(words[i]))) {
+ tmp_spot = line_buffer + strlen(words[i]);
+ break;
+ }
+ }
+ strcpy(clean_buffer, " \0");
+ strcat(clean_buffer, tmp_spot);
+
+ p = strstr(clean_buffer, tempname);
+ while(p) {
+ if((p)&&(!isalpha((int)*(p-1)))) {
+ ret_val=INTRIN_NAMED_ARRAY_OR_FUNC_CALL;
+ break;
+ }
+ for(i=0; i< strlen(tempname); i++)
+ p++;
+ strcpy(space_buffer, " \0");
+ strcat(space_buffer, p);
+ p = strstr(space_buffer, tempname);
+ }
+
+ free(space_buffer);
+ free(clean_buffer);
+ free(tempname);
+
+ return ret_val;
+}
+
+/*****************************************************************************
+ * *
+ * print_sym_table_names *
+ * *
+ * Routine to see what's in the symbol table. *
+ * *
+ *****************************************************************************/
+
+void
+print_sym_table_names(SYMTABLE *table){
+ Dlist t_table, tmp;
+ AST *node;
+
+ t_table = enumerate_symtable(table);
+ dl_traverse(tmp, t_table){
+
+ node = (AST *)dl_val(tmp);
+ printf("sym_table %s\n", node->astnode.ident.name);
+ }
+}
+
+/*****************************************************************************
+ * *
+ * insert_name *
+ * *
+ * this function inserts the given node into the symbol table, if it is not *
+ * already there. *
+ * *
+ *****************************************************************************/
+
+void
+insert_name(SYMTABLE * tt, AST *node, enum returntype ret)
+{
+ HASHNODE *hash_entry;
+
+ hash_entry = type_lookup(tt,node->astnode.ident.name);
+
+ if(hash_entry == NULL)
+ node->vartype = ret;
+ else
+ node->vartype = hash_entry->variable->vartype;
+
+ type_insert(tt, node, node->vartype, node->astnode.ident.name);
+}
+
+
+/*****************************************************************************
+ * *
+ * initialize_implicit_table *
+ * *
+ * this function the implicit table, which indicates the implicit typing for *
+ * the current program unit (i.e. which letters correspond to which data *
+ * type). *
+ * *
+ *****************************************************************************/
+
+void
+initialize_implicit_table(ITAB_ENTRY *itab)
+{
+ int i;
+
+ /* first initialize everything to float */
+ for(i = 0; i < 26; i++) {
+ itab[i].type = Float;
+ itab[i].declared = FALSE;
+ }
+
+ /* then change 'i' through 'n' to Integer */
+ for(i = 'i' - 'a'; i <= 'n' - 'a'; i++)
+ itab[i].type = Integer;
+}
+
+/*****************************************************************************
+ * *
+ * add_implicit_to_tree *
+ * *
+ * this adds a node for an implicit variable to typedec *
+ * *
+ *****************************************************************************/
+
+void
+add_implicit_to_tree(AST *typedec)
+{
+ Dlist t_table, tmp;
+ AST *ast, *new_node, *last_typedec;
+
+ last_typedec = typedec;
+ while(last_typedec->nextstmt!=NULL) {
+ last_typedec = last_typedec->nextstmt;
+ }
+
+ t_table = enumerate_symtable(type_table);
+ dl_traverse(tmp, t_table) {
+ ast = (AST *)dl_val(tmp);
+ if(ast->astnode.ident.explicit == FALSE) {
+ if(debug)printf("implicit name=%s\n", ast->astnode.ident.name);
+
+ new_node = addnode();
+ new_node->astnode.typeunit.returns = ast->vartype;
+ new_node->nodetype = Typedec;
+ ast->parent = new_node;
+ new_node->astnode.typeunit.declist = clone_ident(ast);
+ last_typedec->nextstmt = new_node;
+ last_typedec = last_typedec->nextstmt;
+ }
+ }
+}
+
+/*****************************************************************************
+ * *
+ * clone_ident *
+ * *
+ * this function clones an astnode(ident) and passes back the new node *
+ * *
+ *****************************************************************************/
+
+AST *
+clone_ident(AST *ast)
+{
+ AST *new_node;
+ int i;
+
+ new_node = addnode();
+
+ new_node->parent = ast->parent;
+ new_node->vartype = ast->vartype;
+
+ new_node->astnode.ident.dim = ast->astnode.ident.dim;
+ new_node->astnode.ident.position = ast->astnode.ident.position;
+ new_node->astnode.ident.len = ast->astnode.ident.len;
+ new_node->astnode.ident.localvnum = ast->astnode.ident.localvnum;
+ new_node->astnode.ident.which_implicit = ast->astnode.ident.which_implicit;
+
+ new_node->astnode.ident.passByRef = ast->astnode.ident.passByRef;
+ new_node->astnode.ident.needs_declaration =
+ ast->astnode.ident.needs_declaration;
+ new_node->astnode.ident.explicit = FALSE;
+
+ for(i=0; i<=MAX_ARRAY_DIM; i++) {
+ new_node->astnode.ident.startDim[i] = ast->astnode.ident.startDim[i];
+ new_node->astnode.ident.endDim[i] = ast->astnode.ident.endDim[i];
+ }
+
+ new_node->astnode.ident.arraylist = ast->astnode.ident.arraylist;
+
+ if(ast->astnode.ident.leaddim)
+ new_node->astnode.ident.leaddim = strdup(ast->astnode.ident.leaddim);
+
+ if(ast->astnode.ident.opcode)
+ new_node->astnode.ident.opcode = strdup(ast->astnode.ident.opcode);
+
+ if(ast->astnode.ident.commonBlockName)
+ new_node->astnode.ident.commonBlockName =
+ strdup(ast->astnode.ident.commonBlockName);
+
+ strcpy(new_node->astnode.ident.name, ast->astnode.ident.name);
+
+ if(ast->astnode.ident.merged_name)
+ new_node->astnode.ident.merged_name =
+ strdup(ast->astnode.ident.merged_name);
+
+ if(ast->astnode.ident.descriptor)
+ new_node->astnode.ident.descriptor =
+ strdup(ast->astnode.ident.descriptor);
+
+ return new_node;
+}
+
+/*****************************************************************************
+ * *
+ * in_dlist *
+ * *
+ * Returns 1 if the given name is in the list, returns 0 otherwise. *
+ * Assumes that the list contains char pointers. *
+ * *
+ *****************************************************************************/
+
+int
+in_dlist(Dlist list, char *name)
+{
+ Dlist ptr;
+ char *list_name;
+
+ dl_traverse(ptr, list){
+ list_name = (char *)dl_val(ptr);
+ if(!strcmp(list_name, name))
+ return 1;
+ }
+
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * in_dlist_stmt_label *
+ * *
+ * Returns 1 if the given label is in the list, returns 0 otherwise. *
+ * Assumes that the list contains AST pointers. *
+ * *
+ *****************************************************************************/
+
+int
+in_dlist_stmt_label(Dlist list, AST *label)
+{
+ Dlist ptr;
+ AST *tmp;
+
+ dl_traverse(ptr, list){
+ tmp = (AST *)dl_val(ptr);
+
+ if(!strcmp(tmp->astnode.constant.number, label->astnode.constant.number))
+ return 1;
+ }
+
+ return 0;
+}
+
+/*****************************************************************************
+ * *
+ * process_typestmt *
+ * *
+ * Performs processing to handle a list of variable declarations. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_typestmt(enum returntype this_type, AST *tvlist)
+{
+ AST *temp, *new;
+ enum returntype ret;
+ HASHNODE *hashtemp, *hashtemp2;
+
+ new = addnode();
+ free_ast_node(tvlist->parent);
+ tvlist = switchem(tvlist);
+ new->nodetype = Typedec;
+
+ for(temp = tvlist; temp != NULL; temp = temp->nextstmt)
+ {
+ temp->vartype = this_type;
+ ret = this_type;
+ if(temp->astnode.ident.len < 0)
+ temp->astnode.ident.len = len;
+ temp->parent = new;
+
+ hashtemp = type_lookup(args_table, temp->astnode.ident.name);
+ if(hashtemp)
+ hashtemp->variable->vartype = this_type;
+
+ hashtemp2 = type_lookup(type_table, temp->astnode.ident.name);
+ if(hashtemp2) {
+ temp->vartype = this_type;
+ temp->astnode.ident.explicit = TRUE;
+ hashtemp2->variable = temp;
+ if(debug) printf("explicit: %s\n",
+ hashtemp2->variable->astnode.ident.name);
+ }
+
+ if(hashtemp) {
+ if(temp->vartype != hashtemp->variable->vartype){
+ if(debug) printf("different vartypes\n");
+ hashtemp->variable->vartype=temp->vartype;
+ hashtemp2->variable->vartype=temp->vartype;
+ }
+ }
+ }
+
+ new->astnode.typeunit.declist = tvlist;
+ new->astnode.typeunit.returns = this_type;
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * process_array_declaration *
+ * *
+ * Performs processing to handle an array declaration. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_array_declaration(AST *varname, AST *dimlist)
+{
+ AST *new, *temp, *tmp, *tnode;
+ int count, i, alen;
+ char *tempname, *id;
+ enum returntype ret;
+
+ if(debug)
+ printf("we have an array declaration %s\n", varname->astnode.ident.name);
+
+ tempname = strdup(varname->astnode.ident.name);
+ uppercase(tempname);
+
+ /* put in type table. we now know this intrinsic name is an array */
+ if(methodscan(intrinsic_toks, tempname) != NULL) {
+ tmp=addnode();
+
+ tmp->token = NAME;
+ tmp->nodetype = Identifier;
+ tmp->astnode.ident.needs_declaration = FALSE;
+ tmp->astnode.ident.explicit = FALSE;
+ tmp->astnode.ident.localvnum = -1;
+
+ id = strdup(varname->astnode.ident.name);
+ strcpy(tmp->astnode.ident.name, id);
+
+ ret = implicit_table[tolower(id[0]) - 'a'].type;
+ tmp->vartype = ret;
+
+ tnode = clone_ident(tmp);
+ tnode->nodetype = Identifier;
+ tnode->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY;
+
+ type_insert(type_table, tnode, ret, tnode->astnode.ident.name);
+ }
+
+ new = varname;
+
+ if(debug)
+ printf("reduced arraydeclaration... calling switchem\n");
+ new->astnode.ident.arraylist = switchem(dimlist);
+
+ count = 0;
+ for(temp=new->astnode.ident.arraylist; temp != NULL; temp=temp->nextstmt)
+ count++;
+
+ if(count > MAX_ARRAY_DIM) {
+ fprintf(stderr,"Error: array %s exceeds max ", new->astnode.ident.name);
+ fprintf(stderr,"number of dimensions: %d\n", MAX_ARRAY_DIM);
+ exit(EXIT_FAILURE);
+ }
+
+ new->astnode.ident.dim = count;
+
+ /*
+ * If this is a one-dimensional one-length character array, for example:
+ * character foo(12)
+ * character*1 bar(12)
+ * then don't treat as an array. Set dimension to zero and arraylist
+ * to NULL. Save the arraylist in startDim[2] since we will need it
+ * during code generation.
+ */
+
+ if((typedec_context == String) && (len == 1) && (count == 1)) {
+ new->astnode.ident.dim = 0;
+ new->astnode.ident.startDim[2] = new->astnode.ident.arraylist;
+ new->astnode.ident.arraylist = NULL;
+ return new;
+ }
+
+ alen = 1;
+
+ for(temp = new->astnode.ident.arraylist, i = 0;
+ temp != NULL;
+ temp=temp->nextstmt, i++)
+ {
+ /* if this dimension is an implied size, then set both
+ * start and end to NULL.
+ */
+
+ if((temp->nodetype == Identifier) &&
+ (temp->astnode.ident.name[0] == '*'))
+ {
+ new->astnode.ident.startDim[i] = NULL;
+ new->astnode.ident.endDim[i] = NULL;
+ alen = 0;
+ }
+ else if(temp->nodetype == ArrayIdxRange) {
+ new->astnode.ident.startDim[i] = temp->astnode.expression.lhs;
+ new->astnode.ident.endDim[i] = temp->astnode.expression.rhs;
+ alen *= (int)(eval_const_expr(new->astnode.ident.endDim[i]) -
+ eval_const_expr(new->astnode.ident.startDim[i])) + 1;
+ }
+ else {
+ new->astnode.ident.startDim[i] = NULL;
+ new->astnode.ident.endDim[i] = temp;
+ alen *= (int) eval_const_expr(new->astnode.ident.endDim[i]);
+ }
+ }
+
+ if(alen)
+ new->astnode.ident.array_len = alen;
+ else
+ new->astnode.ident.array_len = -1;
+
+ new->astnode.ident.leaddim = NULL;
+
+ /* leaddim might be a constant, so check for that. --keith */
+ if(new->astnode.ident.arraylist->nodetype == Constant)
+ {
+ new->astnode.ident.leaddim =
+ strdup(new->astnode.ident.arraylist->astnode.constant.number);
+ }
+ else {
+ new->astnode.ident.leaddim =
+ strdup(new->astnode.ident.arraylist->astnode.ident.name);
+ }
+
+ store_array_var(new);
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * process_subroutine_call *
+ * *
+ * Performs processing to handle a subroutine/function call or array access. *
+ * *
+ *****************************************************************************/
+
+AST *
+process_subroutine_call(AST *varname, AST *explist)
+{
+ char *tempname;
+ AST *new;
+
+ new = addnode();
+ varname->parent = new;
+
+ if(explist != NULL)
+ strcpy(explist->parent->astnode.ident.name,
+ varname->astnode.ident.name);
+
+ /*
+ * Here we could look up the name in the array table and set
+ * the nodetype to ArrayAccess if it is found. Then the code
+ * generator could easily distinguish between array accesses
+ * and function calls. I'll have to implement the rest of
+ * this soon. -- Keith
+ *
+ * if(type_lookup(array_table, varname->astnode.ident.name))
+ * new->nodetype = ArrayAccess;
+ * else
+ * new->nodetype = Identifier;
+ */
+
+ new->nodetype = Identifier;
+
+ strcpy(new->astnode.ident.name, varname->astnode.ident.name);
+
+ /* We don't switch index order. */
+ if(explist == NULL) {
+ new->astnode.ident.arraylist = addnode();
+ new->astnode.ident.arraylist->nodetype = EmptyArgList;
+ }
+ else
+ new->astnode.ident.arraylist = switchem(explist);
+
+ tempname = strdup(new->astnode.ident.name);
+ uppercase(tempname);
+
+ if(!type_lookup(external_table, new->astnode.ident.name) &&
+ !type_lookup(array_table, new->astnode.ident.name) &&
+ methodscan(intrinsic_toks, tempname))
+ {
+ HASHNODE *ife;
+
+ /* this must be an intrinsic function call, so remove
+ * the entry from the type table (because the code
+ * generator checks whether something is an intrinsic
+ * or not by checking whether it's in the type table).
+ */
+ ife = type_lookup(type_table, new->astnode.ident.name);
+ if(ife)
+ ife = hash_delete(type_table, new->astnode.ident.name);
+ }
+
+ free_ast_node(varname);
+ free(tempname);
+
+ return new;
+}
+
+/*****************************************************************************
+ * *
+ * assign_function_return_type *
+ * *
+ * This function scans the type declarations to see if this function was *
+ * declared. If so, we reset the return type of the function to the *
+ * type declared here. e.g.: *
+ * function dlaneg(n) *
+ * integer n *
+ * integer dlaneg *
+ * Normally the function would have an implicit type of REAL, but it *
+ * will be set to INTEGER in this case. *
+ * *
+ *****************************************************************************/
+
+void
+assign_function_return_type(AST *func, AST *specs)
+{
+ AST *temp, *dec_temp;
+ HASHNODE *ht;
+
+ for(temp = specs; temp; temp=temp->nextstmt) {
+
+ if(temp->nodetype == Typedec) {
+ for(dec_temp = temp->astnode.typeunit.declist; dec_temp;
+ dec_temp = dec_temp->nextstmt)
+ {
+ if(!strcmp(dec_temp->astnode.ident.name,
+ func->astnode.source.name->astnode.ident.name))
+ {
+ func->astnode.source.returns = temp->astnode.typeunit.returns;
+ func->vartype = temp->astnode.typeunit.returns;
+ func->astnode.source.name->vartype = temp->astnode.typeunit.returns;
+
+ ht = type_lookup(type_table, dec_temp->astnode.ident.name);
+
+ /* the else case shouldn't be hit since the implied variable
+ * should have been inserted already.
+ */
+
+ if(ht)
+ ht->variable->vartype = temp->astnode.typeunit.returns;
+ else
+ insert_name(type_table, dec_temp, temp->astnode.typeunit.returns);
+ }
+ }
+ }
+ }
+}
+
diff --git a/src/y.tab.h b/src/y.tab.h
new file mode 100644
index 0000000..de8e877
--- /dev/null
+++ b/src/y.tab.h
@@ -0,0 +1,242 @@
+/* A Bison parser, made by GNU Bison 2.0. */
+
+/* Skeleton parser for Yacc-like parsing with Bison,
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004 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. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ PLUS = 258,
+ MINUS = 259,
+ OP = 260,
+ CP = 261,
+ STAR = 262,
+ POW = 263,
+ DIV = 264,
+ CAT = 265,
+ CM = 266,
+ EQ = 267,
+ COLON = 268,
+ NL = 269,
+ NOT = 270,
+ AND = 271,
+ OR = 272,
+ RELOP = 273,
+ EQV = 274,
+ NEQV = 275,
+ NAME = 276,
+ DOUBLE = 277,
+ INTEGER = 278,
+ E_EXPONENTIAL = 279,
+ D_EXPONENTIAL = 280,
+ CONST_EXP = 281,
+ TrUE = 282,
+ FaLSE = 283,
+ ICON = 284,
+ RCON = 285,
+ LCON = 286,
+ CCON = 287,
+ FLOAT = 288,
+ CHARACTER = 289,
+ LOGICAL = 290,
+ COMPLEX = 291,
+ NONE = 292,
+ IF = 293,
+ THEN = 294,
+ ELSE = 295,
+ ELSEIF = 296,
+ ENDIF = 297,
+ DO = 298,
+ GOTO = 299,
+ ASSIGN = 300,
+ TO = 301,
+ CONTINUE = 302,
+ STOP = 303,
+ RDWR = 304,
+ END = 305,
+ ENDDO = 306,
+ STRING = 307,
+ CHAR = 308,
+ PAUSE = 309,
+ OPEN = 310,
+ CLOSE = 311,
+ BACKSPACE = 312,
+ REWIND = 313,
+ ENDFILE = 314,
+ FORMAT = 315,
+ PROGRAM = 316,
+ FUNCTION = 317,
+ SUBROUTINE = 318,
+ ENTRY = 319,
+ CALL = 320,
+ RETURN = 321,
+ ARITH_TYPE = 322,
+ CHAR_TYPE = 323,
+ DIMENSION = 324,
+ INCLUDE = 325,
+ COMMON = 326,
+ EQUIVALENCE = 327,
+ EXTERNAL = 328,
+ PARAMETER = 329,
+ INTRINSIC = 330,
+ IMPLICIT = 331,
+ SAVE = 332,
+ DATA = 333,
+ COMMENT = 334,
+ READ = 335,
+ WRITE = 336,
+ PRINT = 337,
+ FMT = 338,
+ EDIT_DESC = 339,
+ REPEAT = 340,
+ OPEN_IOSTAT = 341,
+ OPEN_ERR = 342,
+ OPEN_FILE = 343,
+ OPEN_STATUS = 344,
+ OPEN_ACCESS = 345,
+ OPEN_FORM = 346,
+ OPEN_UNIT = 347,
+ OPEN_RECL = 348,
+ OPEN_BLANK = 349,
+ LOWER_THAN_COMMENT = 350
+ };
+#endif
+#define PLUS 258
+#define MINUS 259
+#define OP 260
+#define CP 261
+#define STAR 262
+#define POW 263
+#define DIV 264
+#define CAT 265
+#define CM 266
+#define EQ 267
+#define COLON 268
+#define NL 269
+#define NOT 270
+#define AND 271
+#define OR 272
+#define RELOP 273
+#define EQV 274
+#define NEQV 275
+#define NAME 276
+#define DOUBLE 277
+#define INTEGER 278
+#define E_EXPONENTIAL 279
+#define D_EXPONENTIAL 280
+#define CONST_EXP 281
+#define TrUE 282
+#define FaLSE 283
+#define ICON 284
+#define RCON 285
+#define LCON 286
+#define CCON 287
+#define FLOAT 288
+#define CHARACTER 289
+#define LOGICAL 290
+#define COMPLEX 291
+#define NONE 292
+#define IF 293
+#define THEN 294
+#define ELSE 295
+#define ELSEIF 296
+#define ENDIF 297
+#define DO 298
+#define GOTO 299
+#define ASSIGN 300
+#define TO 301
+#define CONTINUE 302
+#define STOP 303
+#define RDWR 304
+#define END 305
+#define ENDDO 306
+#define STRING 307
+#define CHAR 308
+#define PAUSE 309
+#define OPEN 310
+#define CLOSE 311
+#define BACKSPACE 312
+#define REWIND 313
+#define ENDFILE 314
+#define FORMAT 315
+#define PROGRAM 316
+#define FUNCTION 317
+#define SUBROUTINE 318
+#define ENTRY 319
+#define CALL 320
+#define RETURN 321
+#define ARITH_TYPE 322
+#define CHAR_TYPE 323
+#define DIMENSION 324
+#define INCLUDE 325
+#define COMMON 326
+#define EQUIVALENCE 327
+#define EXTERNAL 328
+#define PARAMETER 329
+#define INTRINSIC 330
+#define IMPLICIT 331
+#define SAVE 332
+#define DATA 333
+#define COMMENT 334
+#define READ 335
+#define WRITE 336
+#define PRINT 337
+#define FMT 338
+#define EDIT_DESC 339
+#define REPEAT 340
+#define OPEN_IOSTAT 341
+#define OPEN_ERR 342
+#define OPEN_FILE 343
+#define OPEN_STATUS 344
+#define OPEN_ACCESS 345
+#define OPEN_FORM 346
+#define OPEN_UNIT 347
+#define OPEN_RECL 348
+#define OPEN_BLANK 349
+#define LOWER_THAN_COMMENT 350
+
+
+
+
+#if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED)
+#line 120 "f2jparse.y"
+typedef union YYSTYPE {
+ struct ast_node *ptnode;
+ int tok;
+ enum returntype type;
+ char lexeme[YYTEXTLEN];
+} YYSTYPE;
+/* Line 1318 of yacc.c. */
+#line 234 "y.tab.h"
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+extern YYSTYPE yylval;
+
+
+
diff --git a/util/Makefile b/util/Makefile
new file mode 100644
index 0000000..00df93a
--- /dev/null
+++ b/util/Makefile
@@ -0,0 +1,21 @@
+include make.def
+
+OUTDIR=obj
+JAR=jar
+
+UTIL_JAR=f2jutil.jar
+
+VER_TARGET=1.2
+
+$(UTIL_JAR):
+ mkdir -p $(OUTDIR)
+ $(JAVAC) -source $(VER_TARGET) -target $(VER_TARGET) -d $(OUTDIR) org/j_paine/formatter/*.java
+ $(JAVAC) -source $(VER_TARGET) -target $(VER_TARGET) -d $(OUTDIR) org/netlib/util/*.java
+ cd $(OUTDIR); $(JAR) cvf ../$(UTIL_JAR) .
+
+install: $(UTIL_JAR)
+ install -d -m 755 $(F2J_LIBDIR)
+ install -m 644 $(UTIL_JAR) $(F2J_LIBDIR)
+
+clean:
+ /bin/rm -rf $(OUTDIR) $(UTIL_JAR)
diff --git a/util/make.def.in b/util/make.def.in
new file mode 100644
index 0000000..6aba949
--- /dev/null
+++ b/util/make.def.in
@@ -0,0 +1,3 @@
+JAVAC=@JAVAC@
+
+F2J_LIBDIR=@F2J_INSTALL_PREFIX@/lib
diff --git a/util/org/CVS/Entries b/util/org/CVS/Entries
new file mode 100644
index 0000000..8066737
--- /dev/null
+++ b/util/org/CVS/Entries
@@ -0,0 +1,2 @@
+D/netlib////
+D/j_paine////
diff --git a/util/org/CVS/Repository b/util/org/CVS/Repository
new file mode 100644
index 0000000..b06e907
--- /dev/null
+++ b/util/org/CVS/Repository
@@ -0,0 +1 @@
+f2j/util/org
diff --git a/util/org/CVS/Root b/util/org/CVS/Root
new file mode 100644
index 0000000..f54aada
--- /dev/null
+++ b/util/org/CVS/Root
@@ -0,0 +1 @@
+:ext:keithseymour at f2j.cvs.sourceforge.net:/cvsroot/f2j
diff --git a/util/org/j_paine/CVS/Entries b/util/org/j_paine/CVS/Entries
new file mode 100644
index 0000000..11cf5b3
--- /dev/null
+++ b/util/org/j_paine/CVS/Entries
@@ -0,0 +1 @@
+D/formatter////
diff --git a/util/org/j_paine/CVS/Repository b/util/org/j_paine/CVS/Repository
new file mode 100644
index 0000000..542e224
--- /dev/null
+++ b/util/org/j_paine/CVS/Repository
@@ -0,0 +1 @@
+f2j/util/org/j_paine
diff --git a/util/org/j_paine/CVS/Root b/util/org/j_paine/CVS/Root
new file mode 100644
index 0000000..f54aada
--- /dev/null
+++ b/util/org/j_paine/CVS/Root
@@ -0,0 +1 @@
+:ext:keithseymour at f2j.cvs.sourceforge.net:/cvsroot/f2j
diff --git a/util/org/j_paine/formatter/CVS/Entries b/util/org/j_paine/formatter/CVS/Entries
new file mode 100644
index 0000000..55c7fb2
--- /dev/null
+++ b/util/org/j_paine/formatter/CVS/Entries
@@ -0,0 +1,17 @@
+/NumberParser.java/1.1/Fri Apr 13 17:39:38 2007//
+/NumberParser.jj/1.1/Fri Apr 13 17:39:36 2007//
+/NumberParserConstants.java/1.1/Fri Apr 13 17:39:38 2007//
+/NumberParserTokenManager.java/1.1/Fri Apr 13 17:39:38 2007//
+/ParseException.java/1.1/Thu Apr 12 18:15:22 2007//
+/SimpleCharStream.java/1.1/Thu Apr 12 18:19:48 2007//
+/Token.java/1.1/Thu Apr 12 18:15:22 2007//
+/TokenMgrError.java/1.1/Thu Apr 12 18:15:22 2007//
+/EndOfFileWhenStartingReadException.java/1.2/Wed May 9 21:05:40 2007//
+/FormatParser.java/1.3/Wed May 9 20:50:00 2007//
+/FormatParser.jj/1.3/Wed May 9 20:49:54 2007//
+/README/1.2/Wed May 9 21:07:57 2007//
+/FormatParserConstants.java/1.2/Wed May 9 20:50:00 2007//
+/FormatParserTokenManager.java/1.2/Wed May 9 20:50:00 2007//
+/Formatter.java/1.5/Tue Nov 13 19:52:35 2007//
+/PrintfFormat.java/1.1/Tue Nov 13 04:16:00 2007//
+D
diff --git a/util/org/j_paine/formatter/CVS/Repository b/util/org/j_paine/formatter/CVS/Repository
new file mode 100644
index 0000000..3133a22
--- /dev/null
+++ b/util/org/j_paine/formatter/CVS/Repository
@@ -0,0 +1 @@
+f2j/util/org/j_paine/formatter
diff --git a/util/org/j_paine/formatter/CVS/Root b/util/org/j_paine/formatter/CVS/Root
new file mode 100644
index 0000000..f54aada
--- /dev/null
+++ b/util/org/j_paine/formatter/CVS/Root
@@ -0,0 +1 @@
+:ext:keithseymour at f2j.cvs.sourceforge.net:/cvsroot/f2j
diff --git a/util/org/j_paine/formatter/EndOfFileWhenStartingReadException.java b/util/org/j_paine/formatter/EndOfFileWhenStartingReadException.java
new file mode 100644
index 0000000..436924c
--- /dev/null
+++ b/util/org/j_paine/formatter/EndOfFileWhenStartingReadException.java
@@ -0,0 +1,33 @@
+package org.j_paine.formatter;
+
+/* This was originally in Formatter.java, but I needed to be able to
+ * refer to this from outside the package.
+ * --kgs
+ */
+
+public class EndOfFileWhenStartingReadException extends InputFormatException
+{
+ public EndOfFileWhenStartingReadException( int vecptr,
+ String format,
+ String line,
+ int line_number
+ )
+ {
+ this( "End of file when starting read of formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ "Last line was number " + line_number + ":\n" +
+ line
+ );
+ }
+
+ public EndOfFileWhenStartingReadException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfFileWhenStartingReadException( )
+ {
+ super( );
+ }
+}
diff --git a/util/org/j_paine/formatter/FormatParser.java b/util/org/j_paine/formatter/FormatParser.java
new file mode 100644
index 0000000..991b630
--- /dev/null
+++ b/util/org/j_paine/formatter/FormatParser.java
@@ -0,0 +1,505 @@
+/* Generated By:JavaCC: Do not edit this line. FormatParser.java */
+package org.j_paine.formatter;
+
+class FormatParser implements FormatParserConstants {
+
+ static final public int Integer() throws ParseException {
+ Token t;
+ t = jj_consume_token(INTEGER);
+ {if (true) return (Integer.valueOf(t.image)).intValue();}
+ throw new Error("Missing return statement in function");
+ }
+
+/* I split FormatIOElement into FormatIOElementFloat and
+ * FormatIOElementNonFloat because a floating point edit
+ * descriptor (F, E, D, or G) may follow a P edit descriptor
+ * without a comma. --kgs
+ */
+ static final public FormatElement FormatIOElementFloat() throws ParseException {
+ FormatElement fe;
+ int w, d, m;
+ w = d = m = -1;
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case F_DESC:
+ jj_consume_token(F_DESC);
+ w = Integer();
+ jj_consume_token(13);
+ d = Integer();
+ fe=new FormatF(w,d);
+ break;
+ case D_DESC:
+ jj_consume_token(D_DESC);
+ w = Integer();
+ jj_consume_token(13);
+ d = Integer();
+ fe=new FormatE(w,d);
+ break;
+ case E_DESC:
+ jj_consume_token(E_DESC);
+ w = Integer();
+ jj_consume_token(13);
+ d = Integer();
+ fe=new FormatE(w,d);
+ break;
+ case G_DESC:
+ jj_consume_token(G_DESC);
+ w = Integer();
+ jj_consume_token(13);
+ d = Integer();
+ fe=new FormatE(w,d);
+ break;
+ default:
+ jj_la1[0] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ {if (true) return fe;}
+ throw new Error("Missing return statement in function");
+ }
+
+ static final public FormatElement FormatIOElementNonFloat() throws ParseException {
+ FormatElement fe;
+ int w, d, m;
+ w = d = m = -1;
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case A_DESC:
+ jj_consume_token(A_DESC);
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER:
+ w = Integer();
+ break;
+ default:
+ jj_la1[1] = jj_gen;
+ ;
+ }
+ fe=new FormatA(w);
+ break;
+ case I_DESC:
+ jj_consume_token(I_DESC);
+ w = Integer();
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 13:
+ jj_consume_token(13);
+ m = Integer();
+ break;
+ default:
+ jj_la1[2] = jj_gen;
+ ;
+ }
+ fe=new FormatI(w);
+ break;
+ case L_DESC:
+ jj_consume_token(L_DESC);
+ w = Integer();
+ fe=new FormatL(w);
+ break;
+ default:
+ jj_la1[3] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ {if (true) return fe;}
+ throw new Error("Missing return statement in function");
+ }
+
+// This represents a format element that transfers one
+// data item.
+ static final public FormatElement FormatNonIOElement() throws ParseException {
+ jj_consume_token(X_DESC);
+ {if (true) return new FormatX();}
+ throw new Error("Missing return statement in function");
+ }
+
+// This represents a format element that doesn't transfer
+// any data items.
+ static final public FormatElement FormatElement() throws ParseException {
+ FormatElement fe;
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case F_DESC:
+ case D_DESC:
+ case E_DESC:
+ case G_DESC:
+ fe = FormatIOElementFloat();
+ break;
+ case A_DESC:
+ case I_DESC:
+ case L_DESC:
+ fe = FormatIOElementNonFloat();
+ break;
+ case X_DESC:
+ fe = FormatNonIOElement();
+ break;
+ case P_DESC:
+ fe = FormatScale();
+ break;
+ default:
+ jj_la1[4] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ {if (true) return fe;}
+ throw new Error("Missing return statement in function");
+ }
+
+ static final public FormatElement FormatScale() throws ParseException {
+ FormatElement fe = null;
+ int r=1;
+ jj_consume_token(P_DESC);
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER:
+ case F_DESC:
+ case D_DESC:
+ case E_DESC:
+ case G_DESC:
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER:
+ r = Integer();
+ break;
+ default:
+ jj_la1[5] = jj_gen;
+ ;
+ }
+ fe = FormatIOElementFloat();
+ break;
+ default:
+ jj_la1[6] = jj_gen;
+ ;
+ }
+ {if (true) return new FormatP(r, fe);}
+ throw new Error("Missing return statement in function");
+ }
+
+ static final public FormatSlash FormatSlash() throws ParseException {
+ jj_consume_token(14);
+ {if (true) return new FormatSlash();}
+ throw new Error("Missing return statement in function");
+ }
+
+// These are a special case. Unlike other format elements,
+// Fortran permits several slashes to be concatenated without
+// commas to separate them, and you can't use a repetition
+// factor on them.
+ static final public FormatString FormatString() throws ParseException {
+ Token t;
+ String s;
+ t = jj_consume_token(STRING);
+ s = t.image;
+ s = s.substring(1,s.length()-1); // Remove the quotes.
+ {if (true) return new FormatString(s);}
+ throw new Error("Missing return statement in function");
+ }
+
+// Another special case that can't be repeated, and can be
+// concatenated to other elements without commas.
+ static final public void OptionalFormatSlashesOrStrings(Format f) throws ParseException {
+ FormatUniv fs;
+ label_1:
+ while (true) {
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case STRING:
+ case 14:
+ ;
+ break;
+ default:
+ jj_la1[7] = jj_gen;
+ break label_1;
+ }
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 14:
+ fs = FormatSlash();
+ break;
+ case STRING:
+ fs = FormatString();
+ break;
+ default:
+ jj_la1[8] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ f.addElement(fs);
+ }
+ }
+
+ static final public FormatRepeatedItem FormatRepeatedItem() throws ParseException {
+ int r=1;
+ FormatUniv fu;
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER:
+ r = Integer();
+ break;
+ default:
+ jj_la1[9] = jj_gen;
+ ;
+ }
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 15:
+ jj_consume_token(15);
+ fu = Format();
+ jj_consume_token(16);
+ break;
+ case A_DESC:
+ case P_DESC:
+ case X_DESC:
+ case I_DESC:
+ case F_DESC:
+ case D_DESC:
+ case E_DESC:
+ case G_DESC:
+ case L_DESC:
+ fu = FormatElement();
+ break;
+ default:
+ jj_la1[10] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ /* here we check whether the parsed format element is a P edit
+ * descriptor. in that case, it may have parsed a floating point
+ * edit descriptor along with it (if it followed without a comma)
+ * so return that element here. --kgs
+ */
+
+ if(fu instanceof FormatP) {
+ FormatRepeatedItem ritem;
+
+ ritem = ((FormatP)fu).getRepeatedItem();
+
+ if(ritem != null)
+ {if (true) return ritem;}
+ else
+ {if (true) return new FormatRepeatedItem( r, fu );}
+ }
+ else
+ {if (true) return new FormatRepeatedItem( r, fu );}
+ throw new Error("Missing return statement in function");
+ }
+
+ static final public void FormatGroup(Format f) throws ParseException {
+ FormatRepeatedItem fri;
+ OptionalFormatSlashesOrStrings(f);
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER:
+ case A_DESC:
+ case P_DESC:
+ case X_DESC:
+ case I_DESC:
+ case F_DESC:
+ case D_DESC:
+ case E_DESC:
+ case G_DESC:
+ case L_DESC:
+ case 15:
+ fri = FormatRepeatedItem();
+ if(fri != null) f.addElement(fri);
+ OptionalFormatSlashesOrStrings(f);
+ break;
+ default:
+ jj_la1[11] = jj_gen;
+ ;
+ }
+ }
+
+// This rather messy syntax allows us to have slashes and/or
+// strings either side of a format element or repeated group
+// without needing to separate them from each other or the element
+// with commas.
+// It also means that we can have empty format groups and format
+// groups that don't transfer any data elements. So for example,
+// the format ,/, is valid under this grammar.
+ static final public Format Format() throws ParseException {
+ FormatRepeatedItem fri;
+ Format f = new Format();
+ FormatGroup(f);
+ label_2:
+ while (true) {
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 17:
+ ;
+ break;
+ default:
+ jj_la1[12] = jj_gen;
+ break label_2;
+ }
+ jj_consume_token(17);
+ FormatGroup(f);
+ }
+ {if (true) return f;}
+ throw new Error("Missing return statement in function");
+ }
+
+ static private boolean jj_initialized_once = false;
+ static public FormatParserTokenManager token_source;
+ static SimpleCharStream jj_input_stream;
+ static public Token token, jj_nt;
+ static private int jj_ntk;
+ static private int jj_gen;
+ static final private int[] jj_la1 = new int[13];
+ static private int[] jj_la1_0;
+ static {
+ jj_la1_0();
+ }
+ private static void jj_la1_0() {
+ jj_la1_0 = new int[] {0xf00,0x4,0x2000,0x1090,0x1ff0,0x4,0xf04,0x4008,0x4008,0x4,0x9ff0,0x9ff4,0x20000,};
+ }
+
+ public FormatParser(java.io.InputStream stream) {
+ this(stream, null);
+ }
+ public FormatParser(java.io.InputStream stream, String encoding) {
+ if (jj_initialized_once) {
+ System.out.println("ERROR: Second call to constructor of static parser. You must");
+ System.out.println(" either use ReInit() or set the JavaCC option STATIC to false");
+ System.out.println(" during parser generation.");
+ throw new Error();
+ }
+ jj_initialized_once = true;
+ try { jj_input_stream = new SimpleCharStream(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); }
+ token_source = new FormatParserTokenManager(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ static public void ReInit(java.io.InputStream stream) {
+ ReInit(stream, null);
+ }
+ static public void ReInit(java.io.InputStream stream, String encoding) {
+ try { jj_input_stream.ReInit(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); }
+ token_source.ReInit(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ public FormatParser(java.io.Reader stream) {
+ if (jj_initialized_once) {
+ System.out.println("ERROR: Second call to constructor of static parser. You must");
+ System.out.println(" either use ReInit() or set the JavaCC option STATIC to false");
+ System.out.println(" during parser generation.");
+ throw new Error();
+ }
+ jj_initialized_once = true;
+ jj_input_stream = new SimpleCharStream(stream, 1, 1);
+ token_source = new FormatParserTokenManager(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ static public void ReInit(java.io.Reader stream) {
+ jj_input_stream.ReInit(stream, 1, 1);
+ token_source.ReInit(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ public FormatParser(FormatParserTokenManager tm) {
+ if (jj_initialized_once) {
+ System.out.println("ERROR: Second call to constructor of static parser. You must");
+ System.out.println(" either use ReInit() or set the JavaCC option STATIC to false");
+ System.out.println(" during parser generation.");
+ throw new Error();
+ }
+ jj_initialized_once = true;
+ token_source = tm;
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ public void ReInit(FormatParserTokenManager tm) {
+ token_source = tm;
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 13; i++) jj_la1[i] = -1;
+ }
+
+ static final private Token jj_consume_token(int kind) throws ParseException {
+ Token oldToken;
+ if ((oldToken = token).next != null) token = token.next;
+ else token = token.next = token_source.getNextToken();
+ jj_ntk = -1;
+ if (token.kind == kind) {
+ jj_gen++;
+ return token;
+ }
+ token = oldToken;
+ jj_kind = kind;
+ throw generateParseException();
+ }
+
+ static final public Token getNextToken() {
+ if (token.next != null) token = token.next;
+ else token = token.next = token_source.getNextToken();
+ jj_ntk = -1;
+ jj_gen++;
+ return token;
+ }
+
+ static final public Token getToken(int index) {
+ Token t = token;
+ for (int i = 0; i < index; i++) {
+ if (t.next != null) t = t.next;
+ else t = t.next = token_source.getNextToken();
+ }
+ return t;
+ }
+
+ static final private int jj_ntk() {
+ if ((jj_nt=token.next) == null)
+ return (jj_ntk = (token.next=token_source.getNextToken()).kind);
+ else
+ return (jj_ntk = jj_nt.kind);
+ }
+
+ static private java.util.Vector jj_expentries = new java.util.Vector();
+ static private int[] jj_expentry;
+ static private int jj_kind = -1;
+
+ static public ParseException generateParseException() {
+ jj_expentries.removeAllElements();
+ boolean[] la1tokens = new boolean[18];
+ for (int i = 0; i < 18; i++) {
+ la1tokens[i] = false;
+ }
+ if (jj_kind >= 0) {
+ la1tokens[jj_kind] = true;
+ jj_kind = -1;
+ }
+ for (int i = 0; i < 13; i++) {
+ if (jj_la1[i] == jj_gen) {
+ for (int j = 0; j < 32; j++) {
+ if ((jj_la1_0[i] & (1<<j)) != 0) {
+ la1tokens[j] = true;
+ }
+ }
+ }
+ }
+ for (int i = 0; i < 18; i++) {
+ if (la1tokens[i]) {
+ jj_expentry = new int[1];
+ jj_expentry[0] = i;
+ jj_expentries.addElement(jj_expentry);
+ }
+ }
+ int[][] exptokseq = new int[jj_expentries.size()][];
+ for (int i = 0; i < jj_expentries.size(); i++) {
+ exptokseq[i] = (int[])jj_expentries.elementAt(i);
+ }
+ return new ParseException(token, exptokseq, tokenImage);
+ }
+
+ static final public void enable_tracing() {
+ }
+
+ static final public void disable_tracing() {
+ }
+
+}
diff --git a/util/org/j_paine/formatter/FormatParser.jj b/util/org/j_paine/formatter/FormatParser.jj
new file mode 100644
index 0000000..75e29de
--- /dev/null
+++ b/util/org/j_paine/formatter/FormatParser.jj
@@ -0,0 +1,235 @@
+/* FormatParser.java */
+
+
+/*
+This parser parses Fortran format strings.
+*/
+
+
+options {
+ STATIC = true;
+ DEBUG_PARSER = false;
+ DEBUG_TOKEN_MANAGER = false;
+ DEBUG_LOOKAHEAD = false;
+}
+
+PARSER_BEGIN(FormatParser)
+package org.j_paine.formatter;
+
+class FormatParser
+{
+}
+
+PARSER_END(FormatParser)
+
+
+SKIP :
+{
+ <(" ")+>
+}
+
+
+TOKEN :
+{
+ <INTEGER: (["0"-"9"])+ >
+}
+// An unsigned integer, for repetition factors, field widths, etc.
+// previously: <INTEGER: ["1"-"9"] (["0"-"9"])* >
+
+
+TOKEN :
+{
+ <STRING: "'" ( ~["'"] )* "'" >
+}
+// A string literal inside a format. We haven't implemented
+// embedded quotes yet.
+
+TOKEN : { < A_DESC : "A" | "a" > }
+TOKEN : { < P_DESC : "P" | "p" > }
+TOKEN : { < X_DESC : "X" | "x" > }
+TOKEN : { < I_DESC : "I" | "i" > }
+TOKEN : { < F_DESC : "F" | "f" > }
+TOKEN : { < D_DESC : "D" | "d" > }
+TOKEN : { < E_DESC : "E" | "e" > }
+TOKEN : { < G_DESC : "G" | "g" > }
+TOKEN : { < L_DESC : "L" | "l" > }
+
+int Integer():
+{ Token t;
+}
+{
+ t=<INTEGER>
+ { return (Integer.valueOf(t.image)).intValue(); }
+}
+
+/* I split FormatIOElement into FormatIOElementFloat and
+ * FormatIOElementNonFloat because a floating point edit
+ * descriptor (F, E, D, or G) may follow a P edit descriptor
+ * without a comma. --kgs
+ */
+
+FormatElement FormatIOElementFloat():
+{ FormatElement fe;
+ int w, d, m;
+ w = d = m = -1;
+}
+{
+// for Iw.m, ignore the .m value
+/* added D and G edit descriptors, but just use the E implementation. --kgs */
+ (
+ <F_DESC> w=Integer() "." d=Integer() { fe=new FormatF(w,d); }
+ | <D_DESC> w=Integer() "." d=Integer() { fe=new FormatE(w,d); }
+ | <E_DESC> w=Integer() "." d=Integer() { fe=new FormatE(w,d); }
+ | <G_DESC> w=Integer() "." d=Integer() { fe=new FormatE(w,d); }
+ )
+ { return fe; }
+}
+
+FormatElement FormatIOElementNonFloat():
+{ FormatElement fe;
+ int w, d, m;
+ w = d = m = -1;
+}
+{
+// for Iw.m, ignore the .m value
+/* added L edit descriptor. --kgs */
+ (
+ <A_DESC> [w=Integer()] { fe=new FormatA(w); }
+ | <I_DESC> w=Integer() ["." m=Integer()] { fe=new FormatI(w); }
+ | <L_DESC> w=Integer() { fe=new FormatL(w); }
+ )
+ { return fe; }
+}
+// This represents a format element that transfers one
+// data item.
+
+
+FormatElement FormatNonIOElement(): {}
+{
+ <X_DESC> { return new FormatX(); }
+}
+// This represents a format element that doesn't transfer
+// any data items.
+
+
+FormatElement FormatElement():
+{ FormatElement fe;
+}
+{
+ ( fe=FormatIOElementFloat()
+ | fe=FormatIOElementNonFloat()
+ | fe=FormatNonIOElement()
+ | fe=FormatScale()
+ )
+ { return fe; }
+}
+
+FormatElement FormatScale():
+{ FormatElement fe = null;
+ int r=1;
+}
+{
+ /* Commas may be omitted between a P edit descriptor and an
+ * immediately following F, E, D, or G edit descriptor (13.5.9).
+ * --kgs
+ */
+
+ <P_DESC> [ [r=Integer()] (fe=FormatIOElementFloat()) ]
+ {
+ return new FormatP(r, fe);
+ }
+}
+
+FormatSlash FormatSlash(): {}
+{
+ "/" { return new FormatSlash(); }
+}
+// These are a special case. Unlike other format elements,
+// Fortran permits several slashes to be concatenated without
+// commas to separate them, and you can't use a repetition
+// factor on them.
+
+
+FormatString FormatString():
+{ Token t;
+ String s;
+}
+{
+ ( t=<STRING> )
+ { s = t.image;
+ s = s.substring(1,s.length()-1); // Remove the quotes.
+ return new FormatString(s);
+ }
+}
+// Another special case that can't be repeated, and can be
+// concatenated to other elements without commas.
+
+
+void OptionalFormatSlashesOrStrings( Format f ):
+{ FormatUniv fs;
+}
+{
+ ( (fs=FormatSlash() | fs=FormatString()) { f.addElement(fs); } )*
+}
+
+
+FormatRepeatedItem FormatRepeatedItem():
+{ int r=1;
+ FormatUniv fu;
+}
+{
+ [ r=Integer() ]
+ ( "(" fu=Format() ")"
+ | fu=FormatElement()
+ )
+ {
+ /* here we check whether the parsed format element is a P edit
+ * descriptor. in that case, it may have parsed a floating point
+ * edit descriptor along with it (if it followed without a comma)
+ * so return that element here. --kgs
+ */
+
+ if(fu instanceof FormatP) {
+ FormatRepeatedItem ritem;
+
+ ritem = ((FormatP)fu).getRepeatedItem();
+
+ if(ritem != null)
+ return ritem;
+ else
+ return new FormatRepeatedItem( r, fu );
+ }
+ else
+ return new FormatRepeatedItem( r, fu );
+ }
+}
+
+
+void FormatGroup( Format f ):
+{ FormatRepeatedItem fri;
+}
+{
+ ( OptionalFormatSlashesOrStrings( f )
+ [ fri = FormatRepeatedItem() { if(fri != null) f.addElement(fri); }
+ OptionalFormatSlashesOrStrings( f )
+ ]
+ )
+}
+// This rather messy syntax allows us to have slashes and/or
+// strings either side of a format element or repeated group
+// without needing to separate them from each other or the element
+// with commas.
+// It also means that we can have empty format groups and format
+// groups that don't transfer any data elements. So for example,
+// the format ,/, is valid under this grammar.
+
+
+Format Format():
+{ FormatRepeatedItem fri;
+ Format f = new Format();
+}
+{
+ ( FormatGroup(f) )
+ ( "," ( FormatGroup(f) ) )*
+ { return f; }
+}
diff --git a/util/org/j_paine/formatter/FormatParserConstants.java b/util/org/j_paine/formatter/FormatParserConstants.java
new file mode 100644
index 0000000..94aaf71
--- /dev/null
+++ b/util/org/j_paine/formatter/FormatParserConstants.java
@@ -0,0 +1,42 @@
+/* Generated By:JavaCC: Do not edit this line. FormatParserConstants.java */
+package org.j_paine.formatter;
+
+public interface FormatParserConstants {
+
+ int EOF = 0;
+ int INTEGER = 2;
+ int STRING = 3;
+ int A_DESC = 4;
+ int P_DESC = 5;
+ int X_DESC = 6;
+ int I_DESC = 7;
+ int F_DESC = 8;
+ int D_DESC = 9;
+ int E_DESC = 10;
+ int G_DESC = 11;
+ int L_DESC = 12;
+
+ int DEFAULT = 0;
+
+ String[] tokenImage = {
+ "<EOF>",
+ "<token of kind 1>",
+ "<INTEGER>",
+ "<STRING>",
+ "<A_DESC>",
+ "<P_DESC>",
+ "<X_DESC>",
+ "<I_DESC>",
+ "<F_DESC>",
+ "<D_DESC>",
+ "<E_DESC>",
+ "<G_DESC>",
+ "<L_DESC>",
+ "\".\"",
+ "\"/\"",
+ "\"(\"",
+ "\")\"",
+ "\",\"",
+ };
+
+}
diff --git a/util/org/j_paine/formatter/FormatParserTokenManager.java b/util/org/j_paine/formatter/FormatParserTokenManager.java
new file mode 100644
index 0000000..64725b3
--- /dev/null
+++ b/util/org/j_paine/formatter/FormatParserTokenManager.java
@@ -0,0 +1,408 @@
+/* Generated By:JavaCC: Do not edit this line. FormatParserTokenManager.java */
+package org.j_paine.formatter;
+
+public class FormatParserTokenManager implements FormatParserConstants
+{
+ public static java.io.PrintStream debugStream = System.out;
+ public static void setDebugStream(java.io.PrintStream ds) { debugStream = ds; }
+private static final int jjStopStringLiteralDfa_0(int pos, long active0)
+{
+ switch (pos)
+ {
+ default :
+ return -1;
+ }
+}
+private static final int jjStartNfa_0(int pos, long active0)
+{
+ return jjMoveNfa_0(jjStopStringLiteralDfa_0(pos, active0), pos + 1);
+}
+static private final int jjStopAtPos(int pos, int kind)
+{
+ jjmatchedKind = kind;
+ jjmatchedPos = pos;
+ return pos + 1;
+}
+static private final int jjStartNfaWithStates_0(int pos, int kind, int state)
+{
+ jjmatchedKind = kind;
+ jjmatchedPos = pos;
+ try { curChar = input_stream.readChar(); }
+ catch(java.io.IOException e) { return pos + 1; }
+ return jjMoveNfa_0(state, pos + 1);
+}
+static private final int jjMoveStringLiteralDfa0_0()
+{
+ switch(curChar)
+ {
+ case 40:
+ return jjStopAtPos(0, 15);
+ case 41:
+ return jjStopAtPos(0, 16);
+ case 44:
+ return jjStopAtPos(0, 17);
+ case 46:
+ return jjStopAtPos(0, 13);
+ case 47:
+ return jjStopAtPos(0, 14);
+ default :
+ return jjMoveNfa_0(2, 0);
+ }
+}
+static private final void jjCheckNAdd(int state)
+{
+ if (jjrounds[state] != jjround)
+ {
+ jjstateSet[jjnewStateCnt++] = state;
+ jjrounds[state] = jjround;
+ }
+}
+static private final void jjAddStates(int start, int end)
+{
+ do {
+ jjstateSet[jjnewStateCnt++] = jjnextStates[start];
+ } while (start++ != end);
+}
+static private final void jjCheckNAddTwoStates(int state1, int state2)
+{
+ jjCheckNAdd(state1);
+ jjCheckNAdd(state2);
+}
+static private final void jjCheckNAddStates(int start, int end)
+{
+ do {
+ jjCheckNAdd(jjnextStates[start]);
+ } while (start++ != end);
+}
+static private final void jjCheckNAddStates(int start)
+{
+ jjCheckNAdd(jjnextStates[start]);
+ jjCheckNAdd(jjnextStates[start + 1]);
+}
+static final long[] jjbitVec0 = {
+ 0x0L, 0x0L, 0xffffffffffffffffL, 0xffffffffffffffffL
+};
+static private final int jjMoveNfa_0(int startState, int curPos)
+{
+ int[] nextStates;
+ int startsAt = 0;
+ jjnewStateCnt = 14;
+ int i = 1;
+ jjstateSet[0] = startState;
+ int j, kind = 0x7fffffff;
+ for (;;)
+ {
+ if (++jjround == 0x7fffffff)
+ ReInitRounds();
+ if (curChar < 64)
+ {
+ long l = 1L << curChar;
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ case 2:
+ if ((0x3ff000000000000L & l) != 0L)
+ {
+ if (kind > 2)
+ kind = 2;
+ jjCheckNAdd(1);
+ }
+ else if (curChar == 39)
+ jjCheckNAddTwoStates(3, 4);
+ else if (curChar == 32)
+ {
+ if (kind > 1)
+ kind = 1;
+ jjCheckNAdd(0);
+ }
+ break;
+ case 0:
+ if (curChar != 32)
+ break;
+ if (kind > 1)
+ kind = 1;
+ jjCheckNAdd(0);
+ break;
+ case 1:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 2)
+ kind = 2;
+ jjCheckNAdd(1);
+ break;
+ case 3:
+ if ((0xffffff7fffffffffL & l) != 0L)
+ jjCheckNAddTwoStates(3, 4);
+ break;
+ case 4:
+ if (curChar == 39 && kind > 3)
+ kind = 3;
+ break;
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ else if (curChar < 128)
+ {
+ long l = 1L << (curChar & 077);
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ case 2:
+ if ((0x100000001000L & l) != 0L)
+ {
+ if (kind > 12)
+ kind = 12;
+ }
+ else if ((0x8000000080L & l) != 0L)
+ {
+ if (kind > 11)
+ kind = 11;
+ }
+ else if ((0x2000000020L & l) != 0L)
+ {
+ if (kind > 10)
+ kind = 10;
+ }
+ else if ((0x1000000010L & l) != 0L)
+ {
+ if (kind > 9)
+ kind = 9;
+ }
+ else if ((0x4000000040L & l) != 0L)
+ {
+ if (kind > 8)
+ kind = 8;
+ }
+ else if ((0x20000000200L & l) != 0L)
+ {
+ if (kind > 7)
+ kind = 7;
+ }
+ else if ((0x100000001000000L & l) != 0L)
+ {
+ if (kind > 6)
+ kind = 6;
+ }
+ else if ((0x1000000010000L & l) != 0L)
+ {
+ if (kind > 5)
+ kind = 5;
+ }
+ else if ((0x200000002L & l) != 0L)
+ {
+ if (kind > 4)
+ kind = 4;
+ }
+ break;
+ case 3:
+ jjAddStates(0, 1);
+ break;
+ case 5:
+ if ((0x200000002L & l) != 0L && kind > 4)
+ kind = 4;
+ break;
+ case 6:
+ if ((0x1000000010000L & l) != 0L && kind > 5)
+ kind = 5;
+ break;
+ case 7:
+ if ((0x100000001000000L & l) != 0L && kind > 6)
+ kind = 6;
+ break;
+ case 8:
+ if ((0x20000000200L & l) != 0L && kind > 7)
+ kind = 7;
+ break;
+ case 9:
+ if ((0x4000000040L & l) != 0L && kind > 8)
+ kind = 8;
+ break;
+ case 10:
+ if ((0x1000000010L & l) != 0L && kind > 9)
+ kind = 9;
+ break;
+ case 11:
+ if ((0x2000000020L & l) != 0L && kind > 10)
+ kind = 10;
+ break;
+ case 12:
+ if ((0x8000000080L & l) != 0L && kind > 11)
+ kind = 11;
+ break;
+ case 13:
+ if ((0x100000001000L & l) != 0L && kind > 12)
+ kind = 12;
+ break;
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ else
+ {
+ int i2 = (curChar & 0xff) >> 6;
+ long l2 = 1L << (curChar & 077);
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ case 3:
+ if ((jjbitVec0[i2] & l2) != 0L)
+ jjAddStates(0, 1);
+ break;
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ if (kind != 0x7fffffff)
+ {
+ jjmatchedKind = kind;
+ jjmatchedPos = curPos;
+ kind = 0x7fffffff;
+ }
+ ++curPos;
+ if ((i = jjnewStateCnt) == (startsAt = 14 - (jjnewStateCnt = startsAt)))
+ return curPos;
+ try { curChar = input_stream.readChar(); }
+ catch(java.io.IOException e) { return curPos; }
+ }
+}
+static final int[] jjnextStates = {
+ 3, 4,
+};
+public static final String[] jjstrLiteralImages = {
+"", null, null, null, null, null, null, null, null, null, null, null, null,
+"\56", "\57", "\50", "\51", "\54", };
+public static final String[] lexStateNames = {
+ "DEFAULT",
+};
+static final long[] jjtoToken = {
+ 0x3fffdL,
+};
+static final long[] jjtoSkip = {
+ 0x2L,
+};
+static protected SimpleCharStream input_stream;
+static private final int[] jjrounds = new int[14];
+static private final int[] jjstateSet = new int[28];
+static protected char curChar;
+public FormatParserTokenManager(SimpleCharStream stream){
+ if (input_stream != null)
+ throw new TokenMgrError("ERROR: Second call to constructor of static lexer. You must use ReInit() to initialize the static variables.", TokenMgrError.STATIC_LEXER_ERROR);
+ input_stream = stream;
+}
+public FormatParserTokenManager(SimpleCharStream stream, int lexState){
+ this(stream);
+ SwitchTo(lexState);
+}
+static public void ReInit(SimpleCharStream stream)
+{
+ jjmatchedPos = jjnewStateCnt = 0;
+ curLexState = defaultLexState;
+ input_stream = stream;
+ ReInitRounds();
+}
+static private final void ReInitRounds()
+{
+ int i;
+ jjround = 0x80000001;
+ for (i = 14; i-- > 0;)
+ jjrounds[i] = 0x80000000;
+}
+static public void ReInit(SimpleCharStream stream, int lexState)
+{
+ ReInit(stream);
+ SwitchTo(lexState);
+}
+static public void SwitchTo(int lexState)
+{
+ if (lexState >= 1 || lexState < 0)
+ throw new TokenMgrError("Error: Ignoring invalid lexical state : " + lexState + ". State unchanged.", TokenMgrError.INVALID_LEXICAL_STATE);
+ else
+ curLexState = lexState;
+}
+
+static protected Token jjFillToken()
+{
+ Token t = Token.newToken(jjmatchedKind);
+ t.kind = jjmatchedKind;
+ String im = jjstrLiteralImages[jjmatchedKind];
+ t.image = (im == null) ? input_stream.GetImage() : im;
+ t.beginLine = input_stream.getBeginLine();
+ t.beginColumn = input_stream.getBeginColumn();
+ t.endLine = input_stream.getEndLine();
+ t.endColumn = input_stream.getEndColumn();
+ return t;
+}
+
+static int curLexState = 0;
+static int defaultLexState = 0;
+static int jjnewStateCnt;
+static int jjround;
+static int jjmatchedPos;
+static int jjmatchedKind;
+
+public static Token getNextToken()
+{
+ int kind;
+ Token specialToken = null;
+ Token matchedToken;
+ int curPos = 0;
+
+ EOFLoop :
+ for (;;)
+ {
+ try
+ {
+ curChar = input_stream.BeginToken();
+ }
+ catch(java.io.IOException e)
+ {
+ jjmatchedKind = 0;
+ matchedToken = jjFillToken();
+ return matchedToken;
+ }
+
+ jjmatchedKind = 0x7fffffff;
+ jjmatchedPos = 0;
+ curPos = jjMoveStringLiteralDfa0_0();
+ if (jjmatchedKind != 0x7fffffff)
+ {
+ if (jjmatchedPos + 1 < curPos)
+ input_stream.backup(curPos - jjmatchedPos - 1);
+ if ((jjtoToken[jjmatchedKind >> 6] & (1L << (jjmatchedKind & 077))) != 0L)
+ {
+ matchedToken = jjFillToken();
+ return matchedToken;
+ }
+ else
+ {
+ continue EOFLoop;
+ }
+ }
+ int error_line = input_stream.getEndLine();
+ int error_column = input_stream.getEndColumn();
+ String error_after = null;
+ boolean EOFSeen = false;
+ try { input_stream.readChar(); input_stream.backup(1); }
+ catch (java.io.IOException e1) {
+ EOFSeen = true;
+ error_after = curPos <= 1 ? "" : input_stream.GetImage();
+ if (curChar == '\n' || curChar == '\r') {
+ error_line++;
+ error_column = 0;
+ }
+ else
+ error_column++;
+ }
+ if (!EOFSeen) {
+ input_stream.backup(1);
+ error_after = curPos <= 1 ? "" : input_stream.GetImage();
+ }
+ throw new TokenMgrError(EOFSeen, curLexState, error_line, error_column, error_after, curChar, TokenMgrError.LEXICAL_ERROR);
+ }
+}
+
+}
diff --git a/util/org/j_paine/formatter/Formatter.buffered b/util/org/j_paine/formatter/Formatter.buffered
new file mode 100644
index 0000000..c2ae182
--- /dev/null
+++ b/util/org/j_paine/formatter/Formatter.buffered
@@ -0,0 +1,1758 @@
+/* Formatter.java
+ *
+ * This is a modified version of Jocelyn Paine's Formatter package:
+ * http://www.j-paine.org/Formatter
+ *
+ * Modifications are flagged with "kgs" in the comments.
+ */
+
+package org.j_paine.formatter;
+
+import java.io.BufferedReader;
+import java.io.IOException;
+import java.io.PrintStream;
+import java.io.StringReader;
+import java.util.Hashtable;
+import java.util.Vector;
+
+
+/* This class holds a Format, and has methods for reading and
+ writing data against it.
+*/
+public class Formatter
+{
+ private Format format = null;
+ private FormatMap format_map = null;
+
+
+ public Formatter( String format ) throws InvalidFormatException
+ {
+ this( new Format(format) );
+ }
+
+ public Formatter( Format format )
+ {
+ this.format = format;
+ }
+
+
+ public void setFormatMap( FormatMap format_map )
+ {
+ this.format_map = format_map;
+ }
+
+
+ public void write( Vector v, PrintStream out )
+ throws OutputFormatException
+ {
+ FormatX dummy_el = new FormatX();
+ FormatOutputList vp = new VectorAndPointer( v );
+
+ /* Loop back around and reuse the format spec if
+ * there are still elements in the vector. Keep
+ * going until all elements in the vector have
+ * been printed. --kgs
+ */
+ while(true) {
+ try {
+ this.format.write( vp, out );
+ vp.checkCurrentElementForWrite(dummy_el);
+ out.println();
+ }catch(EndOfVectorOnWriteException e) {
+ break;
+ }
+ }
+ }
+
+ public void write( int i, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Integer(i), out );
+ }
+
+ public void write( long l, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Long(l), out );
+ }
+
+ public void write( float f, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Float(f), out );
+ }
+
+ public void write( double d, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Double(d), out );
+ }
+
+ public void write( Object o, PrintStream out )
+ throws OutputFormatException
+ {
+ Vector v = new Vector();
+ v.addElement( o );
+ write( v, out );
+ }
+
+
+ public void read( Vector v, BufferedReader in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new VectorAndPointer( v );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( Vector v, Hashtable ht, BufferedReader in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new StringsHashtableAndPointer( v, ht );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( String[] s, Hashtable ht, BufferedReader in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ for ( int i = 0; i<s.length; i++ )
+ v.addElement( s[i] );
+ read( v, ht, in );
+ }
+
+ public Object read( BufferedReader in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ read( v, in );
+ return v.elementAt(0);
+ }
+
+
+ public boolean eof( BufferedReader in )
+ throws IOException
+ {
+ return ( in.ready() );
+ }
+
+
+ public String toString()
+ {
+ return "[Formatter " + this.format.toString() + "]";
+ }
+}
+
+
+/* Below, we define various classes for holding complete formats,
+ format elements, and so on. The class FormatUniv is a superclass
+ of them all. This makes it a convenient "universal type" to
+ use to hold any piece of, or a complete, format.
+*/
+abstract class FormatUniv
+{
+ abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+
+ abstract void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException;
+}
+
+
+/* This class represents a complete format, i.e. a sequence of
+ elements such as F12.5 and so on. Some of the elements may
+ themselves be formats.
+ We implement it as a vector of elements.
+*/
+class Format extends FormatUniv
+{
+ private Vector elements = new Vector();
+
+ public Format( String s ) throws InvalidFormatException
+ {
+ FormatParser fp =
+ Parsers.theParsers().format_parser;
+// fp.ReInit( new StringBufferInputStream(s) );
+ fp.ReInit( new StringReader(s) );
+ try {
+ Format f = fp.Format();
+ this.elements = f.elements;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ }
+
+ // We call this one from inside the parser, which needs a Format
+ // with its vector initialised.
+ Format()
+ {
+ }
+
+
+ public void addElement( FormatUniv fu )
+ {
+ this.elements.addElement( fu );
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.write( vp, out );
+ }
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.read( vp, in, format_map );
+ }
+ }
+
+
+ public String toString()
+ {
+ String s = "";
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ if ( i!=0 )
+ s = s + ", ";
+ s = s + this.elements.elementAt(i).toString();
+ }
+ return s;
+ }
+}
+
+
+/* This class represents a repeated item, e.g. 3F12.5 or 3X.
+ The integer r gives the repetition factor.
+ The item may be either a format element, or an entire format.
+ To cater for either, we hold it in a FormatUniv object (this is
+ why we introduced the class FormatUniv).
+*/
+class FormatRepeatedItem extends FormatUniv
+{
+ private int r=1;
+ private FormatUniv format_univ = null;
+
+
+ public FormatRepeatedItem( FormatUniv format_univ )
+ {
+ this( 1, format_univ );
+ }
+
+ public FormatRepeatedItem( int r, FormatUniv format_univ )
+ {
+ this.r = r;
+ this.format_univ = format_univ;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.write( vp, out );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.read( vp, in, format_map );
+ }
+
+
+ public String toString()
+ {
+ if (r==1)
+ return this.format_univ.toString();
+ else
+ return this.r+"("+this.format_univ.toString()+")";
+ }
+}
+
+
+/* This class represents a single format element such as
+ F12.5, I2, or X.
+*/
+abstract class FormatElement extends FormatUniv
+{
+ /* This method will be defined differently by each subclass.
+ */
+ public abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+}
+
+
+/* This class represents a format element that reads or writes
+ data. So F12.5 or I3, but not X.
+ We assume that all format elements are fixed width.
+*/
+abstract class FormatIOElement extends FormatElement
+{
+ private int width;
+
+ void setWidth( int width )
+ {
+ this.width = width;
+ }
+
+ int getWidth()
+ {
+ return this.width;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ vp.checkCurrentElementForWrite( this );
+ Object o = vp.getCurrentElementAndAdvance();
+ out.print( convertToString(o,vp.getPtr()-1) );
+ }
+
+
+ /* This method is called by write, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to write from
+ the output list, and printing its string representation,
+ are the same for all FormatIOElements. However, the
+ conversion to string is different for each one.
+ */
+ abstract String convertToString( Object o, int vecptr )
+ throws OutputFormatException;
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ /* Get next width characters. */
+ String s = in.getSlice( this.width, vp.getPtr(), this );
+
+ /* Try translating if there's a format map. */
+ if ( format_map != null ) {
+ String repl = format_map.getMapping( s );
+ if ( repl != null )
+ s = repl;
+ }
+
+ /* Parse the string to check it's a valid number, and put into
+ the vector if so.
+ Also, advance the stream input pointer.
+ */
+ Object o = convertFromString( s, vp, in );
+ vp.checkCurrentElementForRead( this, in );
+ vp.putElementAndAdvance( o, this, in );
+ in.advance( this.width );
+ }
+
+
+ /* This method is called by read, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to read from
+ the input stream, and putting it into the input list,
+ are the same for all FormatIOElements. However, the
+ conversion from string is different for each one.
+ vp and in are used only in generating error messages.
+ */
+ abstract Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+}
+
+/* This class represents a P format element, but the scaling
+ * is not implemented yet.
+ */
+class FormatP extends FormatElement
+{
+ FormatRepeatedItem ritem = null;
+
+ public FormatRepeatedItem getRepeatedItem() {
+ return ritem;
+ }
+
+ public FormatP(int r, FormatUniv format_univ) {
+ if(format_univ != null)
+ ritem = new FormatRepeatedItem(r, format_univ);
+ }
+
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ /* the P element itself produces no output. it's a scale factor
+ * for other elements, but that isn't being handled yet.
+ */
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ /* the P element doesn't consume input. --kgs */
+ }
+
+
+ public String toString()
+ {
+ return "P";
+ }
+}
+
+
+/* This class represents an X format element.
+*/
+class FormatX extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print( " " );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ in.advance( 1 );
+ }
+
+
+ public String toString()
+ {
+ return "X";
+ }
+}
+
+
+/* This class represents an Aw format element.
+*/
+class FormatA extends FormatIOElement
+{
+ public FormatA( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ StringTooWideOnWriteException
+ {
+ String s;
+
+ if ( o instanceof String ) {
+ /* pad or truncate strings as necessary. --kgs */
+ s = (String)o;
+ if ( (getWidth() != -1) && (s.length() > getWidth()) )
+ return s.substring(0, getWidth());
+ else {
+ if(getWidth() > s.length()) {
+ char [] pad = new char[getWidth() - s.length()];
+
+ for(int i=0;i<pad.length;i++)
+ pad[i] = ' ';
+
+ return new String(pad) + s;
+ }
+ else
+ return s;
+ }
+ }
+ else {
+ char [] blah = new char[getWidth()];
+
+ /* if this is a non-string argument with an A edit descriptor,
+ * just print some nonsense. --kgs
+ */
+ for(int i=0;i<blah.length;i++)
+ blah[i] = '#';
+
+ return new String(blah);
+ }
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ int len;
+
+ len = getWidth() - s.length();
+
+ /* if the spec width is wider than the string,
+ * return a padded string. --kgs
+ */
+ if(len > 0) {
+ char [] pad = new char[len];
+ for(int i=0;i<len;i++)
+ pad[i] = ' ';
+ String padstr = new String(pad);
+
+ return s.concat(padstr);
+ }
+
+ /* We just return the slice read, as a string. */
+ return s;
+ }
+
+
+ public String toString()
+ {
+ return "A"+getWidth();
+ }
+}
+
+
+/* This class represents an Iw format element.
+*/
+class FormatI extends FormatIOElement
+{
+ public FormatI( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'i' );
+ s = cjf.form( ((Number)o).longValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else if(o instanceof String) {
+ /* String passed to I edit descriptor. try converting the
+ * first character to an integer. --kgs
+ */
+ return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr);
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+// np.ReInit( new StringBufferInputStream(s) );
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Integer();
+ Long l = new Long( s.substring(start) );
+ return l;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "I"+getWidth();
+ }
+}
+
+/*
+ * Handles logical (boolean) edit descriptors.
+ */
+
+class FormatL extends FormatIOElement
+{
+ public FormatL( int w )
+ {
+ setWidth( w );
+ }
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Boolean ) {
+ char [] b = new char[getWidth()];
+ int i;
+
+ for(i=0;i<b.length-1;i++)
+ b[i] = ' ';
+
+ b[i] = (((Boolean)o).booleanValue() == true) ? 'T' : 'F';
+
+ s = new String(b);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+// np.ReInit( new StringBufferInputStream(s) );
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Boolean();
+ char brep = s.substring(start).charAt(0);
+ Boolean b;
+
+ if(brep == 't' || brep == 'T')
+ b = new Boolean(true);
+ else if(brep == 'f' || brep == 'F')
+ b = new Boolean(false);
+ else
+ throw new ParseException("bad logical value");
+ return b;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+ public String toString()
+ {
+ return "L"+getWidth();
+ }
+}
+
+/* This class represents an Fw.d format element.
+ Numbers should be output with d decimal places.
+*/
+class FormatF extends FormatIOElement
+{
+ private int d;
+
+
+ public FormatF( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPrecision( this.d );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'f' );
+ s = cjf.form( ((Number)o).doubleValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+// np.ReInit( new StringBufferInputStream(s) );
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "F"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an Ew.d format element.
+ Numbers should be output as
+ s0.dd...ddEsdd
+ where s is a sign.
+*/
+class FormatE extends FormatIOElement
+{ int d;
+
+
+ public FormatE( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPrecision( this.d );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'E' );
+ s = cjf.form( ((Number)o).doubleValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+// np.ReInit( new StringBufferInputStream(s) );
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "E"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an / item.
+*/
+class FormatSlash extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.println();
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ in.readLine( vp.getPtr(), this );
+ }
+
+
+ public String toString()
+ {
+ return "/";
+ }
+}
+
+
+/* This class represents an embedded literal, e.g. 'Title'.
+ toString() does not yet handle embedded quotes.
+*/
+class FormatString extends FormatElement
+{
+ private String s;
+
+
+ public FormatString( String s )
+ {
+ this.s = s;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print(this.s);
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ String s = in.getSlice( this.s.length(), vp.getPtr(), this );
+ if ( !( this.s.equals(s) ) )
+ throw new UnmatchedStringOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport()
+ );
+ in.advance( this.s.length() );
+ }
+
+
+ public String toString()
+ {
+ return "'" + this.s + "'";
+ }
+}
+
+
+/* This class represents a mapping from input data. We use it to specify,
+ for example, that on input, an "X" should be replaced by a "0" before
+ being interpreted by the formatted input routines.
+ The user must provide an instance of this class, with getMapping
+ defined. getMapping should return either null, if the input string
+ is to be left as it is, or a replacement string.
+*/
+abstract class FormatMap
+{
+ public abstract String getMapping( String in );
+}
+
+
+interface FormatOutputList
+{
+ boolean hasCurrentElement();
+
+ void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException;
+
+ Object getCurrentElement();
+
+ Object getCurrentElementAndAdvance();
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+interface FormatInputList
+{
+ /* format_element and in are only for generating error messages.
+ */
+ void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+ // If the list is a VectorAndPointer, it won't throw an exception.
+ // If it is a StringsHashtableAndPointer, it will throw a
+ // EndOfKeyVectorOnReadException.
+
+ /* Puts o into the input list and advances its pointer.
+ Must be defined for each subclass.
+ format_element and in are only for generating error messages.
+ */
+ void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+/* This class represents a Vector and a current-element pointer.
+ We use it when outputting or inputting a Vector against a format:
+ the pointer keeps track of the current element being output, and
+ can be incremented by the format write and read methods.
+*/
+class VectorAndPointer implements FormatInputList, FormatOutputList
+{
+ private Vector v = null;
+ private int vecptr = 0;
+ // On output, vecptr points at the next element to be used.
+ // On input, it points at the next free slot to be filled.
+
+
+ public VectorAndPointer( Vector v )
+ {
+ this.v = v;
+ }
+
+
+ public VectorAndPointer()
+ {
+ this.v = new Vector();
+ }
+
+
+ public boolean hasCurrentElement()
+ {
+ return ( this.vecptr < this.v.size() );
+ }
+
+
+ public void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException
+ {
+ if ( !hasCurrentElement() )
+ throw new EndOfVectorOnWriteException( this.vecptr,
+ format_element.toString()
+ );
+ }
+
+
+ /* Checks that the current element in the input list is OK and
+ throws an exception if not. For this implementation of
+ FormatInputList, there are no error conditions - we
+ introduced the method for the StringHashtableAndPointer class,
+ and need it here for compatibility.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ }
+
+
+ public Object getCurrentElement()
+ {
+ return this.v.elementAt( this.vecptr );
+ }
+
+ public Object getCurrentElementAndAdvance()
+ {
+ this.vecptr = this.vecptr+1;
+ return this.v.elementAt( this.vecptr-1 );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ format_element and in are only for generating error messages,
+ and not used in this implementation, since no error conditions
+ can arise.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ this.v.addElement(o);
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ public void advance()
+ {
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vecptr;
+ }
+}
+
+
+/* This class represents a Vector of Strings and a current-element pointer.
+ We use it when inputting data against a format.
+*/
+class StringsHashtableAndPointer implements FormatInputList
+{
+ private VectorAndPointer vp;
+ private Hashtable ht;
+
+
+ public StringsHashtableAndPointer( Vector strings, Hashtable ht )
+ {
+ this.vp = new VectorAndPointer( strings );
+ this.ht = ht;
+ }
+
+
+ /* Checks that there is a current element in the key vector, and
+ throws an exception if not.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws EndOfKeyVectorOnReadException
+ {
+ if ( !(this.vp.hasCurrentElement() ) )
+ throw new EndOfKeyVectorOnReadException( this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ In this implementation, that means getting the current key,
+ putting o into an appropriate hashtable slot, and advancing
+ the pointer in the vector of keys.
+ format_element and in are only for generating error messages.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws KeyNotStringOnReadException
+ {
+ Object current_key = this.vp.getCurrentElement();
+ if ( current_key instanceof String ) {
+ this.ht.put( (String)current_key, o );
+ this.vp.advance();
+ }
+ else
+ throw new KeyNotStringOnReadException( current_key,
+ this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vp.getPtr();
+ }
+}
+
+
+/* This class holds an input stream and a line buffer.
+*/
+class InputStreamAndBuffer
+{
+ private BufferedReader in;
+ // The stream we read from.
+
+ private String line;
+ // The line just read.
+
+ private int ptr;
+ // Initialised to 0 after reading a line. Index of the next
+ // character to use in line.
+
+ private int line_number;
+ // Initially 0. Is incremented each time a line is read, so
+ // the first line read is number 1.
+
+ private boolean nothing_read;
+ // Initially true. Is set false after reading a line. We
+ // use this so that the first call of getSlice
+ // knows to read a line.
+
+
+ public InputStreamAndBuffer( BufferedReader in )
+ {
+ this.in = in;
+ this.ptr = 0;
+ this.line = "";
+ this.line_number = 0;
+ this.nothing_read = true;
+ }
+
+
+ /* Reads the next line into the line buffer.
+ vecptr and format are used only in generating error messages.
+ */
+ public void readLine( int vecptr, FormatElement format )
+ throws EndOfFileWhenStartingReadException,
+ LineMissingOnReadException,
+ IOExceptionOnReadException
+ {
+ try {
+ String line = this.in.readLine();
+
+ if ( line == null ) {
+ if ( this.nothing_read )
+ throw new EndOfFileWhenStartingReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ else
+ throw new LineMissingOnReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ }
+ else {
+ this.ptr = 0;
+ this.nothing_read = false;
+ this.line_number = this.line_number + 1;
+ this.line = line;
+ // Don't do the assignment until we've checked for a null
+ // line, because then we can then use this.line as the
+ // previous value for error messages.
+ }
+ }
+ catch ( IOException e ) {
+ throw new IOExceptionOnReadException( this.line, this.line_number,
+ e.getMessage()
+ );
+ }
+ }
+
+
+ /* Returns a string consisting of the next width characters,
+ and throws an exception if the line is not long enough.
+ The 'vecptr' and 'format' parameters are used only in generating error
+ messages.
+ */
+ public String getSlice( int width, int vecptr, FormatElement format )
+ throws DataMissingOnReadException,
+ LineMissingOnReadException,
+ EndOfFileWhenStartingReadException,
+ IOExceptionOnReadException
+ {
+ if ( this.nothing_read )
+ readLine( vecptr, format );
+ if ( this.ptr+width > this.line.length() ) {
+ /* if there aren't 'width' characters left, just return the
+ * remainder of the line. --kgs
+ */
+ return this.line.substring( this.ptr );
+ }
+ else {
+ return this.line.substring( this.ptr, this.ptr+width );
+ }
+ }
+
+
+ /* Advances the pointer by width.
+ */
+ public void advance( int width )
+ {
+ this.ptr = this.ptr + width;
+ }
+
+
+ /* Generates an error report showing the line, character pointer
+ ptr and line number.
+ */
+ public String getLineErrorReport()
+ {
+ StringBuffer s = new StringBuffer();
+
+ /* Report the line number. */
+ s.append( " Line number = " + this.line_number + ":\n" );
+
+ /* Show the line. */
+ s.append( this.line + "\n" );
+
+ /* Show an arrow under ptr. */
+ for ( int i=0; i<this.ptr; i++ )
+ s.append( " " );
+ s.append( "^" );
+
+ return s.toString();
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted output.
+*/
+abstract class OutputFormatException extends Exception
+{
+ public OutputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public OutputFormatException()
+ {
+ super();
+ }
+}
+
+
+/* This exception is thrown if formatted output runs off the
+ end of the vector being output before it has completed the
+ format.
+*/
+class EndOfVectorOnWriteException extends OutputFormatException
+{
+ public EndOfVectorOnWriteException( int vecptr,
+ String format
+ )
+ {
+ this( "End of vector while writing formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public EndOfVectorOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfVectorOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects an object
+ that's the wrong type for a format element, e.g. a real
+ when outputting against an Iw element.
+*/
+class IllegalObjectOnWriteException extends OutputFormatException
+{
+ public IllegalObjectOnWriteException( Object o,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Illegal object while writing formatted data:\n" +
+ " Object = \"" + o + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public IllegalObjectOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public IllegalObjectOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a string
+ that won't fit in its format, e.g. trying to output abcde
+ against an A4 element.
+*/
+class StringTooWideOnWriteException extends OutputFormatException
+{
+ public StringTooWideOnWriteException( String s,
+ int vecptr,
+ String format
+ )
+ {
+ this( "String too wide while writing formatted data:\n" +
+ " String = \"" + s + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public StringTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public StringTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a number
+ that won't fit in its format, e.g. trying to output 1234
+ against an I3 element.
+*/
+class NumberTooWideOnWriteException extends OutputFormatException
+{
+ public NumberTooWideOnWriteException( Number n,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Number too wide while writing formatted data:\n" +
+ " Number = \"" + n + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public NumberTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public NumberTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted input.
+*/
+abstract class InputFormatException extends Exception
+{
+ public InputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public InputFormatException()
+ {
+ super();
+ }
+
+
+}
+
+
+class LineMissingOnReadException extends InputFormatException
+{
+ public LineMissingOnReadException( int vecptr,
+ String format,
+ String line,
+ int line_number
+ )
+ {
+ this( "End of file while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ "Last line was number " + line_number + ":\n" +
+ line
+ );
+ }
+
+ public LineMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public LineMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class DataMissingOnReadException extends InputFormatException
+{
+ public DataMissingOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this("Warning: EOL reading formatted data: idx=" +
+ vecptr + " fmt=" + format);
+ }
+
+ public DataMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public DataMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class InvalidNumberOnReadException extends InputFormatException
+{
+ public InvalidNumberOnReadException( String number,
+ int vecptr,
+ String format,
+ String line_error_report,
+ String parser_message
+ )
+ {
+ this( "Invalid number while reading formatted data:\n" +
+ " Number = \"" + number + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n" +
+ parser_message
+ );
+ }
+
+ public InvalidNumberOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public InvalidNumberOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class UnmatchedStringOnReadException extends InputFormatException
+{
+ public UnmatchedStringOnReadException( String string,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Unmatched string while reading formatted data:\n" +
+ " String = \"" + string + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public UnmatchedStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public UnmatchedStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class EndOfKeyVectorOnReadException extends InputFormatException
+{
+ public EndOfKeyVectorOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "End of key vector while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public EndOfKeyVectorOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfKeyVectorOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class KeyNotStringOnReadException extends InputFormatException
+{
+ public KeyNotStringOnReadException( Object key,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Key not string while reading formatted data:\n" +
+ " Key = \"" + vecptr + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public KeyNotStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public KeyNotStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class IOExceptionOnReadException extends InputFormatException
+{
+ public IOExceptionOnReadException( String line,
+ int line_number,
+ String IOMessage
+ )
+ {
+ this( "IOException while reading formatted data:\n" +
+ "Last line was number " + line_number + ":\n" +
+ line + "\n" +
+ IOMessage
+ );
+ }
+
+ public IOExceptionOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public IOExceptionOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown when a syntax error is detected while
+ parsing a format string.
+*/
+class InvalidFormatException extends Exception
+{
+ public InvalidFormatException( String parser_message )
+ {
+ super( parser_message );
+ }
+
+ public InvalidFormatException( )
+ {
+ super( );
+ }
+}
+
+
+/* This class is used to hold the parsers for formats and numbers.
+ We generate them static (see JavaCC documentation) because it
+ makes them more efficient. However, that then means that we need
+ somewhere to put an instance of each. That's what we use the result
+ of Parsers.theParsers() for.
+*/
+class Parsers
+{
+ static boolean already_created = false;
+ static Parsers parsers = null;
+
+ FormatParser format_parser = null;
+ NumberParser number_parser = null;
+
+
+ static Parsers theParsers()
+ {
+ if ( !(already_created) ) {
+ parsers = new Parsers();
+ already_created = true;
+ }
+ return parsers;
+ }
+
+
+ private Parsers()
+ {
+// this.format_parser = new FormatParser( new StringBufferInputStream("") );
+// this.number_parser = new NumberParser( new StringBufferInputStream("") );
+ this.format_parser = new FormatParser( new StringReader("") );
+ this.number_parser = new NumberParser( new StringReader("") );
+ }
+}
diff --git a/util/org/j_paine/formatter/Formatter.java b/util/org/j_paine/formatter/Formatter.java
new file mode 100644
index 0000000..dd5dd3e
--- /dev/null
+++ b/util/org/j_paine/formatter/Formatter.java
@@ -0,0 +1,1747 @@
+/* Formatter.java
+ *
+ * This is a modified version of Jocelyn Paine's Formatter package:
+ * http://www.j-paine.org/Formatter
+ *
+ * Modifications are flagged with "kgs" in the comments.
+ */
+
+package org.j_paine.formatter;
+
+import java.io.DataInputStream;
+import java.io.IOException;
+import java.io.PrintStream;
+import java.io.StringReader;
+import java.util.Hashtable;
+import java.util.Vector;
+
+
+/* This class holds a Format, and has methods for reading and
+ writing data against it.
+*/
+public class Formatter
+{
+ private Format format = null;
+ private FormatMap format_map = null;
+
+
+ public Formatter( String format ) throws InvalidFormatException
+ {
+ this( new Format(format) );
+ }
+
+ public Formatter( Format format )
+ {
+ this.format = format;
+ }
+
+
+ public void setFormatMap( FormatMap format_map )
+ {
+ this.format_map = format_map;
+ }
+
+
+ public void write( Vector v, PrintStream out )
+ throws OutputFormatException
+ {
+ FormatX dummy_el = new FormatX();
+ FormatOutputList vp = new VectorAndPointer( v );
+
+ /* Loop back around and reuse the format spec if
+ * there are still elements in the vector. Keep
+ * going until all elements in the vector have
+ * been printed. --kgs
+ */
+ while(true) {
+ try {
+ this.format.write( vp, out );
+ vp.checkCurrentElementForWrite(dummy_el);
+ out.println();
+ }catch(EndOfVectorOnWriteException e) {
+ break;
+ }
+ }
+ }
+
+ public void write( int i, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Integer(i), out );
+ }
+
+ public void write( long l, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Long(l), out );
+ }
+
+ public void write( float f, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Float(f), out );
+ }
+
+ public void write( double d, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Double(d), out );
+ }
+
+ public void write( Object o, PrintStream out )
+ throws OutputFormatException
+ {
+ Vector v = new Vector();
+ v.addElement( o );
+ write( v, out );
+ }
+
+
+ public void read( Vector v, DataInputStream in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new VectorAndPointer( v );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( Vector v, Hashtable ht, DataInputStream in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new StringsHashtableAndPointer( v, ht );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( String[] s, Hashtable ht, DataInputStream in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ for ( int i = 0; i<s.length; i++ )
+ v.addElement( s[i] );
+ read( v, ht, in );
+ }
+
+ public Object read( DataInputStream in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ read( v, in );
+ return v.elementAt(0);
+ }
+
+
+ public boolean eof( DataInputStream in )
+ throws IOException
+ {
+ return ( in.available() <= 0 );
+ }
+
+
+ public String toString()
+ {
+ return "[Formatter " + this.format.toString() + "]";
+ }
+}
+
+
+/* Below, we define various classes for holding complete formats,
+ format elements, and so on. The class FormatUniv is a superclass
+ of them all. This makes it a convenient "universal type" to
+ use to hold any piece of, or a complete, format.
+*/
+abstract class FormatUniv
+{
+ abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+
+ abstract void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException;
+}
+
+
+/* This class represents a complete format, i.e. a sequence of
+ elements such as F12.5 and so on. Some of the elements may
+ themselves be formats.
+ We implement it as a vector of elements.
+*/
+class Format extends FormatUniv
+{
+ private Vector elements = new Vector();
+
+ public Format( String s ) throws InvalidFormatException
+ {
+ FormatParser fp =
+ Parsers.theParsers().format_parser;
+ fp.ReInit( new StringReader(s) );
+ try {
+ Format f = fp.Format();
+ this.elements = f.elements;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ }
+
+ // We call this one from inside the parser, which needs a Format
+ // with its vector initialised.
+ Format()
+ {
+ }
+
+
+ public void addElement( FormatUniv fu )
+ {
+ this.elements.addElement( fu );
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.write( vp, out );
+ }
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.read( vp, in, format_map );
+ }
+ }
+
+
+ public String toString()
+ {
+ String s = "";
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ if ( i!=0 )
+ s = s + ", ";
+ s = s + this.elements.elementAt(i).toString();
+ }
+ return s;
+ }
+}
+
+
+/* This class represents a repeated item, e.g. 3F12.5 or 3X.
+ The integer r gives the repetition factor.
+ The item may be either a format element, or an entire format.
+ To cater for either, we hold it in a FormatUniv object (this is
+ why we introduced the class FormatUniv).
+*/
+class FormatRepeatedItem extends FormatUniv
+{
+ private int r=1;
+ private FormatUniv format_univ = null;
+
+
+ public FormatRepeatedItem( FormatUniv format_univ )
+ {
+ this( 1, format_univ );
+ }
+
+ public FormatRepeatedItem( int r, FormatUniv format_univ )
+ {
+ this.r = r;
+ this.format_univ = format_univ;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.write( vp, out );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.read( vp, in, format_map );
+ }
+
+
+ public String toString()
+ {
+ if (r==1)
+ return this.format_univ.toString();
+ else
+ return this.r+"("+this.format_univ.toString()+")";
+ }
+}
+
+
+/* This class represents a single format element such as
+ F12.5, I2, or X.
+*/
+abstract class FormatElement extends FormatUniv
+{
+ /* This method will be defined differently by each subclass.
+ */
+ public abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+}
+
+
+/* This class represents a format element that reads or writes
+ data. So F12.5 or I3, but not X.
+ We assume that all format elements are fixed width.
+*/
+abstract class FormatIOElement extends FormatElement
+{
+ private int width;
+
+ void setWidth( int width )
+ {
+ this.width = width;
+ }
+
+ int getWidth()
+ {
+ return this.width;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ vp.checkCurrentElementForWrite( this );
+ Object o = vp.getCurrentElementAndAdvance();
+ out.print( convertToString(o,vp.getPtr()-1) );
+ }
+
+
+ /* This method is called by write, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to write from
+ the output list, and printing its string representation,
+ are the same for all FormatIOElements. However, the
+ conversion to string is different for each one.
+ */
+ abstract String convertToString( Object o, int vecptr )
+ throws OutputFormatException;
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ /* Get next width characters. */
+ String s = in.getSlice( this.width, vp.getPtr(), this );
+
+ /* Try translating if there's a format map. */
+ if ( format_map != null ) {
+ String repl = format_map.getMapping( s );
+ if ( repl != null )
+ s = repl;
+ }
+
+ /* Parse the string to check it's a valid number, and put into
+ the vector if so.
+ Also, advance the stream input pointer.
+ */
+ Object o = convertFromString( s, vp, in );
+ vp.checkCurrentElementForRead( this, in );
+ vp.putElementAndAdvance( o, this, in );
+ in.advance( this.width );
+ }
+
+
+ /* This method is called by read, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to read from
+ the input stream, and putting it into the input list,
+ are the same for all FormatIOElements. However, the
+ conversion from string is different for each one.
+ vp and in are used only in generating error messages.
+ */
+ abstract Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+}
+
+/* This class represents a P format element, but the scaling
+ * is not implemented yet.
+ */
+class FormatP extends FormatElement
+{
+ FormatRepeatedItem ritem = null;
+
+ public FormatRepeatedItem getRepeatedItem() {
+ return ritem;
+ }
+
+ public FormatP(int r, FormatUniv format_univ) {
+ if(format_univ != null)
+ ritem = new FormatRepeatedItem(r, format_univ);
+ }
+
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ /* the P element itself produces no output. it's a scale factor
+ * for other elements, but that isn't being handled yet.
+ */
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ /* the P element doesn't consume input. --kgs */
+ }
+
+
+ public String toString()
+ {
+ return "P";
+ }
+}
+
+
+/* This class represents an X format element.
+*/
+class FormatX extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print( " " );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ in.advance( 1 );
+ }
+
+
+ public String toString()
+ {
+ return "X";
+ }
+}
+
+
+/* This class represents an Aw format element.
+*/
+class FormatA extends FormatIOElement
+{
+ public FormatA( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ StringTooWideOnWriteException
+ {
+ String s;
+
+ if ( o instanceof String ) {
+ /* pad or truncate strings as necessary. --kgs */
+ s = (String)o;
+ if ( (getWidth() != -1) && (s.length() > getWidth()) )
+ return s.substring(0, getWidth());
+ else {
+ if(getWidth() > s.length()) {
+ char [] pad = new char[getWidth() - s.length()];
+
+ for(int i=0;i<pad.length;i++)
+ pad[i] = ' ';
+
+ return new String(pad) + s;
+ }
+ else
+ return s;
+ }
+ }
+ else {
+ char [] blah = new char[getWidth()];
+
+ /* if this is a non-string argument with an A edit descriptor,
+ * just print some nonsense. --kgs
+ */
+ for(int i=0;i<blah.length;i++)
+ blah[i] = '#';
+
+ return new String(blah);
+ }
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ int len;
+
+ len = getWidth() - s.length();
+
+ /* if the spec width is wider than the string,
+ * return a padded string. --kgs
+ */
+ if(len > 0) {
+ char [] pad = new char[len];
+ for(int i=0;i<len;i++)
+ pad[i] = ' ';
+ String padstr = new String(pad);
+
+ return s.concat(padstr);
+ }
+
+ /* We just return the slice read, as a string. */
+ return s;
+ }
+
+
+ public String toString()
+ {
+ return "A"+getWidth();
+ }
+}
+
+
+/* This class represents an Iw format element.
+*/
+class FormatI extends FormatIOElement
+{
+ public FormatI( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ) {
+ String fmtstr = "%" + Integer.toString(getWidth()) + "d";
+ s = new PrintfFormat(fmtstr).sprintf(o);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else if(o instanceof String) {
+ /* String passed to I edit descriptor. try converting the
+ * first character to an integer. --kgs
+ */
+ return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr);
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Integer();
+ Long l = new Long( s.substring(start) );
+ return l;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "I"+getWidth();
+ }
+}
+
+/*
+ * Handles logical (boolean) edit descriptors.
+ */
+
+class FormatL extends FormatIOElement
+{
+ public FormatL( int w )
+ {
+ setWidth( w );
+ }
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Boolean ) {
+ char [] b = new char[getWidth()];
+ int i;
+
+ for(i=0;i<b.length-1;i++)
+ b[i] = ' ';
+
+ b[i] = (((Boolean)o).booleanValue() == true) ? 'T' : 'F';
+
+ s = new String(b);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Boolean();
+ char brep = s.substring(start).charAt(0);
+ Boolean b;
+
+ if(brep == 't' || brep == 'T')
+ b = new Boolean(true);
+ else if(brep == 'f' || brep == 'F')
+ b = new Boolean(false);
+ else
+ throw new ParseException("bad logical value");
+ return b;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+ public String toString()
+ {
+ return "L"+getWidth();
+ }
+}
+
+/* This class represents an Fw.d format element.
+ Numbers should be output with d decimal places.
+*/
+class FormatF extends FormatIOElement
+{
+ private int d;
+
+
+ public FormatF( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ String fmtstr = "%" + Integer.toString(getWidth()) + "." +
+ Integer.toString(this.d) + "f";
+ s = new PrintfFormat(fmtstr).sprintf(o);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "F"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an Ew.d format element.
+ Numbers should be output as
+ s0.dd...ddEsdd
+ where s is a sign.
+*/
+class FormatE extends FormatIOElement
+{ int d;
+
+
+ public FormatE( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ String fmtstr = "%" + Integer.toString(getWidth()) + "." +
+ Integer.toString(this.d) + "E";
+ s = new PrintfFormat(fmtstr).sprintf(o);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringReader(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "E"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an / item.
+*/
+class FormatSlash extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.println();
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ in.readLine( vp.getPtr(), this );
+ }
+
+
+ public String toString()
+ {
+ return "/";
+ }
+}
+
+
+/* This class represents an embedded literal, e.g. 'Title'.
+ toString() does not yet handle embedded quotes.
+*/
+class FormatString extends FormatElement
+{
+ private String s;
+
+
+ public FormatString( String s )
+ {
+ this.s = s;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print(this.s);
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ String s = in.getSlice( this.s.length(), vp.getPtr(), this );
+ if ( !( this.s.equals(s) ) )
+ throw new UnmatchedStringOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport()
+ );
+ in.advance( this.s.length() );
+ }
+
+
+ public String toString()
+ {
+ return "'" + this.s + "'";
+ }
+}
+
+
+/* This class represents a mapping from input data. We use it to specify,
+ for example, that on input, an "X" should be replaced by a "0" before
+ being interpreted by the formatted input routines.
+ The user must provide an instance of this class, with getMapping
+ defined. getMapping should return either null, if the input string
+ is to be left as it is, or a replacement string.
+*/
+abstract class FormatMap
+{
+ public abstract String getMapping( String in );
+}
+
+
+interface FormatOutputList
+{
+ boolean hasCurrentElement();
+
+ void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException;
+
+ Object getCurrentElement();
+
+ Object getCurrentElementAndAdvance();
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+interface FormatInputList
+{
+ /* format_element and in are only for generating error messages.
+ */
+ void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+ // If the list is a VectorAndPointer, it won't throw an exception.
+ // If it is a StringsHashtableAndPointer, it will throw a
+ // EndOfKeyVectorOnReadException.
+
+ /* Puts o into the input list and advances its pointer.
+ Must be defined for each subclass.
+ format_element and in are only for generating error messages.
+ */
+ void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+/* This class represents a Vector and a current-element pointer.
+ We use it when outputting or inputting a Vector against a format:
+ the pointer keeps track of the current element being output, and
+ can be incremented by the format write and read methods.
+*/
+class VectorAndPointer implements FormatInputList, FormatOutputList
+{
+ private Vector v = null;
+ private int vecptr = 0;
+ // On output, vecptr points at the next element to be used.
+ // On input, it points at the next free slot to be filled.
+
+
+ public VectorAndPointer( Vector v )
+ {
+ this.v = v;
+ }
+
+
+ public VectorAndPointer()
+ {
+ this.v = new Vector();
+ }
+
+
+ public boolean hasCurrentElement()
+ {
+ return ( this.vecptr < this.v.size() );
+ }
+
+
+ public void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException
+ {
+ if ( !hasCurrentElement() )
+ throw new EndOfVectorOnWriteException( this.vecptr,
+ format_element.toString()
+ );
+ }
+
+
+ /* Checks that the current element in the input list is OK and
+ throws an exception if not. For this implementation of
+ FormatInputList, there are no error conditions - we
+ introduced the method for the StringHashtableAndPointer class,
+ and need it here for compatibility.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ }
+
+
+ public Object getCurrentElement()
+ {
+ return this.v.elementAt( this.vecptr );
+ }
+
+ public Object getCurrentElementAndAdvance()
+ {
+ this.vecptr = this.vecptr+1;
+ return this.v.elementAt( this.vecptr-1 );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ format_element and in are only for generating error messages,
+ and not used in this implementation, since no error conditions
+ can arise.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ this.v.addElement(o);
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ public void advance()
+ {
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vecptr;
+ }
+}
+
+
+/* This class represents a Vector of Strings and a current-element pointer.
+ We use it when inputting data against a format.
+*/
+class StringsHashtableAndPointer implements FormatInputList
+{
+ private VectorAndPointer vp;
+ private Hashtable ht;
+
+
+ public StringsHashtableAndPointer( Vector strings, Hashtable ht )
+ {
+ this.vp = new VectorAndPointer( strings );
+ this.ht = ht;
+ }
+
+
+ /* Checks that there is a current element in the key vector, and
+ throws an exception if not.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws EndOfKeyVectorOnReadException
+ {
+ if ( !(this.vp.hasCurrentElement() ) )
+ throw new EndOfKeyVectorOnReadException( this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ In this implementation, that means getting the current key,
+ putting o into an appropriate hashtable slot, and advancing
+ the pointer in the vector of keys.
+ format_element and in are only for generating error messages.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws KeyNotStringOnReadException
+ {
+ Object current_key = this.vp.getCurrentElement();
+ if ( current_key instanceof String ) {
+ this.ht.put( (String)current_key, o );
+ this.vp.advance();
+ }
+ else
+ throw new KeyNotStringOnReadException( current_key,
+ this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vp.getPtr();
+ }
+}
+
+
+/* This class holds an input stream and a line buffer.
+*/
+class InputStreamAndBuffer
+{
+ private DataInputStream in;
+ // The stream we read from.
+
+ private String line;
+ // The line just read.
+
+ private int ptr;
+ // Initialised to 0 after reading a line. Index of the next
+ // character to use in line.
+
+ private int line_number;
+ // Initially 0. Is incremented each time a line is read, so
+ // the first line read is number 1.
+
+ private boolean nothing_read;
+ // Initially true. Is set false after reading a line. We
+ // use this so that the first call of getSlice
+ // knows to read a line.
+
+
+ public InputStreamAndBuffer( DataInputStream in )
+ {
+ this.in = in;
+ this.ptr = 0;
+ this.line = "";
+ this.line_number = 0;
+ this.nothing_read = true;
+ }
+
+ /* Really crappy readline implementation to quiet deprecation warnings
+ * about using DataInputStream.readLine(). --kgs
+ */
+
+ public String readLine_hack() throws java.io.IOException
+ {
+ StringBuffer sb = new StringBuffer();
+ int c = 0;
+
+ while(c >= 0) {
+ c = in.read();
+
+ if(c < 0)
+ return null;
+
+ if((char)c == '\n')
+ break;
+
+ sb.append((char) c);
+ }
+
+ return sb.toString();
+ }
+
+ /* Reads the next line into the line buffer.
+ vecptr and format are used only in generating error messages.
+ */
+ public void readLine( int vecptr, FormatElement format )
+ throws EndOfFileWhenStartingReadException,
+ LineMissingOnReadException,
+ IOExceptionOnReadException
+ {
+ try {
+ String line = readLine_hack();
+
+ if ( line == null ) {
+ if ( this.nothing_read )
+ throw new EndOfFileWhenStartingReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ else
+ throw new LineMissingOnReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ }
+ else {
+ this.ptr = 0;
+ this.nothing_read = false;
+ this.line_number = this.line_number + 1;
+ this.line = line;
+ // Don't do the assignment until we've checked for a null
+ // line, because then we can then use this.line as the
+ // previous value for error messages.
+ }
+ }
+ catch ( IOException e ) {
+ throw new IOExceptionOnReadException( this.line, this.line_number,
+ e.getMessage()
+ );
+ }
+ }
+
+
+ /* Returns a string consisting of the next width characters,
+ and throws an exception if the line is not long enough.
+ The 'vecptr' and 'format' parameters are used only in generating error
+ messages.
+ */
+ public String getSlice( int width, int vecptr, FormatElement format )
+ throws DataMissingOnReadException,
+ LineMissingOnReadException,
+ EndOfFileWhenStartingReadException,
+ IOExceptionOnReadException
+ {
+ if ( this.nothing_read )
+ readLine( vecptr, format );
+ if ( this.ptr+width > this.line.length() ) {
+ /* if there aren't 'width' characters left, just return the
+ * remainder of the line. --kgs
+ */
+ return this.line.substring( this.ptr );
+ }
+ else {
+ return this.line.substring( this.ptr, this.ptr+width );
+ }
+ }
+
+
+ /* Advances the pointer by width.
+ */
+ public void advance( int width )
+ {
+ this.ptr = this.ptr + width;
+ }
+
+
+ /* Generates an error report showing the line, character pointer
+ ptr and line number.
+ */
+ public String getLineErrorReport()
+ {
+ StringBuffer s = new StringBuffer();
+
+ /* Report the line number. */
+ s.append( " Line number = " + this.line_number + ":\n" );
+
+ /* Show the line. */
+ s.append( this.line + "\n" );
+
+ /* Show an arrow under ptr. */
+ for ( int i=0; i<this.ptr; i++ )
+ s.append( " " );
+ s.append( "^" );
+
+ return s.toString();
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted output.
+*/
+abstract class OutputFormatException extends Exception
+{
+ public OutputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public OutputFormatException()
+ {
+ super();
+ }
+}
+
+
+/* This exception is thrown if formatted output runs off the
+ end of the vector being output before it has completed the
+ format.
+*/
+class EndOfVectorOnWriteException extends OutputFormatException
+{
+ public EndOfVectorOnWriteException( int vecptr,
+ String format
+ )
+ {
+ this( "End of vector while writing formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public EndOfVectorOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfVectorOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects an object
+ that's the wrong type for a format element, e.g. a real
+ when outputting against an Iw element.
+*/
+class IllegalObjectOnWriteException extends OutputFormatException
+{
+ public IllegalObjectOnWriteException( Object o,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Illegal object while writing formatted data:\n" +
+ " Object = \"" + o + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public IllegalObjectOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public IllegalObjectOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a string
+ that won't fit in its format, e.g. trying to output abcde
+ against an A4 element.
+*/
+class StringTooWideOnWriteException extends OutputFormatException
+{
+ public StringTooWideOnWriteException( String s,
+ int vecptr,
+ String format
+ )
+ {
+ this( "String too wide while writing formatted data:\n" +
+ " String = \"" + s + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public StringTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public StringTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a number
+ that won't fit in its format, e.g. trying to output 1234
+ against an I3 element.
+*/
+class NumberTooWideOnWriteException extends OutputFormatException
+{
+ public NumberTooWideOnWriteException( Number n,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Number too wide while writing formatted data:\n" +
+ " Number = \"" + n + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public NumberTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public NumberTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted input.
+*/
+abstract class InputFormatException extends Exception
+{
+ public InputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public InputFormatException()
+ {
+ super();
+ }
+
+
+}
+
+
+class LineMissingOnReadException extends InputFormatException
+{
+ public LineMissingOnReadException( int vecptr,
+ String format,
+ String line,
+ int line_number
+ )
+ {
+ this( "End of file while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ "Last line was number " + line_number + ":\n" +
+ line
+ );
+ }
+
+ public LineMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public LineMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class DataMissingOnReadException extends InputFormatException
+{
+ public DataMissingOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this("Warning: EOL reading formatted data: idx=" +
+ vecptr + " fmt=" + format);
+ }
+
+ public DataMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public DataMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class InvalidNumberOnReadException extends InputFormatException
+{
+ public InvalidNumberOnReadException( String number,
+ int vecptr,
+ String format,
+ String line_error_report,
+ String parser_message
+ )
+ {
+ this( "Invalid number while reading formatted data:\n" +
+ " Number = \"" + number + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n" +
+ parser_message
+ );
+ }
+
+ public InvalidNumberOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public InvalidNumberOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class UnmatchedStringOnReadException extends InputFormatException
+{
+ public UnmatchedStringOnReadException( String string,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Unmatched string while reading formatted data:\n" +
+ " String = \"" + string + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public UnmatchedStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public UnmatchedStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class EndOfKeyVectorOnReadException extends InputFormatException
+{
+ public EndOfKeyVectorOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "End of key vector while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public EndOfKeyVectorOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfKeyVectorOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class KeyNotStringOnReadException extends InputFormatException
+{
+ public KeyNotStringOnReadException( Object key,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Key not string while reading formatted data:\n" +
+ " Key = \"" + vecptr + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public KeyNotStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public KeyNotStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class IOExceptionOnReadException extends InputFormatException
+{
+ public IOExceptionOnReadException( String line,
+ int line_number,
+ String IOMessage
+ )
+ {
+ this( "IOException while reading formatted data:\n" +
+ "Last line was number " + line_number + ":\n" +
+ line + "\n" +
+ IOMessage
+ );
+ }
+
+ public IOExceptionOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public IOExceptionOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown when a syntax error is detected while
+ parsing a format string.
+*/
+class InvalidFormatException extends Exception
+{
+ public InvalidFormatException( String parser_message )
+ {
+ super( parser_message );
+ }
+
+ public InvalidFormatException( )
+ {
+ super( );
+ }
+}
+
+
+/* This class is used to hold the parsers for formats and numbers.
+ We generate them static (see JavaCC documentation) because it
+ makes them more efficient. However, that then means that we need
+ somewhere to put an instance of each. That's what we use the result
+ of Parsers.theParsers() for.
+*/
+class Parsers
+{
+ static boolean already_created = false;
+ static Parsers parsers = null;
+
+ FormatParser format_parser = null;
+ NumberParser number_parser = null;
+
+
+ static Parsers theParsers()
+ {
+ if ( !(already_created) ) {
+ parsers = new Parsers();
+ already_created = true;
+ }
+ return parsers;
+ }
+
+
+ private Parsers()
+ {
+ this.format_parser = new FormatParser( new StringReader("") );
+ this.number_parser = new NumberParser( new StringReader("") );
+ }
+}
diff --git a/util/org/j_paine/formatter/Formatter.java~ b/util/org/j_paine/formatter/Formatter.java~
new file mode 100644
index 0000000..7b0f069
--- /dev/null
+++ b/util/org/j_paine/formatter/Formatter.java~
@@ -0,0 +1,1724 @@
+/* Formatter.java */
+
+package org.j_paine.formatter;
+
+import java.io.DataInputStream;
+import java.io.IOException;
+import java.io.PrintStream;
+import java.io.StringBufferInputStream;
+import java.util.Hashtable;
+import java.util.Vector;
+
+
+/* This class holds a Format, and has methods for reading and
+ writing data against it.
+*/
+public class Formatter
+{
+ private Format format = null;
+ private FormatMap format_map = null;
+
+
+ public Formatter( String format ) throws InvalidFormatException
+ {
+ this( new Format(format) );
+ }
+
+ public Formatter( Format format )
+ {
+ this.format = format;
+ }
+
+
+ public void setFormatMap( FormatMap format_map )
+ {
+ this.format_map = format_map;
+ }
+
+
+ public void write( Vector v, PrintStream out )
+ throws OutputFormatException
+ {
+ FormatX dummy_el = new FormatX();
+ FormatOutputList vp = new VectorAndPointer( v );
+
+ while(true) {
+ try {
+ this.format.write( vp, out );
+ vp.checkCurrentElementForWrite(dummy_el);
+ out.println();
+ }catch(EndOfVectorOnWriteException e) {
+ break;
+ }
+ }
+ }
+
+ public void write( int i, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Integer(i), out );
+ }
+
+ public void write( long l, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Long(l), out );
+ }
+
+ public void write( float f, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Float(f), out );
+ }
+
+ public void write( double d, PrintStream out )
+ throws OutputFormatException
+ {
+ write( new Double(d), out );
+ }
+
+ public void write( Object o, PrintStream out )
+ throws OutputFormatException
+ {
+ Vector v = new Vector();
+ v.addElement( o );
+ write( v, out );
+ }
+
+
+ public void read( Vector v, DataInputStream in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new VectorAndPointer( v );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( Vector v, Hashtable ht, DataInputStream in )
+ throws InputFormatException
+ {
+ FormatInputList vp = new StringsHashtableAndPointer( v, ht );
+ InputStreamAndBuffer inb = new InputStreamAndBuffer(in);
+ this.format.read( vp, inb, this.format_map );
+ }
+
+ public void read( String[] s, Hashtable ht, DataInputStream in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ for ( int i = 0; i<s.length; i++ )
+ v.addElement( s[i] );
+ read( v, ht, in );
+ }
+
+ public Object read( DataInputStream in )
+ throws InputFormatException
+ {
+ Vector v = new Vector();
+ read( v, in );
+ return v.elementAt(0);
+ }
+
+
+ public boolean eof( DataInputStream in )
+ throws IOException
+ {
+ return ( in.available() <= 0 );
+ }
+
+
+ public String toString()
+ {
+ return "[Formatter " + this.format.toString() + "]";
+ }
+}
+
+
+/* Below, we define various classes for holding complete formats,
+ format elements, and so on. The class FormatUniv is a superclass
+ of them all. This makes it a convenient "universal type" to
+ use to hold any piece of, or a complete, format.
+*/
+abstract class FormatUniv
+{
+ abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+
+ abstract void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException;
+}
+
+
+/* This class represents a complete format, i.e. a sequence of
+ elements such as F12.5 and so on. Some of the elements may
+ themselves be formats.
+ We implement it as a vector of elements.
+*/
+class Format extends FormatUniv
+{
+ private Vector elements = new Vector();
+
+ public Format( String s ) throws InvalidFormatException
+ {
+ FormatParser fp =
+ Parsers.theParsers().format_parser;
+ fp.ReInit( new StringBufferInputStream(s) );
+ try {
+ Format f = fp.Format();
+ this.elements = f.elements;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidFormatException( e.getMessage() );
+ }
+ }
+
+ // We call this one from inside the parser, which needs a Format
+ // with its vector initialised.
+ Format()
+ {
+ }
+
+
+ public void addElement( FormatUniv fu )
+ {
+ this.elements.addElement( fu );
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.write( vp, out );
+ }
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ FormatUniv fu = (FormatUniv)this.elements.elementAt(i);
+ fu.read( vp, in, format_map );
+ }
+ }
+
+
+ public String toString()
+ {
+ String s = "";
+ for ( int i=0; i<this.elements.size(); i++ ) {
+ if ( i!=0 )
+ s = s + ", ";
+ s = s + this.elements.elementAt(i).toString();
+ }
+ return s;
+ }
+}
+
+
+/* This class represents a repeated item, e.g. 3F12.5 or 3X.
+ The integer r gives the repetition factor.
+ The item may be either a format element, or an entire format.
+ To cater for either, we hold it in a FormatUniv object (this is
+ why we introduced the class FormatUniv).
+*/
+class FormatRepeatedItem extends FormatUniv
+{
+ private int r=1;
+ private FormatUniv format_univ = null;
+
+
+ public FormatRepeatedItem( FormatUniv format_univ )
+ {
+ this( 1, format_univ );
+ }
+
+ public FormatRepeatedItem( int r, FormatUniv format_univ )
+ {
+ this.r = r;
+ this.format_univ = format_univ;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.write( vp, out );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ for ( int i=1; i<=this.r; i++ )
+ this.format_univ.read( vp, in, format_map );
+ }
+
+
+ public String toString()
+ {
+ if (r==1)
+ return this.format_univ.toString();
+ else
+ return this.r+"("+this.format_univ.toString()+")";
+ }
+
+ public int getRepCount()
+ {
+ return r;
+ }
+}
+
+
+/* This class represents a single format element such as
+ F12.5, I2, or X.
+*/
+abstract class FormatElement extends FormatUniv
+{
+ /* This method will be defined differently by each subclass.
+ */
+ public abstract void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException;
+}
+
+
+/* This class represents a format element that reads or writes
+ data. So F12.5 or I3, but not X.
+ We assume that all format elements are fixed width.
+*/
+abstract class FormatIOElement extends FormatElement
+{
+ private int width;
+
+ void setWidth( int width )
+ {
+ this.width = width;
+ }
+
+ int getWidth()
+ {
+ return this.width;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ throws OutputFormatException
+ {
+ vp.checkCurrentElementForWrite( this );
+ Object o = vp.getCurrentElementAndAdvance();
+ out.print( convertToString(o,vp.getPtr()-1) );
+ }
+
+
+ /* This method is called by write, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to write from
+ the output list, and printing its string representation,
+ are the same for all FormatIOElements. However, the
+ conversion to string is different for each one.
+ */
+ abstract String convertToString( Object o, int vecptr )
+ throws OutputFormatException;
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ /* Get next width characters. */
+ String s = in.getSlice( this.width, vp.getPtr(), this );
+
+ /* Try translating if there's a format map. */
+ if ( format_map != null ) {
+ String repl = format_map.getMapping( s );
+ if ( repl != null )
+ s = repl;
+ }
+
+ /* Parse the string to check it's a valid number, and put into
+ the vector if so.
+ Also, advance the stream input pointer.
+ */
+ Object o = convertFromString( s, vp, in );
+ vp.checkCurrentElementForRead( this, in );
+ vp.putElementAndAdvance( o, this, in );
+ in.advance( this.width );
+ }
+
+
+ /* This method is called by read, above. It will be
+ defined differently for each subclass of FormatIOElement.
+ The idea is that getting the next element to read from
+ the input stream, and putting it into the input list,
+ are the same for all FormatIOElements. However, the
+ conversion from string is different for each one.
+ vp and in are used only in generating error messages.
+ */
+ abstract Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+}
+
+/* This class represents a P format element.
+*/
+class FormatP extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ /* the P element produces no output. it's a scale factor
+ * for other elements, but isn't being handled yet.
+ */
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ // in.advance( 1 );
+ }
+
+
+ public String toString()
+ {
+ return "P";
+ }
+}
+
+
+/* This class represents an X format element.
+*/
+class FormatX extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print( " " );
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ {
+ in.advance( 1 );
+ }
+
+
+ public String toString()
+ {
+ return "X";
+ }
+}
+
+
+/* This class represents an Aw format element.
+*/
+class FormatA extends FormatIOElement
+{
+ public FormatA( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ StringTooWideOnWriteException
+ {
+ String s;
+
+ if ( o instanceof String ) {
+ /* Throw an exception if the string won't fit. */
+ s = (String)o;
+ if ( (getWidth() != -1) && (s.length() > getWidth()) )
+ return s.substring(0, getWidth());
+ else {
+ if(getWidth() > s.length()) {
+ char [] pad = new char[getWidth() - s.length()];
+
+ for(int i=0;i<pad.length;i++)
+ pad[i] = ' ';
+
+ return new String(pad) + s;
+ }
+ else
+ return s;
+ }
+ }
+ else {
+ char [] blah = new char[getWidth()];
+
+ for(int i=0;i<blah.length;i++)
+ blah[i] = '#';
+
+ return new String(blah);
+ }
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ int len;
+
+ len = getWidth() - s.length();
+
+ /* if the spec width is wider than the string, return a padded string */
+ if(len > 0) {
+ char [] pad = new char[len];
+ for(int i=0;i<len;i++)
+ pad[i] = ' ';
+ String padstr = new String(pad);
+
+ return s.concat(padstr);
+ }
+
+ /* We just return the slice read, as a string. */
+ return s;
+ }
+
+
+ public String toString()
+ {
+ return "A"+getWidth();
+ }
+}
+
+
+/* This class represents an Iw format element.
+*/
+class FormatI extends FormatIOElement
+{
+ public FormatI( int w )
+ {
+ setWidth( w );
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'i' );
+ s = cjf.form( ((Number)o).longValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else if(o instanceof String) {
+ return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr);
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringBufferInputStream(s) );
+ try {
+ int start = np.Integer();
+ Long l = new Long( s.substring(start) );
+ return l;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "I"+getWidth();
+ }
+}
+
+class FormatL extends FormatIOElement
+{
+ public FormatL( int w )
+ {
+ setWidth( w );
+ }
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Boolean ) {
+ char [] b = new char[getWidth()];
+ int i;
+
+ for(i=0;i<b.length-1;i++)
+ b[i] = ' ';
+
+ b[i] = (((Boolean)o).booleanValue() == true) ? 'T' : 'F';
+
+ s = new String(b);
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringBufferInputStream(s) );
+ try {
+ int start = np.Boolean();
+ char brep = s.substring(start).charAt(0);
+ Boolean b;
+
+ if(brep == 't' || brep == 'T')
+ b = new Boolean(true);
+ else if(brep == 'f' || brep == 'F')
+ b = new Boolean(false);
+ else
+ throw new ParseException("bad logical value");
+ return b;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+ public String toString()
+ {
+ return "L"+getWidth();
+ }
+}
+
+/* This class represents an Fw.d format element.
+ Numbers should be output with d decimal places.
+*/
+class FormatF extends FormatIOElement
+{
+ private int d;
+
+
+ public FormatF( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPrecision( this.d );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'f' );
+ s = cjf.form( ((Number)o).doubleValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringBufferInputStream(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "F"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an Ew.d format element.
+ Numbers should be output as
+ s0.dd...ddEsdd
+ where s is a sign.
+*/
+class FormatE extends FormatIOElement
+{ int d;
+
+
+ public FormatE( int w, int d )
+ {
+ setWidth( w );
+ this.d = d;
+ }
+
+
+ String convertToString( Object o, int vecptr )
+ throws IllegalObjectOnWriteException,
+ NumberTooWideOnWriteException
+ {
+ String s;
+
+ /* Convert the number to a string. */
+ if ( o instanceof Integer || o instanceof Long ||
+ o instanceof Float || o instanceof Double ) {
+ CJFormat cjf = new CJFormat();
+ cjf.setWidth( getWidth() );
+ cjf.setPrecision( this.d );
+ cjf.setPre( "" );
+ cjf.setPost( "" );
+ cjf.setLeadingZeroes( false );
+ cjf.setShowPlus( false );
+ cjf.setAlternate( false );
+ cjf.setShowSpace( false );
+ cjf.setLeftAlign( false );
+ cjf.setFmt( 'E' );
+ s = cjf.form( ((Number)o).doubleValue() );
+
+ /* Throw an exception if the string won't fit. */
+ if ( s.length() > getWidth() )
+ throw new NumberTooWideOnWriteException( (Number)o,
+ vecptr,
+ this.toString()
+ );
+ else
+ return s;
+ }
+ else
+ throw new IllegalObjectOnWriteException( o,
+ vecptr,
+ this.toString()
+ );
+ }
+
+
+ /* vp and in are used only in generating error messages.
+ */
+ Object convertFromString( String s,
+ FormatInputList vp,
+ InputStreamAndBuffer in
+ )
+ throws InvalidNumberOnReadException
+ {
+ /* Parse the string to check it's a valid number,
+ and convert if so.
+ */
+ NumberParser np =
+ Parsers.theParsers().number_parser;
+ np.ReInit( new StringBufferInputStream(s) );
+ try {
+ int start = np.Float();
+ Double d = new Double( s.substring(start) );
+ return d;
+ }
+ catch ( ParseException e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ catch ( TokenMgrError e ) {
+ throw new InvalidNumberOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport(),
+ e.getMessage()
+ );
+ }
+ }
+
+
+ public String toString()
+ {
+ return "E"+getWidth()+"."+this.d;
+ }
+}
+
+
+/* This class represents an / item.
+*/
+class FormatSlash extends FormatElement
+{
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.println();
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ in.readLine( vp.getPtr(), this );
+ }
+
+
+ public String toString()
+ {
+ return "/";
+ }
+}
+
+
+/* This class represents an embedded literal, e.g. 'Title'.
+ toString() does not yet handle embedded quotes.
+*/
+class FormatString extends FormatElement
+{
+ private String s;
+
+
+ public FormatString( String s )
+ {
+ this.s = s;
+ }
+
+
+ public void write( FormatOutputList vp, PrintStream out )
+ {
+ out.print(this.s);
+ }
+
+
+ public void read( FormatInputList vp,
+ InputStreamAndBuffer in,
+ FormatMap format_map
+ )
+ throws InputFormatException
+ {
+ String s = in.getSlice( this.s.length(), vp.getPtr(), this );
+ if ( !( this.s.equals(s) ) )
+ throw new UnmatchedStringOnReadException( s,
+ vp.getPtr(),
+ this.toString(),
+ in.getLineErrorReport()
+ );
+ in.advance( this.s.length() );
+ }
+
+
+ public String toString()
+ {
+ return "'" + this.s + "'";
+ }
+}
+
+
+/* This class represents a mapping from input data. We use it to specify,
+ for example, that on input, an "X" should be replaced by a "0" before
+ being interpreted by the formatted input routines.
+ The user must provide an instance of this class, with getMapping
+ defined. getMapping should return either null, if the input string
+ is to be left as it is, or a replacement string.
+*/
+abstract class FormatMap
+{
+ public abstract String getMapping( String in );
+}
+
+
+interface FormatOutputList
+{
+ boolean hasCurrentElement();
+
+ void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException;
+
+ Object getCurrentElement();
+
+ Object getCurrentElementAndAdvance();
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+interface FormatInputList
+{
+ /* format_element and in are only for generating error messages.
+ */
+ void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+ // If the list is a VectorAndPointer, it won't throw an exception.
+ // If it is a StringsHashtableAndPointer, it will throw a
+ // EndOfKeyVectorOnReadException.
+
+ /* Puts o into the input list and advances its pointer.
+ Must be defined for each subclass.
+ format_element and in are only for generating error messages.
+ */
+ void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws InputFormatException;
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ int getPtr();
+}
+
+
+/* This class represents a Vector and a current-element pointer.
+ We use it when outputting or inputting a Vector against a format:
+ the pointer keeps track of the current element being output, and
+ can be incremented by the format write and read methods.
+*/
+class VectorAndPointer implements FormatInputList, FormatOutputList
+{
+ private Vector v = null;
+ private int vecptr = 0;
+ // On output, vecptr points at the next element to be used.
+ // On input, it points at the next free slot to be filled.
+
+
+ public VectorAndPointer( Vector v )
+ {
+ this.v = v;
+ }
+
+
+ public VectorAndPointer()
+ {
+ this.v = new Vector();
+ }
+
+
+ public boolean hasCurrentElement()
+ {
+ return ( this.vecptr < this.v.size() );
+ }
+
+
+ public void checkCurrentElementForWrite( FormatElement format_element )
+ throws EndOfVectorOnWriteException
+ {
+ if ( !hasCurrentElement() )
+ throw new EndOfVectorOnWriteException( this.vecptr,
+ format_element.toString()
+ );
+ }
+
+
+ /* Checks that the current element in the input list is OK and
+ throws an exception if not. For this implementation of
+ FormatInputList, there are no error conditions - we
+ introduced the method for the StringHashtableAndPointer class,
+ and need it here for compatibility.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ }
+
+
+ public Object getCurrentElement()
+ {
+ return this.v.elementAt( this.vecptr );
+ }
+
+ public Object getCurrentElementAndAdvance()
+ {
+ this.vecptr = this.vecptr+1;
+ return this.v.elementAt( this.vecptr-1 );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ format_element and in are only for generating error messages,
+ and not used in this implementation, since no error conditions
+ can arise.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ {
+ this.v.addElement(o);
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ public void advance()
+ {
+ this.vecptr = this.vecptr + 1;
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vecptr;
+ }
+}
+
+
+/* This class represents a Vector of Strings and a current-element pointer.
+ We use it when inputting data against a format.
+*/
+class StringsHashtableAndPointer implements FormatInputList
+{
+ private VectorAndPointer vp;
+ private Hashtable ht;
+
+
+ public StringsHashtableAndPointer( Vector strings, Hashtable ht )
+ {
+ this.vp = new VectorAndPointer( strings );
+ this.ht = ht;
+ }
+
+
+ /* Checks that there is a current element in the key vector, and
+ throws an exception if not.
+ format_element and in are only for generating error messages.
+ */
+ public void checkCurrentElementForRead( FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws EndOfKeyVectorOnReadException
+ {
+ if ( !(this.vp.hasCurrentElement() ) )
+ throw new EndOfKeyVectorOnReadException( this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Puts o into the input list and advances its pointer.
+ In this implementation, that means getting the current key,
+ putting o into an appropriate hashtable slot, and advancing
+ the pointer in the vector of keys.
+ format_element and in are only for generating error messages.
+ */
+ public void putElementAndAdvance( Object o,
+ FormatElement format_element,
+ InputStreamAndBuffer in
+ )
+ throws KeyNotStringOnReadException
+ {
+ Object current_key = this.vp.getCurrentElement();
+ if ( current_key instanceof String ) {
+ this.ht.put( (String)current_key, o );
+ this.vp.advance();
+ }
+ else
+ throw new KeyNotStringOnReadException( current_key,
+ this.vp.getPtr(),
+ format_element.toString(),
+ in.getLineErrorReport()
+ );
+ }
+
+
+ /* Returns the current pointer.
+ Used only in generating error messages.
+ */
+ public int getPtr()
+ {
+ return this.vp.getPtr();
+ }
+}
+
+
+/* This class holds an input stream and a line buffer.
+*/
+class InputStreamAndBuffer
+{
+ private DataInputStream in;
+ // The stream we read from.
+
+ private String line;
+ // The line just read.
+
+ private int ptr;
+ // Initialised to 0 after reading a line. Index of the next
+ // character to use in line.
+
+ private int line_number;
+ // Initially 0. Is incremented each time a line is read, so
+ // the first line read is number 1.
+
+ private boolean nothing_read;
+ // Initially true. Is set false after reading a line. We
+ // use this so that the first call of getSlice
+ // knows to read a line.
+
+
+ public InputStreamAndBuffer( DataInputStream in )
+ {
+ this.in = in;
+ this.ptr = 0;
+ this.line = "";
+ this.line_number = 0;
+ this.nothing_read = true;
+ }
+
+
+ /* Reads the next line into the line buffer.
+ vecptr and format are used only in generating error messages.
+ */
+ public void readLine( int vecptr, FormatElement format )
+ throws EndOfFileWhenStartingReadException,
+ LineMissingOnReadException,
+ IOExceptionOnReadException
+ {
+ try {
+ String line = this.in.readLine();
+
+ if ( line == null ) {
+ if ( this.nothing_read )
+ throw new EndOfFileWhenStartingReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ else
+ throw new LineMissingOnReadException( vecptr,
+ format.toString(),
+ this.line,
+ this.line_number
+ );
+ }
+ else {
+ this.ptr = 0;
+ this.nothing_read = false;
+ this.line_number = this.line_number + 1;
+ this.line = line;
+ // Don't do the assignment until we've checked for a null
+ // line, because then we can then use this.line as the
+ // previous value for error messages.
+ }
+ }
+ catch ( IOException e ) {
+ throw new IOExceptionOnReadException( this.line, this.line_number,
+ e.getMessage()
+ );
+ }
+ }
+
+
+ /* Returns a string consisting of the next width characters,
+ and throws an exception if the line is not long enough.
+ The 'vecptr' and 'format' parameters are used only in generating error
+ messages.
+ */
+ public String getSlice( int width, int vecptr, FormatElement format )
+ throws DataMissingOnReadException,
+ LineMissingOnReadException,
+ EndOfFileWhenStartingReadException,
+ IOExceptionOnReadException
+ {
+ if ( this.nothing_read )
+ readLine( vecptr, format );
+ if ( this.ptr+width > this.line.length() ) {
+/**
+ throw new DataMissingOnReadException( vecptr,
+ format.toString(),
+ getLineErrorReport()
+ );
+**/
+ return this.line.substring( this.ptr );
+ }
+ else {
+ return this.line.substring( this.ptr, this.ptr+width );
+ }
+ }
+
+
+ /* Advances the pointer by width.
+ */
+ public void advance( int width )
+ {
+ this.ptr = this.ptr + width;
+ }
+
+
+ /* Generates an error report showing the line, character pointer
+ ptr and line number.
+ */
+ public String getLineErrorReport()
+ {
+ StringBuffer s = new StringBuffer();
+
+ /* Report the line number. */
+ s.append( " Line number = " + this.line_number + ":\n" );
+
+ /* Show the line. */
+ s.append( this.line + "\n" );
+
+ /* Show an arrow under ptr. */
+ for ( int i=0; i<this.ptr; i++ )
+ s.append( " " );
+ s.append( "^" );
+
+ return s.toString();
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted output.
+*/
+abstract class OutputFormatException extends Exception
+{
+ public OutputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public OutputFormatException()
+ {
+ super();
+ }
+}
+
+
+/* This exception is thrown if formatted output runs off the
+ end of the vector being output before it has completed the
+ format.
+*/
+class EndOfVectorOnWriteException extends OutputFormatException
+{
+ public EndOfVectorOnWriteException( int vecptr,
+ String format
+ )
+ {
+// this( "End of vector while writing formatted data:\n" +
+// " Index = " + vecptr + "\n" +
+// " Format = " + format + " ."
+// );
+ }
+
+ public EndOfVectorOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfVectorOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects an object
+ that's the wrong type for a format element, e.g. a real
+ when outputting against an Iw element.
+*/
+class IllegalObjectOnWriteException extends OutputFormatException
+{
+ public IllegalObjectOnWriteException( Object o,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Illegal object while writing formatted data:\n" +
+ " Object = \"" + o + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public IllegalObjectOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public IllegalObjectOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a string
+ that won't fit in its format, e.g. trying to output abcde
+ against an A4 element.
+*/
+class StringTooWideOnWriteException extends OutputFormatException
+{
+ public StringTooWideOnWriteException( String s,
+ int vecptr,
+ String format
+ )
+ {
+ this( "String too wide while writing formatted data:\n" +
+ " String = \"" + s + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public StringTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public StringTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown if formatted output detects a number
+ that won't fit in its format, e.g. trying to output 1234
+ against an I3 element.
+*/
+class NumberTooWideOnWriteException extends OutputFormatException
+{
+ public NumberTooWideOnWriteException( Number n,
+ int vecptr,
+ String format
+ )
+ {
+ this( "Number too wide while writing formatted data:\n" +
+ " Number = \"" + n + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + " ."
+ );
+ }
+
+ public NumberTooWideOnWriteException( String s )
+ {
+ super( s );
+ }
+
+ public NumberTooWideOnWriteException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is a generic one, a superclass of all those
+ thrown to report an error while doing formatted input.
+*/
+abstract class InputFormatException extends Exception
+{
+ public InputFormatException( String s )
+ {
+ super( s );
+ }
+
+ public InputFormatException()
+ {
+ super();
+ }
+
+
+}
+
+
+class LineMissingOnReadException extends InputFormatException
+{
+ public LineMissingOnReadException( int vecptr,
+ String format,
+ String line,
+ int line_number
+ )
+ {
+ this( "End of file while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ "Last line was number " + line_number + ":\n" +
+ line
+ );
+ }
+
+ public LineMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public LineMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class DataMissingOnReadException extends InputFormatException
+{
+ public DataMissingOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this("Warning: EOL reading formatted data: idx=" +
+ vecptr + " fmt=" + format);
+ }
+
+ public DataMissingOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public DataMissingOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class InvalidNumberOnReadException extends InputFormatException
+{
+ public InvalidNumberOnReadException( String number,
+ int vecptr,
+ String format,
+ String line_error_report,
+ String parser_message
+ )
+ {
+ this( "Invalid number while reading formatted data:\n" +
+ " Number = \"" + number + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n" +
+ parser_message
+ );
+ }
+
+ public InvalidNumberOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public InvalidNumberOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class UnmatchedStringOnReadException extends InputFormatException
+{
+ public UnmatchedStringOnReadException( String string,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Unmatched string while reading formatted data:\n" +
+ " String = \"" + string + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public UnmatchedStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public UnmatchedStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class EndOfKeyVectorOnReadException extends InputFormatException
+{
+ public EndOfKeyVectorOnReadException( int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "End of key vector while reading formatted data:\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public EndOfKeyVectorOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public EndOfKeyVectorOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class KeyNotStringOnReadException extends InputFormatException
+{
+ public KeyNotStringOnReadException( Object key,
+ int vecptr,
+ String format,
+ String line_error_report
+ )
+ {
+ this( "Key not string while reading formatted data:\n" +
+ " Key = \"" + vecptr + "\"\n" +
+ " Index = " + vecptr + "\n" +
+ " Format = " + format + "\n" +
+ line_error_report + "\n"
+ );
+ }
+
+ public KeyNotStringOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public KeyNotStringOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+class IOExceptionOnReadException extends InputFormatException
+{
+ public IOExceptionOnReadException( String line,
+ int line_number,
+ String IOMessage
+ )
+ {
+ this( "IOException while reading formatted data:\n" +
+ "Last line was number " + line_number + ":\n" +
+ line + "\n" +
+ IOMessage
+ );
+ }
+
+ public IOExceptionOnReadException( String s )
+ {
+ super( s );
+ }
+
+ public IOExceptionOnReadException( )
+ {
+ super( );
+ }
+}
+
+
+/* This exception is thrown when a syntax error is detected while
+ parsing a format string.
+*/
+class InvalidFormatException extends Exception
+{
+ public InvalidFormatException( String parser_message )
+ {
+ super( parser_message );
+ }
+
+ public InvalidFormatException( )
+ {
+ super( );
+ }
+}
+
+
+/* This class is used to hold the parsers for formats and numbers.
+ We generate them static (see JavaCC documentation) because it
+ makes them more efficient. However, that then means that we need
+ somewhere to put an instance of each. That's what we use the result
+ of Parsers.theParsers() for.
+*/
+class Parsers
+{
+ static boolean already_created = false;
+ static Parsers parsers = null;
+
+ FormatParser format_parser = null;
+ NumberParser number_parser = null;
+
+
+ static Parsers theParsers()
+ {
+ if ( !(already_created) ) {
+ parsers = new Parsers();
+ already_created = true;
+ }
+ return parsers;
+ }
+
+
+ private Parsers()
+ {
+ this.format_parser = new FormatParser( new StringBufferInputStream("") );
+ this.number_parser = new NumberParser( new StringBufferInputStream("") );
+ }
+}
diff --git a/util/org/j_paine/formatter/NumberParser.java b/util/org/j_paine/formatter/NumberParser.java
new file mode 100644
index 0000000..93b5b12
--- /dev/null
+++ b/util/org/j_paine/formatter/NumberParser.java
@@ -0,0 +1,282 @@
+/* Generated By:JavaCC: Do not edit this line. NumberParser.java */
+package org.j_paine.formatter;
+
+class NumberParser implements NumberParserConstants {
+
+ final public int Float() throws ParseException {
+ int start = 0;
+ label_1:
+ while (true) {
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 6:
+ ;
+ break;
+ default:
+ jj_la1[0] = jj_gen;
+ break label_1;
+ }
+ jj_consume_token(6);
+ start++;
+ }
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 7:
+ case 8:
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 7:
+ jj_consume_token(7);
+ break;
+ case 8:
+ jj_consume_token(8);
+ break;
+ default:
+ jj_la1[1] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ break;
+ default:
+ jj_la1[2] = jj_gen;
+ ;
+ }
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case INTEGER_LITERAL:
+ jj_consume_token(INTEGER_LITERAL);
+ break;
+ case FLOATING_POINT_LITERAL:
+ jj_consume_token(FLOATING_POINT_LITERAL);
+ break;
+ default:
+ jj_la1[3] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ jj_consume_token(0);
+ {if (true) return start;}
+ throw new Error("Missing return statement in function");
+ }
+
+// This is the syntax of numbers we want a real format to accept.
+// The <EOF> makes sure that trailing non-numeric characters
+// (even spaces) are reported as an error.
+// Returns an integer which is the number of spaces to skip before
+// the number starts.
+ final public int Integer() throws ParseException {
+ int start = 0;
+ label_2:
+ while (true) {
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 6:
+ ;
+ break;
+ default:
+ jj_la1[4] = jj_gen;
+ break label_2;
+ }
+ jj_consume_token(6);
+ start++;
+ }
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 7:
+ case 8:
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 7:
+ jj_consume_token(7);
+ break;
+ case 8:
+ jj_consume_token(8);
+ break;
+ default:
+ jj_la1[5] = jj_gen;
+ jj_consume_token(-1);
+ throw new ParseException();
+ }
+ break;
+ default:
+ jj_la1[6] = jj_gen;
+ ;
+ }
+ jj_consume_token(INTEGER_LITERAL);
+ jj_consume_token(0);
+ {if (true) return start;}
+ throw new Error("Missing return statement in function");
+ }
+
+// This is the syntax of numbers we want an integer format to
+// accept.
+// Returns an integer which is the number of spaces to skip before
+// the number starts.
+ final public int Boolean() throws ParseException {
+ int start = 0;
+ label_3:
+ while (true) {
+ switch ((jj_ntk==-1)?jj_ntk():jj_ntk) {
+ case 6:
+ ;
+ break;
+ default:
+ jj_la1[7] = jj_gen;
+ break label_3;
+ }
+ jj_consume_token(6);
+ start++;
+ }
+ jj_consume_token(LOGICAL_LITERAL);
+ jj_consume_token(0);
+ {if (true) return start;}
+ throw new Error("Missing return statement in function");
+ }
+
+ public NumberParserTokenManager token_source;
+ SimpleCharStream jj_input_stream;
+ public Token token, jj_nt;
+ private int jj_ntk;
+ private int jj_gen;
+ final private int[] jj_la1 = new int[8];
+ static private int[] jj_la1_0;
+ static {
+ jj_la1_0();
+ }
+ private static void jj_la1_0() {
+ jj_la1_0 = new int[] {0x40,0x180,0x180,0x12,0x40,0x180,0x180,0x40,};
+ }
+
+ public NumberParser(java.io.InputStream stream) {
+ this(stream, null);
+ }
+ public NumberParser(java.io.InputStream stream, String encoding) {
+ try { jj_input_stream = new SimpleCharStream(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); }
+ token_source = new NumberParserTokenManager(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ public void ReInit(java.io.InputStream stream) {
+ ReInit(stream, null);
+ }
+ public void ReInit(java.io.InputStream stream, String encoding) {
+ try { jj_input_stream.ReInit(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); }
+ token_source.ReInit(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ public NumberParser(java.io.Reader stream) {
+ jj_input_stream = new SimpleCharStream(stream, 1, 1);
+ token_source = new NumberParserTokenManager(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ public void ReInit(java.io.Reader stream) {
+ jj_input_stream.ReInit(stream, 1, 1);
+ token_source.ReInit(jj_input_stream);
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ public NumberParser(NumberParserTokenManager tm) {
+ token_source = tm;
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ public void ReInit(NumberParserTokenManager tm) {
+ token_source = tm;
+ token = new Token();
+ jj_ntk = -1;
+ jj_gen = 0;
+ for (int i = 0; i < 8; i++) jj_la1[i] = -1;
+ }
+
+ final private Token jj_consume_token(int kind) throws ParseException {
+ Token oldToken;
+ if ((oldToken = token).next != null) token = token.next;
+ else token = token.next = token_source.getNextToken();
+ jj_ntk = -1;
+ if (token.kind == kind) {
+ jj_gen++;
+ return token;
+ }
+ token = oldToken;
+ jj_kind = kind;
+ throw generateParseException();
+ }
+
+ final public Token getNextToken() {
+ if (token.next != null) token = token.next;
+ else token = token.next = token_source.getNextToken();
+ jj_ntk = -1;
+ jj_gen++;
+ return token;
+ }
+
+ final public Token getToken(int index) {
+ Token t = token;
+ for (int i = 0; i < index; i++) {
+ if (t.next != null) t = t.next;
+ else t = t.next = token_source.getNextToken();
+ }
+ return t;
+ }
+
+ final private int jj_ntk() {
+ if ((jj_nt=token.next) == null)
+ return (jj_ntk = (token.next=token_source.getNextToken()).kind);
+ else
+ return (jj_ntk = jj_nt.kind);
+ }
+
+ private java.util.Vector jj_expentries = new java.util.Vector();
+ private int[] jj_expentry;
+ private int jj_kind = -1;
+
+ public ParseException generateParseException() {
+ jj_expentries.removeAllElements();
+ boolean[] la1tokens = new boolean[9];
+ for (int i = 0; i < 9; i++) {
+ la1tokens[i] = false;
+ }
+ if (jj_kind >= 0) {
+ la1tokens[jj_kind] = true;
+ jj_kind = -1;
+ }
+ for (int i = 0; i < 8; i++) {
+ if (jj_la1[i] == jj_gen) {
+ for (int j = 0; j < 32; j++) {
+ if ((jj_la1_0[i] & (1<<j)) != 0) {
+ la1tokens[j] = true;
+ }
+ }
+ }
+ }
+ for (int i = 0; i < 9; i++) {
+ if (la1tokens[i]) {
+ jj_expentry = new int[1];
+ jj_expentry[0] = i;
+ jj_expentries.addElement(jj_expentry);
+ }
+ }
+ int[][] exptokseq = new int[jj_expentries.size()][];
+ for (int i = 0; i < jj_expentries.size(); i++) {
+ exptokseq[i] = (int[])jj_expentries.elementAt(i);
+ }
+ return new ParseException(token, exptokseq, tokenImage);
+ }
+
+ final public void enable_tracing() {
+ }
+
+ final public void disable_tracing() {
+ }
+
+}
diff --git a/util/org/j_paine/formatter/NumberParser.jj b/util/org/j_paine/formatter/NumberParser.jj
new file mode 100644
index 0000000..ffe2fc2
--- /dev/null
+++ b/util/org/j_paine/formatter/NumberParser.jj
@@ -0,0 +1,95 @@
+/* NumberParser.java */
+
+
+/*
+This parser is used to check the syntax of numbers read by our
+formatted read routines.
+*/
+
+
+options {
+ STATIC = false;
+ DEBUG_PARSER = false;
+ DEBUG_TOKEN_MANAGER = false;
+ DEBUG_LOOKAHEAD = false;
+}
+
+PARSER_BEGIN(NumberParser)
+package org.j_paine.formatter;
+
+class NumberParser
+{
+}
+
+PARSER_END(NumberParser)
+
+
+TOKEN :
+{
+ < INTEGER_LITERAL:
+ <DECIMAL_LITERAL>
+ >
+|
+ < #DECIMAL_LITERAL:
+ "0"
+ | ["1"-"9"] (["0"-"9"])*
+ >
+|
+ < LOGICAL_LITERAL:
+ "T" | "F"
+ >
+ // We don't allow leading zeroes in integers, as these
+ // might indicate typing errors in the data.
+|
+ < FLOATING_POINT_LITERAL:
+ (["0"-"9"])+ "." (["0"-"9"])* (<EXPONENT>)?
+ | "." (["0"-"9"])+ (<EXPONENT>)?
+ | (["0"-"9"])+ <EXPONENT>
+ | (["0"-"9"])+ (<EXPONENT>)?
+ >
+|
+ < #EXPONENT: ["e","E"] (["+","-"])? (["0"-"9"])+ >
+}
+
+
+int Float():
+{ int start = 0;
+}
+{
+ ( " " {start++;} )*
+ [ "-" | "+" ]
+ ( <INTEGER_LITERAL> | <FLOATING_POINT_LITERAL> )
+ <EOF>
+ { return start; }
+}
+// This is the syntax of numbers we want a real format to accept.
+// The <EOF> makes sure that trailing non-numeric characters
+// (even spaces) are reported as an error.
+// Returns an integer which is the number of spaces to skip before
+// the number starts.
+
+
+int Integer():
+{ int start = 0;
+}
+{
+ ( " " {start++;} )*
+ [ "-" | "+" ]
+ <INTEGER_LITERAL>
+ <EOF>
+ { return start; }
+}
+// This is the syntax of numbers we want an integer format to
+// accept.
+// Returns an integer which is the number of spaces to skip before
+// the number starts.
+
+int Boolean():
+{ int start = 0;
+}
+{
+ ( " " {start++;} )*
+ <LOGICAL_LITERAL>
+ <EOF>
+ { return start; }
+}
diff --git a/util/org/j_paine/formatter/NumberParserConstants.java b/util/org/j_paine/formatter/NumberParserConstants.java
new file mode 100644
index 0000000..ed21bb3
--- /dev/null
+++ b/util/org/j_paine/formatter/NumberParserConstants.java
@@ -0,0 +1,27 @@
+/* Generated By:JavaCC: Do not edit this line. NumberParserConstants.java */
+package org.j_paine.formatter;
+
+public interface NumberParserConstants {
+
+ int EOF = 0;
+ int INTEGER_LITERAL = 1;
+ int DECIMAL_LITERAL = 2;
+ int LOGICAL_LITERAL = 3;
+ int FLOATING_POINT_LITERAL = 4;
+ int EXPONENT = 5;
+
+ int DEFAULT = 0;
+
+ String[] tokenImage = {
+ "<EOF>",
+ "<INTEGER_LITERAL>",
+ "<DECIMAL_LITERAL>",
+ "<LOGICAL_LITERAL>",
+ "<FLOATING_POINT_LITERAL>",
+ "<EXPONENT>",
+ "\" \"",
+ "\"-\"",
+ "\"+\"",
+ };
+
+}
diff --git a/util/org/j_paine/formatter/NumberParserTokenManager.java b/util/org/j_paine/formatter/NumberParserTokenManager.java
new file mode 100644
index 0000000..0a4bbbf
--- /dev/null
+++ b/util/org/j_paine/formatter/NumberParserTokenManager.java
@@ -0,0 +1,405 @@
+/* Generated By:JavaCC: Do not edit this line. NumberParserTokenManager.java */
+package org.j_paine.formatter;
+
+public class NumberParserTokenManager implements NumberParserConstants
+{
+ public java.io.PrintStream debugStream = System.out;
+ public void setDebugStream(java.io.PrintStream ds) { debugStream = ds; }
+private final int jjStopStringLiteralDfa_0(int pos, long active0)
+{
+ switch (pos)
+ {
+ default :
+ return -1;
+ }
+}
+private final int jjStartNfa_0(int pos, long active0)
+{
+ return jjMoveNfa_0(jjStopStringLiteralDfa_0(pos, active0), pos + 1);
+}
+private final int jjStopAtPos(int pos, int kind)
+{
+ jjmatchedKind = kind;
+ jjmatchedPos = pos;
+ return pos + 1;
+}
+private final int jjStartNfaWithStates_0(int pos, int kind, int state)
+{
+ jjmatchedKind = kind;
+ jjmatchedPos = pos;
+ try { curChar = input_stream.readChar(); }
+ catch(java.io.IOException e) { return pos + 1; }
+ return jjMoveNfa_0(state, pos + 1);
+}
+private final int jjMoveStringLiteralDfa0_0()
+{
+ switch(curChar)
+ {
+ case 32:
+ return jjStopAtPos(0, 6);
+ case 43:
+ return jjStopAtPos(0, 8);
+ case 45:
+ return jjStopAtPos(0, 7);
+ default :
+ return jjMoveNfa_0(0, 0);
+ }
+}
+private final void jjCheckNAdd(int state)
+{
+ if (jjrounds[state] != jjround)
+ {
+ jjstateSet[jjnewStateCnt++] = state;
+ jjrounds[state] = jjround;
+ }
+}
+private final void jjAddStates(int start, int end)
+{
+ do {
+ jjstateSet[jjnewStateCnt++] = jjnextStates[start];
+ } while (start++ != end);
+}
+private final void jjCheckNAddTwoStates(int state1, int state2)
+{
+ jjCheckNAdd(state1);
+ jjCheckNAdd(state2);
+}
+private final void jjCheckNAddStates(int start, int end)
+{
+ do {
+ jjCheckNAdd(jjnextStates[start]);
+ } while (start++ != end);
+}
+private final void jjCheckNAddStates(int start)
+{
+ jjCheckNAdd(jjnextStates[start]);
+ jjCheckNAdd(jjnextStates[start + 1]);
+}
+private final int jjMoveNfa_0(int startState, int curPos)
+{
+ int[] nextStates;
+ int startsAt = 0;
+ jjnewStateCnt = 24;
+ int i = 1;
+ jjstateSet[0] = startState;
+ int j, kind = 0x7fffffff;
+ for (;;)
+ {
+ if (++jjround == 0x7fffffff)
+ ReInitRounds();
+ if (curChar < 64)
+ {
+ long l = 1L << curChar;
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ case 0:
+ if ((0x3ff000000000000L & l) != 0L)
+ {
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddStates(0, 5);
+ }
+ else if (curChar == 46)
+ jjCheckNAdd(5);
+ if ((0x3fe000000000000L & l) != 0L)
+ {
+ if (kind > 1)
+ kind = 1;
+ jjCheckNAdd(2);
+ }
+ else if (curChar == 48)
+ {
+ if (kind > 1)
+ kind = 1;
+ }
+ break;
+ case 1:
+ if ((0x3fe000000000000L & l) == 0L)
+ break;
+ if (kind > 1)
+ kind = 1;
+ jjCheckNAdd(2);
+ break;
+ case 2:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 1)
+ kind = 1;
+ jjCheckNAdd(2);
+ break;
+ case 4:
+ if (curChar == 46)
+ jjCheckNAdd(5);
+ break;
+ case 5:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddTwoStates(5, 6);
+ break;
+ case 7:
+ if ((0x280000000000L & l) != 0L)
+ jjCheckNAdd(8);
+ break;
+ case 8:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAdd(8);
+ break;
+ case 9:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddStates(0, 5);
+ break;
+ case 10:
+ if ((0x3ff000000000000L & l) != 0L)
+ jjCheckNAddTwoStates(10, 11);
+ break;
+ case 11:
+ if (curChar != 46)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddTwoStates(12, 13);
+ break;
+ case 12:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddTwoStates(12, 13);
+ break;
+ case 14:
+ if ((0x280000000000L & l) != 0L)
+ jjCheckNAdd(15);
+ break;
+ case 15:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAdd(15);
+ break;
+ case 16:
+ if ((0x3ff000000000000L & l) != 0L)
+ jjCheckNAddTwoStates(16, 17);
+ break;
+ case 18:
+ if ((0x280000000000L & l) != 0L)
+ jjCheckNAdd(19);
+ break;
+ case 19:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAdd(19);
+ break;
+ case 20:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAddTwoStates(20, 21);
+ break;
+ case 22:
+ if ((0x280000000000L & l) != 0L)
+ jjCheckNAdd(23);
+ break;
+ case 23:
+ if ((0x3ff000000000000L & l) == 0L)
+ break;
+ if (kind > 4)
+ kind = 4;
+ jjCheckNAdd(23);
+ break;
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ else if (curChar < 128)
+ {
+ long l = 1L << (curChar & 077);
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ case 0:
+ if ((0x100040L & l) != 0L)
+ kind = 3;
+ break;
+ case 6:
+ if ((0x2000000020L & l) != 0L)
+ jjAddStates(6, 7);
+ break;
+ case 13:
+ if ((0x2000000020L & l) != 0L)
+ jjAddStates(8, 9);
+ break;
+ case 17:
+ if ((0x2000000020L & l) != 0L)
+ jjAddStates(10, 11);
+ break;
+ case 21:
+ if ((0x2000000020L & l) != 0L)
+ jjAddStates(12, 13);
+ break;
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ else
+ {
+ int i2 = (curChar & 0xff) >> 6;
+ long l2 = 1L << (curChar & 077);
+ MatchLoop: do
+ {
+ switch(jjstateSet[--i])
+ {
+ default : break;
+ }
+ } while(i != startsAt);
+ }
+ if (kind != 0x7fffffff)
+ {
+ jjmatchedKind = kind;
+ jjmatchedPos = curPos;
+ kind = 0x7fffffff;
+ }
+ ++curPos;
+ if ((i = jjnewStateCnt) == (startsAt = 24 - (jjnewStateCnt = startsAt)))
+ return curPos;
+ try { curChar = input_stream.readChar(); }
+ catch(java.io.IOException e) { return curPos; }
+ }
+}
+static final int[] jjnextStates = {
+ 10, 11, 16, 17, 20, 21, 7, 8, 14, 15, 18, 19, 22, 23,
+};
+public static final String[] jjstrLiteralImages = {
+"", null, null, null, null, null, "\40", "\55", "\53", };
+public static final String[] lexStateNames = {
+ "DEFAULT",
+};
+protected SimpleCharStream input_stream;
+private final int[] jjrounds = new int[24];
+private final int[] jjstateSet = new int[48];
+protected char curChar;
+public NumberParserTokenManager(SimpleCharStream stream){
+ if (SimpleCharStream.staticFlag)
+ throw new Error("ERROR: Cannot use a static CharStream class with a non-static lexical analyzer.");
+ input_stream = stream;
+}
+public NumberParserTokenManager(SimpleCharStream stream, int lexState){
+ this(stream);
+ SwitchTo(lexState);
+}
+public void ReInit(SimpleCharStream stream)
+{
+ jjmatchedPos = jjnewStateCnt = 0;
+ curLexState = defaultLexState;
+ input_stream = stream;
+ ReInitRounds();
+}
+private final void ReInitRounds()
+{
+ int i;
+ jjround = 0x80000001;
+ for (i = 24; i-- > 0;)
+ jjrounds[i] = 0x80000000;
+}
+public void ReInit(SimpleCharStream stream, int lexState)
+{
+ ReInit(stream);
+ SwitchTo(lexState);
+}
+public void SwitchTo(int lexState)
+{
+ if (lexState >= 1 || lexState < 0)
+ throw new TokenMgrError("Error: Ignoring invalid lexical state : " + lexState + ". State unchanged.", TokenMgrError.INVALID_LEXICAL_STATE);
+ else
+ curLexState = lexState;
+}
+
+protected Token jjFillToken()
+{
+ Token t = Token.newToken(jjmatchedKind);
+ t.kind = jjmatchedKind;
+ String im = jjstrLiteralImages[jjmatchedKind];
+ t.image = (im == null) ? input_stream.GetImage() : im;
+ t.beginLine = input_stream.getBeginLine();
+ t.beginColumn = input_stream.getBeginColumn();
+ t.endLine = input_stream.getEndLine();
+ t.endColumn = input_stream.getEndColumn();
+ return t;
+}
+
+int curLexState = 0;
+int defaultLexState = 0;
+int jjnewStateCnt;
+int jjround;
+int jjmatchedPos;
+int jjmatchedKind;
+
+public Token getNextToken()
+{
+ int kind;
+ Token specialToken = null;
+ Token matchedToken;
+ int curPos = 0;
+
+ EOFLoop :
+ for (;;)
+ {
+ try
+ {
+ curChar = input_stream.BeginToken();
+ }
+ catch(java.io.IOException e)
+ {
+ jjmatchedKind = 0;
+ matchedToken = jjFillToken();
+ return matchedToken;
+ }
+
+ jjmatchedKind = 0x7fffffff;
+ jjmatchedPos = 0;
+ curPos = jjMoveStringLiteralDfa0_0();
+ if (jjmatchedKind != 0x7fffffff)
+ {
+ if (jjmatchedPos + 1 < curPos)
+ input_stream.backup(curPos - jjmatchedPos - 1);
+ matchedToken = jjFillToken();
+ return matchedToken;
+ }
+ int error_line = input_stream.getEndLine();
+ int error_column = input_stream.getEndColumn();
+ String error_after = null;
+ boolean EOFSeen = false;
+ try { input_stream.readChar(); input_stream.backup(1); }
+ catch (java.io.IOException e1) {
+ EOFSeen = true;
+ error_after = curPos <= 1 ? "" : input_stream.GetImage();
+ if (curChar == '\n' || curChar == '\r') {
+ error_line++;
+ error_column = 0;
+ }
+ else
+ error_column++;
+ }
+ if (!EOFSeen) {
+ input_stream.backup(1);
+ error_after = curPos <= 1 ? "" : input_stream.GetImage();
+ }
+ throw new TokenMgrError(EOFSeen, curLexState, error_line, error_column, error_after, curChar, TokenMgrError.LEXICAL_ERROR);
+ }
+}
+
+}
diff --git a/util/org/j_paine/formatter/ParseException.java b/util/org/j_paine/formatter/ParseException.java
new file mode 100644
index 0000000..2db0cef
--- /dev/null
+++ b/util/org/j_paine/formatter/ParseException.java
@@ -0,0 +1,192 @@
+/* Generated By:JavaCC: Do not edit this line. ParseException.java Version 3.0 */
+package org.j_paine.formatter;
+
+/**
+ * This exception is thrown when parse errors are encountered.
+ * You can explicitly create objects of this exception type by
+ * calling the method generateParseException in the generated
+ * parser.
+ *
+ * You can modify this class to customize your error reporting
+ * mechanisms so long as you retain the public fields.
+ */
+public class ParseException extends Exception {
+
+ /**
+ * This constructor is used by the method "generateParseException"
+ * in the generated parser. Calling this constructor generates
+ * a new object of this type with the fields "currentToken",
+ * "expectedTokenSequences", and "tokenImage" set. The boolean
+ * flag "specialConstructor" is also set to true to indicate that
+ * this constructor was used to create this object.
+ * This constructor calls its super class with the empty string
+ * to force the "toString" method of parent class "Throwable" to
+ * print the error message in the form:
+ * ParseException: <result of getMessage>
+ */
+ public ParseException(Token currentTokenVal,
+ int[][] expectedTokenSequencesVal,
+ String[] tokenImageVal
+ )
+ {
+ super("");
+ specialConstructor = true;
+ currentToken = currentTokenVal;
+ expectedTokenSequences = expectedTokenSequencesVal;
+ tokenImage = tokenImageVal;
+ }
+
+ /**
+ * The following constructors are for use by you for whatever
+ * purpose you can think of. Constructing the exception in this
+ * manner makes the exception behave in the normal way - i.e., as
+ * documented in the class "Throwable". The fields "errorToken",
+ * "expectedTokenSequences", and "tokenImage" do not contain
+ * relevant information. The JavaCC generated code does not use
+ * these constructors.
+ */
+
+ public ParseException() {
+ super();
+ specialConstructor = false;
+ }
+
+ public ParseException(String message) {
+ super(message);
+ specialConstructor = false;
+ }
+
+ /**
+ * This variable determines which constructor was used to create
+ * this object and thereby affects the semantics of the
+ * "getMessage" method (see below).
+ */
+ protected boolean specialConstructor;
+
+ /**
+ * This is the last token that has been consumed successfully. If
+ * this object has been created due to a parse error, the token
+ * followng this token will (therefore) be the first error token.
+ */
+ public Token currentToken;
+
+ /**
+ * Each entry in this array is an array of integers. Each array
+ * of integers represents a sequence of tokens (by their ordinal
+ * values) that is expected at this point of the parse.
+ */
+ public int[][] expectedTokenSequences;
+
+ /**
+ * This is a reference to the "tokenImage" array of the generated
+ * parser within which the parse error occurred. This array is
+ * defined in the generated ...Constants interface.
+ */
+ public String[] tokenImage;
+
+ /**
+ * This method has the standard behavior when this object has been
+ * created using the standard constructors. Otherwise, it uses
+ * "currentToken" and "expectedTokenSequences" to generate a parse
+ * error message and returns it. If this object has been created
+ * due to a parse error, and you do not catch it (it gets thrown
+ * from the parser), then this method is called during the printing
+ * of the final stack trace, and hence the correct error message
+ * gets displayed.
+ */
+ public String getMessage() {
+ if (!specialConstructor) {
+ return super.getMessage();
+ }
+ StringBuffer expected = new StringBuffer();
+ int maxSize = 0;
+ for (int i = 0; i < expectedTokenSequences.length; i++) {
+ if (maxSize < expectedTokenSequences[i].length) {
+ maxSize = expectedTokenSequences[i].length;
+ }
+ for (int j = 0; j < expectedTokenSequences[i].length; j++) {
+ expected.append(tokenImage[expectedTokenSequences[i][j]]).append(" ");
+ }
+ if (expectedTokenSequences[i][expectedTokenSequences[i].length - 1] != 0) {
+ expected.append("...");
+ }
+ expected.append(eol).append(" ");
+ }
+ String retval = "Encountered \"";
+ Token tok = currentToken.next;
+ for (int i = 0; i < maxSize; i++) {
+ if (i != 0) retval += " ";
+ if (tok.kind == 0) {
+ retval += tokenImage[0];
+ break;
+ }
+ retval += add_escapes(tok.image);
+ tok = tok.next;
+ }
+ retval += "\" at line " + currentToken.next.beginLine + ", column " + currentToken.next.beginColumn;
+ retval += "." + eol;
+ if (expectedTokenSequences.length == 1) {
+ retval += "Was expecting:" + eol + " ";
+ } else {
+ retval += "Was expecting one of:" + eol + " ";
+ }
+ retval += expected.toString();
+ return retval;
+ }
+
+ /**
+ * The end of line string for this machine.
+ */
+ protected String eol = System.getProperty("line.separator", "\n");
+
+ /**
+ * Used to convert raw characters to their escaped version
+ * when these raw version cannot be used as part of an ASCII
+ * string literal.
+ */
+ protected String add_escapes(String str) {
+ StringBuffer retval = new StringBuffer();
+ char ch;
+ for (int i = 0; i < str.length(); i++) {
+ switch (str.charAt(i))
+ {
+ case 0 :
+ continue;
+ case '\b':
+ retval.append("\\b");
+ continue;
+ case '\t':
+ retval.append("\\t");
+ continue;
+ case '\n':
+ retval.append("\\n");
+ continue;
+ case '\f':
+ retval.append("\\f");
+ continue;
+ case '\r':
+ retval.append("\\r");
+ continue;
+ case '\"':
+ retval.append("\\\"");
+ continue;
+ case '\'':
+ retval.append("\\\'");
+ continue;
+ case '\\':
+ retval.append("\\\\");
+ continue;
+ default:
+ if ((ch = str.charAt(i)) < 0x20 || ch > 0x7e) {
+ String s = "0000" + Integer.toString(ch, 16);
+ retval.append("\\u" + s.substring(s.length() - 4, s.length()));
+ } else {
+ retval.append(ch);
+ }
+ continue;
+ }
+ }
+ return retval.toString();
+ }
+
+}
diff --git a/util/org/j_paine/formatter/PrintfFormat.java b/util/org/j_paine/formatter/PrintfFormat.java
new file mode 100644
index 0000000..e1633bd
--- /dev/null
+++ b/util/org/j_paine/formatter/PrintfFormat.java
@@ -0,0 +1,3091 @@
+
+//
+// (c) 2000 Sun Microsystems, Inc.
+// ALL RIGHTS RESERVED
+//
+// License Grant-
+//
+//
+// Permission to use, copy, modify, and distribute this Software and its
+// documentation for NON-COMMERCIAL or COMMERCIAL purposes and without fee is
+// hereby granted.
+//
+// This Software is provided "AS IS". All express warranties, including any
+// implied warranty of merchantability, satisfactory quality, fitness for a
+// particular purpose, or non-infringement, are disclaimed, except to the extent
+// that such disclaimers are held to be legally invalid.
+//
+// You acknowledge that Software is not designed, licensed or intended for use in
+// the design, construction, operation or maintenance of any nuclear facility
+// ("High Risk Activities"). Sun disclaims any express or implied warranty of
+// fitness for such uses.
+//
+// Please refer to the file http://www.sun.com/policies/trademarks/ for further
+// important trademark information and to
+// http://java.sun.com/nav/business/index.html for further important licensing
+// information for the Java Technology.
+//
+package org.j_paine.formatter;
+
+import java.util.Enumeration;
+import java.util.Vector;
+import java.util.Locale;
+import java.text.DecimalFormatSymbols;
+
+/**
+ * PrintfFormat allows the formatting of an array of
+ * objects embedded within a string. Primitive types
+ * must be passed using wrapper types. The formatting
+ * is controlled by a control string.
+ *<p>
+ * A control string is a Java string that contains a
+ * control specification. The control specification
+ * starts at the first percent sign (%) in the string,
+ * provided that this percent sign
+ *<ol>
+ *<li>is not escaped protected by a matching % or is
+ * not an escape % character,
+ *<li>is not at the end of the format string, and
+ *<li>precedes a sequence of characters that parses as
+ * a valid control specification.
+ *</ol>
+ *</p><p>
+ * A control specification usually takes the form:
+ *<pre> % ['-+ #0]* [0..9]* { . [0..9]* }+
+ * { [hlL] }+ [idfgGoxXeEcs]
+ *</pre>
+ * There are variants of this basic form that are
+ * discussed below.</p>
+ *<p>
+ * The format is composed of zero or more directives
+ * defined as follows:
+ *<ul>
+ *<li>ordinary characters, which are simply copied to
+ * the output stream;
+ *<li>escape sequences, which represent non-graphic
+ * characters; and
+ *<li>conversion specifications, each of which
+ * results in the fetching of zero or more arguments.
+ *</ul></p>
+ *<p>
+ * The results are undefined if there are insufficient
+ * arguments for the format. Usually an unchecked
+ * exception will be thrown. If the format is
+ * exhausted while arguments remain, the excess
+ * arguments are evaluated but are otherwise ignored.
+ * In format strings containing the % form of
+ * conversion specifications, each argument in the
+ * argument list is used exactly once.</p>
+ * <p>
+ * Conversions can be applied to the <code>n</code>th
+ * argument after the format in the argument list,
+ * rather than to the next unused argument. In this
+ * case, the conversion characer % is replaced by the
+ * sequence %<code>n</code>$, where <code>n</code> is
+ * a decimal integer giving the position of the
+ * argument in the argument list.</p>
+ * <p>
+ * In format strings containing the %<code>n</code>$
+ * form of conversion specifications, each argument
+ * in the argument list is used exactly once.</p>
+ *
+ *<h4>Escape Sequences</h4>
+ *<p>
+ * The following table lists escape sequences and
+ * associated actions on display devices capable of
+ * the action.
+ *<table>
+ *<tr><th align=left>Sequence</th>
+ * <th align=left>Name</th>
+ * <th align=left>Description</th></tr>
+ *<tr><td>\\</td><td>backlash</td><td>None.
+ *</td></tr>
+ *<tr><td>\a</td><td>alert</td><td>Attempts to alert
+ * the user through audible or visible
+ * notification.
+ *</td></tr>
+ *<tr><td>\b</td><td>backspace</td><td>Moves the
+ * printing position to one column before
+ * the current position, unless the
+ * current position is the start of a line.
+ *</td></tr>
+ *<tr><td>\f</td><td>form-feed</td><td>Moves the
+ * printing position to the initial
+ * printing position of the next logical
+ * page.
+ *</td></tr>
+ *<tr><td>\n</td><td>newline</td><td>Moves the
+ * printing position to the start of the
+ * next line.
+ *</td></tr>
+ *<tr><td>\r</td><td>carriage-return</td><td>Moves
+ * the printing position to the start of
+ * the current line.
+ *</td></tr>
+ *<tr><td>\t</td><td>tab</td><td>Moves the printing
+ * position to the next implementation-
+ * defined horizontal tab position.
+ *</td></tr>
+ *<tr><td>\v</td><td>vertical-tab</td><td>Moves the
+ * printing position to the start of the
+ * next implementation-defined vertical
+ * tab position.
+ *</td></tr>
+ *</table></p>
+ *<h4>Conversion Specifications</h4>
+ *<p>
+ * Each conversion specification is introduced by
+ * the percent sign character (%). After the character
+ * %, the following appear in sequence:</p>
+ *<p>
+ * Zero or more flags (in any order), which modify the
+ * meaning of the conversion specification.</p>
+ *<p>
+ * An optional minimum field width. If the converted
+ * value has fewer characters than the field width, it
+ * will be padded with spaces by default on the left;
+ * t will be padded on the right, if the left-
+ * adjustment flag (-), described below, is given to
+ * the field width. The field width takes the form
+ * of a decimal integer. If the conversion character
+ * is s, the field width is the the minimum number of
+ * characters to be printed.</p>
+ *<p>
+ * An optional precision that gives the minumum number
+ * of digits to appear for the d, i, o, x or X
+ * conversions (the field is padded with leading
+ * zeros); the number of digits to appear after the
+ * radix character for the e, E, and f conversions,
+ * the maximum number of significant digits for the g
+ * and G conversions; or the maximum number of
+ * characters to be written from a string is s and S
+ * conversions. The precision takes the form of an
+ * optional decimal digit string, where a null digit
+ * string is treated as 0. If a precision appears
+ * with a c conversion character the precision is
+ * ignored.
+ * </p>
+ *<p>
+ * An optional h specifies that a following d, i, o,
+ * x, or X conversion character applies to a type
+ * short argument (the argument will be promoted
+ * according to the integral promotions and its value
+ * converted to type short before printing).</p>
+ *<p>
+ * An optional l (ell) specifies that a following
+ * d, i, o, x, or X conversion character applies to a
+ * type long argument.</p>
+ *<p>
+ * A field width or precision may be indicated by an
+ * asterisk (*) instead of a digit string. In this
+ * case, an integer argument supplised the field width
+ * precision. The argument that is actually converted
+ * is not fetched until the conversion letter is seen,
+ * so the the arguments specifying field width or
+ * precision must appear before the argument (if any)
+ * to be converted. If the precision argument is
+ * negative, it will be changed to zero. A negative
+ * field width argument is taken as a - flag, followed
+ * by a positive field width.</p>
+ * <p>
+ * In format strings containing the %<code>n</code>$
+ * form of a conversion specification, a field width
+ * or precision may be indicated by the sequence
+ * *<code>m</code>$, where m is a decimal integer
+ * giving the position in the argument list (after the
+ * format argument) of an integer argument containing
+ * the field width or precision.</p>
+ * <p>
+ * The format can contain either numbered argument
+ * specifications (that is, %<code>n</code>$ and
+ * *<code>m</code>$), or unnumbered argument
+ * specifications (that is % and *), but normally not
+ * both. The only exception to this is that %% can
+ * be mixed with the %<code>n</code>$ form. The
+ * results of mixing numbered and unnumbered argument
+ * specifications in a format string are undefined.</p>
+ *
+ *<h4>Flag Characters</h4>
+ *<p>
+ * The flags and their meanings are:</p>
+ *<dl>
+ * <dt>'<dd> integer portion of the result of a
+ * decimal conversion (%i, %d, %f, %g, or %G) will
+ * be formatted with thousands' grouping
+ * characters. For other conversions the flag
+ * is ignored. The non-monetary grouping
+ * character is used.
+ * <dt>-<dd> result of the conversion is left-justified
+ * within the field. (It will be right-justified
+ * if this flag is not specified).</td></tr>
+ * <dt>+<dd> result of a signed conversion always
+ * begins with a sign (+ or -). (It will begin
+ * with a sign only when a negative value is
+ * converted if this flag is not specified.)
+ * <dt><space><dd> If the first character of a
+ * signed conversion is not a sign, a space
+ * character will be placed before the result.
+ * This means that if the space character and +
+ * flags both appear, the space flag will be
+ * ignored.
+ * <dt>#<dd> value is to be converted to an alternative
+ * form. For c, d, i, and s conversions, the flag
+ * has no effect. For o conversion, it increases
+ * the precision to force the first digit of the
+ * result to be a zero. For x or X conversion, a
+ * non-zero result has 0x or 0X prefixed to it,
+ * respectively. For e, E, f, g, and G
+ * conversions, the result always contains a radix
+ * character, even if no digits follow the radix
+ * character (normally, a decimal point appears in
+ * the result of these conversions only if a digit
+ * follows it). For g and G conversions, trailing
+ * zeros will not be removed from the result as
+ * they normally are.
+ * <dt>0<dd> d, i, o, x, X, e, E, f, g, and G
+ * conversions, leading zeros (following any
+ * indication of sign or base) are used to pad to
+ * the field width; no space padding is
+ * performed. If the 0 and - flags both appear,
+ * the 0 flag is ignored. For d, i, o, x, and X
+ * conversions, if a precision is specified, the
+ * 0 flag will be ignored. For c conversions,
+ * the flag is ignored.
+ *</dl>
+ *
+ *<h4>Conversion Characters</h4>
+ *<p>
+ * Each conversion character results in fetching zero
+ * or more arguments. The results are undefined if
+ * there are insufficient arguments for the format.
+ * Usually, an unchecked exception will be thrown.
+ * If the format is exhausted while arguments remain,
+ * the excess arguments are ignored.</p>
+ *
+ *<p>
+ * The conversion characters and their meanings are:
+ *</p>
+ *<dl>
+ * <dt>d,i<dd>The int argument is converted to a
+ * signed decimal in the style [-]dddd. The
+ * precision specifies the minimum number of
+ * digits to appear; if the value being
+ * converted can be represented in fewer
+ * digits, it will be expanded with leading
+ * zeros. The default precision is 1. The
+ * result of converting 0 with an explicit
+ * precision of 0 is no characters.
+ * <dt>o<dd> The int argument is converted to unsigned
+ * octal format in the style ddddd. The
+ * precision specifies the minimum number of
+ * digits to appear; if the value being
+ * converted can be represented in fewer
+ * digits, it will be expanded with leading
+ * zeros. The default precision is 1. The
+ * result of converting 0 with an explicit
+ * precision of 0 is no characters.
+ * <dt>x<dd> The int argument is converted to unsigned
+ * hexadecimal format in the style dddd; the
+ * letters abcdef are used. The precision
+ * specifies the minimum numberof digits to
+ * appear; if the value being converted can be
+ * represented in fewer digits, it will be
+ * expanded with leading zeros. The default
+ * precision is 1. The result of converting 0
+ * with an explicit precision of 0 is no
+ * characters.
+ * <dt>X<dd> Behaves the same as the x conversion
+ * character except that letters ABCDEF are
+ * used instead of abcdef.
+ * <dt>f<dd> The floating point number argument is
+ * written in decimal notation in the style
+ * [-]ddd.ddd, where the number of digits after
+ * the radix character (shown here as a decimal
+ * point) is equal to the precision
+ * specification. A Locale is used to determine
+ * the radix character to use in this format.
+ * If the precision is omitted from the
+ * argument, six digits are written after the
+ * radix character; if the precision is
+ * explicitly 0 and the # flag is not specified,
+ * no radix character appears. If a radix
+ * character appears, at least 1 digit appears
+ * before it. The value is rounded to the
+ * appropriate number of digits.
+ * <dt>e,E<dd>The floating point number argument is
+ * written in the style [-]d.ddde{+-}dd
+ * (the symbols {+-} indicate either a plus or
+ * minus sign), where there is one digit before
+ * the radix character (shown here as a decimal
+ * point) and the number of digits after it is
+ * equal to the precision. A Locale is used to
+ * determine the radix character to use in this
+ * format. When the precision is missing, six
+ * digits are written after the radix character;
+ * if the precision is 0 and the # flag is not
+ * specified, no radix character appears. The
+ * E conversion will produce a number with E
+ * instead of e introducing the exponent. The
+ * exponent always contains at least two digits.
+ * However, if the value to be written requires
+ * an exponent greater than two digits,
+ * additional exponent digits are written as
+ * necessary. The value is rounded to the
+ * appropriate number of digits.
+ * <dt>g,G<dd>The floating point number argument is
+ * written in style f or e (or in sytle E in the
+ * case of a G conversion character), with the
+ * precision specifying the number of
+ * significant digits. If the precision is
+ * zero, it is taken as one. The style used
+ * depends on the value converted: style e
+ * (or E) will be used only if the exponent
+ * resulting from the conversion is less than
+ * -4 or greater than or equal to the precision.
+ * Trailing zeros are removed from the result.
+ * A radix character appears only if it is
+ * followed by a digit.
+ * <dt>c,C<dd>The integer argument is converted to a
+ * char and the result is written.
+ *
+ * <dt>s,S<dd>The argument is taken to be a string and
+ * bytes from the string are written until the
+ * end of the string or the number of bytes
+ * indicated by the precision specification of
+ * the argument is reached. If the precision
+ * is omitted from the argument, it is taken to
+ * be infinite, so all characters up to the end
+ * of the string are written.
+ * <dt>%<dd>Write a % character; no argument is
+ * converted.
+ *</dl>
+ *<p>
+ * If a conversion specification does not match one of
+ * the above forms, an IllegalArgumentException is
+ * thrown and the instance of PrintfFormat is not
+ * created.</p>
+ *<p>
+ * If a floating point value is the internal
+ * representation for infinity, the output is
+ * [+]Infinity, where Infinity is either Infinity or
+ * Inf, depending on the desired output string length.
+ * Printing of the sign follows the rules described
+ * above.</p>
+ *<p>
+ * If a floating point value is the internal
+ * representation for "not-a-number," the output is
+ * [+]NaN. Printing of the sign follows the rules
+ * described above.</p>
+ *<p>
+ * In no case does a non-existent or small field width
+ * cause truncation of a field; if the result of a
+ * conversion is wider than the field width, the field
+ * is simply expanded to contain the conversion result.
+ *</p>
+ *<p>
+ * The behavior is like printf. One exception is that
+ * the minimum number of exponent digits is 3 instead
+ * of 2 for e and E formats when the optional L is used
+ * before the e, E, g, or G conversion character. The
+ * optional L does not imply conversion to a long long
+ * double. </p>
+ * <p>
+ * The biggest divergence from the C printf
+ * specification is in the use of 16 bit characters.
+ * This allows the handling of characters beyond the
+ * small ASCII character set and allows the utility to
+ * interoperate correctly with the rest of the Java
+ * runtime environment.</p>
+ *<p>
+ * Omissions from the C printf specification are
+ * numerous. All the known omissions are present
+ * because Java never uses bytes to represent
+ * characters and does not have pointers:</p>
+ *<ul>
+ * <li>%c is the same as %C.
+ * <li>%s is the same as %S.
+ * <li>u, p, and n conversion characters.
+ * <li>%ws format.
+ * <li>h modifier applied to an n conversion character.
+ * <li>l (ell) modifier applied to the c, n, or s
+ * conversion characters.
+ * <li>ll (ell ell) modifier to d, i, o, u, x, or X
+ * conversion characters.
+ * <li>ll (ell ell) modifier to an n conversion
+ * character.
+ * <li>c, C, d,i,o,u,x, and X conversion characters
+ * apply to Byte, Character, Short, Integer, Long
+ * types.
+ * <li>f, e, E, g, and G conversion characters apply
+ * to Float and Double types.
+ * <li>s and S conversion characters apply to String
+ * types.
+ * <li>All other reference types can be formatted
+ * using the s or S conversion characters only.
+ *</ul>
+ * <p>
+ * Most of this specification is quoted from the Unix
+ * man page for the sprintf utility.</p>
+ *
+ * @author Allan Jacobs
+ * @version 1
+ * Release 1: Initial release.
+ * Release 2: Asterisk field widths and precisions
+ * %n$ and *m$
+ * Bug fixes
+ * g format fix (2 digits in e form corrupt)
+ * rounding in f format implemented
+ * round up when digit not printed is 5
+ * formatting of -0.0f
+ * round up/down when last digits are 50000...
+ */
+public class PrintfFormat {
+ /**
+ * Constructs an array of control specifications
+ * possibly preceded, separated, or followed by
+ * ordinary strings. Control strings begin with
+ * unpaired percent signs. A pair of successive
+ * percent signs designates a single percent sign in
+ * the format.
+ * @param fmtArg Control string.
+ * @exception IllegalArgumentException if the control
+ * string is null, zero length, or otherwise
+ * malformed.
+ */
+ public PrintfFormat(String fmtArg)
+ throws IllegalArgumentException {
+ this(Locale.getDefault(),fmtArg);
+ }
+ /**
+ * Constructs an array of control specifications
+ * possibly preceded, separated, or followed by
+ * ordinary strings. Control strings begin with
+ * unpaired percent signs. A pair of successive
+ * percent signs designates a single percent sign in
+ * the format.
+ * @param fmtArg Control string.
+ * @exception IllegalArgumentException if the control
+ * string is null, zero length, or otherwise
+ * malformed.
+ */
+ public PrintfFormat(Locale locale,String fmtArg)
+ throws IllegalArgumentException {
+ dfs = new DecimalFormatSymbols(locale);
+ int ePos=0;
+ ConversionSpecification sFmt=null;
+ String unCS = this.nonControl(fmtArg,0);
+ if (unCS!=null) {
+ sFmt = new ConversionSpecification();
+ sFmt.setLiteral(unCS);
+ vFmt.addElement(sFmt);
+ }
+ while(cPos!=-1 && cPos<fmtArg.length()) {
+ for (ePos=cPos+1; ePos<fmtArg.length();
+ ePos++) {
+ char c=0;
+ c = fmtArg.charAt(ePos);
+ if (c == 'i') break;
+ if (c == 'd') break;
+ if (c == 'f') break;
+ if (c == 'g') break;
+ if (c == 'G') break;
+ if (c == 'o') break;
+ if (c == 'x') break;
+ if (c == 'X') break;
+ if (c == 'e') break;
+ if (c == 'E') break;
+ if (c == 'c') break;
+ if (c == 's') break;
+ if (c == '%') break;
+ }
+ ePos=Math.min(ePos+1,fmtArg.length());
+ sFmt = new ConversionSpecification(
+ fmtArg.substring(cPos,ePos));
+ vFmt.addElement(sFmt);
+ unCS = this.nonControl(fmtArg,ePos);
+ if (unCS!=null) {
+ sFmt = new ConversionSpecification();
+ sFmt.setLiteral(unCS);
+ vFmt.addElement(sFmt);
+ }
+ }
+ }
+ /**
+ * Return a substring starting at
+ * <code>start</code> and ending at either the end
+ * of the String <code>s</code>, the next unpaired
+ * percent sign, or at the end of the String if the
+ * last character is a percent sign.
+ * @param s Control string.
+ * @param start Position in the string
+ * <code>s</code> to begin looking for the start
+ * of a control string.
+ * @return the substring from the start position
+ * to the beginning of the control string.
+ */
+ private String nonControl(String s,int start) {
+ String ret="";
+ cPos=s.indexOf("%",start);
+ if (cPos==-1) cPos=s.length();
+ return s.substring(start,cPos);
+ }
+ /**
+ * Format an array of objects. Byte, Short,
+ * Integer, Long, Float, Double, and Character
+ * arguments are treated as wrappers for primitive
+ * types.
+ * @param o The array of objects to format.
+ * @return The formatted String.
+ */
+ public String sprintf(Object[] o) {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ int i=0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else {
+ if (cs.isPositionalSpecification()) {
+ i=cs.getArgumentPosition()-1;
+ if (cs.isPositionalFieldWidth()) {
+ int ifw=cs.getArgumentPositionForFieldWidth()-1;
+ cs.setFieldWidthWithArg(((Integer)o[ifw]).intValue());
+ }
+ if (cs.isPositionalPrecision()) {
+ int ipr=cs.getArgumentPositionForPrecision()-1;
+ cs.setPrecisionWithArg(((Integer)o[ipr]).intValue());
+ }
+ }
+ else {
+ if (cs.isVariableFieldWidth()) {
+ cs.setFieldWidthWithArg(((Integer)o[i]).intValue());
+ i++;
+ }
+ if (cs.isVariablePrecision()) {
+ cs.setPrecisionWithArg(((Integer)o[i]).intValue());
+ i++;
+ }
+ }
+ if (o[i] instanceof Byte)
+ sb.append(cs.internalsprintf(
+ ((Byte)o[i]).byteValue()));
+ else if (o[i] instanceof Short)
+ sb.append(cs.internalsprintf(
+ ((Short)o[i]).shortValue()));
+ else if (o[i] instanceof Integer)
+ sb.append(cs.internalsprintf(
+ ((Integer)o[i]).intValue()));
+ else if (o[i] instanceof Long)
+ sb.append(cs.internalsprintf(
+ ((Long)o[i]).longValue()));
+ else if (o[i] instanceof Float)
+ sb.append(cs.internalsprintf(
+ ((Float)o[i]).floatValue()));
+ else if (o[i] instanceof Double)
+ sb.append(cs.internalsprintf(
+ ((Double)o[i]).doubleValue()));
+ else if (o[i] instanceof Character)
+ sb.append(cs.internalsprintf(
+ ((Character)o[i]).charValue()));
+ else if (o[i] instanceof String)
+ sb.append(cs.internalsprintf(
+ (String)o[i]));
+ else
+ sb.append(cs.internalsprintf(
+ o[i]));
+ if (!cs.isPositionalSpecification())
+ i++;
+ }
+ }
+ return sb.toString();
+ }
+ /**
+ * Format nothing. Just use the control string.
+ * @return the formatted String.
+ */
+ public String sprintf() {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ }
+ return sb.toString();
+ }
+ /**
+ * Format an int.
+ * @param x The int to format.
+ * @return The formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is f, e, E, g, G, s,
+ * or S.
+ */
+ public String sprintf(int x)
+ throws IllegalArgumentException {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else sb.append(cs.internalsprintf(x));
+ }
+ return sb.toString();
+ }
+ /**
+ * Format an long.
+ * @param x The long to format.
+ * @return The formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is f, e, E, g, G, s,
+ * or S.
+ */
+ public String sprintf(long x)
+ throws IllegalArgumentException {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else sb.append(cs.internalsprintf(x));
+ }
+ return sb.toString();
+ }
+ /**
+ * Format a double.
+ * @param x The double to format.
+ * @return The formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is c, C, s, S,
+ * d, d, x, X, or o.
+ */
+ public String sprintf(double x)
+ throws IllegalArgumentException {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else sb.append(cs.internalsprintf(x));
+ }
+ return sb.toString();
+ }
+ /**
+ * Format a String.
+ * @param x The String to format.
+ * @return The formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is neither s nor S.
+ */
+ public String sprintf(String x)
+ throws IllegalArgumentException {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else sb.append(cs.internalsprintf(x));
+ }
+ return sb.toString();
+ }
+ /**
+ * Format an Object. Convert wrapper types to
+ * their primitive equivalents and call the
+ * appropriate internal formatting method. Convert
+ * Strings using an internal formatting method for
+ * Strings. Otherwise use the default formatter
+ * (use toString).
+ * @param x the Object to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is inappropriate for
+ * formatting an unwrapped value.
+ */
+ public String sprintf(Object x)
+ throws IllegalArgumentException {
+ Enumeration e = vFmt.elements();
+ ConversionSpecification cs = null;
+ char c = 0;
+ StringBuffer sb=new StringBuffer();
+ while (e.hasMoreElements()) {
+ cs = (ConversionSpecification)
+ e.nextElement();
+ c = cs.getConversionCharacter();
+ if (c=='\0') sb.append(cs.getLiteral());
+ else if (c=='%') sb.append("%");
+ else {
+ if (x instanceof Byte)
+ sb.append(cs.internalsprintf(
+ ((Byte)x).byteValue()));
+ else if (x instanceof Short)
+ sb.append(cs.internalsprintf(
+ ((Short)x).shortValue()));
+ else if (x instanceof Integer)
+ sb.append(cs.internalsprintf(
+ ((Integer)x).intValue()));
+ else if (x instanceof Long)
+ sb.append(cs.internalsprintf(
+ ((Long)x).longValue()));
+ else if (x instanceof Float)
+ sb.append(cs.internalsprintf(
+ ((Float)x).floatValue()));
+ else if (x instanceof Double)
+ sb.append(cs.internalsprintf(
+ ((Double)x).doubleValue()));
+ else if (x instanceof Character)
+ sb.append(cs.internalsprintf(
+ ((Character)x).charValue()));
+ else if (x instanceof String)
+ sb.append(cs.internalsprintf(
+ (String)x));
+ else
+ sb.append(cs.internalsprintf(x));
+ }
+ }
+ return sb.toString();
+ }
+ /**
+ *<p>
+ * ConversionSpecification allows the formatting of
+ * a single primitive or object embedded within a
+ * string. The formatting is controlled by a
+ * format string. Only one Java primitive or
+ * object can be formatted at a time.
+ *<p>
+ * A format string is a Java string that contains
+ * a control string. The control string starts at
+ * the first percent sign (%) in the string,
+ * provided that this percent sign
+ *<ol>
+ *<li>is not escaped protected by a matching % or
+ * is not an escape % character,
+ *<li>is not at the end of the format string, and
+ *<li>precedes a sequence of characters that parses
+ * as a valid control string.
+ *</ol>
+ *<p>
+ * A control string takes the form:
+ *<pre> % ['-+ #0]* [0..9]* { . [0..9]* }+
+ * { [hlL] }+ [idfgGoxXeEcs]
+ *</pre>
+ *<p>
+ * The behavior is like printf. One (hopefully the
+ * only) exception is that the minimum number of
+ * exponent digits is 3 instead of 2 for e and E
+ * formats when the optional L is used before the
+ * e, E, g, or G conversion character. The
+ * optional L does not imply conversion to a long
+ * long double.
+ */
+ private class ConversionSpecification {
+ /**
+ * Constructor. Used to prepare an instance
+ * to hold a literal, not a control string.
+ */
+ ConversionSpecification() { }
+ /**
+ * Constructor for a conversion specification.
+ * The argument must begin with a % and end
+ * with the conversion character for the
+ * conversion specification.
+ * @param fmtArg String specifying the
+ * conversion specification.
+ * @exception IllegalArgumentException if the
+ * input string is null, zero length, or
+ * otherwise malformed.
+ */
+ ConversionSpecification(String fmtArg)
+ throws IllegalArgumentException {
+ if (fmtArg==null)
+ throw new NullPointerException();
+ if (fmtArg.length()==0)
+ throw new IllegalArgumentException(
+ "Control strings must have positive"+
+ " lengths.");
+ if (fmtArg.charAt(0)=='%') {
+ fmt = fmtArg;
+ pos=1;
+ setArgPosition();
+ setFlagCharacters();
+ setFieldWidth();
+ setPrecision();
+ setOptionalHL();
+ if (setConversionCharacter()) {
+ if (pos==fmtArg.length()) {
+ if(leadingZeros&&leftJustify)
+ leadingZeros=false;
+ if(precisionSet&&leadingZeros){
+ if(conversionCharacter=='d'
+ ||conversionCharacter=='i'
+ ||conversionCharacter=='o'
+ ||conversionCharacter=='x')
+ {
+ leadingZeros=false;
+ }
+ }
+ }
+ else
+ throw new IllegalArgumentException(
+ "Malformed conversion specification="+
+ fmtArg);
+ }
+ else
+ throw new IllegalArgumentException(
+ "Malformed conversion specification="+
+ fmtArg);
+ }
+ else
+ throw new IllegalArgumentException(
+ "Control strings must begin with %.");
+ }
+ /**
+ * Set the String for this instance.
+ * @param s the String to store.
+ */
+ void setLiteral(String s) {
+ fmt = s;
+ }
+ /**
+ * Get the String for this instance. Translate
+ * any escape sequences.
+ *
+ * @return s the stored String.
+ */
+ String getLiteral() {
+ StringBuffer sb=new StringBuffer();
+ int i=0;
+ while (i<fmt.length()) {
+ if (fmt.charAt(i)=='\\') {
+ i++;
+ if (i<fmt.length()) {
+ char c=fmt.charAt(i);
+ switch(c) {
+ case 'a':
+ sb.append((char)0x07);
+ break;
+ case 'b':
+ sb.append('\b');
+ break;
+ case 'f':
+ sb.append('\f');
+ break;
+ case 'n':
+ sb.append(System.getProperty("line.separator"));
+ break;
+ case 'r':
+ sb.append('\r');
+ break;
+ case 't':
+ sb.append('\t');
+ break;
+ case 'v':
+ sb.append((char)0x0b);
+ break;
+ case '\\':
+ sb.append('\\');
+ break;
+ }
+ i++;
+ }
+ else
+ sb.append('\\');
+ }
+ else
+ i++;
+ }
+ return fmt;
+ }
+ /**
+ * Get the conversion character that tells what
+ * type of control character this instance has.
+ *
+ * @return the conversion character.
+ */
+ char getConversionCharacter() {
+ return conversionCharacter;
+ }
+ /**
+ * Check whether the specifier has a variable
+ * field width that is going to be set by an
+ * argument.
+ * @return <code>true</code> if the conversion
+ * uses an * field width; otherwise
+ * <code>false</code>.
+ */
+ boolean isVariableFieldWidth() {
+ return variableFieldWidth;
+ }
+ /**
+ * Set the field width with an argument. A
+ * negative field width is taken as a - flag
+ * followed by a positive field width.
+ * @param fw the field width.
+ */
+ void setFieldWidthWithArg(int fw) {
+ if (fw<0) leftJustify = true;
+ fieldWidthSet = true;
+ fieldWidth = Math.abs(fw);
+ }
+ /**
+ * Check whether the specifier has a variable
+ * precision that is going to be set by an
+ * argument.
+ * @return <code>true</code> if the conversion
+ * uses an * precision; otherwise
+ * <code>false</code>.
+ */
+ boolean isVariablePrecision() {
+ return variablePrecision;
+ }
+ /**
+ * Set the precision with an argument. A
+ * negative precision will be changed to zero.
+ * @param pr the precision.
+ */
+ void setPrecisionWithArg(int pr) {
+ precisionSet = true;
+ precision = Math.max(pr,0);
+ }
+ /**
+ * Format an int argument using this conversion
+ * specification.
+ * @param s the int to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is f, e, E, g, or G.
+ */
+ String internalsprintf(int s)
+ throws IllegalArgumentException {
+ String s2 = "";
+ switch(conversionCharacter) {
+ case 'd':
+ case 'i':
+ if (optionalh)
+ s2 = printDFormat((short)s);
+ else if (optionall)
+ s2 = printDFormat((long)s);
+ else
+ s2 = printDFormat(s);
+ break;
+ case 'x':
+ case 'X':
+ if (optionalh)
+ s2 = printXFormat((short)s);
+ else if (optionall)
+ s2 = printXFormat((long)s);
+ else
+ s2 = printXFormat(s);
+ break;
+ case 'o':
+ if (optionalh)
+ s2 = printOFormat((short)s);
+ else if (optionall)
+ s2 = printOFormat((long)s);
+ else
+ s2 = printOFormat(s);
+ break;
+ case 'c':
+ case 'C':
+ s2 = printCFormat((char)s);
+ break;
+ default:
+ throw new IllegalArgumentException(
+ "Cannot format a int with a format using a "+
+ conversionCharacter+
+ " conversion character.");
+ }
+ return s2;
+ }
+ /**
+ * Format a long argument using this conversion
+ * specification.
+ * @param s the long to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is f, e, E, g, or G.
+ */
+ String internalsprintf(long s)
+ throws IllegalArgumentException {
+ String s2 = "";
+ switch(conversionCharacter) {
+ case 'd':
+ case 'i':
+ if (optionalh)
+ s2 = printDFormat((short)s);
+ else if (optionall)
+ s2 = printDFormat(s);
+ else
+ s2 = printDFormat((int)s);
+ break;
+ case 'x':
+ case 'X':
+ if (optionalh)
+ s2 = printXFormat((short)s);
+ else if (optionall)
+ s2 = printXFormat(s);
+ else
+ s2 = printXFormat((int)s);
+ break;
+ case 'o':
+ if (optionalh)
+ s2 = printOFormat((short)s);
+ else if (optionall)
+ s2 = printOFormat(s);
+ else
+ s2 = printOFormat((int)s);
+ break;
+ case 'c':
+ case 'C':
+ s2 = printCFormat((char)s);
+ break;
+ default:
+ throw new IllegalArgumentException(
+ "Cannot format a long with a format using a "+
+ conversionCharacter+" conversion character.");
+ }
+ return s2;
+ }
+ /**
+ * Format a double argument using this conversion
+ * specification.
+ * @param s the double to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is c, C, s, S, i, d,
+ * x, X, or o.
+ */
+ String internalsprintf(double s)
+ throws IllegalArgumentException {
+ String s2 = "";
+ switch(conversionCharacter) {
+ case 'f':
+ s2 = printFFormat(s);
+ break;
+ case 'E':
+ case 'e':
+ s2 = printEFormat(s);
+ break;
+ case 'G':
+ case 'g':
+ s2 = printGFormat(s);
+ break;
+ default:
+ throw new IllegalArgumentException("Cannot "+
+ "format a double with a format using a "+
+ conversionCharacter+" conversion character.");
+ }
+ return s2;
+ }
+ /**
+ * Format a String argument using this conversion
+ * specification.
+ * @param s the String to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is neither s nor S.
+ */
+ String internalsprintf(String s)
+ throws IllegalArgumentException {
+ String s2 = "";
+ if(conversionCharacter=='s'
+ || conversionCharacter=='S')
+ s2 = printSFormat(s);
+ else
+ throw new IllegalArgumentException("Cannot "+
+ "format a String with a format using a "+
+ conversionCharacter+" conversion character.");
+ return s2;
+ }
+ /**
+ * Format an Object argument using this conversion
+ * specification.
+ * @param s the Object to format.
+ * @return the formatted String.
+ * @exception IllegalArgumentException if the
+ * conversion character is neither s nor S.
+ */
+ String internalsprintf(Object s) {
+ String s2 = "";
+ if(conversionCharacter=='s'
+ || conversionCharacter=='S')
+ s2 = printSFormat(s.toString());
+ else
+ throw new IllegalArgumentException(
+ "Cannot format a String with a format using"+
+ " a "+conversionCharacter+
+ " conversion character.");
+ return s2;
+ }
+ /**
+ * For f format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both
+ * a '+' and a ' ' are specified, the blank flag
+ * is ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the number of digits
+ * to appear after the radix character. Padding is
+ * with trailing 0s.
+ */
+ private char[] fFormatDigits(double x) {
+ // int defaultDigits=6;
+ String sx,sxOut;
+ int i,j,k;
+ int n1In,n2In;
+ int expon=0;
+ boolean minusSign=false;
+ if (x>0.0)
+ sx = Double.toString(x);
+ else if (x<0.0) {
+ sx = Double.toString(-x);
+ minusSign=true;
+ }
+ else {
+ sx = Double.toString(x);
+ if (sx.charAt(0)=='-') {
+ minusSign=true;
+ sx=sx.substring(1);
+ }
+ }
+ int ePos = sx.indexOf('E');
+ int rPos = sx.indexOf('.');
+ if (rPos!=-1) n1In=rPos;
+ else if (ePos!=-1) n1In=ePos;
+ else n1In=sx.length();
+ if (rPos!=-1) {
+ if (ePos!=-1) n2In = ePos-rPos-1;
+ else n2In = sx.length()-rPos-1;
+ }
+ else
+ n2In = 0;
+ if (ePos!=-1) {
+ int ie=ePos+1;
+ expon=0;
+ if (sx.charAt(ie)=='-') {
+ for (++ie; ie<sx.length(); ie++)
+ if (sx.charAt(ie)!='0') break;
+ if (ie<sx.length())
+ expon=-Integer.parseInt(sx.substring(ie));
+ }
+ else {
+ if (sx.charAt(ie)=='+') ++ie;
+ for (; ie<sx.length(); ie++)
+ if (sx.charAt(ie)!='0') break;
+ if (ie<sx.length())
+ expon=Integer.parseInt(sx.substring(ie));
+ }
+ }
+ int p;
+ if (precisionSet) p = precision;
+ else p = defaultDigits-1;
+ char[] ca1 = sx.toCharArray();
+ char[] ca2 = new char[n1In+n2In];
+ char[] ca3,ca4,ca5;
+ for (j=0; j<n1In; j++)
+ ca2[j] = ca1[j];
+ i = j+1;
+ for (k=0; k<n2In; j++,i++,k++)
+ ca2[j] = ca1[i];
+ if (n1In+expon<=0) {
+ ca3 = new char[-expon+n2In];
+ for (j=0,k=0; k<(-n1In-expon); k++,j++)
+ ca3[j]='0';
+ for (i=0; i<(n1In+n2In); i++,j++)
+ ca3[j]=ca2[i];
+ }
+ else
+ ca3 = ca2;
+ boolean carry=false;
+ if (p<-expon+n2In) {
+ if (expon<0) i = p;
+ else i = p+n1In;
+ carry=checkForCarry(ca3,i);
+ if (carry)
+ carry=startSymbolicCarry(ca3,i-1,0);
+ }
+ if (n1In+expon<=0) {
+ ca4 = new char[2+p];
+ if (!carry) ca4[0]='0';
+ else ca4[0]='1';
+ if(alternateForm||!precisionSet||precision!=0){
+ ca4[1]='.';
+ for(i=0,j=2;i<Math.min(p,ca3.length);i++,j++)
+ ca4[j]=ca3[i];
+ for (; j<ca4.length; j++) ca4[j]='0';
+ }
+ }
+ else {
+ if (!carry) {
+ if(alternateForm||!precisionSet
+ ||precision!=0)
+ ca4 = new char[n1In+expon+p+1];
+ else
+ ca4 = new char[n1In+expon];
+ j=0;
+ }
+ else {
+ if(alternateForm||!precisionSet
+ ||precision!=0)
+ ca4 = new char[n1In+expon+p+2];
+ else
+ ca4 = new char[n1In+expon+1];
+ ca4[0]='1';
+ j=1;
+ }
+ for (i=0; i<Math.min(n1In+expon,ca3.length); i++,j++)
+ ca4[j]=ca3[i];
+ for (; i<n1In+expon; i++,j++)
+ ca4[j]='0';
+ if(alternateForm||!precisionSet||precision!=0){
+ ca4[j]='.'; j++;
+ for (k=0; i<ca3.length && k<p; i++,j++,k++)
+ ca4[j]=ca3[i];
+ for (; j<ca4.length; j++) ca4[j]='0';
+ }
+ }
+ int nZeros=0;
+ if (!leftJustify && leadingZeros) {
+ int xThousands=0;
+ if (thousands) {
+ int xlead=0;
+ if (ca4[0]=='+'||ca4[0]=='-'||ca4[0]==' ')
+ xlead=1;
+ int xdp=xlead;
+ for (; xdp<ca4.length; xdp++)
+ if (ca4[xdp]=='.') break;
+ xThousands=(xdp-xlead)/3;
+ }
+ if (fieldWidthSet)
+ nZeros = fieldWidth-ca4.length;
+ if ((!minusSign&&(leadingSign||leadingSpace))||minusSign)
+ nZeros--;
+ nZeros-=xThousands;
+ if (nZeros<0) nZeros=0;
+ }
+ j=0;
+ if ((!minusSign&&(leadingSign||leadingSpace))||minusSign) {
+ ca5 = new char[ca4.length+nZeros+1];
+ j++;
+ }
+ else
+ ca5 = new char[ca4.length+nZeros];
+ if (!minusSign) {
+ if (leadingSign) ca5[0]='+';
+ if (leadingSpace) ca5[0]=' ';
+ }
+ else
+ ca5[0]='-';
+ for (i=0; i<nZeros; i++,j++)
+ ca5[j]='0';
+ for (i=0; i<ca4.length; i++,j++) ca5[j]=ca4[i];
+
+ int lead=0;
+ if (ca5[0]=='+'||ca5[0]=='-'||ca5[0]==' ')
+ lead=1;
+ int dp=lead;
+ for (; dp<ca5.length; dp++)
+ if (ca5[dp]=='.') break;
+ int nThousands=(dp-lead)/3;
+ // Localize the decimal point.
+ if (dp<ca5.length)
+ ca5[dp]=dfs.getDecimalSeparator();
+ char[] ca6 = ca5;
+ if (thousands && nThousands>0) {
+ ca6 = new char[ca5.length+nThousands+lead];
+ ca6[0]=ca5[0];
+ for (i=lead,k=lead; i<dp; i++) {
+ if (i>0 && (dp-i)%3==0) {
+ // ca6[k]=',';
+ ca6[k]=dfs.getGroupingSeparator();
+ ca6[k+1]=ca5[i];
+ k+=2;
+ }
+ else {
+ ca6[k]=ca5[i]; k++;
+ }
+ }
+ for (; i<ca5.length; i++,k++) {
+ ca6[k]=ca5[i];
+ }
+ }
+ return ca6;
+ }
+ /**
+ * An intermediate routine on the way to creating
+ * an f format String. The method decides whether
+ * the input double value is an infinity,
+ * not-a-number, or a finite double and formats
+ * each type of input appropriately.
+ * @param x the double value to be formatted.
+ * @return the converted double value.
+ */
+ private String fFormatString(double x) {
+ boolean noDigits=false;
+ char[] ca6,ca7;
+ if (Double.isInfinite(x)) {
+ if (x==Double.POSITIVE_INFINITY) {
+ if (leadingSign) ca6 = "+Inf".toCharArray();
+ else if (leadingSpace)
+ ca6 = " Inf".toCharArray();
+ else ca6 = "Inf".toCharArray();
+ }
+ else
+ ca6 = "-Inf".toCharArray();
+ noDigits = true;
+ }
+ else if (Double.isNaN(x)) {
+ if (leadingSign) ca6 = "+NaN".toCharArray();
+ else if (leadingSpace)
+ ca6 = " NaN".toCharArray();
+ else ca6 = "NaN".toCharArray();
+ noDigits = true;
+ }
+ else
+ ca6 = fFormatDigits(x);
+ ca7 = applyFloatPadding(ca6,false);
+ return new String(ca7);
+ }
+ /**
+ * For e format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both a
+ * '+' and a ' ' are specified, the blank flag is
+ * ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear after the radix character.
+ * Padding is with trailing 0s.
+ *
+ * The behavior is like printf. One (hopefully the
+ * only) exception is that the minimum number of
+ * exponent digits is 3 instead of 2 for e and E
+ * formats when the optional L is used before the
+ * e, E, g, or G conversion character. The optional
+ * L does not imply conversion to a long long
+ * double.
+ */
+ private char[] eFormatDigits(double x,char eChar) {
+ char[] ca1,ca2,ca3;
+ // int defaultDigits=6;
+ String sx,sxOut;
+ int i,j,k,p;
+ int n1In,n2In;
+ int expon=0;
+ int ePos,rPos,eSize;
+ boolean minusSign=false;
+ if (x>0.0)
+ sx = Double.toString(x);
+ else if (x<0.0) {
+ sx = Double.toString(-x);
+ minusSign=true;
+ }
+ else {
+ sx = Double.toString(x);
+ if (sx.charAt(0)=='-') {
+ minusSign=true;
+ sx=sx.substring(1);
+ }
+ }
+ ePos = sx.indexOf('E');
+ if (ePos==-1) ePos = sx.indexOf('e');
+ rPos = sx.indexOf('.');
+ if (rPos!=-1) n1In=rPos;
+ else if (ePos!=-1) n1In=ePos;
+ else n1In=sx.length();
+ if (rPos!=-1) {
+ if (ePos!=-1) n2In = ePos-rPos-1;
+ else n2In = sx.length()-rPos-1;
+ }
+ else
+ n2In = 0;
+ if (ePos!=-1) {
+ int ie=ePos+1;
+ expon=0;
+ if (sx.charAt(ie)=='-') {
+ for (++ie; ie<sx.length(); ie++)
+ if (sx.charAt(ie)!='0') break;
+ if (ie<sx.length())
+ expon=-Integer.parseInt(sx.substring(ie));
+ }
+ else {
+ if (sx.charAt(ie)=='+') ++ie;
+ for (; ie<sx.length(); ie++)
+ if (sx.charAt(ie)!='0') break;
+ if (ie<sx.length())
+ expon=Integer.parseInt(sx.substring(ie));
+ }
+ }
+ if (rPos!=-1) expon += rPos-1;
+ if (precisionSet) p = precision;
+ else p = defaultDigits-1;
+ if (rPos!=-1 && ePos!=-1)
+ ca1=(sx.substring(0,rPos)+
+ sx.substring(rPos+1,ePos)).toCharArray();
+ else if (rPos!=-1)
+ ca1 = (sx.substring(0,rPos)+
+ sx.substring(rPos+1)).toCharArray();
+ else if (ePos!=-1)
+ ca1 = sx.substring(0,ePos).toCharArray();
+ else
+ ca1 = sx.toCharArray();
+ boolean carry=false;
+ int i0=0;
+ if (ca1[0]!='0')
+ i0 = 0;
+ else
+ for (i0=0; i0<ca1.length; i0++)
+ if (ca1[i0]!='0') break;
+ if (i0+p<ca1.length-1) {
+ carry=checkForCarry(ca1,i0+p+1);
+ if (carry)
+ carry = startSymbolicCarry(ca1,i0+p,i0);
+ if (carry) {
+ ca2 = new char[i0+p+1];
+ ca2[i0]='1';
+ for (j=0; j<i0; j++) ca2[j]='0';
+ for (i=i0,j=i0+1; j<p+1; i++,j++)
+ ca2[j] = ca1[i];
+ expon++;
+ ca1 = ca2;
+ }
+ }
+ if (Math.abs(expon)<100 && !optionalL) eSize=4;
+ else eSize=5;
+ if (alternateForm||!precisionSet||precision!=0)
+ ca2 = new char[2+p+eSize];
+ else
+ ca2 = new char[1+eSize];
+ if (ca1[0]!='0') {
+ ca2[0] = ca1[0];
+ j=1;
+ }
+ else {
+ for (j=1; j<(ePos==-1?ca1.length:ePos); j++)
+ if (ca1[j]!='0') break;
+ if ((ePos!=-1 && j<ePos)||
+ (ePos==-1 && j<ca1.length)) {
+ ca2[0] = ca1[j];
+ expon -= j;
+ j++;
+ }
+ else {
+ ca2[0]='0';
+ j=2;
+ }
+ }
+ if (alternateForm||!precisionSet||precision!=0) {
+ ca2[1] = '.';
+ i=2;
+ }
+ else
+ i=1;
+ for (k=0; k<p && j<ca1.length; j++,i++,k++)
+ ca2[i] = ca1[j];
+ for (;i<ca2.length-eSize; i++)
+ ca2[i] = '0';
+ ca2[i++] = eChar;
+ if (expon<0) ca2[i++]='-';
+ else ca2[i++]='+';
+ expon = Math.abs(expon);
+ if (expon>=100) {
+ switch(expon/100) {
+ case 1: ca2[i]='1'; break;
+ case 2: ca2[i]='2'; break;
+ case 3: ca2[i]='3'; break;
+ case 4: ca2[i]='4'; break;
+ case 5: ca2[i]='5'; break;
+ case 6: ca2[i]='6'; break;
+ case 7: ca2[i]='7'; break;
+ case 8: ca2[i]='8'; break;
+ case 9: ca2[i]='9'; break;
+ }
+ i++;
+ }
+ switch((expon%100)/10) {
+ case 0: ca2[i]='0'; break;
+ case 1: ca2[i]='1'; break;
+ case 2: ca2[i]='2'; break;
+ case 3: ca2[i]='3'; break;
+ case 4: ca2[i]='4'; break;
+ case 5: ca2[i]='5'; break;
+ case 6: ca2[i]='6'; break;
+ case 7: ca2[i]='7'; break;
+ case 8: ca2[i]='8'; break;
+ case 9: ca2[i]='9'; break;
+ }
+ i++;
+ switch(expon%10) {
+ case 0: ca2[i]='0'; break;
+ case 1: ca2[i]='1'; break;
+ case 2: ca2[i]='2'; break;
+ case 3: ca2[i]='3'; break;
+ case 4: ca2[i]='4'; break;
+ case 5: ca2[i]='5'; break;
+ case 6: ca2[i]='6'; break;
+ case 7: ca2[i]='7'; break;
+ case 8: ca2[i]='8'; break;
+ case 9: ca2[i]='9'; break;
+ }
+ int nZeros=0;
+ if (!leftJustify && leadingZeros) {
+ int xThousands=0;
+ if (thousands) {
+ int xlead=0;
+ if (ca2[0]=='+'||ca2[0]=='-'||ca2[0]==' ')
+ xlead=1;
+ int xdp=xlead;
+ for (; xdp<ca2.length; xdp++)
+ if (ca2[xdp]=='.') break;
+ xThousands=(xdp-xlead)/3;
+ }
+ if (fieldWidthSet)
+ nZeros = fieldWidth-ca2.length;
+ if ((!minusSign&&(leadingSign||leadingSpace))||minusSign)
+ nZeros--;
+ nZeros-=xThousands;
+ if (nZeros<0) nZeros=0;
+ }
+ j=0;
+ if ((!minusSign&&(leadingSign || leadingSpace))||minusSign) {
+ ca3 = new char[ca2.length+nZeros+1];
+ j++;
+ }
+ else
+ ca3 = new char[ca2.length+nZeros];
+ if (!minusSign) {
+ if (leadingSign) ca3[0]='+';
+ if (leadingSpace) ca3[0]=' ';
+ }
+ else
+ ca3[0]='-';
+ for (k=0; k<nZeros; j++,k++)
+ ca3[j]='0';
+ for (i=0; i<ca2.length && j<ca3.length; i++,j++)
+ ca3[j]=ca2[i];
+
+ int lead=0;
+ if (ca3[0]=='+'||ca3[0]=='-'||ca3[0]==' ')
+ lead=1;
+ int dp=lead;
+ for (; dp<ca3.length; dp++)
+ if (ca3[dp]=='.') break;
+ int nThousands=dp/3;
+ // Localize the decimal point.
+ if (dp < ca3.length)
+ ca3[dp] = dfs.getDecimalSeparator();
+ char[] ca4 = ca3;
+ if (thousands && nThousands>0) {
+ ca4 = new char[ca3.length+nThousands+lead];
+ ca4[0]=ca3[0];
+ for (i=lead,k=lead; i<dp; i++) {
+ if (i>0 && (dp-i)%3==0) {
+ // ca4[k]=',';
+ ca4[k]=dfs.getGroupingSeparator();
+ ca4[k+1]=ca3[i];
+ k+=2;
+ }
+ else {
+ ca4[k]=ca3[i]; k++;
+ }
+ }
+ for (; i<ca3.length; i++,k++)
+ ca4[k]=ca3[i];
+ }
+ return ca4;
+ }
+ /**
+ * Check to see if the digits that are going to
+ * be truncated because of the precision should
+ * force a round in the preceding digits.
+ * @param ca1 the array of digits
+ * @param icarry the index of the first digit that
+ * is to be truncated from the print
+ * @return <code>true</code> if the truncation forces
+ * a round that will change the print
+ */
+ private boolean checkForCarry(char[] ca1,int icarry) {
+ boolean carry=false;
+ if (icarry<ca1.length) {
+ if (ca1[icarry]=='6'||ca1[icarry]=='7'
+ ||ca1[icarry]=='8'||ca1[icarry]=='9') carry=true;
+ else if (ca1[icarry]=='5') {
+ int ii=icarry+1;
+ for (;ii<ca1.length; ii++)
+ if (ca1[ii]!='0') break;
+ carry=ii<ca1.length;
+ if (!carry&&icarry>0) {
+ carry=(ca1[icarry-1]=='1'||ca1[icarry-1]=='3'
+ ||ca1[icarry-1]=='5'||ca1[icarry-1]=='7'
+ ||ca1[icarry-1]=='9');
+ }
+ }
+ }
+ return carry;
+ }
+ /**
+ * Start the symbolic carry process. The process
+ * is not quite finished because the symbolic
+ * carry may change the length of the string and
+ * change the exponent (in e format).
+ * @param cLast index of the last digit changed
+ * by the round
+ * @param cFirst index of the first digit allowed
+ * to be changed by this phase of the round
+ * @return <code>true</code> if the carry forces
+ * a round that will change the print still
+ * more
+ */
+ private boolean startSymbolicCarry(
+ char[] ca,int cLast,int cFirst) {
+ boolean carry=true;
+ for (int i=cLast; carry && i>=cFirst; i--) {
+ carry = false;
+ switch(ca[i]) {
+ case '0': ca[i]='1'; break;
+ case '1': ca[i]='2'; break;
+ case '2': ca[i]='3'; break;
+ case '3': ca[i]='4'; break;
+ case '4': ca[i]='5'; break;
+ case '5': ca[i]='6'; break;
+ case '6': ca[i]='7'; break;
+ case '7': ca[i]='8'; break;
+ case '8': ca[i]='9'; break;
+ case '9': ca[i]='0'; carry=true; break;
+ }
+ }
+ return carry;
+ }
+ /**
+ * An intermediate routine on the way to creating
+ * an e format String. The method decides whether
+ * the input double value is an infinity,
+ * not-a-number, or a finite double and formats
+ * each type of input appropriately.
+ * @param x the double value to be formatted.
+ * @param eChar an 'e' or 'E' to use in the
+ * converted double value.
+ * @return the converted double value.
+ */
+ private String eFormatString(double x,char eChar) {
+ boolean noDigits=false;
+ char[] ca4,ca5;
+ if (Double.isInfinite(x)) {
+ if (x==Double.POSITIVE_INFINITY) {
+ if (leadingSign) ca4 = "+Inf".toCharArray();
+ else if (leadingSpace)
+ ca4 = " Inf".toCharArray();
+ else ca4 = "Inf".toCharArray();
+ }
+ else
+ ca4 = "-Inf".toCharArray();
+ noDigits = true;
+ }
+ else if (Double.isNaN(x)) {
+ if (leadingSign) ca4 = "+NaN".toCharArray();
+ else if (leadingSpace)
+ ca4 = " NaN".toCharArray();
+ else ca4 = "NaN".toCharArray();
+ noDigits = true;
+ }
+ else
+ ca4 = eFormatDigits(x,eChar);
+ ca5 = applyFloatPadding(ca4,false);
+ return new String(ca5);
+ }
+ /**
+ * Apply zero or blank, left or right padding.
+ * @param ca4 array of characters before padding is
+ * finished
+ * @param noDigits NaN or signed Inf
+ * @return a padded array of characters
+ */
+ private char[] applyFloatPadding(
+ char[] ca4,boolean noDigits) {
+ char[] ca5 = ca4;
+ if (fieldWidthSet) {
+ int i,j,nBlanks;
+ if (leftJustify) {
+ nBlanks = fieldWidth-ca4.length;
+ if (nBlanks > 0) {
+ ca5 = new char[ca4.length+nBlanks];
+ for (i=0; i<ca4.length; i++)
+ ca5[i] = ca4[i];
+ for (j=0; j<nBlanks; j++,i++)
+ ca5[i] = ' ';
+ }
+ }
+ else if (!leadingZeros || noDigits) {
+ nBlanks = fieldWidth-ca4.length;
+ if (nBlanks > 0) {
+ ca5 = new char[ca4.length+nBlanks];
+ for (i=0; i<nBlanks; i++)
+ ca5[i] = ' ';
+ for (j=0; j<ca4.length; i++,j++)
+ ca5[i] = ca4[j];
+ }
+ }
+ else if (leadingZeros) {
+ nBlanks = fieldWidth-ca4.length;
+ if (nBlanks > 0) {
+ ca5 = new char[ca4.length+nBlanks];
+ i=0; j=0;
+ if (ca4[0]=='-') { ca5[0]='-'; i++; j++; }
+ for (int k=0; k<nBlanks; i++,k++)
+ ca5[i] = '0';
+ for (; j<ca4.length; i++,j++)
+ ca5[i] = ca4[j];
+ }
+ }
+ }
+ return ca5;
+ }
+ /**
+ * Format method for the f conversion character.
+ * @param x the double to format.
+ * @return the formatted String.
+ */
+ private String printFFormat(double x) {
+ return fFormatString(x);
+ }
+ /**
+ * Format method for the e or E conversion
+ * character.
+ * @param x the double to format.
+ * @return the formatted String.
+ */
+ private String printEFormat(double x) {
+ if (conversionCharacter=='e')
+ return eFormatString(x,'e');
+ else
+ return eFormatString(x,'E');
+ }
+ /**
+ * Format method for the g conversion character.
+ *
+ * For g format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both a
+ * '+' and a ' ' are specified, the blank flag is
+ * ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear after the radix character.
+ * Padding is with trailing 0s.
+ * @param x the double to format.
+ * @return the formatted String.
+ */
+ private String printGFormat(double x) {
+ String sx,sy,sz,ret;
+ int savePrecision=precision;
+ int i;
+ char[] ca4,ca5;
+ boolean noDigits=false;
+ if (Double.isInfinite(x)) {
+ if (x==Double.POSITIVE_INFINITY) {
+ if (leadingSign) ca4 = "+Inf".toCharArray();
+ else if (leadingSpace)
+ ca4 = " Inf".toCharArray();
+ else ca4 = "Inf".toCharArray();
+ }
+ else
+ ca4 = "-Inf".toCharArray();
+ noDigits = true;
+ }
+ else if (Double.isNaN(x)) {
+ if (leadingSign) ca4 = "+NaN".toCharArray();
+ else if (leadingSpace)
+ ca4 = " NaN".toCharArray();
+ else ca4 = "NaN".toCharArray();
+ noDigits = true;
+ }
+ else {
+ if (!precisionSet) precision=defaultDigits;
+ if (precision==0) precision=1;
+ int ePos=-1;
+ if (conversionCharacter=='g') {
+ sx = eFormatString(x,'e').trim();
+ ePos=sx.indexOf('e');
+ }
+ else {
+ sx = eFormatString(x,'E').trim();
+ ePos=sx.indexOf('E');
+ }
+ i=ePos+1;
+ int expon=0;
+ if (sx.charAt(i)=='-') {
+ for (++i; i<sx.length(); i++)
+ if (sx.charAt(i)!='0') break;
+ if (i<sx.length())
+ expon=-Integer.parseInt(sx.substring(i));
+ }
+ else {
+ if (sx.charAt(i)=='+') ++i;
+ for (; i<sx.length(); i++)
+ if (sx.charAt(i)!='0') break;
+ if (i<sx.length())
+ expon=Integer.parseInt(sx.substring(i));
+ }
+ // Trim trailing zeros.
+ // If the radix character is not followed by
+ // a digit, trim it, too.
+ if (!alternateForm) {
+ if (expon>=-4 && expon<precision)
+ sy = fFormatString(x).trim();
+ else
+ sy = sx.substring(0,ePos);
+ i=sy.length()-1;
+ for (; i>=0; i--)
+ if (sy.charAt(i)!='0') break;
+ if (i>=0 && sy.charAt(i)=='.') i--;
+ if (i==-1) sz="0";
+ else if (!Character.isDigit(sy.charAt(i)))
+ sz=sy.substring(0,i+1)+"0";
+ else sz=sy.substring(0,i+1);
+ if (expon>=-4 && expon<precision)
+ ret=sz;
+ else
+ ret=sz+sx.substring(ePos);
+ }
+ else {
+ if (expon>=-4 && expon<precision)
+ ret = fFormatString(x).trim();
+ else
+ ret = sx;
+ }
+ // leading space was trimmed off during
+ // construction
+ if (leadingSpace) if (x>=0) ret = " "+ret;
+ ca4 = ret.toCharArray();
+ }
+ // Pad with blanks or zeros.
+ ca5 = applyFloatPadding(ca4,false);
+ precision=savePrecision;
+ return new String(ca5);
+ }
+ /**
+ * Format method for the d conversion specifer and
+ * short argument.
+ *
+ * For d format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. A '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both a
+ * '+' and a ' ' are specified, the blank flag is
+ * ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the short to format.
+ * @return the formatted String.
+ */
+ private String printDFormat(short x) {
+ return printDFormat(Short.toString(x));
+ }
+ /**
+ * Format method for the d conversion character and
+ * long argument.
+ *
+ * For d format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. A '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both a
+ * '+' and a ' ' are specified, the blank flag is
+ * ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the long to format.
+ * @return the formatted String.
+ */
+ private String printDFormat(long x) {
+ return printDFormat(Long.toString(x));
+ }
+ /**
+ * Format method for the d conversion character and
+ * int argument.
+ *
+ * For d format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. A '+' character means that the conversion
+ * will always begin with a sign (+ or -). The
+ * blank flag character means that a non-negative
+ * input will be preceded with a blank. If both a
+ * '+' and a ' ' are specified, the blank flag is
+ * ignored. The '0' flag character implies that
+ * padding to the field width will be done with
+ * zeros instead of blanks.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the int to format.
+ * @return the formatted String.
+ */
+ private String printDFormat(int x) {
+ return printDFormat(Integer.toString(x));
+ }
+ /**
+ * Utility method for formatting using the d
+ * conversion character.
+ * @param sx the String to format, the result of
+ * converting a short, int, or long to a
+ * String.
+ * @return the formatted String.
+ */
+ private String printDFormat(String sx) {
+ int nLeadingZeros=0;
+ int nBlanks=0,n=0;
+ int i=0,jFirst=0;
+ boolean neg = sx.charAt(0)=='-';
+ if (sx.equals("0")&&precisionSet&&precision==0)
+ sx="";
+ if (!neg) {
+ if (precisionSet && sx.length() < precision)
+ nLeadingZeros = precision-sx.length();
+ }
+ else {
+ if (precisionSet&&(sx.length()-1)<precision)
+ nLeadingZeros = precision-sx.length()+1;
+ }
+ if (nLeadingZeros<0) nLeadingZeros=0;
+ if (fieldWidthSet) {
+ nBlanks = fieldWidth-nLeadingZeros-sx.length();
+ if (!neg&&(leadingSign||leadingSpace))
+ nBlanks--;
+ }
+ if (nBlanks<0) nBlanks=0;
+ if (leadingSign) n++;
+ else if (leadingSpace) n++;
+ n += nBlanks;
+ n += nLeadingZeros;
+ n += sx.length();
+ char[] ca = new char[n];
+ if (leftJustify) {
+ if (neg) ca[i++] = '-';
+ else if (leadingSign) ca[i++] = '+';
+ else if (leadingSpace) ca[i++] = ' ';
+ char[] csx = sx.toCharArray();
+ jFirst = neg?1:0;
+ for (int j=0; j<nLeadingZeros; i++,j++)
+ ca[i]='0';
+ for (int j=jFirst; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ for (int j=0; j<nBlanks; i++,j++)
+ ca[i] = ' ';
+ }
+ else {
+ if (!leadingZeros) {
+ for (i=0; i<nBlanks; i++)
+ ca[i] = ' ';
+ if (neg) ca[i++] = '-';
+ else if (leadingSign) ca[i++] = '+';
+ else if (leadingSpace) ca[i++] = ' ';
+ }
+ else {
+ if (neg) ca[i++] = '-';
+ else if (leadingSign) ca[i++] = '+';
+ else if (leadingSpace) ca[i++] = ' ';
+ for (int j=0; j<nBlanks; j++,i++)
+ ca[i] = '0';
+ }
+ for (int j=0; j<nLeadingZeros; j++,i++)
+ ca[i] = '0';
+ char[] csx = sx.toCharArray();
+ jFirst = neg?1:0;
+ for (int j=jFirst; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ }
+ return new String(ca);
+ }
+ /**
+ * Format method for the x conversion character and
+ * short argument.
+ *
+ * For x format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means to lead with
+ * '0x'.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the short to format.
+ * @return the formatted String.
+ */
+ private String printXFormat(short x) {
+ String sx=null;
+ if (x == Short.MIN_VALUE)
+ sx = "8000";
+ else if (x < 0) {
+ String t;
+ if (x==Short.MIN_VALUE)
+ t = "0";
+ else {
+ t = Integer.toString(
+ (~(-x-1))^Short.MIN_VALUE,16);
+ if (t.charAt(0)=='F'||t.charAt(0)=='f')
+ t = t.substring(16,32);
+ }
+ switch (t.length()) {
+ case 1:
+ sx = "800"+t;
+ break;
+ case 2:
+ sx = "80"+t;
+ break;
+ case 3:
+ sx = "8"+t;
+ break;
+ case 4:
+ switch (t.charAt(0)) {
+ case '1':
+ sx = "9"+t.substring(1,4);
+ break;
+ case '2':
+ sx = "a"+t.substring(1,4);
+ break;
+ case '3':
+ sx = "b"+t.substring(1,4);
+ break;
+ case '4':
+ sx = "c"+t.substring(1,4);
+ break;
+ case '5':
+ sx = "d"+t.substring(1,4);
+ break;
+ case '6':
+ sx = "e"+t.substring(1,4);
+ break;
+ case '7':
+ sx = "f"+t.substring(1,4);
+ break;
+ }
+ break;
+ }
+ }
+ else
+ sx = Integer.toString((int)x,16);
+ return printXFormat(sx);
+ }
+ /**
+ * Format method for the x conversion character and
+ * long argument.
+ *
+ * For x format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means to lead with
+ * '0x'.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the long to format.
+ * @return the formatted String.
+ */
+ private String printXFormat(long x) {
+ String sx=null;
+ if (x == Long.MIN_VALUE)
+ sx = "8000000000000000";
+ else if (x < 0) {
+ String t = Long.toString(
+ (~(-x-1))^Long.MIN_VALUE,16);
+ switch (t.length()) {
+ case 1:
+ sx = "800000000000000"+t;
+ break;
+ case 2:
+ sx = "80000000000000"+t;
+ break;
+ case 3:
+ sx = "8000000000000"+t;
+ break;
+ case 4:
+ sx = "800000000000"+t;
+ break;
+ case 5:
+ sx = "80000000000"+t;
+ break;
+ case 6:
+ sx = "8000000000"+t;
+ break;
+ case 7:
+ sx = "800000000"+t;
+ break;
+ case 8:
+ sx = "80000000"+t;
+ break;
+ case 9:
+ sx = "8000000"+t;
+ break;
+ case 10:
+ sx = "800000"+t;
+ break;
+ case 11:
+ sx = "80000"+t;
+ break;
+ case 12:
+ sx = "8000"+t;
+ break;
+ case 13:
+ sx = "800"+t;
+ break;
+ case 14:
+ sx = "80"+t;
+ break;
+ case 15:
+ sx = "8"+t;
+ break;
+ case 16:
+ switch (t.charAt(0)) {
+ case '1':
+ sx = "9"+t.substring(1,16);
+ break;
+ case '2':
+ sx = "a"+t.substring(1,16);
+ break;
+ case '3':
+ sx = "b"+t.substring(1,16);
+ break;
+ case '4':
+ sx = "c"+t.substring(1,16);
+ break;
+ case '5':
+ sx = "d"+t.substring(1,16);
+ break;
+ case '6':
+ sx = "e"+t.substring(1,16);
+ break;
+ case '7':
+ sx = "f"+t.substring(1,16);
+ break;
+ }
+ break;
+ }
+ }
+ else
+ sx = Long.toString(x,16);
+ return printXFormat(sx);
+ }
+ /**
+ * Format method for the x conversion character and
+ * int argument.
+ *
+ * For x format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means to lead with
+ * '0x'.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the int to format.
+ * @return the formatted String.
+ */
+ private String printXFormat(int x) {
+ String sx=null;
+ if (x == Integer.MIN_VALUE)
+ sx = "80000000";
+ else if (x < 0) {
+ String t = Integer.toString(
+ (~(-x-1))^Integer.MIN_VALUE,16);
+ switch (t.length()) {
+ case 1:
+ sx = "8000000"+t;
+ break;
+ case 2:
+ sx = "800000"+t;
+ break;
+ case 3:
+ sx = "80000"+t;
+ break;
+ case 4:
+ sx = "8000"+t;
+ break;
+ case 5:
+ sx = "800"+t;
+ break;
+ case 6:
+ sx = "80"+t;
+ break;
+ case 7:
+ sx = "8"+t;
+ break;
+ case 8:
+ switch (t.charAt(0)) {
+ case '1':
+ sx = "9"+t.substring(1,8);
+ break;
+ case '2':
+ sx = "a"+t.substring(1,8);
+ break;
+ case '3':
+ sx = "b"+t.substring(1,8);
+ break;
+ case '4':
+ sx = "c"+t.substring(1,8);
+ break;
+ case '5':
+ sx = "d"+t.substring(1,8);
+ break;
+ case '6':
+ sx = "e"+t.substring(1,8);
+ break;
+ case '7':
+ sx = "f"+t.substring(1,8);
+ break;
+ }
+ break;
+ }
+ }
+ else
+ sx = Integer.toString(x,16);
+ return printXFormat(sx);
+ }
+ /**
+ * Utility method for formatting using the x
+ * conversion character.
+ * @param sx the String to format, the result of
+ * converting a short, int, or long to a
+ * String.
+ * @return the formatted String.
+ */
+ private String printXFormat(String sx) {
+ int nLeadingZeros = 0;
+ int nBlanks = 0;
+ if (sx.equals("0")&&precisionSet&&precision==0)
+ sx="";
+ if (precisionSet)
+ nLeadingZeros = precision-sx.length();
+ if (nLeadingZeros<0) nLeadingZeros=0;
+ if (fieldWidthSet) {
+ nBlanks = fieldWidth-nLeadingZeros-sx.length();
+ if (alternateForm) nBlanks = nBlanks - 2;
+ }
+ if (nBlanks<0) nBlanks=0;
+ int n=0;
+ if (alternateForm) n+=2;
+ n += nLeadingZeros;
+ n += sx.length();
+ n += nBlanks;
+ char[] ca = new char[n];
+ int i=0;
+ if (leftJustify) {
+ if (alternateForm) {
+ ca[i++]='0'; ca[i++]='x';
+ }
+ for (int j=0; j<nLeadingZeros; j++,i++)
+ ca[i]='0';
+ char[] csx = sx.toCharArray();
+ for (int j=0; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ for (int j=0; j<nBlanks; j++,i++)
+ ca[i] = ' ';
+ }
+ else {
+ if (!leadingZeros)
+ for (int j=0; j<nBlanks; j++,i++)
+ ca[i] = ' ';
+ if (alternateForm) {
+ ca[i++]='0'; ca[i++]='x';
+ }
+ if (leadingZeros)
+ for (int j=0; j<nBlanks; j++,i++)
+ ca[i] = '0';
+ for (int j=0; j<nLeadingZeros; j++,i++)
+ ca[i]='0';
+ char[] csx = sx.toCharArray();
+ for (int j=0; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ }
+ String caReturn=new String(ca);
+ if (conversionCharacter=='X')
+ caReturn = caReturn.toUpperCase();
+ return caReturn;
+ }
+ /**
+ * Format method for the o conversion character and
+ * short argument.
+ *
+ * For o format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means that the
+ * output begins with a leading 0 and the precision
+ * is increased by 1.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the short to format.
+ * @return the formatted String.
+ */
+ private String printOFormat(short x) {
+ String sx=null;
+ if (x == Short.MIN_VALUE)
+ sx = "100000";
+ else if (x < 0) {
+ String t = Integer.toString(
+ (~(-x-1))^Short.MIN_VALUE,8);
+ switch (t.length()) {
+ case 1:
+ sx = "10000"+t;
+ break;
+ case 2:
+ sx = "1000"+t;
+ break;
+ case 3:
+ sx = "100"+t;
+ break;
+ case 4:
+ sx = "10"+t;
+ break;
+ case 5:
+ sx = "1"+t;
+ break;
+ }
+ }
+ else
+ sx = Integer.toString((int)x,8);
+ return printOFormat(sx);
+ }
+ /**
+ * Format method for the o conversion character and
+ * long argument.
+ *
+ * For o format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means that the
+ * output begins with a leading 0 and the precision
+ * is increased by 1.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the long to format.
+ * @return the formatted String.
+ */
+ private String printOFormat(long x) {
+ String sx=null;
+ if (x == Long.MIN_VALUE)
+ sx = "1000000000000000000000";
+ else if (x < 0) {
+ String t = Long.toString(
+ (~(-x-1))^Long.MIN_VALUE,8);
+ switch (t.length()) {
+ case 1:
+ sx = "100000000000000000000"+t;
+ break;
+ case 2:
+ sx = "10000000000000000000"+t;
+ break;
+ case 3:
+ sx = "1000000000000000000"+t;
+ break;
+ case 4:
+ sx = "100000000000000000"+t;
+ break;
+ case 5:
+ sx = "10000000000000000"+t;
+ break;
+ case 6:
+ sx = "1000000000000000"+t;
+ break;
+ case 7:
+ sx = "100000000000000"+t;
+ break;
+ case 8:
+ sx = "10000000000000"+t;
+ break;
+ case 9:
+ sx = "1000000000000"+t;
+ break;
+ case 10:
+ sx = "100000000000"+t;
+ break;
+ case 11:
+ sx = "10000000000"+t;
+ break;
+ case 12:
+ sx = "1000000000"+t;
+ break;
+ case 13:
+ sx = "100000000"+t;
+ break;
+ case 14:
+ sx = "10000000"+t;
+ break;
+ case 15:
+ sx = "1000000"+t;
+ break;
+ case 16:
+ sx = "100000"+t;
+ break;
+ case 17:
+ sx = "10000"+t;
+ break;
+ case 18:
+ sx = "1000"+t;
+ break;
+ case 19:
+ sx = "100"+t;
+ break;
+ case 20:
+ sx = "10"+t;
+ break;
+ case 21:
+ sx = "1"+t;
+ break;
+ }
+ }
+ else
+ sx = Long.toString(x,8);
+ return printOFormat(sx);
+ }
+ /**
+ * Format method for the o conversion character and
+ * int argument.
+ *
+ * For o format, the flag character '-', means that
+ * the output should be left justified within the
+ * field. The default is to pad with blanks on the
+ * left. The '#' flag character means that the
+ * output begins with a leading 0 and the precision
+ * is increased by 1.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is to
+ * add no padding. Padding is with blanks by
+ * default.
+ *
+ * The precision, if set, is the minimum number of
+ * digits to appear. Padding is with leading 0s.
+ * @param x the int to format.
+ * @return the formatted String.
+ */
+ private String printOFormat(int x) {
+ String sx=null;
+ if (x == Integer.MIN_VALUE)
+ sx = "20000000000";
+ else if (x < 0) {
+ String t = Integer.toString(
+ (~(-x-1))^Integer.MIN_VALUE,8);
+ switch (t.length()) {
+ case 1:
+ sx = "2000000000"+t;
+ break;
+ case 2:
+ sx = "200000000"+t;
+ break;
+ case 3:
+ sx = "20000000"+t;
+ break;
+ case 4:
+ sx = "2000000"+t;
+ break;
+ case 5:
+ sx = "200000"+t;
+ break;
+ case 6:
+ sx = "20000"+t;
+ break;
+ case 7:
+ sx = "2000"+t;
+ break;
+ case 8:
+ sx = "200"+t;
+ break;
+ case 9:
+ sx = "20"+t;
+ break;
+ case 10:
+ sx = "2"+t;
+ break;
+ case 11:
+ sx = "3"+t.substring(1);
+ break;
+ }
+ }
+ else
+ sx = Integer.toString(x,8);
+ return printOFormat(sx);
+ }
+ /**
+ * Utility method for formatting using the o
+ * conversion character.
+ * @param sx the String to format, the result of
+ * converting a short, int, or long to a
+ * String.
+ * @return the formatted String.
+ */
+ private String printOFormat(String sx) {
+ int nLeadingZeros = 0;
+ int nBlanks = 0;
+ if (sx.equals("0")&&precisionSet&&precision==0)
+ sx="";
+ if (precisionSet)
+ nLeadingZeros = precision-sx.length();
+ if (alternateForm) nLeadingZeros++;
+ if (nLeadingZeros<0) nLeadingZeros=0;
+ if (fieldWidthSet)
+ nBlanks = fieldWidth-nLeadingZeros-sx.length();
+ if (nBlanks<0) nBlanks=0;
+ int n=nLeadingZeros+sx.length()+nBlanks;
+ char[] ca = new char[n];
+ int i;
+ if (leftJustify) {
+ for (i=0; i<nLeadingZeros; i++) ca[i]='0';
+ char[] csx = sx.toCharArray();
+ for (int j=0; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ for (int j=0; j<nBlanks; j++,i++) ca[i] = ' ';
+ }
+ else {
+ if (leadingZeros)
+ for (i=0; i<nBlanks; i++) ca[i]='0';
+ else
+ for (i=0; i<nBlanks; i++) ca[i]=' ';
+ for (int j=0; j<nLeadingZeros; j++,i++)
+ ca[i]='0';
+ char[] csx = sx.toCharArray();
+ for (int j=0; j<csx.length; j++,i++)
+ ca[i] = csx[j];
+ }
+ return new String(ca);
+ }
+ /**
+ * Format method for the c conversion character and
+ * char argument.
+ *
+ * The only flag character that affects c format is
+ * the '-', meaning that the output should be left
+ * justified within the field. The default is to
+ * pad with blanks on the left.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. Padding is with
+ * blanks by default. The default width is 1.
+ *
+ * The precision, if set, is ignored.
+ * @param x the char to format.
+ * @return the formatted String.
+ */
+ private String printCFormat(char x) {
+ int nPrint = 1;
+ int width = fieldWidth;
+ if (!fieldWidthSet) width = nPrint;
+ char[] ca = new char[width];
+ int i=0;
+ if (leftJustify) {
+ ca[0] = x;
+ for (i=1; i<=width-nPrint; i++) ca[i]=' ';
+ }
+ else {
+ for (i=0; i<width-nPrint; i++) ca[i]=' ';
+ ca[i] = x;
+ }
+ return new String(ca);
+ }
+ /**
+ * Format method for the s conversion character and
+ * String argument.
+ *
+ * The only flag character that affects s format is
+ * the '-', meaning that the output should be left
+ * justified within the field. The default is to
+ * pad with blanks on the left.
+ *
+ * The field width is treated as the minimum number
+ * of characters to be printed. The default is the
+ * smaller of the number of characters in the the
+ * input and the precision. Padding is with blanks
+ * by default.
+ *
+ * The precision, if set, specifies the maximum
+ * number of characters to be printed from the
+ * string. A null digit string is treated
+ * as a 0. The default is not to set a maximum
+ * number of characters to be printed.
+ * @param x the String to format.
+ * @return the formatted String.
+ */
+ private String printSFormat(String x) {
+ int nPrint = x.length();
+ int width = fieldWidth;
+ if (precisionSet && nPrint>precision)
+ nPrint=precision;
+ if (!fieldWidthSet) width = nPrint;
+ int n=0;
+ if (width>nPrint) n+=width-nPrint;
+ if (nPrint>=x.length()) n+= x.length();
+ else n+= nPrint;
+ char[] ca = new char[n];
+ int i=0;
+ if (leftJustify) {
+ if (nPrint>=x.length()) {
+ char[] csx = x.toCharArray();
+ for (i=0; i<x.length(); i++) ca[i]=csx[i];
+ }
+ else {
+ char[] csx =
+ x.substring(0,nPrint).toCharArray();
+ for (i=0; i<nPrint; i++) ca[i]=csx[i];
+ }
+ for (int j=0; j<width-nPrint; j++,i++)
+ ca[i]=' ';
+ }
+ else {
+ for (i=0; i<width-nPrint; i++) ca[i]=' ';
+ if (nPrint>=x.length()) {
+ char[] csx = x.toCharArray();
+ for (int j=0; j<x.length(); i++,j++)
+ ca[i]=csx[j];
+ }
+ else {
+ char[] csx =
+ x.substring(0,nPrint).toCharArray();
+ for (int j=0; j<nPrint; i++,j++)
+ ca[i]=csx[j];
+ }
+ }
+ return new String(ca);
+ }
+ /**
+ * Check for a conversion character. If it is
+ * there, store it.
+ * @param x the String to format.
+ * @return <code>true</code> if the conversion
+ * character is there, and
+ * <code>false</code> otherwise.
+ */
+ private boolean setConversionCharacter() {
+ /* idfgGoxXeEcs */
+ boolean ret = false;
+ conversionCharacter='\0';
+ if (pos < fmt.length()) {
+ char c = fmt.charAt(pos);
+ if (c=='i'||c=='d'||c=='f'||c=='g'||c=='G'
+ || c=='o' || c=='x' || c=='X' || c=='e'
+ || c=='E' || c=='c' || c=='s' || c=='%') {
+ conversionCharacter = c;
+ pos++;
+ ret = true;
+ }
+ }
+ return ret;
+ }
+ /**
+ * Check for an h, l, or L in a format. An L is
+ * used to control the minimum number of digits
+ * in an exponent when using floating point
+ * formats. An l or h is used to control
+ * conversion of the input to a long or short,
+ * respectively, before formatting. If any of
+ * these is present, store them.
+ */
+ private void setOptionalHL() {
+ optionalh=false;
+ optionall=false;
+ optionalL=false;
+ if (pos < fmt.length()) {
+ char c = fmt.charAt(pos);
+ if (c=='h') { optionalh=true; pos++; }
+ else if (c=='l') { optionall=true; pos++; }
+ else if (c=='L') { optionalL=true; pos++; }
+ }
+ }
+ /**
+ * Set the precision.
+ */
+ private void setPrecision() {
+ int firstPos = pos;
+ precisionSet = false;
+ if (pos<fmt.length()&&fmt.charAt(pos)=='.') {
+ pos++;
+ if ((pos < fmt.length())
+ && (fmt.charAt(pos)=='*')) {
+ pos++;
+ if (!setPrecisionArgPosition()) {
+ variablePrecision = true;
+ precisionSet = true;
+ }
+ return;
+ }
+ else {
+ while (pos < fmt.length()) {
+ char c = fmt.charAt(pos);
+ if (Character.isDigit(c)) pos++;
+ else break;
+ }
+ if (pos > firstPos+1) {
+ String sz = fmt.substring(firstPos+1,pos);
+ precision = Integer.parseInt(sz);
+ precisionSet = true;
+ }
+ }
+ }
+ }
+ /**
+ * Set the field width.
+ */
+ private void setFieldWidth() {
+ int firstPos = pos;
+ fieldWidth = 0;
+ fieldWidthSet = false;
+ if ((pos < fmt.length())
+ && (fmt.charAt(pos)=='*')) {
+ pos++;
+ if (!setFieldWidthArgPosition()) {
+ variableFieldWidth = true;
+ fieldWidthSet = true;
+ }
+ }
+ else {
+ while (pos < fmt.length()) {
+ char c = fmt.charAt(pos);
+ if (Character.isDigit(c)) pos++;
+ else break;
+ }
+ if (firstPos<pos && firstPos < fmt.length()) {
+ String sz = fmt.substring(firstPos,pos);
+ fieldWidth = Integer.parseInt(sz);
+ fieldWidthSet = true;
+ }
+ }
+ }
+ /**
+ * Store the digits <code>n</code> in %n$ forms.
+ */
+ private void setArgPosition() {
+ int xPos;
+ for (xPos=pos; xPos<fmt.length(); xPos++) {
+ if (!Character.isDigit(fmt.charAt(xPos)))
+ break;
+ }
+ if (xPos>pos && xPos<fmt.length()) {
+ if (fmt.charAt(xPos)=='$') {
+ positionalSpecification = true;
+ argumentPosition=
+ Integer.parseInt(fmt.substring(pos,xPos));
+ pos=xPos+1;
+ }
+ }
+ }
+ /**
+ * Store the digits <code>n</code> in *n$ forms.
+ */
+ private boolean setFieldWidthArgPosition() {
+ boolean ret=false;
+ int xPos;
+ for (xPos=pos; xPos<fmt.length(); xPos++) {
+ if (!Character.isDigit(fmt.charAt(xPos)))
+ break;
+ }
+ if (xPos>pos && xPos<fmt.length()) {
+ if (fmt.charAt(xPos)=='$') {
+ positionalFieldWidth = true;
+ argumentPositionForFieldWidth=
+ Integer.parseInt(fmt.substring(pos,xPos));
+ pos=xPos+1;
+ ret=true;
+ }
+ }
+ return ret;
+ }
+ /**
+ * Store the digits <code>n</code> in *n$ forms.
+ */
+ private boolean setPrecisionArgPosition() {
+ boolean ret=false;
+ int xPos;
+ for (xPos=pos; xPos<fmt.length(); xPos++) {
+ if (!Character.isDigit(fmt.charAt(xPos)))
+ break;
+ }
+ if (xPos>pos && xPos<fmt.length()) {
+ if (fmt.charAt(xPos)=='$') {
+ positionalPrecision = true;
+ argumentPositionForPrecision=
+ Integer.parseInt(fmt.substring(pos,xPos));
+ pos=xPos+1;
+ ret=true;
+ }
+ }
+ return ret;
+ }
+ boolean isPositionalSpecification() {
+ return positionalSpecification;
+ }
+ int getArgumentPosition() { return argumentPosition; }
+ boolean isPositionalFieldWidth() {
+ return positionalFieldWidth;
+ }
+ int getArgumentPositionForFieldWidth() {
+ return argumentPositionForFieldWidth;
+ }
+ boolean isPositionalPrecision() {
+ return positionalPrecision;
+ }
+ int getArgumentPositionForPrecision() {
+ return argumentPositionForPrecision;
+ }
+ /**
+ * Set flag characters, one of '-+#0 or a space.
+ */
+ private void setFlagCharacters() {
+ /* '-+ #0 */
+ thousands = false;
+ leftJustify = false;
+ leadingSign = false;
+ leadingSpace = false;
+ alternateForm = false;
+ leadingZeros = false;
+ for ( ; pos < fmt.length(); pos++) {
+ char c = fmt.charAt(pos);
+ if (c == '\'') thousands = true;
+ else if (c == '-') {
+ leftJustify = true;
+ leadingZeros = false;
+ }
+ else if (c == '+') {
+ leadingSign = true;
+ leadingSpace = false;
+ }
+ else if (c == ' ') {
+ if (!leadingSign) leadingSpace = true;
+ }
+ else if (c == '#') alternateForm = true;
+ else if (c == '0') {
+ if (!leftJustify) leadingZeros = true;
+ }
+ else break;
+ }
+ }
+ /**
+ * The integer portion of the result of a decimal
+ * conversion (i, d, u, f, g, or G) will be
+ * formatted with thousands' grouping characters.
+ * For other conversions the flag is ignored.
+ */
+ private boolean thousands = false;
+ /**
+ * The result of the conversion will be
+ * left-justified within the field.
+ */
+ private boolean leftJustify = false;
+ /**
+ * The result of a signed conversion will always
+ * begin with a sign (+ or -).
+ */
+ private boolean leadingSign = false;
+ /**
+ * Flag indicating that left padding with spaces is
+ * specified.
+ */
+ private boolean leadingSpace = false;
+ /**
+ * For an o conversion, increase the precision to
+ * force the first digit of the result to be a
+ * zero. For x (or X) conversions, a non-zero
+ * result will have 0x (or 0X) prepended to it.
+ * For e, E, f, g, or G conversions, the result
+ * will always contain a radix character, even if
+ * no digits follow the point. For g and G
+ * conversions, trailing zeros will not be removed
+ * from the result.
+ */
+ private boolean alternateForm = false;
+ /**
+ * Flag indicating that left padding with zeroes is
+ * specified.
+ */
+ private boolean leadingZeros = false;
+ /**
+ * Flag indicating that the field width is *.
+ */
+ private boolean variableFieldWidth = false;
+ /**
+ * If the converted value has fewer bytes than the
+ * field width, it will be padded with spaces or
+ * zeroes.
+ */
+ private int fieldWidth = 0;
+ /**
+ * Flag indicating whether or not the field width
+ * has been set.
+ */
+ private boolean fieldWidthSet = false;
+ /**
+ * The minimum number of digits to appear for the
+ * d, i, o, u, x, or X conversions. The number of
+ * digits to appear after the radix character for
+ * the e, E, and f conversions. The maximum number
+ * of significant digits for the g and G
+ * conversions. The maximum number of bytes to be
+ * printed from a string in s and S conversions.
+ */
+ private int precision = 0;
+ /** Default precision. */
+ private final static int defaultDigits=6;
+ /**
+ * Flag indicating that the precision is *.
+ */
+ private boolean variablePrecision = false;
+ /**
+ * Flag indicating whether or not the precision has
+ * been set.
+ */
+ private boolean precisionSet = false;
+ /*
+ */
+ private boolean positionalSpecification=false;
+ private int argumentPosition=0;
+ private boolean positionalFieldWidth=false;
+ private int argumentPositionForFieldWidth=0;
+ private boolean positionalPrecision=false;
+ private int argumentPositionForPrecision=0;
+ /**
+ * Flag specifying that a following d, i, o, u, x,
+ * or X conversion character applies to a type
+ * short int.
+ */
+ private boolean optionalh = false;
+ /**
+ * Flag specifying that a following d, i, o, u, x,
+ * or X conversion character applies to a type lont
+ * int argument.
+ */
+ private boolean optionall = false;
+ /**
+ * Flag specifying that a following e, E, f, g, or
+ * G conversion character applies to a type double
+ * argument. This is a noop in Java.
+ */
+ private boolean optionalL = false;
+ /** Control string type. */
+ private char conversionCharacter = '\0';
+ /**
+ * Position within the control string. Used by
+ * the constructor.
+ */
+ private int pos = 0;
+ /** Literal or control format string. */
+ private String fmt;
+ }
+ /** Vector of control strings and format literals. */
+ private Vector vFmt = new Vector();
+ /** Character position. Used by the constructor. */
+ private int cPos=0;
+ /** Character position. Used by the constructor. */
+ private DecimalFormatSymbols dfs=null;
+}
diff --git a/util/org/j_paine/formatter/README b/util/org/j_paine/formatter/README
new file mode 100644
index 0000000..e8b30d5
--- /dev/null
+++ b/util/org/j_paine/formatter/README
@@ -0,0 +1,23 @@
+This directory contains the Formatter package written by Jocelyn Paine.
+
+ http://www.j-paine.org/Formatter
+
+This is actually a modified version of the Formatter, hacked up to work
+with f2j. Among other things, I removed some exception handling, so the
+modified version may not be ideal for use in other Java code.
+
+A quick summary of the modifications:
+
+-added package name
+
+-loop back to reuse format spec if more elements in vector
+
+-support L (logical) formats
+
+-added parsing for P formats, but no scale support
+
+-removed some exceptions to better emulate g77
+
+-return padded strings on READ
+
+-allow edit descriptors to be upper or lower case
diff --git a/util/org/j_paine/formatter/SimpleCharStream.java b/util/org/j_paine/formatter/SimpleCharStream.java
new file mode 100644
index 0000000..70505d9
--- /dev/null
+++ b/util/org/j_paine/formatter/SimpleCharStream.java
@@ -0,0 +1,439 @@
+/* Generated By:JavaCC: Do not edit this line. SimpleCharStream.java Version 4.0 */
+package org.j_paine.formatter;
+
+/**
+ * An implementation of interface CharStream, where the stream is assumed to
+ * contain only ASCII characters (without unicode processing).
+ */
+
+public class SimpleCharStream
+{
+ public static final boolean staticFlag = false;
+ int bufsize;
+ int available;
+ int tokenBegin;
+ public int bufpos = -1;
+ protected int bufline[];
+ protected int bufcolumn[];
+
+ protected int column = 0;
+ protected int line = 1;
+
+ protected boolean prevCharIsCR = false;
+ protected boolean prevCharIsLF = false;
+
+ protected java.io.Reader inputStream;
+
+ protected char[] buffer;
+ protected int maxNextCharInd = 0;
+ protected int inBuf = 0;
+ protected int tabSize = 8;
+
+ protected void setTabSize(int i) { tabSize = i; }
+ protected int getTabSize(int i) { return tabSize; }
+
+
+ protected void ExpandBuff(boolean wrapAround)
+ {
+ char[] newbuffer = new char[bufsize + 2048];
+ int newbufline[] = new int[bufsize + 2048];
+ int newbufcolumn[] = new int[bufsize + 2048];
+
+ try
+ {
+ if (wrapAround)
+ {
+ System.arraycopy(buffer, tokenBegin, newbuffer, 0, bufsize - tokenBegin);
+ System.arraycopy(buffer, 0, newbuffer,
+ bufsize - tokenBegin, bufpos);
+ buffer = newbuffer;
+
+ System.arraycopy(bufline, tokenBegin, newbufline, 0, bufsize - tokenBegin);
+ System.arraycopy(bufline, 0, newbufline, bufsize - tokenBegin, bufpos);
+ bufline = newbufline;
+
+ System.arraycopy(bufcolumn, tokenBegin, newbufcolumn, 0, bufsize - tokenBegin);
+ System.arraycopy(bufcolumn, 0, newbufcolumn, bufsize - tokenBegin, bufpos);
+ bufcolumn = newbufcolumn;
+
+ maxNextCharInd = (bufpos += (bufsize - tokenBegin));
+ }
+ else
+ {
+ System.arraycopy(buffer, tokenBegin, newbuffer, 0, bufsize - tokenBegin);
+ buffer = newbuffer;
+
+ System.arraycopy(bufline, tokenBegin, newbufline, 0, bufsize - tokenBegin);
+ bufline = newbufline;
+
+ System.arraycopy(bufcolumn, tokenBegin, newbufcolumn, 0, bufsize - tokenBegin);
+ bufcolumn = newbufcolumn;
+
+ maxNextCharInd = (bufpos -= tokenBegin);
+ }
+ }
+ catch (Throwable t)
+ {
+ throw new Error(t.getMessage());
+ }
+
+
+ bufsize += 2048;
+ available = bufsize;
+ tokenBegin = 0;
+ }
+
+ protected void FillBuff() throws java.io.IOException
+ {
+ if (maxNextCharInd == available)
+ {
+ if (available == bufsize)
+ {
+ if (tokenBegin > 2048)
+ {
+ bufpos = maxNextCharInd = 0;
+ available = tokenBegin;
+ }
+ else if (tokenBegin < 0)
+ bufpos = maxNextCharInd = 0;
+ else
+ ExpandBuff(false);
+ }
+ else if (available > tokenBegin)
+ available = bufsize;
+ else if ((tokenBegin - available) < 2048)
+ ExpandBuff(true);
+ else
+ available = tokenBegin;
+ }
+
+ int i;
+ try {
+ if ((i = inputStream.read(buffer, maxNextCharInd,
+ available - maxNextCharInd)) == -1)
+ {
+ inputStream.close();
+ throw new java.io.IOException();
+ }
+ else
+ maxNextCharInd += i;
+ return;
+ }
+ catch(java.io.IOException e) {
+ --bufpos;
+ backup(0);
+ if (tokenBegin == -1)
+ tokenBegin = bufpos;
+ throw e;
+ }
+ }
+
+ public char BeginToken() throws java.io.IOException
+ {
+ tokenBegin = -1;
+ char c = readChar();
+ tokenBegin = bufpos;
+
+ return c;
+ }
+
+ protected void UpdateLineColumn(char c)
+ {
+ column++;
+
+ if (prevCharIsLF)
+ {
+ prevCharIsLF = false;
+ line += (column = 1);
+ }
+ else if (prevCharIsCR)
+ {
+ prevCharIsCR = false;
+ if (c == '\n')
+ {
+ prevCharIsLF = true;
+ }
+ else
+ line += (column = 1);
+ }
+
+ switch (c)
+ {
+ case '\r' :
+ prevCharIsCR = true;
+ break;
+ case '\n' :
+ prevCharIsLF = true;
+ break;
+ case '\t' :
+ column--;
+ column += (tabSize - (column % tabSize));
+ break;
+ default :
+ break;
+ }
+
+ bufline[bufpos] = line;
+ bufcolumn[bufpos] = column;
+ }
+
+ public char readChar() throws java.io.IOException
+ {
+ if (inBuf > 0)
+ {
+ --inBuf;
+
+ if (++bufpos == bufsize)
+ bufpos = 0;
+
+ return buffer[bufpos];
+ }
+
+ if (++bufpos >= maxNextCharInd)
+ FillBuff();
+
+ char c = buffer[bufpos];
+
+ UpdateLineColumn(c);
+ return (c);
+ }
+
+ /**
+ * @deprecated
+ * @see #getEndColumn
+ */
+
+ public int getColumn() {
+ return bufcolumn[bufpos];
+ }
+
+ /**
+ * @deprecated
+ * @see #getEndLine
+ */
+
+ public int getLine() {
+ return bufline[bufpos];
+ }
+
+ public int getEndColumn() {
+ return bufcolumn[bufpos];
+ }
+
+ public int getEndLine() {
+ return bufline[bufpos];
+ }
+
+ public int getBeginColumn() {
+ return bufcolumn[tokenBegin];
+ }
+
+ public int getBeginLine() {
+ return bufline[tokenBegin];
+ }
+
+ public void backup(int amount) {
+
+ inBuf += amount;
+ if ((bufpos -= amount) < 0)
+ bufpos += bufsize;
+ }
+
+ public SimpleCharStream(java.io.Reader dstream, int startline,
+ int startcolumn, int buffersize)
+ {
+ inputStream = dstream;
+ line = startline;
+ column = startcolumn - 1;
+
+ available = bufsize = buffersize;
+ buffer = new char[buffersize];
+ bufline = new int[buffersize];
+ bufcolumn = new int[buffersize];
+ }
+
+ public SimpleCharStream(java.io.Reader dstream, int startline,
+ int startcolumn)
+ {
+ this(dstream, startline, startcolumn, 4096);
+ }
+
+ public SimpleCharStream(java.io.Reader dstream)
+ {
+ this(dstream, 1, 1, 4096);
+ }
+ public void ReInit(java.io.Reader dstream, int startline,
+ int startcolumn, int buffersize)
+ {
+ inputStream = dstream;
+ line = startline;
+ column = startcolumn - 1;
+
+ if (buffer == null || buffersize != buffer.length)
+ {
+ available = bufsize = buffersize;
+ buffer = new char[buffersize];
+ bufline = new int[buffersize];
+ bufcolumn = new int[buffersize];
+ }
+ prevCharIsLF = prevCharIsCR = false;
+ tokenBegin = inBuf = maxNextCharInd = 0;
+ bufpos = -1;
+ }
+
+ public void ReInit(java.io.Reader dstream, int startline,
+ int startcolumn)
+ {
+ ReInit(dstream, startline, startcolumn, 4096);
+ }
+
+ public void ReInit(java.io.Reader dstream)
+ {
+ ReInit(dstream, 1, 1, 4096);
+ }
+ public SimpleCharStream(java.io.InputStream dstream, String encoding, int startline,
+ int startcolumn, int buffersize) throws java.io.UnsupportedEncodingException
+ {
+ this(encoding == null ? new java.io.InputStreamReader(dstream) : new java.io.InputStreamReader(dstream, encoding), startline, startcolumn, buffersize);
+ }
+
+ public SimpleCharStream(java.io.InputStream dstream, int startline,
+ int startcolumn, int buffersize)
+ {
+ this(new java.io.InputStreamReader(dstream), startline, startcolumn, buffersize);
+ }
+
+ public SimpleCharStream(java.io.InputStream dstream, String encoding, int startline,
+ int startcolumn) throws java.io.UnsupportedEncodingException
+ {
+ this(dstream, encoding, startline, startcolumn, 4096);
+ }
+
+ public SimpleCharStream(java.io.InputStream dstream, int startline,
+ int startcolumn)
+ {
+ this(dstream, startline, startcolumn, 4096);
+ }
+
+ public SimpleCharStream(java.io.InputStream dstream, String encoding) throws java.io.UnsupportedEncodingException
+ {
+ this(dstream, encoding, 1, 1, 4096);
+ }
+
+ public SimpleCharStream(java.io.InputStream dstream)
+ {
+ this(dstream, 1, 1, 4096);
+ }
+
+ public void ReInit(java.io.InputStream dstream, String encoding, int startline,
+ int startcolumn, int buffersize) throws java.io.UnsupportedEncodingException
+ {
+ ReInit(encoding == null ? new java.io.InputStreamReader(dstream) : new java.io.InputStreamReader(dstream, encoding), startline, startcolumn, buffersize);
+ }
+
+ public void ReInit(java.io.InputStream dstream, int startline,
+ int startcolumn, int buffersize)
+ {
+ ReInit(new java.io.InputStreamReader(dstream), startline, startcolumn, buffersize);
+ }
+
+ public void ReInit(java.io.InputStream dstream, String encoding) throws java.io.UnsupportedEncodingException
+ {
+ ReInit(dstream, encoding, 1, 1, 4096);
+ }
+
+ public void ReInit(java.io.InputStream dstream)
+ {
+ ReInit(dstream, 1, 1, 4096);
+ }
+ public void ReInit(java.io.InputStream dstream, String encoding, int startline,
+ int startcolumn) throws java.io.UnsupportedEncodingException
+ {
+ ReInit(dstream, encoding, startline, startcolumn, 4096);
+ }
+ public void ReInit(java.io.InputStream dstream, int startline,
+ int startcolumn)
+ {
+ ReInit(dstream, startline, startcolumn, 4096);
+ }
+ public String GetImage()
+ {
+ if (bufpos >= tokenBegin)
+ return new String(buffer, tokenBegin, bufpos - tokenBegin + 1);
+ else
+ return new String(buffer, tokenBegin, bufsize - tokenBegin) +
+ new String(buffer, 0, bufpos + 1);
+ }
+
+ public char[] GetSuffix(int len)
+ {
+ char[] ret = new char[len];
+
+ if ((bufpos + 1) >= len)
+ System.arraycopy(buffer, bufpos - len + 1, ret, 0, len);
+ else
+ {
+ System.arraycopy(buffer, bufsize - (len - bufpos - 1), ret, 0,
+ len - bufpos - 1);
+ System.arraycopy(buffer, 0, ret, len - bufpos - 1, bufpos + 1);
+ }
+
+ return ret;
+ }
+
+ public void Done()
+ {
+ buffer = null;
+ bufline = null;
+ bufcolumn = null;
+ }
+
+ /**
+ * Method to adjust line and column numbers for the start of a token.
+ */
+ public void adjustBeginLineColumn(int newLine, int newCol)
+ {
+ int start = tokenBegin;
+ int len;
+
+ if (bufpos >= tokenBegin)
+ {
+ len = bufpos - tokenBegin + inBuf + 1;
+ }
+ else
+ {
+ len = bufsize - tokenBegin + bufpos + 1 + inBuf;
+ }
+
+ int i = 0, j = 0, k = 0;
+ int nextColDiff = 0, columnDiff = 0;
+
+ while (i < len &&
+ bufline[j = start % bufsize] == bufline[k = ++start % bufsize])
+ {
+ bufline[j] = newLine;
+ nextColDiff = columnDiff + bufcolumn[k] - bufcolumn[j];
+ bufcolumn[j] = newCol + columnDiff;
+ columnDiff = nextColDiff;
+ i++;
+ }
+
+ if (i < len)
+ {
+ bufline[j] = newLine++;
+ bufcolumn[j] = newCol + columnDiff;
+
+ while (i++ < len)
+ {
+ if (bufline[j = start % bufsize] != bufline[++start % bufsize])
+ bufline[j] = newLine++;
+ else
+ bufline[j] = newLine;
+ }
+ }
+
+ line = bufline[j];
+ column = bufcolumn[j];
+ }
+
+}
diff --git a/util/org/j_paine/formatter/Token.java b/util/org/j_paine/formatter/Token.java
new file mode 100644
index 0000000..fc7539b
--- /dev/null
+++ b/util/org/j_paine/formatter/Token.java
@@ -0,0 +1,81 @@
+/* Generated By:JavaCC: Do not edit this line. Token.java Version 3.0 */
+package org.j_paine.formatter;
+
+/**
+ * Describes the input token stream.
+ */
+
+public class Token {
+
+ /**
+ * An integer that describes the kind of this token. This numbering
+ * system is determined by JavaCCParser, and a table of these numbers is
+ * stored in the file ...Constants.java.
+ */
+ public int kind;
+
+ /**
+ * beginLine and beginColumn describe the position of the first character
+ * of this token; endLine and endColumn describe the position of the
+ * last character of this token.
+ */
+ public int beginLine, beginColumn, endLine, endColumn;
+
+ /**
+ * The string image of the token.
+ */
+ public String image;
+
+ /**
+ * A reference to the next regular (non-special) token from the input
+ * stream. If this is the last token from the input stream, or if the
+ * token manager has not read tokens beyond this one, this field is
+ * set to null. This is true only if this token is also a regular
+ * token. Otherwise, see below for a description of the contents of
+ * this field.
+ */
+ public Token next;
+
+ /**
+ * This field is used to access special tokens that occur prior to this
+ * token, but after the immediately preceding regular (non-special) token.
+ * If there are no such special tokens, this field is set to null.
+ * When there are more than one such special token, this field refers
+ * to the last of these special tokens, which in turn refers to the next
+ * previous special token through its specialToken field, and so on
+ * until the first special token (whose specialToken field is null).
+ * The next fields of special tokens refer to other special tokens that
+ * immediately follow it (without an intervening regular token). If there
+ * is no such token, this field is null.
+ */
+ public Token specialToken;
+
+ /**
+ * Returns the image.
+ */
+ public String toString()
+ {
+ return image;
+ }
+
+ /**
+ * Returns a new Token object, by default. However, if you want, you
+ * can create and return subclass objects based on the value of ofKind.
+ * Simply add the cases to the switch for all those special cases.
+ * For example, if you have a subclass of Token called IDToken that
+ * you want to create if ofKind is ID, simlpy add something like :
+ *
+ * case MyParserConstants.ID : return new IDToken();
+ *
+ * to the following switch statement. Then you can cast matchedToken
+ * variable to the appropriate type and use it in your lexical actions.
+ */
+ public static final Token newToken(int ofKind)
+ {
+ switch(ofKind)
+ {
+ default : return new Token();
+ }
+ }
+
+}
diff --git a/util/org/j_paine/formatter/TokenMgrError.java b/util/org/j_paine/formatter/TokenMgrError.java
new file mode 100644
index 0000000..9407563
--- /dev/null
+++ b/util/org/j_paine/formatter/TokenMgrError.java
@@ -0,0 +1,133 @@
+/* Generated By:JavaCC: Do not edit this line. TokenMgrError.java Version 3.0 */
+package org.j_paine.formatter;
+
+public class TokenMgrError extends Error
+{
+ /*
+ * Ordinals for various reasons why an Error of this type can be thrown.
+ */
+
+ /**
+ * Lexical error occured.
+ */
+ static final int LEXICAL_ERROR = 0;
+
+ /**
+ * An attempt wass made to create a second instance of a static token manager.
+ */
+ static final int STATIC_LEXER_ERROR = 1;
+
+ /**
+ * Tried to change to an invalid lexical state.
+ */
+ static final int INVALID_LEXICAL_STATE = 2;
+
+ /**
+ * Detected (and bailed out of) an infinite loop in the token manager.
+ */
+ static final int LOOP_DETECTED = 3;
+
+ /**
+ * Indicates the reason why the exception is thrown. It will have
+ * one of the above 4 values.
+ */
+ int errorCode;
+
+ /**
+ * Replaces unprintable characters by their espaced (or unicode escaped)
+ * equivalents in the given string
+ */
+ protected static final String addEscapes(String str) {
+ StringBuffer retval = new StringBuffer();
+ char ch;
+ for (int i = 0; i < str.length(); i++) {
+ switch (str.charAt(i))
+ {
+ case 0 :
+ continue;
+ case '\b':
+ retval.append("\\b");
+ continue;
+ case '\t':
+ retval.append("\\t");
+ continue;
+ case '\n':
+ retval.append("\\n");
+ continue;
+ case '\f':
+ retval.append("\\f");
+ continue;
+ case '\r':
+ retval.append("\\r");
+ continue;
+ case '\"':
+ retval.append("\\\"");
+ continue;
+ case '\'':
+ retval.append("\\\'");
+ continue;
+ case '\\':
+ retval.append("\\\\");
+ continue;
+ default:
+ if ((ch = str.charAt(i)) < 0x20 || ch > 0x7e) {
+ String s = "0000" + Integer.toString(ch, 16);
+ retval.append("\\u" + s.substring(s.length() - 4, s.length()));
+ } else {
+ retval.append(ch);
+ }
+ continue;
+ }
+ }
+ return retval.toString();
+ }
+
+ /**
+ * Returns a detailed message for the Error when it is thrown by the
+ * token manager to indicate a lexical error.
+ * Parameters :
+ * EOFSeen : indicates if EOF caused the lexicl error
+ * curLexState : lexical state in which this error occured
+ * errorLine : line number when the error occured
+ * errorColumn : column number when the error occured
+ * errorAfter : prefix that was seen before this error occured
+ * curchar : the offending character
+ * Note: You can customize the lexical error message by modifying this method.
+ */
+ protected static String LexicalError(boolean EOFSeen, int lexState, int errorLine, int errorColumn, String errorAfter, char curChar) {
+ return("Lexical error at line " +
+ errorLine + ", column " +
+ errorColumn + ". Encountered: " +
+ (EOFSeen ? "<EOF> " : ("\"" + addEscapes(String.valueOf(curChar)) + "\"") + " (" + (int)curChar + "), ") +
+ "after : \"" + addEscapes(errorAfter) + "\"");
+ }
+
+ /**
+ * You can also modify the body of this method to customize your error messages.
+ * For example, cases like LOOP_DETECTED and INVALID_LEXICAL_STATE are not
+ * of end-users concern, so you can return something like :
+ *
+ * "Internal Error : Please file a bug report .... "
+ *
+ * from this method for such cases in the release version of your parser.
+ */
+ public String getMessage() {
+ return super.getMessage();
+ }
+
+ /*
+ * Constructors of various flavors follow.
+ */
+
+ public TokenMgrError() {
+ }
+
+ public TokenMgrError(String message, int reason) {
+ super(message);
+ errorCode = reason;
+ }
+
+ public TokenMgrError(boolean EOFSeen, int lexState, int errorLine, int errorColumn, String errorAfter, char curChar, int reason) {
+ this(LexicalError(EOFSeen, lexState, errorLine, errorColumn, errorAfter, curChar), reason);
+ }
+}
diff --git a/util/org/netlib/CVS/Entries b/util/org/netlib/CVS/Entries
new file mode 100644
index 0000000..1319525
--- /dev/null
+++ b/util/org/netlib/CVS/Entries
@@ -0,0 +1 @@
+D/util////
diff --git a/util/org/netlib/CVS/Repository b/util/org/netlib/CVS/Repository
new file mode 100644
index 0000000..78a6178
--- /dev/null
+++ b/util/org/netlib/CVS/Repository
@@ -0,0 +1 @@
+f2j/util/org/netlib
diff --git a/util/org/netlib/CVS/Root b/util/org/netlib/CVS/Root
new file mode 100644
index 0000000..f54aada
--- /dev/null
+++ b/util/org/netlib/CVS/Root
@@ -0,0 +1 @@
+:ext:keithseymour at f2j.cvs.sourceforge.net:/cvsroot/f2j
diff --git a/util/org/netlib/util/ArraySpec.java b/util/org/netlib/util/ArraySpec.java
new file mode 100644
index 0000000..c5f81f3
--- /dev/null
+++ b/util/org/netlib/util/ArraySpec.java
@@ -0,0 +1,104 @@
+package org.netlib.util;
+
+import java.util.Vector;
+
+/**
+ * This class represents array arguments to I/O calls. For example,
+ * if you pass an array to WRITE() in Fortran and the format specifies
+ * to print multiple values, they'll be pulled from the array as
+ * appropriate. Here, we just pull all the array elements into
+ * the I/O vector.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ */
+
+public class ArraySpec {
+ private Vector vec;
+
+ /**
+ * Create a new ArraySpec for an integer array.
+ *
+ * @param arr The array to be used in the I/O call
+ * @param offset The offset into the array (i.e. the start point)
+ * @param len The number of elements to copy from the
+ * array to the I/O vector.
+ */
+ public ArraySpec(int [] arr, int offset, int len) {
+ vec = new Vector();
+
+ for(int i=offset; i< offset+len; i++)
+ vec.addElement(new Integer(arr[i]));
+ }
+
+ /**
+ * Create a new ArraySpec for a double precision array.
+ *
+ * @param arr The array to be used in the I/O call
+ * @param offset The offset into the array (i.e. the start point)
+ * @param len The number of elements to copy from the
+ * array to the I/O vector.
+ */
+ public ArraySpec(double [] arr, int offset, int len) {
+ vec = new Vector();
+
+ for(int i=offset; i< offset+len; i++)
+ vec.addElement(new Double(arr[i]));
+ }
+
+ /**
+ * Create a new ArraySpec for a float array.
+ *
+ * @param arr The array to be used in the I/O call
+ * @param offset The offset into the array (i.e. the start point)
+ * @param len The number of elements to copy from the
+ * array to the I/O vector.
+ */
+ public ArraySpec(float [] arr, int offset, int len) {
+ vec = new Vector();
+
+ for(int i=offset; i< offset+len; i++)
+ vec.addElement(new Float(arr[i]));
+ }
+
+ /**
+ * Create a new ArraySpec for a String array.
+ *
+ * @param arr The array to be used in the I/O call
+ * @param offset The offset into the array (i.e. the start point)
+ * @param len The number of elements to copy from the
+ * array to the I/O vector.
+ */
+ public ArraySpec(String [] arr, int offset, int len) {
+ vec = new Vector();
+
+ for(int i=offset; i< offset+len; i++)
+ vec.addElement(new String(arr[i]));
+ }
+
+ /**
+ * Create a new ArraySpec for a String (not array). Here the
+ * String is not an array, but we want to pull out the characters
+ * individually.
+ *
+ * @param str The string to be used in the I/O call
+ */
+ public ArraySpec(String str) {
+ char [] chars = str.toCharArray();
+ vec = new Vector();
+
+ for(int i = 0; i < chars.length; i++)
+ vec.addElement(new String(String.valueOf(chars[i])));
+ }
+
+ /**
+ * Gets the I/O vector for this ArraySpec.
+ *
+ * @return the Vector representation of the ArraySpec.
+ */
+ public Vector get_vec() {
+ return vec;
+ }
+}
diff --git a/util/org/netlib/util/CVS/Entries b/util/org/netlib/util/CVS/Entries
new file mode 100644
index 0000000..7e1515f
--- /dev/null
+++ b/util/org/netlib/util/CVS/Entries
@@ -0,0 +1,14 @@
+/Dummy.java/1.4/Thu Jan 25 21:31:37 2007//
+/Etime.java/1.4/Thu Jan 25 21:32:16 2007//
+/MatConv.java/1.4/Thu Jan 25 21:33:14 2007//
+/Second.java/1.4/Thu Jan 25 21:33:33 2007//
+/StrictUtil.java/1.3/Thu Jan 25 21:34:13 2007//
+/StringW.java/1.4/Thu Jan 25 21:34:35 2007//
+/booleanW.java/1.4/Thu Jan 25 21:35:36 2007//
+/doubleW.java/1.4/Thu Jan 25 21:36:23 2007//
+/floatW.java/1.4/Thu Jan 25 21:36:27 2007//
+/intW.java/1.4/Thu Jan 25 21:36:16 2007//
+/EasyIn.java/1.6/Tue May 1 18:48:08 2007//
+/Util.java/1.10/Thu Jul 19 18:37:36 2007//
+/ArraySpec.java/1.4/Fri Dec 14 20:49:10 2007//
+D
diff --git a/util/org/netlib/util/CVS/Repository b/util/org/netlib/util/CVS/Repository
new file mode 100644
index 0000000..f90ff45
--- /dev/null
+++ b/util/org/netlib/util/CVS/Repository
@@ -0,0 +1 @@
+f2j/util/org/netlib/util
diff --git a/util/org/netlib/util/CVS/Root b/util/org/netlib/util/CVS/Root
new file mode 100644
index 0000000..f54aada
--- /dev/null
+++ b/util/org/netlib/util/CVS/Root
@@ -0,0 +1 @@
+:ext:keithseymour at f2j.cvs.sourceforge.net:/cvsroot/f2j
diff --git a/util/org/netlib/util/Dummy.java b/util/org/netlib/util/Dummy.java
new file mode 100644
index 0000000..e8c1fb3
--- /dev/null
+++ b/util/org/netlib/util/Dummy.java
@@ -0,0 +1,46 @@
+package org.netlib.util;
+
+/**
+ * Placeholders for Fortran GOTO statements and labels.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class aids in the translation of goto statements.
+ * The code generator translates gotos and labels into calls
+ * to Dummy.go_to() or Dummy.label(). These calls act as
+ * 'placeholders' so that the gotos and labels can be found
+ * in the class file and converted to real branch
+ * instructions in the bytecode. Thus the resulting class
+ * file should contain no calls to Dummy.go_to() or Dummy.label().
+ * If so, the print statements should warn the user that the
+ * goto translation was not successful.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class Dummy {
+
+ /**
+ * Placeholder for a Fortran GOTO statement.
+ *
+ * @param clname name of the program unit where this GOTO exists
+ * @param lbl the label number (target) of the GOTO
+ */
+ public static void go_to(String clname, int lbl) {
+ System.err.println("Warning: Untransformed goto remaining in program! ("
+ +clname+", " + lbl + ")");
+ }
+
+ /**
+ * Placeholder for a Fortran label.
+ *
+ * @param clname name of the program unit where this label exists
+ * @param lbl the label number
+ */
+ public static void label(String clname, int lbl) {
+ System.err.println("Warning: Untransformed label remaining in program! ("
+ +clname+", " + lbl + ")");
+ }
+}
diff --git a/util/org/netlib/util/EasyIn.java b/util/org/netlib/util/EasyIn.java
new file mode 100644
index 0000000..52dd599
--- /dev/null
+++ b/util/org/netlib/util/EasyIn.java
@@ -0,0 +1,500 @@
+package org.netlib.util;
+
+import java.io.*;
+
+/**
+ * Simple input from the keyboard for all primitive types. ver 1.0
+ * <p>
+ * Copyright (c) Peter van der Linden, May 5 1997.
+ * corrected error message 11/21/97
+ * <p>
+ * The creator of this software hereby gives you permission to:
+ * <ol>
+ * <li> copy the work without changing it
+ * <li> modify the work providing you send me a copy which I can
+ * use in any way I want, including incorporating into this work.
+ * <li> distribute copies of the work to the public by sale, lease,
+ * rental, or lending
+ * <li> perform the work
+ * <li> display the work
+ * <li> fold the work into a funny hat and wear it on your head.
+ * </ol>
+ * <p>
+ * This is not thread safe, not high performance, and doesn't tell EOF.
+ * It's intended for low-volume easy keyboard input.
+ * An example of use is:
+ * <p>
+ * <code>
+ * EasyIn easy = new EasyIn(); <br>
+ * int i = easy.readInt(); // reads an int from System.in <br>
+ * float f = easy.readFloat(); // reads a float from System.in <br>
+ * </code>
+ * <p>
+ * 2/25/98 - modified by Keith Seymour to be useful with the f2j
+ * translator.
+ * <p>
+ * @author Peter van der Linden
+ */
+
+public class EasyIn {
+ static String line = null;
+ static int idx, len;
+ static String blank_string = " ";
+
+ /* not oringinally part of EasyIn.. I added this to make it possible
+ * to interleave calls to EasyIn with another input method, which
+ * didn't work with the previous static buffered reader.
+ */
+ public static String myCrappyReadLine() throws java.io.IOException
+ {
+ StringBuffer sb = new StringBuffer();
+ int c = 0;
+
+ while(c >= 0) {
+ c = System.in.read();
+
+ if(c < 0)
+ return null;
+
+ if((char)c == '\n')
+ break;
+
+ sb.append((char) c);
+ }
+
+ return sb.toString();
+ }
+
+ /**
+ * Reset the tokenizer.
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ private void initTokenizer() throws IOException {
+ do {
+ line = EasyIn.myCrappyReadLine();
+
+ if(line == null)
+ throw new IOException("EOF");
+
+ idx = 0;
+ len = line.length();
+ } while(!hasTokens(line));
+ }
+
+ /**
+ * Checks if the string contains any tokens.
+ *
+ * @param str string to check
+ *
+ * @return true if there are tokens, false otherwise.
+ */
+ private boolean hasTokens(String str)
+ {
+ int i, str_len;
+
+ str_len = str.length();
+
+ for(i=0;i < str_len;i++)
+ if(! isDelim(str.charAt(i)))
+ return true;
+
+ return false;
+ }
+
+ /**
+ * Checks if this character is a delimiter.
+ *
+ * @param c character to check
+ *
+ * @return true if this character is a delimiter, false otherwise.
+ */
+ private boolean isDelim(char c)
+ {
+ return ( (c == ' ') || (c == '\t') || (c == '\r') || (c == '\n'));
+ }
+
+ /**
+ * Checks if there are more tokens.
+ *
+ * @return true if there are more tokens, false otherwise.
+ */
+ private boolean moreTokens()
+ {
+ return ( idx < len );
+ }
+
+ /**
+ * Gets the next token.
+ *
+ * @throws IOException if an input or output exception occurred.
+ *
+ * @return the token
+ */
+ private String getToken() throws IOException {
+ int begin,end;
+
+ if( (line == null) || !moreTokens() )
+ initTokenizer();
+
+ while( (idx < len) && isDelim(line.charAt(idx)) )
+ idx++;
+
+ if(idx == len) {
+ initTokenizer();
+ while( (idx < len) && isDelim(line.charAt(idx)) )
+ idx++;
+ }
+
+ begin = idx;
+
+ while( (idx < len) && !isDelim(line.charAt(idx)) )
+ idx++;
+
+ end = idx;
+
+ return line.substring(begin,end);
+ }
+
+ /**
+ * Reads the specified number of characters and returns a new String
+ * containing them.
+ *
+ * @param num_chars the number of characters to read
+ *
+ * @throws IOException if an input or output exception occurred.
+ *
+ * @return the String containing the characters read.
+ */
+ public String readchars(int num_chars) throws IOException {
+ int cp_idx;
+
+ if( (line == null) || !moreTokens() )
+ initTokenizer();
+
+ cp_idx = idx;
+
+ if(cp_idx + num_chars < len)
+ {
+ idx += num_chars;
+ return( line.substring(cp_idx,cp_idx+num_chars) );
+ }
+ else
+ {
+ idx = len;
+ return(line.substring(cp_idx,len) + blank_string.substring(0,num_chars-(len-cp_idx)));
+ }
+ }
+
+ /**
+ * Reads the specified number of characters and returns a new String
+ * containing them. Unlike readchars(), does not throw IOException.
+ *
+ * @param num_chars the number of characters to read
+ *
+ * @return the String containing the characters read.
+ */
+ public String readChars(int num_chars) {
+ try{
+ return readchars(num_chars);
+ }catch (IOException e) {
+ System.err.println("IO Exception in EasyIn.readChars");
+ return null;
+ }
+ }
+
+ /**
+ * Skips any tokens remaining on this line.
+ */
+ public void skipRemaining() {
+ line = null; //may not be needed
+ idx = len;
+ }
+
+ /**
+ * Gets a boolean value from the next token.
+ *
+ * @return the boolean value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public boolean readboolean() throws IOException {
+ char ch = getToken().charAt(0);
+ if((ch == 't') || (ch == 'T'))
+ return true;
+ else
+ return false;
+ }
+
+ /**
+ * Gets a boolean value from the next token.
+ * Same as readboolean() except it does not throw IOException.
+ *
+ * @return the boolean value
+ */
+ public boolean readBoolean() {
+ try {
+ char ch = getToken().charAt(0);
+ if((ch == 't') || (ch == 'T'))
+ return true;
+ else
+ return false;
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readBoolean");
+ return false;
+ }
+ }
+
+ /**
+ * Gets a byte value from the next token.
+ *
+ * @return the byte value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public byte readbyte() throws IOException {
+ return Byte.parseByte(getToken());
+ }
+
+ /**
+ * Gets a byte value from the next token.
+ * Same as readbyte() except it does not throw IOException.
+ *
+ * @return the byte value
+ */
+ public byte readByte() {
+ try {
+ return Byte.parseByte(getToken());
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readByte");
+ return 0;
+ }
+ }
+
+ /**
+ * Gets a short value from the next token.
+ *
+ * @return the short value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public short readshort() throws IOException {
+ return Short.parseShort(getToken());
+ }
+
+ /**
+ * Gets a short value from the next token.
+ * Same as readshort() except it does not throw IOException.
+ *
+ * @return the short value
+ */
+ public short readShort() {
+ try {
+ return Short.parseShort(getToken());
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readShort");
+ return 0;
+ }
+ }
+
+ /**
+ * Gets an integer value from the next token.
+ *
+ * @return the integer value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public int readint() throws IOException {
+ return Integer.parseInt(getToken());
+ }
+
+ /**
+ * Gets an integer value from the next token.
+ * Same as readint() except it does not throw IOException.
+ *
+ * @return the integer value
+ */
+ public int readInt() {
+ try {
+ return Integer.parseInt(getToken());
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readInt");
+ return 0;
+ }
+ }
+
+ /**
+ * Gets a long integer value from the next token.
+ *
+ * @return the long integer value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public long readlong() throws IOException {
+ return Long.parseLong(getToken());
+ }
+
+ /**
+ * Gets a long integer value from the next token.
+ * Same as readlong() except it does not throw IOException.
+ *
+ * @return the long integer value
+ */
+ public long readLong() {
+ try {
+ return Long.parseLong(getToken());
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readLong");
+ return 0L;
+ }
+ }
+
+ /**
+ * Gets a float value from the next token.
+ *
+ * @return the float value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public float readfloat() throws IOException {
+ return new Float(getToken()).floatValue();
+ }
+
+ /**
+ * Gets a float value from the next token.
+ * Same as readfloat() except it does not throw IOException.
+ *
+ * @return the float value
+ */
+ public float readFloat() {
+ try {
+ return new Float(getToken()).floatValue();
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readFloat");
+ return 0.0F;
+ }
+ }
+
+ /**
+ * Gets a double value from the next token.
+ *
+ * @return the double value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public double readdouble() throws IOException {
+ String tok = getToken();
+
+ tok = tok.replace('D', 'E');
+ tok = tok.replace('d', 'e');
+
+ return new Double(tok).doubleValue();
+ }
+
+ /**
+ * Gets a double value from the next token.
+ * Same as readdouble() except it does not throw IOException.
+ *
+ * @return the double value
+ */
+ public double readDouble() {
+ try {
+ String tok = getToken();
+
+ tok = tok.replace('D', 'E');
+ tok = tok.replace('d', 'e');
+
+ return new Double(tok).doubleValue();
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readDouble");
+ return 0.0;
+ }
+ }
+
+ /**
+ * Gets a character value from the next token.
+ *
+ * @return the character value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public char readchar() throws IOException {
+ return getToken().charAt(0);
+ }
+
+ /**
+ * Gets a character value from the next token.
+ * Same as readchar() except it does not throw IOException.
+ *
+ * @return the character value
+ */
+ public char readChar() {
+ try {
+ return getToken().charAt(0);
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readChar");
+ return 0;
+ }
+ }
+
+ /**
+ * Gets a string value from the next token.
+ *
+ * @return the string value
+ *
+ * @throws IOException if an input or output exception occurred.
+ */
+ public String readstring() throws IOException {
+ return EasyIn.myCrappyReadLine();
+ }
+
+ /**
+ * Gets a string value from the next token.
+ * Same as readstring() except it does not throw IOException.
+ *
+ * @return the string value
+ */
+ public String readString() {
+ try {
+ return EasyIn.myCrappyReadLine();
+ } catch (IOException ioe) {
+ System.err.println("IO Exception in EasyIn.readString");
+ return "";
+ }
+ }
+
+ /**
+ * This method is just here to test the class
+ */
+
+ public static void main (String args[]){
+ EasyIn easy = new EasyIn();
+
+ System.out.print("enter char: "); System.out.flush();
+ System.out.println("You entered: " + easy.readChar() );
+
+ System.out.print("enter String: "); System.out.flush();
+ System.out.println("You entered: " + easy.readString() );
+
+ System.out.print("enter boolean: "); System.out.flush();
+ System.out.println("You entered: " + easy.readBoolean() );
+
+ System.out.print("enter byte: "); System.out.flush();
+ System.out.println("You entered: " + easy.readByte() );
+
+ System.out.print("enter short: "); System.out.flush();
+ System.out.println("You entered: " + easy.readShort() );
+
+ System.out.print("enter int: "); System.out.flush();
+ System.out.println("You entered: " + easy.readInt() );
+
+ System.out.print("enter long: "); System.out.flush();
+ System.out.println("You entered: " + easy.readLong() );
+
+ System.out.print("enter float: "); System.out.flush();
+ System.out.println("You entered: " + easy.readFloat() );
+
+ System.out.print("enter double: "); System.out.flush();
+ System.out.println("You entered: " + easy.readDouble() );
+ }
+}
diff --git a/util/org/netlib/util/Etime.java b/util/org/netlib/util/Etime.java
new file mode 100644
index 0000000..ad50de0
--- /dev/null
+++ b/util/org/netlib/util/Etime.java
@@ -0,0 +1,70 @@
+package org.netlib.util;
+
+/**
+ * Implementation of Fortran ETIME intrinsic.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class implements the Fortran 77 ETIME intrinsic.
+ * ETIME is supposed to provide the CPU time for the
+ * process since the start of execution. Currently,
+ * Java doesn't have a similar method, so we use this
+ * cheesy simulation: <br>
+ * <ul>
+ * <li> f2j inserts a call to Etime.etime() at the beginning
+ * of the program.
+ * <li> on the first call, record the current time
+ * <li> on subsequent calls, return the difference
+ * between the time of the current call and the starting
+ * time.
+ * </ul>
+ * Essentially, this version of etime returns the
+ * wall-clock time elapsed since the beginning of
+ * execution.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class Etime {
+ private static int call_num = 0;
+ private static long start_time = 0;
+
+ /**
+ * Initializes the timer.
+ */
+ public static void etime()
+ {
+ float [] dummy = new float[2];
+ etime(dummy,0);
+ }
+
+ /**
+ * Get the elapsed time. Sets the first element of the
+ * array 't' to the elapsed time. This is also the
+ * return value.
+ *
+ * @param t Two-element array of times. The first
+ * element should be user time. The second element
+ * should be system time. Currently these are set
+ * the same, though.
+ * @param t_offset Offset from t. Normally zero.
+ *
+ * @return first element of t.
+ */
+ public static float etime(float [] t, int t_offset)
+ {
+ if(call_num++ == 0)
+ {
+ start_time = System.currentTimeMillis();
+ t[0 + t_offset] = 0.0f;
+ t[1 + t_offset] = 0.0f;
+ return 0.0f;
+ }
+
+ t[0 + t_offset]=(float)(System.currentTimeMillis() - start_time) / 1000.0f;
+ t[1 + t_offset] = t[0 + t_offset];
+ return t[0 + t_offset];
+ }
+}
diff --git a/util/org/netlib/util/MatConv.java b/util/org/netlib/util/MatConv.java
new file mode 100644
index 0000000..ec50632
--- /dev/null
+++ b/util/org/netlib/util/MatConv.java
@@ -0,0 +1,216 @@
+package org.netlib.util;
+
+/**
+ * Conversions between one-dimensional linearized arrays and two-dimensional arays.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class contains methods for converting between the linearized
+ * arrays used by f2j-generated code and the more natural Java-style
+ * two-dimensional arrays.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class MatConv
+{
+
+ /**
+ * Convert a double precision two-dimensional array to
+ * a linearized one-dimensional array.
+ *
+ * @param m the matrix to be converted
+ *
+ * @return the linearized array
+ */
+ public static double[] doubleTwoDtoOneD (double[][]m)
+ {
+ /* We make the assumption here that the matrices are
+ * square (or rectangular), to get the value of
+ * the second index.
+ */
+
+ int ld = m.length;
+ double[] apimatrix = new double[ld * m[0].length];
+
+ for (int i = 0; i < ld; i++)
+ for (int j = 0; j < m[0].length; j++)
+ apimatrix[i + j * ld] = m[i][j];
+
+ return apimatrix;
+ }
+
+ /**
+ * Convert a double precision linearized one-dimensional array
+ * to a two-dimensional array.
+ *
+ * @param vec the linearized array to be converted
+ * @param ld leading dimension of the array
+ *
+ * @return the two-dimensional array
+ */
+ public static double[][] doubleOneDtoTwoD(double [] vec, int ld)
+ {
+ int i,j;
+ double [][] mat = new double [ld][vec.length / ld];
+
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+
+ return mat;
+ }
+
+ /**
+ * Convert a single precision two-dimensional array to
+ * a linearized one-dimensional array.
+ *
+ * @param m the matrix to be converted
+ *
+ * @return the linearized array
+ */
+ public static float[] floatTwoDtoOneD (float[][]m)
+ {
+ /* We make the assumption here that the matrices are
+ * square (or rectangular), to get the value of
+ * the second index.
+ */
+
+ int ld = m.length;
+ float[] apimatrix = new float[ld * m[0].length];
+
+ for (int i = 0; i < ld; i++)
+ for (int j = 0; j < m[0].length; j++)
+ apimatrix[i + j * ld] = m[i][j];
+
+ return apimatrix;
+ }
+
+ /**
+ * Convert a single precision linearized one-dimensional array
+ * to a two-dimensional array.
+ *
+ * @param vec the linearized array to be converted
+ * @param ld leading dimension of the array
+ *
+ * @return the two-dimensional array
+ */
+ public static float[][] floatOneDtoTwoD(float [] vec, int ld)
+ {
+ int i,j;
+ float [][] mat = new float [ld][vec.length / ld];
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+
+ return mat;
+ }
+
+ /**
+ * Convert an integer two-dimensional array to
+ * a linearized one-dimensional array.
+ *
+ * @param m the matrix to be converted
+ *
+ * @return the linearized array
+ */
+ public static int[] intTwoDtoOneD (int[][]m)
+ {
+ /* We make the assumption here that the matrices are
+ * square (or rectangular), to get the value of
+ * the second index.
+ */
+
+ int ld = m.length;
+ int[] apimatrix = new int[ld * m[0].length];
+
+ for (int i = 0; i < ld; i++)
+ for (int j = 0; j < m[0].length; j++)
+ apimatrix[i + j * ld] = m[i][j];
+
+ return apimatrix;
+ }
+
+ /**
+ * Convert an integer linearized one-dimensional array
+ * to a two-dimensional array.
+ *
+ * @param vec the linearized array to be converted
+ * @param ld leading dimension of the array
+ *
+ * @return the two-dimensional array
+ */
+ public static int[][] intOneDtoTwoD(int [] vec, int ld)
+ {
+ int i,j;
+ int [][] mat = new int [ld][vec.length / ld];
+
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+
+ return mat;
+ }
+
+ /**
+ * Copies a linearized array into an already allocated two-dimensional
+ * matrix. This is typically called from the simplified wrappers
+ * after the raw routine has been called and the results need to be
+ * copied back into the Java-style two-dimensional matrix.
+ *
+ * @param mat destination matrix
+ * @param vec source array
+ */
+ public static void copyOneDintoTwoD(double [][]mat, double[]vec)
+ {
+ int i,j;
+ int ld = mat.length;
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+ }
+
+ /**
+ * Copies a linearized array into an already allocated two-dimensional
+ * matrix. This is typically called from the simplified wrappers
+ * after the raw routine has been called and the results need to be
+ * copied back into the Java-style two-dimensional matrix.
+ *
+ * @param mat destination matrix
+ * @param vec source array
+ */
+ public static void copyOneDintoTwoD(float [][]mat, float[]vec)
+ {
+ int i,j;
+ int ld = mat.length;
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+ }
+
+ /**
+ * Copies a linearized array into an already allocated two-dimensional
+ * matrix. This is typically called from the simplified wrappers
+ * after the raw routine has been called and the results need to be
+ * copied back into the Java-style two-dimensional matrix.
+ *
+ * @param mat destination matrix
+ * @param vec source array
+ */
+ public static void copyOneDintoTwoD(int [][]mat, int[]vec)
+ {
+ int i,j;
+ int ld = mat.length;
+
+ for (i = 0; i < ld; i++)
+ for (j = 0; j < mat[0].length; j++)
+ mat[i][j] = vec[i + j * ld];
+ }
+}
diff --git a/util/org/netlib/util/Second.java b/util/org/netlib/util/Second.java
new file mode 100644
index 0000000..1112c51
--- /dev/null
+++ b/util/org/netlib/util/Second.java
@@ -0,0 +1,47 @@
+package org.netlib.util;
+
+/**
+ * Implementation of Fortran SECOND intrinsic function.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class implements the Fortran 77 SECOND intrinsic.
+ * SECOND is supposed to provide the CPU time for the
+ * process since the start of execution. Currently,
+ * Java doesn't have a similar method, so we use this
+ * cheesy simulation: <br>
+ * <ul>
+ * <li> f2j inserts a call at the beginning of the program
+ * to record the start time.
+ * <li> on the first call, record the current time.
+ * <li> on subsequent calls, return the difference
+ * between the current call time and the starting
+ * time.
+ * </ul>
+ * Essentially, this version of etime returns the
+ * wall-clock time elapsed since the beginning of
+ * execution.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class Second {
+
+ /**
+ * Supposed to return the elapsed CPU time since the beginning of
+ * program execution. Currently implemented as wall clock time.
+ *
+ * @return the elapsed time.
+ */
+ public static float second()
+ {
+ float [] tarray= new float[2];
+
+ Etime.etime();
+ Etime.etime(tarray,0);
+
+ return tarray[0];
+ }
+}
diff --git a/util/org/netlib/util/StrictUtil.java b/util/org/netlib/util/StrictUtil.java
new file mode 100644
index 0000000..b6a2397
--- /dev/null
+++ b/util/org/netlib/util/StrictUtil.java
@@ -0,0 +1,332 @@
+package org.netlib.util;
+
+import java.io.*;
+
+/**
+ * StrictMath versions of various math related Fortran intrinsic functions.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class contains Strict versions of the math related utilities
+ * in {@link Util}.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public strictfp class StrictUtil extends Util {
+
+ /**
+ * Three argument integer max function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static int max(int x, int y, int z) {
+ return StrictMath.max( x > y ? x : y, StrictMath.max(y,z));
+ }
+
+ /**
+ * Three argument single precision max function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static float max(float x, float y, float z) {
+ return StrictMath.max( x > y ? x : y, StrictMath.max(y,z));
+ }
+
+ /**
+ * Three argument double precision max function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static double max(double x, double y, double z) {
+ return StrictMath.max( x > y ? x : y, StrictMath.max(y,z));
+ }
+
+ /**
+ * Three argument integer min function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static int min(int x, int y, int z) {
+ return StrictMath.min( x < y ? x : y, StrictMath.min(y,z));
+ }
+
+ /**
+ * Three argument single precision min function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static float min(float x, float y, float z) {
+ return StrictMath.min( x < y ? x : y, StrictMath.min(y,z));
+ }
+
+ /**
+ * Three argument double precision min function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static double min(double x, double y, double z) {
+ return StrictMath.min( x < y ? x : y, StrictMath.min(y,z));
+ }
+
+ /**
+ * Base-10 logarithm function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static double log10(double x) {
+ return StrictMath.log(x) / 2.30258509;
+ }
+
+ /**
+ * Base-10 logarithm function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static float log10(float x) {
+ return (float) (StrictMath.log(x) / 2.30258509);
+ }
+
+ /**
+ * Fortran nearest integer (NINT) intrinsic function.
+ * <p>
+ * Returns:
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x the floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int nint(float x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran nearest integer (IDNINT) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param x the double precision floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int idnint(double x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran floating point transfer of sign (SIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran SIGN(a1,a2) as described above.
+ */
+ public static float sign(float a1, float a2) {
+ return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1);
+ }
+
+ /**
+ * Fortran integer transfer of sign (ISIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 integer value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran ISIGN(a1,a2) as described above.
+ */
+ public static int isign(int a1, int a2) {
+ return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1);
+ }
+
+ /**
+ * Fortran double precision transfer of sign (DSIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 double precision floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran DSIGN(a1,a2) as described above.
+ */
+ public static double dsign(double a1, double a2) {
+ return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1);
+ }
+
+ /**
+ * Fortran floating point positive difference (DIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 floating point value
+ * @param a2 floating point value
+ *
+ * @return equivalent of Fortran DIM(a1,a2) as described above.
+ */
+ public static float dim(float a1, float a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran integer positive difference (IDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 integer value
+ * @param a2 integer value
+ *
+ * @return equivalent of Fortran IDIM(a1,a2) as described above.
+ */
+ public static int idim(int a1, int a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran double precision positive difference (DDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a1 double precision floating point value
+ * @param a2 double precision floating point value
+ *
+ * @return equivalent of Fortran DDIM(a1,a2) as described above.
+ */
+ public static double ddim(double a1, double a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran hyperbolic sine (SINH) intrinsic function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a the value to get the sine of
+ *
+ * @return the hyperbolic sine of a
+ */
+ public static double sinh(double a) {
+ return ( StrictMath.exp(a) - StrictMath.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic cosine (COSH) intrinsic function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a the value to get the cosine of
+ *
+ * @return the hyperbolic cosine of a
+ */
+ public static double cosh(double a) {
+ return ( StrictMath.exp(a) + StrictMath.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic tangent (TANH) intrinsic function.
+ * <p>
+ * This function uses Java's StrictMath package.
+ *
+ * @param a the value to get the tangent of
+ *
+ * @return the hyperbolic tangent of a
+ */
+ public static double tanh(double a) {
+ return sinh(a) / cosh(a);
+ }
+}
diff --git a/util/org/netlib/util/StringW.java b/util/org/netlib/util/StringW.java
new file mode 100644
index 0000000..fb03d88
--- /dev/null
+++ b/util/org/netlib/util/StringW.java
@@ -0,0 +1,27 @@
+package org.netlib.util;
+
+/**
+ * f2j object wrapper for strings.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class acts as an object wrapper for passing string
+ * values by reference in f2j translated files.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class StringW {
+ public String val;
+
+ /**
+ * Create a new string wrapper.
+ *
+ * @param x the initial value
+ */
+ public StringW(String x) {
+ val = x;
+ }
+}
diff --git a/util/org/netlib/util/Util.buffered b/util/org/netlib/util/Util.buffered
new file mode 100644
index 0000000..c1b426d
--- /dev/null
+++ b/util/org/netlib/util/Util.buffered
@@ -0,0 +1,551 @@
+package org.netlib.util;
+
+import java.io.*;
+import java.util.Vector;
+import org.j_paine.formatter.*;
+
+/**
+ * Implementations of various Fortran intrinsic functions.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class contains various helper routines for f2j-generated code.
+ * These routines are primarily implemented for handling Fortran intrinsic
+ * functions.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class Util {
+
+ /**
+ * Inserts a string into a substring of another string.
+ * <p>
+ * This method handles situations in which the lhs of an
+ * assignment statement is a substring operation. For example:
+ * <p>
+ * <code>
+ * a(3:4) = 'hi'
+ * </code>
+ * <p>
+ * We haven't figured out an elegant way to do this with Java Strings,
+ * but we do handle it, as follows:
+ * <p>
+ * <p>
+ * <code>
+ * a = new StringW(
+ * a.val.substring(0,E1-1) +
+ * "hi".substring(0,E2-E1+1) +
+ * a.val.substring(E2,a.val.length())
+ * );
+ * <code>
+ * <p>
+ * Where E1 is the expression representing the starting index of the substring
+ * and E2 is the expression representing the ending index of the substring
+ * <p>
+ * The resulting code looks pretty bad because we have to be
+ * prepared to handle rhs strings that are too big to fit in
+ * the lhs substring.
+ * <p>
+ * @param x dest (string to be inserted into)
+ * @param y source (substring to insert into 'x')
+ * @param E1 expression representing the start of the substring
+ * @param E2 expression representing the end of the substring
+ *
+ * @return the string containing the complete string after inserting the
+ * substring
+ */
+ public static String stringInsert(String x, String y, int E1, int E2) {
+ String tmp;
+
+ tmp = new String(
+ x.substring(0,E1-1) +
+ y.substring(0,E2-E1+1) +
+ x.substring(E2,x.length()));
+ return tmp;
+ }
+
+ /**
+ * Inserts a string into a single character substring of another string.
+ *
+ * @param x dest (string to be inserted into)
+ * @param y source (substring to insert into 'x')
+ * @param E1 expression representing the index of the character
+ *
+ * @return the string containing the complete string after inserting the
+ * substring
+ */
+ public static String stringInsert(String x, String y, int E1) {
+ return stringInsert(x, y, E1, E1);
+ }
+
+ /**
+ * Returns a string representation of the character at the given index.
+ * Note: this is based on the Fortran index (1..N).
+ *
+ * @param s the string
+ * @param idx the index
+ *
+ * @return new string containing a single character (from s[idx])
+ */
+ public static String strCharAt(String s, int idx) {
+ return String.valueOf(s.charAt(idx-1));
+ }
+
+ /**
+ * Three argument integer max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static int max(int x, int y, int z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument single precision max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static float max(float x, float y, float z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument double precision max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static double max(double x, double y, double z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument integer min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static int min(int x, int y, int z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Three argument single precision min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static float min(float x, float y, float z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Three argument double precision min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static double min(double x, double y, double z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Base-10 logarithm function.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static double log10(double x) {
+ return Math.log(x) / 2.30258509;
+ }
+
+ /**
+ * Base-10 logarithm function.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static float log10(float x) {
+ return (float) (Math.log(x) / 2.30258509);
+ }
+
+ /**
+ * Fortran nearest integer (NINT) intrinsic function.
+ * <p>
+ * Returns:
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ *
+ * @param x the floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int nint(float x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran nearest integer (IDNINT) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ *
+ * @param x the double precision floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int idnint(double x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran floating point transfer of sign (SIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran SIGN(a1,a2) as described above.
+ */
+ public static float sign(float a1, float a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran integer transfer of sign (ISIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 integer value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran ISIGN(a1,a2) as described above.
+ */
+ public static int isign(int a1, int a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran double precision transfer of sign (DSIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 double precision floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran DSIGN(a1,a2) as described above.
+ */
+ public static double dsign(double a1, double a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran floating point positive difference (DIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 floating point value
+ * @param a2 floating point value
+ *
+ * @return equivalent of Fortran DIM(a1,a2) as described above.
+ */
+ public static float dim(float a1, float a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran integer positive difference (IDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 integer value
+ * @param a2 integer value
+ *
+ * @return equivalent of Fortran IDIM(a1,a2) as described above.
+ */
+ public static int idim(int a1, int a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran double precision positive difference (DDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 double precision floating point value
+ * @param a2 double precision floating point value
+ *
+ * @return equivalent of Fortran DDIM(a1,a2) as described above.
+ */
+ public static double ddim(double a1, double a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran hyperbolic sine (SINH) intrinsic function.
+ *
+ * @param a the value to get the sine of
+ *
+ * @return the hyperbolic sine of a
+ */
+ public static double sinh(double a) {
+ return ( Math.exp(a) - Math.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic cosine (COSH) intrinsic function.
+ *
+ * @param a the value to get the cosine of
+ *
+ * @return the hyperbolic cosine of a
+ */
+ public static double cosh(double a) {
+ return ( Math.exp(a) + Math.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic tangent (TANH) intrinsic function.
+ *
+ * @param a the value to get the tangent of
+ *
+ * @return the hyperbolic tangent of a
+ */
+ public static double tanh(double a) {
+ return sinh(a) / cosh(a);
+ }
+
+ /**
+ * Pauses execution temporarily.
+ * <p>
+ * I think this was an implementation dependent feature of Fortran 77.
+ */
+ public static void pause() {
+ pause(null);
+ }
+
+ /**
+ * Pauses execution temporarily.
+ * <p>
+ * I think this was an implementation dependent feature of Fortran 77.
+ *
+ * @param msg the message to be printed before pausing. if null, no
+ * message will be printed.
+ */
+ public static void pause(String msg) {
+ if(msg != null)
+ System.err.println("PAUSE: " + msg);
+ else
+ System.err.print("PAUSE: ");
+
+ System.err.println("To resume execution, type: go");
+ System.err.println("Any other input will terminate the program.");
+
+ BufferedReader in = new BufferedReader(new InputStreamReader(System.in));
+
+ String response = null;
+
+ try {
+ response = in.readLine();
+ } catch (IOException e) {
+ response = null;
+ }
+
+ if( (response == null) || !response.equals("go")) {
+ System.err.println("STOP");
+ System.exit(0);
+ }
+ }
+
+ /**
+ * Formatted write.
+ *
+ * @param fmt String containing the Fortran format specification.
+ * @param v Vector containing the arguments to the WRITE() call.
+ *
+ */
+ public static void f77write(String fmt, Vector v)
+ {
+ if(fmt == null) {
+ f77write(v);
+ return;
+ }
+
+ try {
+ Formatter f = new Formatter(fmt);
+ Vector newvec = processVector(v);
+ f.write( newvec, System.out );
+ System.out.println();
+ }
+ catch ( Exception e ) {
+ String m = e.getMessage();
+
+ if(m != null)
+ System.out.println(m);
+ else
+ System.out.println();
+ }
+ }
+
+ /**
+ * Unformatted write.
+ *
+ * @param v Vector containing the arguments to the WRITE() call.
+ *
+ */
+ public static void f77write(Vector v)
+ {
+ java.util.Enumeration e;
+ Object o;
+
+ Vector newvec = processVector(v);
+
+ e = newvec.elements();
+
+ /* fortran seems to prepend a space before the first
+ * unformatted element. since non-string types get
+ * a string prepended in the loop below, we only
+ * do it for strings here.
+ */
+
+ if(e.hasMoreElements()) {
+ o = e.nextElement();
+ if(o instanceof String)
+ System.out.print(" ");
+ output_unformatted_element(o);
+ }
+
+ while(e.hasMoreElements())
+ output_unformatted_element(e.nextElement());
+
+ System.out.println();
+ }
+
+ private static void output_unformatted_element(Object o) {
+ if(o instanceof Boolean) {
+ /* print true/false as T/F like fortran does */
+ if(((Boolean) o).booleanValue())
+ System.out.print(" T");
+ else
+ System.out.print(" F");
+ }
+ else if((o instanceof Float) || (o instanceof Double))
+ System.out.print(" " + o); // two spaces
+ else if(o instanceof String)
+ System.out.print(o);
+ else
+ System.out.print(" " + o); // one space
+ }
+
+ private static BufferedReader in_reader = null;
+
+ /**
+ * Formatted read.
+ *
+ * @param fmt String containing the Fortran format specification.
+ * @param v Vector containing the arguments to the READ() call.
+ *
+ */
+ public static int f77read(String fmt, Vector v)
+ {
+ try {
+ Formatter f = new Formatter(fmt);
+
+ if(in_reader == null)
+ in_reader = new BufferedReader(new InputStreamReader(System.in));
+
+ f.read(v, in_reader);
+ }
+ catch ( EndOfFileWhenStartingReadException eof_exc) {
+ return 0;
+ }
+ catch ( Exception e ) {
+ String m = e.getMessage();
+
+ if(m != null)
+ System.out.println(m);
+ else
+ System.out.println("Warning: READ exception.");
+
+ return -1;
+ }
+
+ return v.size();
+ }
+
+ /**
+ * Expands array elements into separate entries in the Vector.
+ *
+ */
+
+ static Vector processVector(Vector v)
+ {
+ java.util.Enumeration e;
+ Vector newvec = new Vector();
+
+ for(e = v.elements(); e.hasMoreElements() ;) {
+ Object el = e.nextElement();
+
+ if(el instanceof ArraySpec)
+ newvec.addAll(((ArraySpec)el).get_vec());
+ else
+ newvec.addElement(el);
+ }
+
+ return newvec;
+ }
+}
diff --git a/util/org/netlib/util/Util.java b/util/org/netlib/util/Util.java
new file mode 100644
index 0000000..8409cd4
--- /dev/null
+++ b/util/org/netlib/util/Util.java
@@ -0,0 +1,543 @@
+package org.netlib.util;
+
+import java.io.*;
+import java.util.Vector;
+import org.j_paine.formatter.*;
+
+/**
+ * Implementations of various Fortran intrinsic functions.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class contains various helper routines for f2j-generated code.
+ * These routines are primarily implemented for handling Fortran intrinsic
+ * functions.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class Util {
+
+ /**
+ * Inserts a string into a substring of another string.
+ * <p>
+ * This method handles situations in which the lhs of an
+ * assignment statement is a substring operation. For example:
+ * <p>
+ * <code>
+ * a(3:4) = 'hi'
+ * </code>
+ * <p>
+ * We haven't figured out an elegant way to do this with Java Strings,
+ * but we do handle it, as follows:
+ * <p>
+ * <p>
+ * <code>
+ * a = new StringW(
+ * a.val.substring(0,E1-1) +
+ * "hi".substring(0,E2-E1+1) +
+ * a.val.substring(E2,a.val.length())
+ * );
+ * <code>
+ * <p>
+ * Where E1 is the expression representing the starting index of the substring
+ * and E2 is the expression representing the ending index of the substring
+ * <p>
+ * The resulting code looks pretty bad because we have to be
+ * prepared to handle rhs strings that are too big to fit in
+ * the lhs substring.
+ * <p>
+ * @param x dest (string to be inserted into)
+ * @param y source (substring to insert into 'x')
+ * @param E1 expression representing the start of the substring
+ * @param E2 expression representing the end of the substring
+ *
+ * @return the string containing the complete string after inserting the
+ * substring
+ */
+ public static String stringInsert(String x, String y, int E1, int E2) {
+ String tmp;
+
+ tmp = new String(
+ x.substring(0,E1-1) +
+ y.substring(0,E2-E1+1) +
+ x.substring(E2,x.length()));
+ return tmp;
+ }
+
+ /**
+ * Inserts a string into a single character substring of another string.
+ *
+ * @param x dest (string to be inserted into)
+ * @param y source (substring to insert into 'x')
+ * @param E1 expression representing the index of the character
+ *
+ * @return the string containing the complete string after inserting the
+ * substring
+ */
+ public static String stringInsert(String x, String y, int E1) {
+ return stringInsert(x, y, E1, E1);
+ }
+
+ /**
+ * Returns a string representation of the character at the given index.
+ * Note: this is based on the Fortran index (1..N).
+ *
+ * @param s the string
+ * @param idx the index
+ *
+ * @return new string containing a single character (from s[idx])
+ */
+ public static String strCharAt(String s, int idx) {
+ return String.valueOf(s.charAt(idx-1));
+ }
+
+ /**
+ * Three argument integer max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static int max(int x, int y, int z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument single precision max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static float max(float x, float y, float z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument double precision max function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the largest of x, y, or z
+ */
+ public static double max(double x, double y, double z) {
+ return Math.max( x > y ? x : y, Math.max(y,z));
+ }
+
+ /**
+ * Three argument integer min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static int min(int x, int y, int z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Three argument single precision min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static float min(float x, float y, float z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Three argument double precision min function.
+ *
+ * @param x value 1
+ * @param y value 2
+ * @param z value 3
+ *
+ * @return the smallest of x, y, or z
+ */
+ public static double min(double x, double y, double z) {
+ return Math.min( x < y ? x : y, Math.min(y,z));
+ }
+
+ /**
+ * Base-10 logarithm function.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static double log10(double x) {
+ return Math.log(x) / 2.30258509;
+ }
+
+ /**
+ * Base-10 logarithm function.
+ *
+ * @param x the value
+ *
+ * @return base-10 log of x
+ */
+ public static float log10(float x) {
+ return (float) (Math.log(x) / 2.30258509);
+ }
+
+ /**
+ * Fortran nearest integer (NINT) intrinsic function.
+ * <p>
+ * Returns:
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ *
+ * @param x the floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int nint(float x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran nearest integer (IDNINT) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> (int)(x+0.5), if x >= 0
+ * <li> (int)(x-0.5), if x < 0
+ * </ul>
+ *
+ * @param x the double precision floating point value
+ *
+ * @return the nearest integer to x
+ */
+ public static int idnint(double x) {
+ return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5));
+ }
+
+ /**
+ * Fortran floating point transfer of sign (SIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran SIGN(a1,a2) as described above.
+ */
+ public static float sign(float a1, float a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran integer transfer of sign (ISIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 integer value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran ISIGN(a1,a2) as described above.
+ */
+ public static int isign(int a1, int a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran double precision transfer of sign (DSIGN) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> abs(a1), if a2 >= 0
+ * <li>-abs(a1), if a2 < 0
+ * </ul>
+ *
+ * @param a1 double precision floating point value
+ * @param a2 sign transfer indicator
+ *
+ * @return equivalent of Fortran DSIGN(a1,a2) as described above.
+ */
+ public static double dsign(double a1, double a2) {
+ return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1);
+ }
+
+ /**
+ * Fortran floating point positive difference (DIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 floating point value
+ * @param a2 floating point value
+ *
+ * @return equivalent of Fortran DIM(a1,a2) as described above.
+ */
+ public static float dim(float a1, float a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran integer positive difference (IDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 integer value
+ * @param a2 integer value
+ *
+ * @return equivalent of Fortran IDIM(a1,a2) as described above.
+ */
+ public static int idim(int a1, int a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran double precision positive difference (DDIM) intrinsic function.
+ * <p>
+ * Returns:<br>
+ * <ul>
+ * <li> a1 - a2, if a1 > a2
+ * <li> 0, if a1 <= a2
+ * </ul>
+ *
+ * @param a1 double precision floating point value
+ * @param a2 double precision floating point value
+ *
+ * @return equivalent of Fortran DDIM(a1,a2) as described above.
+ */
+ public static double ddim(double a1, double a2) {
+ return (a1 > a2) ? (a1 - a2) : 0;
+ }
+
+ /**
+ * Fortran hyperbolic sine (SINH) intrinsic function.
+ *
+ * @param a the value to get the sine of
+ *
+ * @return the hyperbolic sine of a
+ */
+ public static double sinh(double a) {
+ return ( Math.exp(a) - Math.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic cosine (COSH) intrinsic function.
+ *
+ * @param a the value to get the cosine of
+ *
+ * @return the hyperbolic cosine of a
+ */
+ public static double cosh(double a) {
+ return ( Math.exp(a) + Math.exp(-a) ) * 0.5;
+ }
+
+ /**
+ * Fortran hyperbolic tangent (TANH) intrinsic function.
+ *
+ * @param a the value to get the tangent of
+ *
+ * @return the hyperbolic tangent of a
+ */
+ public static double tanh(double a) {
+ return sinh(a) / cosh(a);
+ }
+
+ /**
+ * Pauses execution temporarily.
+ * <p>
+ * I think this was an implementation dependent feature of Fortran 77.
+ */
+ public static void pause() {
+ pause(null);
+ }
+
+ /**
+ * Pauses execution temporarily.
+ * <p>
+ * I think this was an implementation dependent feature of Fortran 77.
+ *
+ * @param msg the message to be printed before pausing. if null, no
+ * message will be printed.
+ */
+ public static void pause(String msg) {
+ if(msg != null)
+ System.err.println("PAUSE: " + msg);
+ else
+ System.err.print("PAUSE: ");
+
+ System.err.println("To resume execution, type: go");
+ System.err.println("Any other input will terminate the program.");
+
+ String response = null;
+
+ try {
+ response = EasyIn.myCrappyReadLine();
+ } catch (IOException e) {
+ response = null;
+ }
+
+ if( (response == null) || !response.equals("go")) {
+ System.err.println("STOP");
+ System.exit(0);
+ }
+ }
+
+ /**
+ * Formatted write.
+ *
+ * @param fmt String containing the Fortran format specification.
+ * @param v Vector containing the arguments to the WRITE() call.
+ *
+ */
+ public static void f77write(String fmt, Vector v)
+ {
+ if(fmt == null) {
+ f77write(v);
+ return;
+ }
+
+ try {
+ Formatter f = new Formatter(fmt);
+ Vector newvec = processVector(v);
+ f.write( newvec, System.out );
+ System.out.println();
+ }
+ catch ( Exception e ) {
+ String m = e.getMessage();
+
+ if(m != null)
+ System.out.println(m);
+ else
+ System.out.println();
+ }
+ }
+
+ /**
+ * Unformatted write.
+ *
+ * @param v Vector containing the arguments to the WRITE() call.
+ *
+ */
+ public static void f77write(Vector v)
+ {
+ java.util.Enumeration e;
+ Object o;
+
+ Vector newvec = processVector(v);
+
+ e = newvec.elements();
+
+ /* fortran seems to prepend a space before the first
+ * unformatted element. since non-string types get
+ * a string prepended in the loop below, we only
+ * do it for strings here.
+ */
+
+ if(e.hasMoreElements()) {
+ o = e.nextElement();
+ if(o instanceof String)
+ System.out.print(" ");
+ output_unformatted_element(o);
+ }
+
+ while(e.hasMoreElements())
+ output_unformatted_element(e.nextElement());
+
+ System.out.println();
+ }
+
+ private static void output_unformatted_element(Object o) {
+ if(o instanceof Boolean) {
+ /* print true/false as T/F like fortran does */
+ if(((Boolean) o).booleanValue())
+ System.out.print(" T");
+ else
+ System.out.print(" F");
+ }
+ else if((o instanceof Float) || (o instanceof Double))
+ System.out.print(" " + o); // two spaces
+ else if(o instanceof String)
+ System.out.print(o);
+ else
+ System.out.print(" " + o); // one space
+ }
+
+ /**
+ * Formatted read.
+ *
+ * @param fmt String containing the Fortran format specification.
+ * @param v Vector containing the arguments to the READ() call.
+ *
+ */
+ public static int f77read(String fmt, Vector v)
+ {
+ try {
+ Formatter f = new Formatter(fmt);
+ f.read( v, new DataInputStream(System.in) );
+ }
+ catch ( EndOfFileWhenStartingReadException eof_exc) {
+ return 0;
+ }
+ catch ( Exception e ) {
+ String m = e.getMessage();
+
+ if(m != null)
+ System.out.println(m);
+ else
+ System.out.println("Warning: READ exception.");
+
+ return -1;
+ }
+
+ return v.size();
+ }
+
+ /**
+ * Expands array elements into separate entries in the Vector.
+ *
+ */
+
+ static Vector processVector(Vector v)
+ {
+ java.util.Enumeration e;
+ Vector newvec = new Vector();
+
+ for(e = v.elements(); e.hasMoreElements() ;) {
+ Object el = e.nextElement();
+
+ if(el instanceof ArraySpec)
+ newvec.addAll(((ArraySpec)el).get_vec());
+ else
+ newvec.addElement(el);
+ }
+
+ return newvec;
+ }
+}
diff --git a/util/org/netlib/util/booleanW.java b/util/org/netlib/util/booleanW.java
new file mode 100644
index 0000000..85c4d85
--- /dev/null
+++ b/util/org/netlib/util/booleanW.java
@@ -0,0 +1,27 @@
+package org.netlib.util;
+
+/**
+ * f2j object wrapper for booleans.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class acts as an object wrapper for passing boolean
+ * values by reference in f2j translated files.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class booleanW {
+ public boolean val;
+
+ /**
+ * Create a new boolean wrapper.
+ *
+ * @param x the initial value
+ */
+ public booleanW(boolean x) {
+ val = x;
+ }
+}
diff --git a/util/org/netlib/util/doubleW.java b/util/org/netlib/util/doubleW.java
new file mode 100644
index 0000000..58b029c
--- /dev/null
+++ b/util/org/netlib/util/doubleW.java
@@ -0,0 +1,28 @@
+package org.netlib.util;
+
+/**
+ * f2j object wrapper for doubles.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class acts as an object wrapper for passing double
+ * precision floating point values by reference in f2j
+ * translated files.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class doubleW {
+ public double val;
+
+ /**
+ * Create a new double wrapper.
+ *
+ * @param x the initial value
+ */
+ public doubleW(double x) {
+ val = x;
+ }
+}
diff --git a/util/org/netlib/util/floatW.java b/util/org/netlib/util/floatW.java
new file mode 100644
index 0000000..7b4386c
--- /dev/null
+++ b/util/org/netlib/util/floatW.java
@@ -0,0 +1,28 @@
+package org.netlib.util;
+
+/**
+ * f2j object wrapper for floats.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class acts as an object wrapper for passing single
+ * precision floating point values by reference in f2j
+ * translated files.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class floatW {
+ public float val;
+
+ /**
+ * Create a new float wrapper.
+ *
+ * @param x the initial value
+ */
+ public floatW(float x) {
+ val = x;
+ }
+}
diff --git a/util/org/netlib/util/intW.java b/util/org/netlib/util/intW.java
new file mode 100644
index 0000000..dec0e48
--- /dev/null
+++ b/util/org/netlib/util/intW.java
@@ -0,0 +1,27 @@
+package org.netlib.util;
+
+/**
+ * f2j object wrapper for integers.
+ * <p>
+ * This file is part of the Fortran-to-Java (f2j) system,
+ * developed at the University of Tennessee.
+ * <p>
+ * This class acts as an object wrapper for passing integer
+ * values by reference in f2j translated files.
+ * <p>
+ * @author Keith Seymour (seymour at cs.utk.edu)
+ *
+ */
+
+public class intW {
+ public int val;
+
+ /**
+ * Create a new int wrapper.
+ *
+ * @param x the initial value
+ */
+ public intW(int x) {
+ val = x;
+ }
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-java/f2j.git
More information about the pkg-java-commits
mailing list