--- /dev/null
+/mobile/*~
+/mobile/*.o
+/mobile/*.lo
+/mobile/*.lo
+/mobile/*.la
+/mobile/.deps
+/mobile/.libs
+/mobile/Makefile
+/mobile/Makefile.in
+/mobile/autom4te.cache/
+/mobile/m4/libtool.m4
+/mobile/m4/ltoptions.m4
+/mobile/m4/ltsugar.m4
+/mobile/m4/ltversion.m4
+/mobile/m4/lt~obsolete.m4
+/mobile/doc/embryo.dox
+/mobile/README
+/mobile/ABOUT-NLS
+/mobile/aclocal.m4
+/mobile/compile
+/mobile/config.cache
+/mobile/config.cache-env
+/mobile/config.guess
+/mobile/config.h
+/mobile/config.h.in
+/mobile/config.log
+/mobile/config.status
+/mobile/config.sub
+/mobile/configure
+/mobile/depcomp
+/mobile/embryo.pc
+/mobile/embryo.spec
+/mobile/install-sh
+/mobile/libtool
+/mobile/ltmain.sh
+/mobile/missing
+/mobile/src/bin/embryo_cc
+/mobile/stamp-h1
+/mobile/doc/Doxyfile
+/mobile/config.guess.cdbs-orig
+/mobile/config.sub.cdbs-orig
+/mobile/debian/files
+/mobile/debian/*.debhelper.log
+/mobile/debian/*.substvars
+/mobile/debian/*.debhelper
+/mobile/debian/stamp-*
+/mobile/debian/tmp/
+/mobile/debian/libembryo-bin/
+/mobile/debian/libembryo-dbg/
+/mobile/debian/libembryo-dev/
+/mobile/debian/libembryo-doc/
+/mobile/debian/libembryo0/
+/mobile/doc/html/
+/mobile/doc/latex/
+/mobile/doc/man/
+
+
+
+
+/wearable/*~
+/wearable/*.o
+/wearable/*.lo
+/wearable/*.lo
+/wearable/*.la
+/wearable/.deps
+/wearable/.libs
+/wearable/Makefile
+/wearable/Makefile.in
+/wearable/autom4te.cache/
+/wearable/m4/libtool.m4
+/wearable/m4/ltoptions.m4
+/wearable/m4/ltsugar.m4
+/wearable/m4/ltversion.m4
+/wearable/m4/lt~obsolete.m4
+/wearable/doc/embryo.dox
+/wearable/README
+/wearable/ABOUT-NLS
+/wearable/aclocal.m4
+/wearable/compile
+/wearable/config.cache
+/wearable/config.cache-env
+/wearable/config.guess
+/wearable/config.h
+/wearable/config.h.in
+/wearable/config.log
+/wearable/config.status
+/wearable/config.sub
+/wearable/configure
+/wearable/depcomp
+/wearable/embryo.pc
+/wearable/embryo.spec
+/wearable/install-sh
+/wearable/libtool
+/wearable/ltmain.sh
+/wearable/missing
+/wearable/src/bin/embryo_cc
+/wearable/stamp-h1
+/wearable/doc/Doxyfile
+/wearable/config.guess.cdbs-orig
+/wearable/config.sub.cdbs-orig
+/wearable/debian/files
+/wearable/debian/*.debhelper.log
+/wearable/debian/*.substvars
+/wearable/debian/*.debhelper
+/wearable/debian/stamp-*
+/wearable/debian/tmp/
+/wearable/debian/libembryo-bin/
+/wearable/debian/libembryo-dbg/
+/wearable/debian/libembryo-dev/
+/wearable/debian/libembryo-doc/
+/wearable/debian/libembryo0/
+/wearable/doc/html/
+/wearable/doc/latex/
+/wearable/doc/man/
--- /dev/null
+Copyright notice for Embryo:
+
+Copyright (C) 2004-2011 Carsten Haitzler and various contributors (see AUTHORS)
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+Large parts of this source come under the following license from the
+original Small (renamed to Pawn afterwards, but was named Small when
+Embryo split off). See the source files that are clearly marked as below:
+
+Copyright (c) ITB CompuPhase, 1997-2003
+
+This software is provided "as-is", without any express or implied warranty.
+In no event will the authors be held liable for any damages arising from
+the use of this software.
+
+Permission is granted to anyone to use this software for any purpose,
+including commercial applications, and to alter it and redistribute it
+freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software in
+ a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
--- /dev/null
+Installation Instructions
+*************************
+
+Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005 Free
+Software Foundation, Inc.
+
+This file is free documentation; the Free Software Foundation gives
+unlimited permission to copy, distribute and modify it.
+
+Basic Installation
+==================
+
+These are generic installation instructions.
+
+ The `configure' shell script attempts to guess correct values for
+various system-dependent variables used during compilation. It uses
+those values to create a `Makefile' in each directory of the package.
+It may also create one or more `.h' files containing system-dependent
+definitions. Finally, it creates a shell script `config.status' that
+you can run in the future to recreate the current configuration, and a
+file `config.log' containing compiler output (useful mainly for
+debugging `configure').
+
+ It can also use an optional file (typically called `config.cache'
+and enabled with `--cache-file=config.cache' or simply `-C') that saves
+the results of its tests to speed up reconfiguring. (Caching is
+disabled by default to prevent problems with accidental use of stale
+cache files.)
+
+ If you need to do unusual things to compile the package, please try
+to figure out how `configure' could check whether to do them, and mail
+diffs or instructions to the address given in the `README' so they can
+be considered for the next release. If you are using the cache, and at
+some point `config.cache' contains results you don't want to keep, you
+may remove or edit it.
+
+ The file `configure.ac' (or `configure.in') is used to create
+`configure' by a program called `autoconf'. You only need
+`configure.ac' if you want to change it or regenerate `configure' using
+a newer version of `autoconf'.
+
+The simplest way to compile this package is:
+
+ 1. `cd' to the directory containing the package's source code and type
+ `./configure' to configure the package for your system. If you're
+ using `csh' on an old version of System V, you might need to type
+ `sh ./configure' instead to prevent `csh' from trying to execute
+ `configure' itself.
+
+ Running `configure' takes awhile. While running, it prints some
+ messages telling which features it is checking for.
+
+ 2. Type `make' to compile the package.
+
+ 3. Optionally, type `make check' to run any self-tests that come with
+ the package.
+
+ 4. Type `make install' to install the programs and any data files and
+ documentation.
+
+ 5. You can remove the program binaries and object files from the
+ source code directory by typing `make clean'. To also remove the
+ files that `configure' created (so you can compile the package for
+ a different kind of computer), type `make distclean'. There is
+ also a `make maintainer-clean' target, but that is intended mainly
+ for the package's developers. If you use it, you may have to get
+ all sorts of other programs in order to regenerate files that came
+ with the distribution.
+
+Compilers and Options
+=====================
+
+Some systems require unusual options for compilation or linking that the
+`configure' script does not know about. Run `./configure --help' for
+details on some of the pertinent environment variables.
+
+ You can give `configure' initial values for configuration parameters
+by setting variables in the command line or in the environment. Here
+is an example:
+
+ ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix
+
+ *Note Defining Variables::, for more details.
+
+Compiling For Multiple Architectures
+====================================
+
+You can compile the package for more than one kind of computer at the
+same time, by placing the object files for each architecture in their
+own directory. To do this, you must use a version of `make' that
+supports the `VPATH' variable, such as GNU `make'. `cd' to the
+directory where you want the object files and executables to go and run
+the `configure' script. `configure' automatically checks for the
+source code in the directory that `configure' is in and in `..'.
+
+ If you have to use a `make' that does not support the `VPATH'
+variable, you have to compile the package for one architecture at a
+time in the source code directory. After you have installed the
+package for one architecture, use `make distclean' before reconfiguring
+for another architecture.
+
+Installation Names
+==================
+
+By default, `make install' installs the package's commands under
+`/usr/local/bin', include files under `/usr/local/include', etc. You
+can specify an installation prefix other than `/usr/local' by giving
+`configure' the option `--prefix=PREFIX'.
+
+ You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files. If you
+pass the option `--exec-prefix=PREFIX' to `configure', the package uses
+PREFIX as the prefix for installing programs and libraries.
+Documentation and other data files still use the regular prefix.
+
+ In addition, if you use an unusual directory layout you can give
+options like `--bindir=DIR' to specify different values for particular
+kinds of files. Run `configure --help' for a list of the directories
+you can set and what kinds of files go in them.
+
+ If the package supports it, you can cause programs to be installed
+with an extra prefix or suffix on their names by giving `configure' the
+option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
+
+Optional Features
+=================
+
+Some packages pay attention to `--enable-FEATURE' options to
+`configure', where FEATURE indicates an optional part of the package.
+They may also pay attention to `--with-PACKAGE' options, where PACKAGE
+is something like `gnu-as' or `x' (for the X Window System). The
+`README' should mention any `--enable-' and `--with-' options that the
+package recognizes.
+
+ For packages that use the X Window System, `configure' can usually
+find the X include and library files automatically, but if it doesn't,
+you can use the `configure' options `--x-includes=DIR' and
+`--x-libraries=DIR' to specify their locations.
+
+Specifying the System Type
+==========================
+
+There may be some features `configure' cannot figure out automatically,
+but needs to determine by the type of machine the package will run on.
+Usually, assuming the package is built to be run on the _same_
+architectures, `configure' can figure that out, but if it prints a
+message saying it cannot guess the machine type, give it the
+`--build=TYPE' option. TYPE can either be a short name for the system
+type, such as `sun4', or a canonical name which has the form:
+
+ CPU-COMPANY-SYSTEM
+
+where SYSTEM can have one of these forms:
+
+ OS KERNEL-OS
+
+ See the file `config.sub' for the possible values of each field. If
+`config.sub' isn't included in this package, then this package doesn't
+need to know the machine type.
+
+ If you are _building_ compiler tools for cross-compiling, you should
+use the option `--target=TYPE' to select the type of system they will
+produce code for.
+
+ If you want to _use_ a cross compiler, that generates code for a
+platform different from the build platform, you should specify the
+"host" platform (i.e., that on which the generated programs will
+eventually be run) with `--host=TYPE'.
+
+Sharing Defaults
+================
+
+If you want to set default values for `configure' scripts to share, you
+can create a site shell script called `config.site' that gives default
+values for variables like `CC', `cache_file', and `prefix'.
+`configure' looks for `PREFIX/share/config.site' if it exists, then
+`PREFIX/etc/config.site' if it exists. Or, you can set the
+`CONFIG_SITE' environment variable to the location of the site script.
+A warning: not all `configure' scripts look for a site script.
+
+Defining Variables
+==================
+
+Variables not defined in a site shell script can be set in the
+environment passed to `configure'. However, some packages may run
+configure again during the build, and the customized values of these
+variables may be lost. In order to avoid this problem, you should set
+them in the `configure' command line, using `VAR=value'. For example:
+
+ ./configure CC=/usr/local2/bin/gcc
+
+causes the specified `gcc' to be used as the C compiler (unless it is
+overridden in the site shell script). Here is a another example:
+
+ /bin/bash ./configure CONFIG_SHELL=/bin/bash
+
+Here the `CONFIG_SHELL=/bin/bash' operand causes subsequent
+configuration-related scripts to be executed by `/bin/bash'.
+
+`configure' Invocation
+======================
+
+`configure' recognizes the following options to control how it operates.
+
+`--help'
+`-h'
+ Print a summary of the options to `configure', and exit.
+
+`--version'
+`-V'
+ Print the version of Autoconf used to generate the `configure'
+ script, and exit.
+
+`--cache-file=FILE'
+ Enable the cache: use and save the results of the tests in FILE,
+ traditionally `config.cache'. FILE defaults to `/dev/null' to
+ disable caching.
+
+`--config-cache'
+`-C'
+ Alias for `--cache-file=config.cache'.
+
+`--quiet'
+`--silent'
+`-q'
+ Do not print messages saying which checks are being made. To
+ suppress all normal output, redirect it to `/dev/null' (any error
+ messages will still be shown).
+
+`--srcdir=DIR'
+ Look for the package's source code in directory DIR. Usually
+ `configure' can determine that directory automatically.
+
+`configure' also accepts some other, not widely useful, options. Run
+`configure --help' for more details.
+
--- /dev/null
+<manifest>
+ <request>
+ <domain name="_"/>
+ </request>
+ <assign>
+ <filesystem path="/usr/bin/embryo_cc" exec_label="none" />
+ </assign>
+</manifest>
--- /dev/null
+The Rasterman (Carsten Haitzler) <raster@rasterman.com>
+Jérôme Pinot <ngc891@gmail.com>
--- /dev/null
+2011-01-29 Carsten Haitzler (The Rasterman)
+
+ 1.0.0 release
+
+2011-05-12 Carsten Haitzler (The Rasterman)
+
+ * Make embryo_cc use eina and eina_prefix to determine include location
+
+2011-07-16 Vincent Torri
+
+ * delete temporary files on Windows
+
+2011-10-05 Vincent Torri
+
+ * use fseek() instead of rewind() as the latter does not exist on
+ Windows CE and fix compilation with Evil.
+
+2011-12-02 Carsten Haitzler (The Rasterman)
+
+ 1.1.0 release
+
+2012-02-24 Cedric Bail
+
+ * Add exotic support
+
+2012-03-07 Vincent Torri
+
+ * Fix windows compilation issues
+
+2012-04-16 Carsten Haitzler (The Rasterman)
+
+ * Add asin(), acos(), atan(), atan2(), log1p(), cbrt(), exp(),
+ exp2(), hypot(), EMBRYO_12 define
+
+2012-04-26 Carsten Haitzler (The Rasterman)
+
+ 1.2.0 release
+
+2012-06-14 Carsten Haitzler (The Rasterman)
+
+ * Fix divide by 0 possibilities in the fp support so no FPE is
+ produced (bad).
+
+2012-08-30 Carsten Haitzler (The Rasterman)
+
+ 1.7.0 release
+
+2012-09-12 Carsten Haitzler (The Rasterman)
+
+ * Fix windows utf/whitespace parsing issue in windows
+
--- /dev/null
+ACLOCAL_AMFLAGS = -I m4
+
+SUBDIRS = src include doc
+
+MAINTAINERCLEANFILES = \
+Makefile.in \
+aclocal.m4 \
+compile \
+config.guess \
+config.h.in \
+config.h.in~ \
+config.sub \
+configure \
+depcomp \
+install-sh \
+ltmain.sh \
+missing \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION).tar.gz \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION).tar.bz2 \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION)-doc.tar.bz2 \
+m4/libtool.m4 \
+m4/lt~obsolete.m4 \
+m4/ltoptions.m4 \
+m4/ltsugar.m4 \
+m4/ltversion.m4
+
+EXTRA_DIST = \
+AUTHORS \
+COPYING \
+autogen.sh \
+embryo.pc.in \
+embryo.spec.in \
+embryo.spec
+
+pkgconfigdir = $(libdir)/pkgconfig
+pkgconfig_DATA = embryo.pc
+
+.PHONY: doc
+
+# Documentation
+
+doc:
+ @echo "entering doc/"
+ make -C doc doc
--- /dev/null
+Embryo 1.8.0
+
+Changes since Embryo 1.7.0:
+---------------------------
+
+Fixes:
+
+ * Fix windows utf8 shitepsace parse issue.
+
+Changes since Embryo 1.2.0:
+---------------------------
+
+Fixes:
+
+ * Fix divide by 0 n FP support to avoid FPE.
+
+Changes since Embryo 1.1.0:
+---------------------------
+
+Additions:
+
+ * exotic support
+ * asin()
+ * acos()
+ * atan()
+ * atan2()
+ * log1p()
+ * cbrt()
+ * exp(),
+ * exp2()
+ * hypot()
+ * EMBRYO_12
+
+Fixes:
+
+ * windows compilation support
+
+Improvements:
+
+ * exotic support
+
+Changes since Embryo 1.0.0:
+---------------------------
+
+Fixes:
+
+ * on windows use fseek instead of rewind as rewind doesn't exist on wince
+ * delete tmp files on windows
+
+Improvements:
+
+ * make embryo_cc use eina_prefix to determine installation location
+
--- /dev/null
+Embryo 1.7.99
+
+******************************************************************************
+
+ FOR ANY ISSUES PLEASE EMAIL:
+ enlightenment-devel@lists.sourceforge.net
+
+******************************************************************************
+
+Requirements:
+-------------
+
+Must:
+ eina
+ libc
+
+WARNING: gcc compatibility!!!
+There seems to be some bug (or disagreement) between embryo and gcc 3.2.x
+where IEEE floating point format encoding does not "agree" with embryo's own
+hand-made tests. embryo_cc may not work if you compile using gcc 3.2.x. gcc
+3.3.x is known to work fine. we are not 100% sure whose fault this is yet, so
+we won't be jumping up and down, but be warned - gcc 3.2.x does not agree
+with embryo.
+
+To view the API docs, run ./gendoc and view doc/html/index.html.
+
+OK a lot of people ask this. What is Embryo?
+
+Embryo is primarily a shared library that gives you an API to load and control
+interpreted programs compiled into an abstract machine bytecode that it
+understands. This abstract (or virtual) machine is similar to a real machine
+with a CPU, but it is emulated in software. The architecture is simple and is
+the same as the abstract machine (AMX) in the
+<a href=http://www.compuphase.com/pawn>PAWN</a> language (formerly called
+SMALL) as it is based on exactly the same code. Embryo has modified the code
+for the AMX extensively and has made it smaller and more portable. It is VERY
+small. The total size of the virtual machine code AND header files is less
+than 2500 lines of code. It includes the floating point library support by
+default as well. This makes it one of the smallest interpreters around, and
+thus makes is very efficient to use in code.
+
+Embryo also uses the PAWN compiler from the same code base. This code has
+barely been touched and so suffers from lots of portability issues. It has
+been partially fixed and now works on both big and little endian but the code
+still need to be gone over and really cleaned up . It does work, but it's only
+just working. It has been called embryo_cc and compiled a subset of PAWN
+binary outputs. It does not support packed strings, variable alignment, or
+debugging output. It does not support many features of the full PAWN
+compiler because the Embryo AMX does not support these either. You will find
+the Embryo codebase to work much better on Linux (and BSD and MacOS X) and
+other UNIX operating systems as it has been developed and tested on them. IT
+is known to work on:
+ gcc Linux (x86-32)
+ gcc Linux (PPC)
+ gcc MacOS X (PPC)
+
+And will likely work on more combinations. IT currently has problems on 64bit
+SPARC CPUs. Other 64bit systems are untested. It is the aim to fix the code
+so it works on all commonly used architectures (32, 64bit, big and little
+endian, alignment forgiving/unforgiving). So far 64bit support is the major
+issue.
+
+For more documentation please see the Language guide here:
+
+<a href=http://www.compuphase.com/pawn>Pawn Language Booklet</a>
+
+This documents the PAWN language and is 100% relevant for Embryo and the
+syntax of files it can compile (.sma files).
+
+Any help is appreciated in helping clean and port this code, so feel free to
+send patches to the Enlightenment development lists.
+
+The main aim of Embryo is to provide an easy to use library for running
+compiled PAWN programs and giving them access to the calling program and
+any API it exports to the PAWN script. PAWN programs/scripts are completely
+sand-boxed. They cannot access any system or function calls other than the
+ones provided by the calling application to the Embryo API. This means a
+PAWN script cannot open or write to, delete or load files. It is fairly
+harmless and this also keeps Embryo small.
+
+This is a work in progress, so please be patient if things don't work for you
+- and patches and help in fixing it is very much appreciated.
+
+------------------------------------------------------------------------------
+COMPILING AND INSTALLING:
+
+ ./configure
+ make
+(as root unless you are installing in your users directories):
+ make install
--- /dev/null
+#!/bin/sh
+
+rm -rf autom4te.cache
+rm -f aclocal.m4 ltmain.sh
+
+touch ABOUT-NLS
+
+echo "Running aclocal..." ; aclocal $ACLOCAL_FLAGS -I m4 || exit 1
+echo "Running autoheader..." ; autoheader || exit 1
+echo "Running autoconf..." ; autoconf || exit 1
+echo "Running libtoolize..." ; (libtoolize --copy --automake || glibtoolize --automake) || exit 1
+echo "Running automake..." ; automake --add-missing --copy --gnu || exit 1
+
+W=0
+
+rm -f config.cache-env.tmp
+echo "OLD_PARM=\"$@\"" >> config.cache-env.tmp
+echo "OLD_CFLAGS=\"$CFLAGS\"" >> config.cache-env.tmp
+echo "OLD_PATH=\"$PATH\"" >> config.cache-env.tmp
+echo "OLD_PKG_CONFIG_PATH=\"$PKG_CONFIG_PATH\"" >> config.cache-env.tmp
+echo "OLD_LDFLAGS=\"$LDFLAGS\"" >> config.cache-env.tmp
+
+cmp config.cache-env.tmp config.cache-env >> /dev/null
+if [ $? -ne 0 ]; then
+ W=1;
+fi
+
+if [ $W -ne 0 ]; then
+ echo "Cleaning configure cache...";
+ rm -f config.cache config.cache-env
+ mv config.cache-env.tmp config.cache-env
+else
+ rm -f config.cache-env.tmp
+fi
+
+if [ -z "$NOCONFIGURE" ]; then
+ ./configure -C "$@"
+fi
--- /dev/null
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_define([v_maj], [1])
+m4_define([v_min], [7])
+m4_define([v_mic], [99])
+m4_define([v_rev], m4_esyscmd([(svnversion "${SVN_REPO_PATH:-.}" | grep -v '\(export\|Unversioned directory\)' || echo 0) | awk -F : '{printf("%s\n", $1);}' | tr -d ' :MSP\n']))
+m4_if(v_rev, [0], [m4_define([v_rev], m4_esyscmd([git log 2> /dev/null | (grep -m1 git-svn-id || echo 0) | sed -e 's/.*@\([0-9]*\).*/\1/' | tr -d '\n']))])
+##-- When released, remove the dnl on the below line
+dnl m4_undefine([v_rev])
+##-- When doing snapshots - change soname. remove dnl on below line
+dnl m4_define([relname], [ver-pre-svn-07])
+dnl m4_define([v_rel], [-release ver-pre-svn-07])
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_ifdef([v_rev], [m4_define([v_ver], [v_maj.v_min.v_mic.v_rev])], [m4_define([v_ver], [v_maj.v_min.v_mic])])
+m4_define([lt_cur], m4_eval(v_maj + v_min))
+m4_define([lt_rev], v_mic)
+m4_define([lt_age], v_min)
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+
+AC_INIT([embryo], [v_ver], [enlightenment-devel@lists.sourceforge.net])
+AC_PREREQ([2.52])
+AC_CONFIG_SRCDIR([configure.ac])
+AC_CONFIG_MACRO_DIR([m4])
+
+AC_CONFIG_HEADERS([config.h])
+AH_TOP([
+#ifndef EFL_CONFIG_H__
+#define EFL_CONFIG_H__
+])
+AH_BOTTOM([
+#endif /* EFL_CONFIG_H__ */
+])
+
+AM_INIT_AUTOMAKE([1.6 dist-bzip2])
+m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])])
+
+AC_LIBTOOL_WIN32_DLL
+define([AC_LIBTOOL_LANG_CXX_CONFIG], [:])dnl
+define([AC_LIBTOOL_LANG_F77_CONFIG], [:])dnl
+AC_PROG_LIBTOOL
+
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_ifdef([v_rev], , [m4_define([v_rev], [0])])
+m4_ifdef([v_rel], , [m4_define([v_rel], [])])
+AC_DEFINE_UNQUOTED(VMAJ, [v_maj], [Major version])
+AC_DEFINE_UNQUOTED(VMIN, [v_min], [Minor version])
+AC_DEFINE_UNQUOTED(VMIC, [v_mic], [Micro version])
+AC_DEFINE_UNQUOTED(VREV, [v_rev], [Revison])
+version_info="lt_cur:lt_rev:lt_age"
+release_info="v_rel"
+AC_SUBST(version_info)
+AC_SUBST(release_info)
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+VMAJ=v_maj
+AC_SUBST(VMAJ)
+
+### Default options with respect to host
+
+AC_CANONICAL_BUILD
+AC_CANONICAL_HOST
+
+requirement_embryo=""
+embryoincludedir="${datadir}/include"
+
+
+### Additional options to configure
+
+EFL_ENABLE_BIN([embryo-cc])
+
+
+### Checks for programs
+AC_PROG_CC
+
+# doxygen program for documentation building
+
+EFL_CHECK_DOXYGEN([build_doc="yes"], [build_doc="no"])
+
+# pkg-config
+
+PKG_PROG_PKG_CONFIG
+
+# Check whether pkg-config supports Requires.private
+if $PKG_CONFIG --atleast-pkgconfig-version 0.22; then
+ pkgconfig_requires_private="Requires.private"
+else
+ pkgconfig_requires_private="Requires"
+fi
+AC_SUBST(pkgconfig_requires_private)
+
+
+### Checks for libraries
+
+# Evil library for compilation on Windows
+
+EFL_EMBRYO_BUILD=""
+case "$host_os" in
+ mingw*)
+ PKG_CHECK_MODULES([EVIL], [evil >= 1.6.99])
+ AC_DEFINE(HAVE_EVIL, 1, [Set to 1 if Evil library is installed])
+ requirement_embryo="evil ${requirement_embryo}"
+ EFL_EMBRYO_BUILD="-DEFL_EMBRYO_BUILD"
+ ;;
+esac
+AC_SUBST(EFL_EMBRYO_BUILD)
+
+# For embryo_cc_prefix.c
+PKG_CHECK_MODULES([EINA], [eina >= 1.6.99])
+
+### Checks for portability layer
+
+PKG_CHECK_MODULES([EXOTIC],
+ [exotic],
+ [enable_exotic="yes"],
+ [enable_exotic="no"])
+
+if test "x${enable_exotic}" = "xyes"; then
+ requirement_embryo="exotic ${requirement_embryo}"
+
+ AC_DEFINE([HAVE_EXOTIC], [1], [Define to 1 if you have Exotic.])
+fi
+
+### Checks for header files
+
+AC_CHECK_HEADERS([unistd.h])
+EFL_CHECK_PATH_MAX
+
+
+### Checks for types
+
+
+### Checks for structures
+
+
+### Checks for compiler characteristics
+AC_C_BIGENDIAN
+AM_PROG_CC_C_O
+AC_C_CONST
+AC_C_INLINE
+AC_PROG_CC_STDC
+AC_HEADER_STDC
+AC_C___ATTRIBUTE__
+
+EMBRYO_CPPFLAGS=""
+EMBRYO_CFLAGS=""
+case "$host_os" in
+ mingw32ce*)
+ EMBRYO_CPPFLAGS="-D_WIN32_WCE=0x0420"
+ ;;
+esac
+AC_SUBST(EMBRYO_CPPFLAGS)
+AC_SUBST(EMBRYO_CFLAGS)
+
+
+### Checks for linker characteristics
+
+lt_enable_auto_import=""
+case "$host_os" in
+ mingw*)
+ lt_enable_auto_import="-Wl,--enable-auto-import"
+ ;;
+esac
+AC_SUBST(lt_enable_auto_import)
+
+
+### Checks for library functions
+
+AC_ISC_POSIX
+
+# alloca
+AC_FUNC_ALLOCA
+
+# fnmatch
+EFL_CHECK_FNMATCH([], [AC_MSG_ERROR([Cannot find fnmatch()])])
+
+# gettimeofday
+EFL_CHECK_GETTIMEOFDAY([], [AC_MSG_ERROR([Cannot find gettimeofday()])])
+
+
+AC_SUBST(requirement_embryo)
+AC_SUBST(embryoincludedir)
+
+AC_OUTPUT([
+Makefile
+doc/Makefile
+doc/Doxyfile
+doc/embryo.dox
+embryo.pc
+include/Makefile
+src/Makefile
+src/lib/Makefile
+src/bin/Makefile
+embryo.spec
+])
+
+
+#####################################################################
+## Info
+
+echo
+echo
+echo
+echo "------------------------------------------------------------------------"
+echo "$PACKAGE $VERSION"
+echo "------------------------------------------------------------------------"
+echo
+echo "Configuration Options Summary:"
+echo
+echo " Build embryo_cc......: $have_embryo_cc"
+echo
+echo " Documentation........: ${build_doc}"
+echo
+echo "Compilation............: make (or gmake)"
+echo " CPPFLAGS.............: $CPPFLAGS"
+echo " CFLAGS...............: $CFLAGS"
+echo " LDFLAGS..............: $LDFLAGS"
+echo
+echo "Installation...........: make install (as root if needed, with 'su' or 'sudo')"
+echo " prefix...............: $prefix"
+echo
--- /dev/null
+PROJECT_NAME = Embryo
+PROJECT_NUMBER =
+OUTPUT_DIRECTORY = .
+INPUT = @srcdir@/embryo.dox @top_srcdir@/src/lib/
+IMAGE_PATH = img
+OUTPUT_LANGUAGE = English
+GENERATE_HTML = YES
+HTML_OUTPUT = html
+HTML_FILE_EXTENSION = .html
+HTML_HEADER = @srcdir@/head.html
+HTML_FOOTER = @srcdir@/foot.html
+HTML_STYLESHEET = @srcdir@/e.css
+HTML_ALIGN_MEMBERS = YES
+ENUM_VALUES_PER_LINE = 1
+GENERATE_HTMLHELP = NO
+CHM_FILE =
+HHC_LOCATION =
+GENERATE_CHI = NO
+BINARY_TOC = NO
+TOC_EXPAND = NO
+DISABLE_INDEX = YES
+EXTRACT_ALL = NO
+EXTRACT_PRIVATE = NO
+EXTRACT_STATIC = NO
+EXTRACT_LOCAL_CLASSES = NO
+HIDE_UNDOC_MEMBERS = YES
+HIDE_UNDOC_CLASSES = YES
+HIDE_FRIEND_COMPOUNDS = YES
+BRIEF_MEMBER_DESC = YES
+REPEAT_BRIEF = YES
+ALWAYS_DETAILED_SEC = NO
+INLINE_INHERITED_MEMB = NO
+FULL_PATH_NAMES = NO
+STRIP_FROM_PATH =
+INTERNAL_DOCS = NO
+STRIP_CODE_COMMENTS = YES
+CASE_SENSE_NAMES = YES
+SHORT_NAMES = NO
+HIDE_SCOPE_NAMES = NO
+VERBATIM_HEADERS = NO
+SHOW_INCLUDE_FILES = NO
+JAVADOC_AUTOBRIEF = YES
+MULTILINE_CPP_IS_BRIEF = NO
+INHERIT_DOCS = YES
+INLINE_INFO = YES
+SORT_MEMBER_DOCS = YES
+DISTRIBUTE_GROUP_DOC = NO
+TAB_SIZE = 2
+GENERATE_TODOLIST = YES
+GENERATE_TESTLIST = YES
+GENERATE_BUGLIST = YES
+GENERATE_DEPRECATEDLIST= YES
+ALIASES =
+ENABLED_SECTIONS =
+MAX_INITIALIZER_LINES = 30
+OPTIMIZE_OUTPUT_FOR_C = YES
+OPTIMIZE_OUTPUT_JAVA = NO
+SHOW_USED_FILES = NO
+QUIET = YES
+WARNINGS = YES
+WARN_IF_UNDOCUMENTED = YES
+WARN_FORMAT = "$file:$line: $text"
+WARN_LOGFILE =
+FILE_PATTERNS =
+RECURSIVE = NO
+EXCLUDE =
+EXCLUDE_SYMLINKS = NO
+EXCLUDE_PATTERNS =
+EXAMPLE_PATH =
+EXAMPLE_PATTERNS =
+EXAMPLE_RECURSIVE = NO
+INPUT_FILTER =
+FILTER_SOURCE_FILES = NO
+SOURCE_BROWSER = NO
+INLINE_SOURCES = NO
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION = YES
+ALPHABETICAL_INDEX = YES
+COLS_IN_ALPHA_INDEX = 2
+IGNORE_PREFIX =
+GENERATE_TREEVIEW = NO
+TREEVIEW_WIDTH = 250
+GENERATE_LATEX = YES
+LATEX_OUTPUT = latex
+LATEX_CMD_NAME = latex
+MAKEINDEX_CMD_NAME = makeindex
+COMPACT_LATEX = NO
+PAPER_TYPE = a4wide
+EXTRA_PACKAGES =
+LATEX_HEADER =
+PDF_HYPERLINKS = YES
+USE_PDFLATEX = NO
+LATEX_BATCHMODE = NO
+GENERATE_RTF = NO
+RTF_OUTPUT = rtf
+COMPACT_RTF = NO
+RTF_HYPERLINKS = NO
+RTF_STYLESHEET_FILE =
+RTF_EXTENSIONS_FILE =
+GENERATE_MAN = YES
+MAN_OUTPUT = man
+MAN_EXTENSION = .3
+MAN_LINKS = YES
+GENERATE_XML = NO
+XML_SCHEMA =
+XML_DTD =
+GENERATE_AUTOGEN_DEF = NO
+ENABLE_PREPROCESSING = YES
+MACRO_EXPANSION = NO
+EXPAND_ONLY_PREDEF = NO
+SEARCH_INCLUDES = NO
+INCLUDE_PATH =
+INCLUDE_FILE_PATTERNS =
+PREDEFINED =
+EXPAND_AS_DEFINED =
+SKIP_FUNCTION_MACROS = YES
+TAGFILES =
+GENERATE_TAGFILE =
+ALLEXTERNALS = NO
+EXTERNAL_GROUPS = YES
+PERL_PATH = /usr/bin/perl
+CLASS_DIAGRAMS = NO
+HIDE_UNDOC_RELATIONS = YES
+HAVE_DOT = NO
+CLASS_GRAPH = NO
+COLLABORATION_GRAPH = NO
+TEMPLATE_RELATIONS = NO
+INCLUDE_GRAPH = NO
+INCLUDED_BY_GRAPH = NO
+GRAPHICAL_HIERARCHY = NO
+DOT_IMAGE_FORMAT = png
+DOT_PATH =
+DOTFILE_DIRS =
+DOT_GRAPH_MAX_NODES = 50
+GENERATE_LEGEND = YES
+DOT_CLEANUP = YES
+SEARCHENGINE = NO
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in embryo.dox
+
+.PHONY: doc
+
+PACKAGE_DOCNAME = $(PACKAGE_TARNAME)-$(PACKAGE_VERSION)-doc
+
+if EFL_BUILD_DOC
+
+doc-clean:
+ rm -rf html/ latex/ man/ xml/ $(top_builddir)/$(PACKAGE_DOCNAME).tar*
+
+doc: all doc-clean
+ $(efl_doxygen)
+ cp $(srcdir)/img/* html/
+ rm -rf $(PACKAGE_DOCNAME).tar*
+ mkdir -p $(PACKAGE_DOCNAME)/doc
+ cp -R html/ latex/ man/ $(PACKAGE_DOCNAME)/doc
+ tar cf $(PACKAGE_DOCNAME).tar $(PACKAGE_DOCNAME)/
+ bzip2 -9 $(PACKAGE_DOCNAME).tar
+ rm -rf $(PACKAGE_DOCNAME)/
+ mv $(PACKAGE_DOCNAME).tar.bz2 $(top_builddir)
+
+clean-local: doc-clean
+
+else
+
+doc:
+ @echo "Documentation not built. Run ./configure --help"
+
+endif
+
+EXTRA_DIST = Doxyfile e.css foot.html head.html $(wildcard img/*.*) embryo.dox.in
--- /dev/null
+/*
+ Author:
+ Andres Blanc <andresblanc@gmail.com>
+ DaveMDS Andreoli <dave@gurumeditation.it>
+
+ Supported Browsers:
+ ie7, opera9, konqueror4 and firefox3
+
+ Please use a different file for ie6, ie5, etc. hacks.
+*/
+
+
+/* Necessary to place the footer at the bottom of the page */
+html, body {
+ height: 100%;
+ margin: 0px;
+ padding: 0px;
+}
+
+#container {
+ min-height: 100%;
+ height: auto !important;
+ height: 100%;
+ margin: 0 auto -53px;
+}
+
+#footer, #push {
+ height: 53px;
+}
+
+
+* html #container {
+ height: 100%;
+}
+
+/* Prevent floating elements overflowing containers */
+.clear {
+ clear: both;
+ width: 0px;
+ height: 0px;
+}
+
+/* Flexible & centered layout from 750 to 960 pixels */
+.layout {
+ max-width: 960px;
+ min-width: 760px;
+ margin-left: auto;
+ margin-right: auto;
+}
+
+body {
+ /*font-family: Lucida Grande, Helvetica, sans-serif;*/
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif
+}
+
+/* Prevent design overflowing the viewport in small resolutions */
+#container {
+ padding-right: 17px;
+ padding-left: 17px;
+ background-image: url(head_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header {
+ width: 100%;
+ height: 102px;
+}
+
+#header h1 {
+ width: 63px;
+ height: 63px;
+ background-image: url(e.png);
+ background-repeat: no-repeat;
+ position: absolute;
+ margin: 0px;
+}
+
+#header h1 span {
+ display: none;
+}
+
+#header h2 {
+ display: none;
+}
+
+/* .menu-container is used to set properties common to .menu and .submenu */
+#header .menu-container {
+}
+
+#header .menu-container ul {
+ list-style-type: none;
+ list-style-position: inside;
+ margin: 0;
+}
+
+#header .menu-container li {
+ display: block;
+ float: right;
+}
+
+#header .menu {
+ height: 63px;
+ display: block;
+ background-image: url(menu_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header .menu ul {
+ height: 100%;
+ display: block;
+ background-image: url(menu_bg_last.png);
+ background-repeat: no-repeat;
+ background-position: top right;
+ padding-right: 17px;
+}
+
+#header .menu li {
+ height: 100%;
+ text-align: center;
+ background-image: url(menu_bg_unsel.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu a {
+ height: 100%;
+ display: block;
+ color: #cdcdcd;
+ text-decoration: none;
+ font-size: 10pt;
+ line-height: 59px;
+ text-align: center;
+ padding: 0px 15px 0px 15px;
+}
+
+#header .menu li:hover {
+ background-image: url(menu_bg_hover.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li:hover a {
+ color: #FFFFFF;
+}
+
+#header .menu li.current {
+ background-image: url(menu_bg_current.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li.current a {
+ color: #646464;
+}
+
+
+/* Hide all the submenus but the current */
+#header .submenu ul {
+ display: none;
+}
+
+#header .submenu .current {
+ display: block;
+}
+
+#header .submenu {
+ font: bold 10px verdana,'Bitstream Vera Sans',helvetica,arial,sans-serif;
+ margin-top: 10px;
+}
+
+#header .submenu a {
+ color: #888888;
+ text-decoration: none;
+ font-size: 0.9em;
+ line-height: 15px;
+ padding:0px 5px 0px 5px;
+}
+
+#header .submenu a:hover {
+ color: #444444;
+}
+
+#header .submenu li {
+ border-left: 1px solid #DDDDDD;
+}
+
+#header .submenu li:last-child {
+ border-left: 0;
+}
+
+#header .doxytitle {
+ position: absolute;
+ font-size: 1.8em;
+ font-weight: bold;
+ color: #444444;
+ line-height: 35px;
+}
+
+#header small {
+ font-size: 0.4em;
+}
+
+#footer {
+ background-image: url(foot_bg.png);
+ width: 100%;
+}
+
+#footer table {
+ width: 100%;
+ text-align: center;
+ white-space: nowrap;
+ padding: 5px 30px 5px 30px;
+ font-size: 0.8em;
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif;
+ color: #888888;
+}
+
+#footer td.copyright {
+ width: 100%;
+}
+
+/*
+ Author:
+ Andres Blanc <andresblanc@gmail.com>
+ DaveMDS Andreoli <dave@gurumeditation.it>
+
+ Supported Browsers:
+ ie7, opera9, konqueror4 and firefox3
+
+ Please use a different file for ie6, ie5, etc. hacks.
+*/
+
+
+/* Necessary to place the footer at the bottom of the page */
+html, body {
+ height: 100%;
+ margin: 0px;
+ padding: 0px;
+}
+
+#container {
+ min-height: 100%;
+ height: auto !important;
+ height: 100%;
+ margin: 0 auto -53px;
+}
+
+#footer, #push {
+ height: 53px;
+}
+
+
+* html #container {
+ height: 100%;
+}
+
+/* Prevent floating elements overflowing containers */
+.clear {
+ clear: both;
+ width: 0px;
+ height: 0px;
+}
+
+/* Flexible & centered layout from 750 to 960 pixels */
+.layout {
+ max-width: 960px;
+ min-width: 760px;
+ margin-left: auto;
+ margin-right: auto;
+}
+
+body {
+ /*font-family: Lucida Grande, Helvetica, sans-serif;*/
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif
+}
+
+/* Prevent design overflowing the viewport in small resolutions */
+#container {
+ padding-right: 17px;
+ padding-left: 17px;
+ background-image: url(head_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header {
+ width: 100%;
+ height: 102px;
+}
+
+#header h1 {
+ width: 63px;
+ height: 63px;
+ background-image: url(e.png);
+ background-repeat: no-repeat;
+ position: absolute;
+ margin: 0px;
+}
+
+#header h1 span {
+ display: none;
+}
+
+#header h2 {
+ display: none;
+}
+
+/* .menu-container is used to set properties common to .menu and .submenu */
+#header .menu-container {
+}
+
+#header .menu-container ul {
+ list-style-type: none;
+ list-style-position: inside;
+ margin: 0;
+}
+
+#header .menu-container li {
+ display: block;
+ float: right;
+}
+
+#header .menu {
+ height: 63px;
+ display: block;
+ background-image: url(menu_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header .menu ul {
+ height: 100%;
+ display: block;
+ background-image: url(menu_bg_last.png);
+ background-repeat: no-repeat;
+ background-position: top right;
+ padding-right: 17px;
+}
+
+#header .menu li {
+ height: 100%;
+ text-align: center;
+ background-image: url(menu_bg_unsel.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu a {
+ height: 100%;
+ display: block;
+ color: #cdcdcd;
+ text-decoration: none;
+ font-size: 10pt;
+ line-height: 59px;
+ text-align: center;
+ padding: 0px 15px 0px 15px;
+}
+
+#header .menu li:hover {
+ background-image: url(menu_bg_hover.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li:hover a {
+ color: #FFFFFF;
+}
+
+#header .menu li.current {
+ background-image: url(menu_bg_current.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li.current a {
+ color: #646464;
+}
+
+
+/* Hide all the submenus but the current */
+#header .submenu ul {
+ display: none;
+}
+
+#header .submenu .current {
+ display: block;
+}
+
+#header .submenu {
+ font: bold 10px verdana,'Bitstream Vera Sans',helvetica,arial,sans-serif;
+ margin-top: 10px;
+}
+
+#header .submenu a {
+ color: #888888;
+ text-decoration: none;
+ font-size: 0.9em;
+ line-height: 15px;
+ padding:0px 5px 0px 5px;
+}
+
+#header .submenu a:hover {
+ color: #444444;
+}
+
+#header .submenu li {
+ border-left: 1px solid #DDDDDD;
+}
+
+#header .submenu li:last-child {
+ border-left: 0;
+}
+
+#header .doxytitle {
+ position: absolute;
+ font-size: 1.8em;
+ font-weight: bold;
+ color: #444444;
+ line-height: 35px;
+}
+
+#header small {
+ font-size: 0.4em;
+}
+
+#footer {
+ background-image: url(foot_bg.png);
+ width: 100%;
+}
+
+#footer table {
+ width: 100%;
+ text-align: center;
+ white-space: nowrap;
+ padding: 5px 30px 5px 30px;
+ font-size: 0.8em;
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif;
+ color: #888888;
+}
+
+#footer td.copyright {
+ width: 100%;
+}
+
--- /dev/null
+td.md {
+ background-color: #ffffff;
+ font-family: monospace;
+ text-align: left;
+ vertical-align: center;
+ font-size: 10;
+ padding-right : 1px;
+ padding-top : 1px;
+ padding-left : 1px;
+ padding-bottom : 1px;
+ margin-left : 1px;
+ margin-right : 1px;
+ margin-top : 1px;
+ margin-bottom : 1px
+}
+td.mdname {
+ font-family: monospace;
+ text-align: left;
+ vertical-align: center;
+ font-size: 10;
+ padding-right : 1px;
+ padding-top : 1px;
+ padding-left : 1px;
+ padding-bottom : 1px;
+ margin-left : 1px;
+ margin-right : 1px;
+ margin-top : 1px;
+ margin-bottom : 1px
+}
+h1
+{
+ text-align: center;
+ color: #333333
+}
+h2
+{
+ text-align: left;
+ color: #333333
+}
+h3
+{
+ text-align: left;
+ color: #333333
+}
+a:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: bold;
+}
+a:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: bold;
+}
+a:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: bold;
+}
+a.nav:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: normal;
+}
+a.nav:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: normal;
+}
+a.nav:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: normal;
+}
+a.qindex:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: normal;
+}
+a.qindex:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: normal;
+}
+a.qindex:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: normal;
+}
+p
+{
+ color: #000000;
+ font-family: sans-serif;
+ font-size: 10;
+}
+body {
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ background-color: #dddddd;
+ color: #000000;
+ font-family: sans-serif;
+ padding: 8px;
+ margin: 0;
+}
+div.fragment
+{
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ border: thin solid #888888;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: left;
+ vertical-align: center;
+ font-size: 12;
+}
+hr
+{
+ border: 0;
+ background-color: #000000;
+ width: 80%;
+ height: 1;
+}
+dl
+{
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ border: thin solid #aaaaaa;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: left;
+ vertical-align: center;
+ font-size: 12;
+}
+em
+{
+ color: #334466;
+ font-family: courier;
+ font-size: 10;
+ font-style: normal;
+}
+
+div.nav
+{
+ border: thin solid #000000;
+ background-color: #ffffff;
+ padding: 1px;
+ text-align: center;
+ vertical-align: center;
+ font-size: 12;
+}
+div.body
+{
+ border: thin solid #000000;
+ background-color: #ffffff;
+ padding: 4px;
+ text-align: left;
+ font-size: 10;
+}
+div.diag
+{
+ border: thin solid #888888;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: center;
+ font-size: 8;
+}
--- /dev/null
+
+ <div id="push"></div>
+ </div> <!-- #content -->
+ </div> <!-- .layout -->
+
+ </div> <!-- #container -->
+
+
+ <div id="footer">
+ <table><tr>
+ <td class="poweredby"><img src="doxygen.png"></td>
+ <td class="copyright">Copyright ©$year Enlightenment</td>
+ <td class="generated">Docs generated $datetime</td>
+ </tr></table>
+ </div>
+
+
+</body>
+</html>
--- /dev/null
+<html>
+<head>
+ <title>$title</title>
+ <meta http-equiv="content-type" content="text/html;charset=UTF-8">
+ <meta name="author" content="Andres Blanc" >
+
+ <link rel="icon" href="img/favicon.png" type="image/x-icon">
+ <link rel="shortcut icon" href="img/favicon.png" type="image/x-icon">
+ <link rel="icon" href="img/favicon.png" type="image/ico">
+ <link rel="shortcut icon" href="img/favicon.png" type="image/ico">
+
+ <link rel="stylesheet" type="text/css" media="screen" href="e.css">
+ <link rel="stylesheet" type="text/css" media="screen" href="edoxy.css">
+</head>
+
+<body>
+
+<div id="container">
+
+<div id="header">
+<div class="layout">
+
+ <h1><span>Enlightenment</span></h1>
+ <h2><span>Beauty at your fingertips</span></h2>
+
+ <div class="menu-container">
+ <div class="menu">
+ <ul>
+ <li class="current"><a href="http://web.enlightenment.org/p.php?p=docs">Docs</a></li>
+ <li><a href="http://trac.enlightenment.org/e">Tracker</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=contact">Contact</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=contribute">Contribute</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=support">Support</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=download">Download</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=about">About</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=news">News</a></li>
+ <li><a href="http://www.enlightenment.org/">Home</a></li>
+ </ul>
+ </div>
+ </div>
+
+ <div class="doxytitle">
+ $projectname Documentation <small>at $date</small>
+ </div>
+
+ <div class="menu-container">
+ <div class="submenu">
+ <ul class="current">
+ <li><a href="todo.html">Todo</a></li>
+ <li><a href="files.html">Files</a></li>
+ <li><a href="annotated.html">Data Structures</a></li>
+ <li><a href="globals.html">Globals</a></li>
+ <li><a href="modules.html">Modules</a></li>
+ <li><a href="pages.html">Related Pages</a></li>
+ <li class="current"><a href="index.html">Main Page</a></li>
+ </ul>
+ </div>
+ </div>
+
+
+ <div class="clear"></div>
+</div>
+</div>
+
+<div id="content">
+<div class="layout">
--- /dev/null
+/*
+ * This file contain a custom doxygen style to match e.org graphics
+ */
+
+
+
+/* BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}*/
+BODY, TD {
+ font-size: 12px;
+}
+H1 {
+ text-align: center;
+ font-size: 160%;
+}
+H2 {
+ font-size: 120%;
+}
+H3 {
+ font-size: 100%;
+}
+CAPTION {
+ font-weight: bold
+}
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navpath {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff
+}
+A.el {
+ text-decoration: none;
+ font-weight: bold
+}
+A.elRef {
+ font-weight: bold
+}
+A.code:link {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.code:visited {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:link {
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:visited {
+ font-weight: normal;
+ color: #0000FF
+}
+A:hover, A:visited:hover {
+ text-decoration: none;
+ /* background-color: #f2f2ff; */
+ color: #000055;
+}
+A.anchor {
+ color: #000;
+}
+DL.el {
+ margin-left: -1cm
+}
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah {
+ background-color: black;
+ font-weight: bold;
+ color: #ffffff;
+ margin-bottom: 3px;
+ margin-top: 3px
+}
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText {
+ margin-left: 16px;
+ font-style: italic;
+ font-size: 90%
+}
+/*BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}*/
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp {
+ text-align: center;
+}
+IMG.formulaDsp {
+}
+IMG.formulaInl {
+ vertical-align: middle;
+}
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+SPAN.vhdldigit { color: #ff00ff }
+SPAN.vhdlchar { color: #000000 }
+SPAN.vhdlkeyword { color: #700070 }
+SPAN.vhdllogic { color: #ff0000 }
+
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search {
+ color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search {
+ font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny {
+ font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab {
+ padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab {
+ background: #e8eef2;
+ font-weight: bold;
+}
+HR {
+ height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+ margin-left: 3px;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+ white-space: nowrap;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+/* these are for tree view when used as main index */
+.directory {
+ font-size: 9pt;
+ font-weight: bold;
+}
+.directory h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+
+/* The following two styles can be used to replace the root node title */
+/* with an image of your choice. Simply uncomment the next two styles, */
+/* specify the name of your image and be sure to set 'height' to the */
+/* proper pixel height of your image. */
+
+/* .directory h3.swap { */
+/* height: 61px; */
+/* background-repeat: no-repeat; */
+/* background-image: url("yourimage.gif"); */
+/* } */
+/* .directory h3.swap span { */
+/* display: none; */
+/* } */
+
+.directory > h3 {
+ margin-top: 0;
+}
+.directory p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory div {
+ display: none;
+ margin: 0px;
+}
+.directory img {
+ vertical-align: -30%;
+}
+/* these are for tree view when not used as main index */
+.directory-alt {
+ font-size: 100%;
+ font-weight: bold;
+}
+.directory-alt h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+.directory-alt > h3 {
+ margin-top: 0;
+}
+.directory-alt p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory-alt div {
+ display: none;
+ margin: 0px;
+}
+.directory-alt img {
+ vertical-align: -30%;
+}
+
+/*
+ * This file contain a custom doxygen style to match e.org graphics
+ */
+
+
+
+/* BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}*/
+BODY, TD {
+ font-size: 12px;
+}
+H1 {
+ text-align: center;
+ font-size: 160%;
+}
+H2 {
+ font-size: 120%;
+}
+H3 {
+ font-size: 100%;
+}
+CAPTION {
+ font-weight: bold
+}
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navpath {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff
+}
+A.el {
+ text-decoration: none;
+ font-weight: bold
+}
+A.elRef {
+ font-weight: bold
+}
+A.code:link {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.code:visited {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:link {
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:visited {
+ font-weight: normal;
+ color: #0000FF
+}
+A:hover, A:visited:hover {
+ text-decoration: none;
+ /* background-color: #f2f2ff; */
+ color: #000055;
+}
+A.anchor {
+ color: #000;
+}
+DL.el {
+ margin-left: -1cm
+}
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah {
+ background-color: black;
+ font-weight: bold;
+ color: #ffffff;
+ margin-bottom: 3px;
+ margin-top: 3px
+}
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText {
+ margin-left: 16px;
+ font-style: italic;
+ font-size: 90%
+}
+/*BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}*/
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp {
+ text-align: center;
+}
+IMG.formulaDsp {
+}
+IMG.formulaInl {
+ vertical-align: middle;
+}
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+SPAN.vhdldigit { color: #ff00ff }
+SPAN.vhdlchar { color: #000000 }
+SPAN.vhdlkeyword { color: #700070 }
+SPAN.vhdllogic { color: #ff0000 }
+
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search {
+ color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search {
+ font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny {
+ font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab {
+ padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab {
+ background: #e8eef2;
+ font-weight: bold;
+}
+HR {
+ height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+ margin-left: 3px;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+ white-space: nowrap;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+/* these are for tree view when used as main index */
+.directory {
+ font-size: 9pt;
+ font-weight: bold;
+}
+.directory h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+
+/* The following two styles can be used to replace the root node title */
+/* with an image of your choice. Simply uncomment the next two styles, */
+/* specify the name of your image and be sure to set 'height' to the */
+/* proper pixel height of your image. */
+
+/* .directory h3.swap { */
+/* height: 61px; */
+/* background-repeat: no-repeat; */
+/* background-image: url("yourimage.gif"); */
+/* } */
+/* .directory h3.swap span { */
+/* display: none; */
+/* } */
+
+.directory > h3 {
+ margin-top: 0;
+}
+.directory p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory div {
+ display: none;
+ margin: 0px;
+}
+.directory img {
+ vertical-align: -30%;
+}
+/* these are for tree view when not used as main index */
+.directory-alt {
+ font-size: 100%;
+ font-weight: bold;
+}
+.directory-alt h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+.directory-alt > h3 {
+ margin-top: 0;
+}
+.directory-alt p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory-alt div {
+ display: none;
+ margin: 0px;
+}
+.directory-alt img {
+ vertical-align: -30%;
+}
+
--- /dev/null
+prefix=/usr
+exec_prefix=/usr
+libdir=/usr/lib
+includedir=/usr/include
+datarootdir=${prefix}/share
+datadir=/usr/share/embryo
+embryoincludedir=/usr/share/include
+
+Name: embryo
+Description: A small virtual machine engine and bytecode compiler
+Requires.private:
+Version: 1.7.99.0
+Libs: -L${libdir} -lembryo
+Libs.private: -lm
+Cflags: -I${includedir}/embryo-1
--- /dev/null
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+datarootdir=@datarootdir@
+datadir=@datadir@/@PACKAGE@
+embryoincludedir=@embryoincludedir@
+
+Name: embryo
+Description: A small virtual machine engine and bytecode compiler
+@pkgconfig_requires_private@: @requirement_embryo@
+Version: @VERSION@
+Libs: -L${libdir} -lembryo
+Libs.private: @EFL_FNMATCH_LIBS@ -lm
+Cflags: -I${includedir}/embryo-@VMAJ@
--- /dev/null
+%define _missing_doc_files_terminate_build 0
+
+%{!?_rel:%{expand:%%global _rel 0.enl%{?dist}}}
+
+Summary: A small virtual machine engine (in a library) and bytecode compiler
+Name: @PACKAGE@
+Version: @VERSION@
+Release: %{_rel}
+License: BSD
+Group: System Environment/Libraries
+Source: %{name}-%{version}.tar.gz
+Packager: %{?_packager:%{_packager}}%{!?_packager:Michael Jennings <mej@eterm.org>}
+Vendor: %{?_vendorinfo:%{_vendorinfo}}%{!?_vendorinfo:The Enlightenment Project (http://www.enlightenment.org/)}
+Distribution: %{?_distribution:%{_distribution}}%{!?_distribution:%{_vendor}}
+URL: http://www.enlightenment.org/
+BuildRoot: %{_tmppath}/%{name}-%{version}-root
+
+%description
+Embryo is a tiny library designed as a virtual machine to interpret a
+limited set of small compiled programs.
+
+%package devel
+Summary: Embryo headers, static libraries, documentation and test programs
+Group: System Environment/Libraries
+Requires: %{name} = %{version}
+
+%description devel
+Headers, static libraries, test programs and documentation for Embryo
+
+%package bin
+Summary: Embryo bytecode compiler and needed data files
+Group: System Environment/Libraries
+Requires: %{name} = %{version}
+
+%description bin
+The embryo bytecode compiler and its files
+
+%prep
+%setup -q
+
+%build
+%{configure} --prefix=%{_prefix}
+### use this if you have build problems
+#./configure --prefix=%{_prefix}
+%{__make} %{?_smp_mflags} %{?mflags}
+
+%install
+%{__make} %{?mflags_install} DESTDIR=$RPM_BUILD_ROOT install
+
+%clean
+test "x$RPM_BUILD_ROOT" != "x/" && rm -rf $RPM_BUILD_ROOT
+
+%post
+/sbin/ldconfig
+
+%postun
+/sbin/ldconfig
+
+%files
+%defattr(-, root, root)
+%doc AUTHORS COPYING* README
+%{_libdir}/*.so.*
+
+%files bin
+%defattr(-, root, root)
+%attr(755,root,root) %{_bindir}/embryo_cc
+%{_datadir}/embryo/include
+
+%files devel
+%defattr(-, root, root)
+%{_libdir}/*.so
+%{_libdir}/*.la
+%{_libdir}/*.a
+%{_libdir}/pkgconfig/*
+%{_includedir}/embryo-1/*.h
+
+%changelog
--- /dev/null
+MAINTAINERCLEANFILES = Makefile.in
+
+filesdir = $(datadir)/embryo/include
+files_DATA = \
+default.inc
+
+EXTRA_DIST = $(files_DATA)
--- /dev/null
+/* Float arithmetic
+ *
+ * (c) Copyright 1999, Artran, Inc.
+ * Written by Greg Garner (gmg@artran.com)
+ * Modified in March 2001 to include user defined
+ * operators for the floating point functions.
+ * (c) Copyright 2004, Carsten Haitzler
+ * Modified March 2004 by Carsten Haitzler <raster@rasterman.com> to conform
+ * to E coding style
+ * Became default include for embryo...
+ * Added string functions
+ * Added rand functions
+ * Added time functions
+ *
+ * This file is provided as is (no warranties).
+ */
+#if defined DEFAULT_INC
+#endinput
+#endif
+#define DEFAULT_INC
+
+#pragma rational Float
+
+#define PI 3.1415926535897932384626433832795
+
+/* Different methods of rounding */
+enum Float_Round_Method
+{
+ ROUND, FLOOR, CEIL, TOZERO
+};
+/* different angle addressing modes (default is radians) */
+enum Float_Angle_Mode
+{
+ RADIAN, DEGREES, GRADES
+};
+
+/* varags - get numebr of args to a function */
+native numargs();
+/* varags - get arg no "arg" */
+native getarg(arg, index=0);
+native getsarg(arg, buf[], buflen);
+native Float:getfarg(arg, index=0);
+/* varags - set arg no "arg" */
+native setarg(arg, index=0, value);
+native setfarg(arg, index=0, Float:value);
+
+/* Convert a string into a floating point value */
+native Float:atof(const string[]);
+/* Return the fractional part of a float */
+native Float:fract(Float:value);
+/* Round a float into a integer value */
+native round(Float:value, Float_Round_Method:method=ROUND);
+/* Return the square root of value, same as float_power(value, 0.5) */
+native Float:sqrt(Float:value);
+/* Return the value raised to the power of the exponent */
+native Float:pow(Float:value, Float:exponent);
+/* Return the logarithm */
+native Float:log(Float:value, Float:base=10.0);
+/* Return the sine, cosine or tangent. The input angle may be in radian*/
+/* degrees or grades. */
+native Float:sin(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:cos(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:tan(Float:value, Float_Angle_Mode:mode=RADIAN);
+/* Return the absolute value */
+native Float:abs(Float:value);
+/* return integer from string */
+native atoi(str[]);
+/* return 0 if string matches glob, non-zero otherwise */
+native fnmatch(glob[], str[]);
+/* same as strcmp() */
+native strcmp(str1[], str2[]);
+/* same as strncmp */
+native strncmp(str1[], str2[], n);
+/* same as strcpy */
+native strcpy(dst[], src[]);
+/* same as strncpy except it nul terminates */
+native strncpy(dst[], src[], n);
+/* same as strlen */
+native strlen(str[]);
+/* same as strcat */
+native strcat(dst[], src[]);
+/* same as strncat except it nul terminates */
+native strncat(dst[], src[], n);
+/* prepends src string onto start of dst string */
+native strprep(dst[], src[]);
+/* prepends at most n chars from src string onto dst string */
+native strnprep(dst[], src[], n);
+/* cuts chars from char n to (not including) n2, and puts them in str */
+native strcut(dst[], str[], n, n2);
+/* same as snprintf, except only supports %%, %c, %i, %d, %f, %x, %X, %s, \n and \t */
+native snprintf(dst[], dstn, fmt[], ...);
+/* same as strstr */
+native strstr(str[], ndl[]);
+/* same as strchr, except ch must be a 1 charater long string, and returns string index */
+native strchr(str[], ch[]);
+/* same as strrchr, except ch must be a 1 charater long string and returns string index */
+native strrchr(str[], ch[]);
+/* return random number 0 - 65535 */
+native rand();
+/* return random number 0.0 - 1.0 */
+native Float:randf();
+/* return seconds since midnight as a float */
+native Float:seconds();
+/* return the current date, year, time etc. in the variables provided */
+native date(&year, &month, &day, &yearday, &weekday, &hr, &min, &Float:sec);
+
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+
+/**************************************************/
+/* Hidden calls - all are overloaded on operators */
+/**************************************************/
+
+/* Convert an integer into a floating point value */
+native Float:float(value);
+/* Multiple two floats together */
+native Float:float_mul(Float:oper1, Float:oper2);
+/* Divide the dividend float by the divisor float */
+native Float:float_div(Float:dividend, Float:divisor);
+/* Add two floats together */
+native Float:float_add(Float:oper1, Float:oper2);
+/* Subtract oper2 float from oper1 float */
+native Float:float_sub(Float:oper1, Float:oper2);
+/* Compare two integers. If the two elements are equal, return 0. */
+/* If the first argument is greater than the second argument, return 1, */
+/* If the first argument is less than the second argument, return -1. */
+native float_cmp(Float:oper1, Float:oper2);
+/* user defined operators */
+native Float:operator*(Float:oper1, Float:oper2) = float_mul;
+native Float:operator/(Float:oper1, Float:oper2) = float_div;
+native Float:operator+(Float:oper1, Float:oper2) = float_add;
+native Float:operator-(Float:oper1, Float:oper2) = float_sub;
+native Float:operator=(oper) = float;
+stock Float:operator++(Float:oper)
+ return oper+1.0;
+stock Float:operator--(Float:oper)
+ return oper-1.0;
+stock Float:operator-(Float:oper)
+ return oper^Float:0x80000000; /* IEEE values are sign/magnitude */
+stock Float:operator*(Float:oper1, oper2)
+ return float_mul(oper1, float(oper2)); /* "*" is commutative */
+stock Float:operator/(Float:oper1, oper2)
+ return float_div(oper1, float(oper2));
+stock Float:operator/(oper1, Float:oper2)
+ return float_div(float(oper1), oper2);
+stock Float:operator+(Float:oper1, oper2)
+ return float_add(oper1, float(oper2)); /* "+" is commutative */
+stock Float:operator-(Float:oper1, oper2)
+ return float_sub(oper1, float(oper2));
+stock Float:operator-(oper1, Float:oper2)
+ return float_sub(float(oper1), oper2);
+stock bool:operator==(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) == 0;
+stock bool:operator==(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) == 0; /* "==" is commutative */
+stock bool:operator!=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) != 0;
+stock bool:operator!=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) != 0; /* "!=" is commutative */
+stock bool:operator>(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) > 0;
+stock bool:operator>(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) > 0;
+stock bool:operator>(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) > 0;
+stock bool:operator>=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) >= 0;
+stock bool:operator>=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) >= 0;
+stock bool:operator>=(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) >= 0;
+stock bool:operator<(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) < 0;
+stock bool:operator<(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) < 0;
+stock bool:operator<(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) < 0;
+stock bool:operator<=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) <= 0;
+stock bool:operator<=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) <= 0;
+stock bool:operator<=(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) <= 0;
+stock bool:operator!(Float:oper)
+ return (_:oper & 0x7fffffff) == 0;
+/* forbidden operations */
+forward operator%(Float:oper1, Float:oper2);
+forward operator%(Float:oper1, oper2);
+forward operator%(oper1, Float:oper2);
+
+/**************************************************************************/
+/* ADDED in embryo 1.2 */
+/**************************************************************************/
+/* use this to determine embryo age */
+#define EMBRYO_12 12
+/* Return the inverse sine, cosine or tangent. The output may be radians, */
+/* degrees or grades. */
+native Float:asin(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:acos(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:atan(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:atan2(Float:valuey, Float:valuex, Float_Angle_Mode:mode=RADIAN);
+/* same as libc functions */
+native Float:log1p(Float:value);
+native Float:cbrt(Float:value);
+native Float:exp(Float:value);
+native Float:exp2(Float:value);
+native Float:hypot(Float:valuex, Float:valuey);
--- /dev/null
+dnl Copyright (C) 2004-2008 Kim Woelders
+dnl Copyright (C) 2008 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+dnl Originally snatched from somewhere...
+
+dnl Macro for checking if the compiler supports __attribute__
+
+dnl Usage: AC_C___ATTRIBUTE__
+dnl call AC_DEFINE for HAVE___ATTRIBUTE__ and __UNUSED__
+dnl if the compiler supports __attribute__, HAVE___ATTRIBUTE__ is
+dnl defined to 1 and __UNUSED__ is defined to __attribute__((unused))
+dnl otherwise, HAVE___ATTRIBUTE__ is not defined and __UNUSED__ is
+dnl defined to nothing.
+
+AC_DEFUN([AC_C___ATTRIBUTE__],
+[
+
+AC_MSG_CHECKING([for __attribute__])
+
+AC_CACHE_VAL([ac_cv___attribute__],
+ [AC_TRY_COMPILE(
+ [
+#include <stdlib.h>
+
+int func(int x);
+int foo(int x __attribute__ ((unused)))
+{
+ exit(1);
+}
+ ],
+ [],
+ [ac_cv___attribute__="yes"],
+ [ac_cv___attribute__="no"]
+ )])
+
+AC_MSG_RESULT($ac_cv___attribute__)
+
+if test "x${ac_cv___attribute__}" = "xyes" ; then
+ AC_DEFINE([HAVE___ATTRIBUTE__], [1], [Define to 1 if your compiler has __attribute__])
+ AC_DEFINE([__UNUSED__], [__attribute__((unused))], [Macro declaring a function argument to be unused])
+ else
+ AC_DEFINE([__UNUSED__], [], [Macro declaring a function argument to be unused])
+fi
+
+])
+
+dnl End of ac_attribute.m4
--- /dev/null
+dnl Copyright (C) 2010 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if a binary is built or not
+
+dnl Usage: EFL_ENABLE_BIN(binary)
+dnl Call AC_SUBST(BINARY_PRG) (BINARY is the uppercase of binary, - being transformed into _)
+dnl Define have_binary (- is transformed into _)
+dnl Define conditional BUILD_BINARY (BINARY is the uppercase of binary, - being transformed into _)
+
+AC_DEFUN([EFL_ENABLE_BIN],
+[
+
+m4_pushdef([UP], m4_translit([[$1]], [-a-z], [_A-Z]))dnl
+m4_pushdef([DOWN], m4_translit([[$1]], [-A-Z], [_a-z]))dnl
+
+have_[]m4_defn([DOWN])="yes"
+
+dnl configure option
+
+AC_ARG_ENABLE([$1],
+ [AC_HELP_STRING([--disable-$1], [disable building of ]DOWN)],
+ [
+ if test "x${enableval}" = "xyes" ; then
+ have_[]m4_defn([DOWN])="yes"
+ else
+ have_[]m4_defn([DOWN])="no"
+ fi
+ ])
+
+AC_MSG_CHECKING([whether to build ]DOWN[ binary])
+AC_MSG_RESULT([$have_[]m4_defn([DOWN])])
+
+if test "x$have_[]m4_defn([DOWN])" = "xyes"; then
+ UP[]_PRG=DOWN[${EXEEXT}]
+fi
+
+AC_SUBST(UP[]_PRG)
+
+AM_CONDITIONAL(BUILD_[]UP, test "x$have_[]m4_defn([DOWN])" = "xyes")
+
+AS_IF([test "x$have_[]m4_defn([DOWN])" = "xyes"], [$2], [$3])
+
+])
--- /dev/null
+dnl Copyright (C) 2008 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if doxygen is available or not.
+
+dnl EFL_CHECK_DOXYGEN([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl Test for the doxygen program
+dnl Defines efl_doxygen
+dnl Defines the automake conditionnal EFL_BUILD_DOC
+dnl
+AC_DEFUN([EFL_CHECK_DOXYGEN],
+[
+
+dnl
+dnl Disable the build of the documentation
+dnl
+AC_ARG_ENABLE([doc],
+ [AC_HELP_STRING(
+ [--disable-doc],
+ [Disable documentation build @<:@default=enabled@:>@])],
+ [
+ if test "x${enableval}" = "xyes" ; then
+ efl_enable_doc="yes"
+ else
+ efl_enable_doc="no"
+ fi
+ ],
+ [efl_enable_doc="yes"])
+
+AC_MSG_CHECKING([whether to build documentation])
+AC_MSG_RESULT([${efl_enable_doc}])
+
+if test "x${efl_enable_doc}" = "xyes" ; then
+
+dnl Specify the file name, without path
+
+ efl_doxygen="doxygen"
+
+ AC_ARG_WITH([doxygen],
+ [AC_HELP_STRING(
+ [--with-doxygen=FILE],
+ [doxygen program to use @<:@default=doxygen@:>@])],
+
+dnl Check the given doxygen program.
+
+ [efl_doxygen=${withval}
+ AC_CHECK_PROG([efl_have_doxygen],
+ [${efl_doxygen}],
+ [yes],
+ [no])
+ if test "x${efl_have_doxygen}" = "xno" ; then
+ echo "WARNING:"
+ echo "The doxygen program you specified:"
+ echo "${efl_doxygen}"
+ echo "was not found. Please check the path and make sure "
+ echo "the program exists and is executable."
+ AC_MSG_WARN([no doxygen detected. Documentation will not be built])
+ fi
+ ],
+ [AC_CHECK_PROG([efl_have_doxygen],
+ [${efl_doxygen}],
+ [yes],
+ [no])
+ if test "x${efl_have_doxygen}" = "xno" ; then
+ echo "WARNING:"
+ echo "The doxygen program was not found in your execute path."
+ echo "You may have doxygen installed somewhere not covered by your path."
+ echo ""
+ echo "If this is the case make sure you have the packages installed, AND"
+ echo "that the doxygen program is in your execute path (see your"
+ echo "shell manual page on setting the \$PATH environment variable), OR"
+ echo "alternatively, specify the program to use with --with-doxygen."
+ AC_MSG_WARN([no doxygen detected. Documentation will not be built])
+ fi
+ ])
+fi
+
+dnl
+dnl Substitution
+dnl
+AC_SUBST([efl_doxygen])
+
+if ! test "x${efl_have_doxygen}" = "xyes" ; then
+ efl_enable_doc="no"
+fi
+
+AM_CONDITIONAL(EFL_BUILD_DOC, test "x${efl_enable_doc}" = "xyes")
+
+if test "x${efl_enable_doc}" = "xyes" ; then
+ m4_default([$1], [:])
+else
+ m4_default([$2], [:])
+fi
+
+])
+
+dnl End of efl_doxygen.m4
--- /dev/null
+dnl Copyright (C) 2010 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if fnmatch functions are available or not.
+
+dnl Usage: EFL_CHECK_FNMATCH([, ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl Call AC_SUBST(EFL_FNMATCH_LIBS)
+
+AC_DEFUN([EFL_CHECK_FNMATCH],
+[
+
+AC_CHECK_HEADER([fnmatch.h], [_efl_have_fnmatch="yes"], [_efl_have_fnmatch="no"])
+
+if test "x${_efl_have_fnmatch}" = "xyes" ; then
+ AC_SEARCH_LIBS([fnmatch],
+ [fnmatch evil exotic iberty],
+ [_efl_have_fnmatch="yes"],
+ [_efl_have_fnmatch="no"])
+fi
+
+EFL_FNMATCH_LIBS=""
+
+if (! test "x${ac_cv_search_fnmatch}" = "xnone required") && (! test "x${ac_cv_search_fnmatch}" = "xno") && (! test "x${ac_cv_search_fnmatch}" = "x-levil") ; then
+ EFL_FNMATCH_LIBS=${ac_cv_search_fnmatch}
+fi
+
+AC_SUBST(EFL_FNMATCH_LIBS)
+
+AS_IF([test "x$_efl_have_fnmatch" = "xyes"], [$1], [$2])
+
+])
--- /dev/null
+dnl Copyright (C) 2011 Cedric Bail <cedric.bail@free.fr>
+dnl This code is public domain and can be freely used or copied.
+
+dnl Macro that check for gettimeofday definition
+
+dnl Usage: EFL_CHECK_GETTIMEOFDAY(ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND])
+dnl Define EFL_HAVE_GETTIMEOFDAY
+
+AC_DEFUN([EFL_CHECK_GETTIMEOFDAY],
+[
+
+_efl_have_gettimeofday="no"
+
+AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[
+#include <stdlib.h>
+#include <sys/time.h>
+ ]],
+ [[
+int res;
+res = gettimeofday(NULL, NULL);
+ ]])],
+ [_efl_have_gettimeofday="yes"],
+ [_efl_have_gettimeofday="no"])
+
+if test "x${_efl_have_gettimeofday}" = "xno" -a "x${enable_exotic}" = "xyes"; then
+ SAVE_LIBS="${LIBS}"
+ SAVE_CFLAGS="${CFLAGS}"
+ LIBS="${LIBS} ${EXOTIC_LIBS}"
+ CFLAGS="${CFLAGS} ${EXOTIC_CFLAGS}"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[
+#include <Exotic.h>
+ ]],
+ [[
+int res;
+res = gettimeofday(NULL, NULL);
+ ]])],
+ [_efl_have_gettimeofday="yes"],
+ [_efl_have_gettimeofday="no"])
+fi
+
+if test "x${_efl_have_gettimeofday}" = "xyes"; then
+ AC_DEFINE([EFL_HAVE_GETTIMEOFDAY], [1], [Defined if gettimeofday is available.])
+fi
+
+AS_IF([test "x${_efl_have_gettimeofday}" = "xyes"], [$1], [$2])
+])
--- /dev/null
+dnl Check for PATH_MAX in limits.h, and define a default value if not found
+dnl This is a workaround for systems not providing PATH_MAX, like GNU/Hurd
+
+dnl EFL_CHECK_PATH_MAX([DEFAULT_VALUE_IF_NOT_FOUND])
+dnl
+dnl If PATH_MAX is not defined in <limits.h>, defines it
+dnl to DEFAULT_VALUE_IF_NOT_FOUND if it exists, or fallback
+dnl to using 4096
+
+AC_DEFUN([EFL_CHECK_PATH_MAX],
+[
+
+default_max=m4_default([$1], "4096")
+AC_LANG_PUSH([C])
+
+AC_MSG_CHECKING([for PATH_MAX in limits.h])
+AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+#include <limits.h>
+ ]],
+ [[
+int i = PATH_MAX;
+ ]])],
+ [AC_MSG_RESULT([yes])],
+ [
+ AC_DEFINE_UNQUOTED([PATH_MAX],
+ [${default_max}],
+ [default value since PATH_MAX is not defined])
+ AC_MSG_RESULT([no: using ${default_max}])
+ ])
+
+AC_LANG_POP([C])
+
+])
+dnl end of efl_path_max.m4
--- /dev/null
+MAINTAINERCLEANFILES = Makefile.in
+
+SUBDIRS = lib bin
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir) \
+-I$(top_builddir) \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EINA_CFLAGS@ \
+@EVIL_CFLAGS@
+
+bin_PROGRAMS = @EMBRYO_CC_PRG@
+EXTRA_PROGRAMS = embryo_cc
+
+embryo_cc_SOURCES = \
+embryo_cc_amx.h \
+embryo_cc_sc.h \
+embryo_cc_sc1.c \
+embryo_cc_sc2.c \
+embryo_cc_sc3.c \
+embryo_cc_sc4.c \
+embryo_cc_sc5.c \
+embryo_cc_sc6.c \
+embryo_cc_sc7.c \
+embryo_cc_scexpand.c \
+embryo_cc_sclist.c \
+embryo_cc_scvars.c \
+embryo_cc_prefix.c \
+embryo_cc_prefix.h
+
+embryo_cc_CFLAGS = @EMBRYO_CFLAGS@
+embryo_cc_LDADD = $(top_builddir)/src/lib/libembryo.la @EVIL_LIBS@ @EINA_LIBS@ -lm
+embryo_cc_LDFLAGS = @lt_enable_auto_import@
+
+EXTRA_DIST = \
+embryo_cc_sc5.scp \
+embryo_cc_sc7.scp
--- /dev/null
+/* Abstract Machine for the Small compiler
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+#ifndef EMBRYO_CC_AMX_H
+#define EMBRYO_CC_AMX_H
+
+#include <sys/types.h>
+
+/* calling convention for all interface functions and callback functions */
+
+/* File format version Required AMX version
+ * 0 (original version) 0
+ * 1 (opcodes JUMP.pri, SWITCH and CASETBL) 1
+ * 2 (compressed files) 2
+ * 3 (public variables) 2
+ * 4 (opcodes SWAP.pri/alt and PUSHADDR) 4
+ * 5 (tagnames table) 4
+ * 6 (reformatted header) 6
+ * 7 (name table, opcodes SYMTAG & SYSREQ.D) 7
+ */
+#define CUR_FILE_VERSION 7 /* current file version; also the current AMX version */
+#define MIN_FILE_VERSION 6 /* lowest supported file format version for the current AMX version */
+#define MIN_AMX_VERSION 7 /* minimum AMX version needed to support the current file format */
+
+#if !defined CELL_TYPE
+#define CELL_TYPE
+ typedef unsigned int ucell;
+ typedef int cell;
+#endif
+
+ struct tagAMX;
+ typedef cell(*AMX_NATIVE) (struct tagAMX * amx,
+ cell * params);
+ typedef int (* AMX_CALLBACK) (struct tagAMX * amx, cell index,
+ cell * result, cell * params);
+ typedef int (* AMX_DEBUG) (struct tagAMX * amx);
+
+ typedef struct
+ {
+ char *name;
+ AMX_NATIVE func ;
+ } AMX_NATIVE_INFO ;
+
+#define AMX_USERNUM 4
+#define sEXPMAX 19 /* maximum name length for file version <= 6 */
+#define sNAMEMAX 31 /* maximum name length of symbol name */
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+ typedef struct tagAMX_FUNCSTUB
+ {
+ unsigned int address;
+ char name[sEXPMAX + 1];
+ } EMBRYO_STRUCT_PACKED AMX_FUNCSTUB;
+
+/* The AMX structure is the internal structure for many functions. Not all
+ * fields are valid at all times; many fields are cached in local variables.
+ */
+ typedef struct tagAMX
+ {
+ unsigned char *base; /* points to the AMX header ("amxhdr") plus the code, optionally also the data */
+ unsigned char *data; /* points to separate data+stack+heap, may be NULL */
+ AMX_CALLBACK callback;
+ AMX_DEBUG debug ; /* debug callback */
+ /* for external functions a few registers must be accessible from the outside */
+ cell cip ; /* instruction pointer: relative to base + amxhdr->cod */
+ cell frm ; /* stack frame base: relative to base + amxhdr->dat */
+ cell hea ; /* top of the heap: relative to base + amxhdr->dat */
+ cell hlw ; /* bottom of the heap: relative to base + amxhdr->dat */
+ cell stk ; /* stack pointer: relative to base + amxhdr->dat */
+ cell stp ; /* top of the stack: relative to base + amxhdr->dat */
+ int flags ; /* current status, see amx_Flags() */
+ /* for assertions and debug hook */
+ cell curline ;
+ cell curfile ;
+ int dbgcode ;
+ cell dbgaddr ;
+ cell dbgparam ;
+ char *dbgname;
+ /* user data */
+ long usertags[AMX_USERNUM];
+ void *userdata[AMX_USERNUM];
+ /* native functions can raise an error */
+ int error ;
+ /* the sleep opcode needs to store the full AMX status */
+ cell pri ;
+ cell alt ;
+ cell reset_stk ;
+ cell reset_hea ;
+ cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
+ } EMBRYO_STRUCT_PACKED AMX;
+
+/* The AMX_HEADER structure is both the memory format as the file format. The
+ * structure is used internaly.
+ */
+ typedef struct tagAMX_HEADER
+ {
+ int size ; /* size of the "file" */
+ unsigned short magic ; /* signature */
+ char file_version ; /* file format version */
+ char amx_version ; /* required version of the AMX */
+ unsigned short flags ;
+ unsigned short defsize ; /* size of a definition record */
+ int cod ; /* initial value of COD - code block */
+ int dat ; /* initial value of DAT - data block */
+ int hea ; /* initial value of HEA - start of the heap */
+ int stp ; /* initial value of STP - stack top */
+ int cip ; /* initial value of CIP - the instruction pointer */
+ int publics ; /* offset to the "public functions" table */
+ int natives ; /* offset to the "native functions" table */
+ int libraries ; /* offset to the table of libraries */
+ int pubvars ; /* the "public variables" table */
+ int tags ; /* the "public tagnames" table */
+ int nametable ; /* name table, file version 7 only */
+ } EMBRYO_STRUCT_PACKED AMX_HEADER;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+#define AMX_MAGIC 0xf1e0
+
+ enum
+ {
+ AMX_ERR_NONE,
+ /* reserve the first 15 error codes for exit codes of the abstract machine */
+ AMX_ERR_EXIT, /* forced exit */
+ AMX_ERR_ASSERT, /* assertion failed */
+ AMX_ERR_STACKERR, /* stack/heap collision */
+ AMX_ERR_BOUNDS, /* index out of bounds */
+ AMX_ERR_MEMACCESS, /* invalid memory access */
+ AMX_ERR_INVINSTR, /* invalid instruction */
+ AMX_ERR_STACKLOW, /* stack underflow */
+ AMX_ERR_HEAPLOW, /* heap underflow */
+ AMX_ERR_CALLBACK, /* no callback, or invalid callback */
+ AMX_ERR_NATIVE, /* native function failed */
+ AMX_ERR_DIVIDE, /* divide by zero */
+ AMX_ERR_SLEEP, /* go into sleepmode - code can be restarted */
+
+ AMX_ERR_MEMORY = 16, /* out of memory */
+ AMX_ERR_FORMAT, /* invalid file format */
+ AMX_ERR_VERSION, /* file is for a newer version of the AMX */
+ AMX_ERR_NOTFOUND, /* function not found */
+ AMX_ERR_INDEX, /* invalid index parameter (bad entry point) */
+ AMX_ERR_DEBUG, /* debugger cannot run */
+ AMX_ERR_INIT, /* AMX not initialized (or doubly initialized) */
+ AMX_ERR_USERDATA, /* unable to set user data field (table full) */
+ AMX_ERR_INIT_JIT, /* cannot initialize the JIT */
+ AMX_ERR_PARAMS, /* parameter error */
+ AMX_ERR_DOMAIN, /* domain error, expression result does not fit in range */
+ };
+
+ enum
+ {
+ DBG_INIT, /* query/initialize */
+ DBG_FILE, /* file number in curfile, filename in name */
+ DBG_LINE, /* line number in curline, file number in curfile */
+ DBG_SYMBOL, /* address in dbgaddr, class/type in dbgparam */
+ DBG_CLRSYM, /* stack address below which locals should be removed. stack address in stk */
+ DBG_CALL, /* function call, address jumped to in dbgaddr */
+ DBG_RETURN, /* function returns */
+ DBG_TERMINATE, /* program ends, code address in dbgaddr, reason in dbgparam */
+ DBG_SRANGE, /* symbol size and dimensions (arrays); level in dbgaddr (!); length in dbgparam */
+ DBG_SYMTAG, /* tag of the most recent symbol (if non-zero), tag in dbgparam */
+ };
+
+#define AMX_FLAG_CHAR16 0x01 /* characters are 16-bit */
+#define AMX_FLAG_DEBUG 0x02 /* symbolic info. available */
+#define AMX_FLAG_COMPACT 0x04 /* compact encoding */
+#define AMX_FLAG_BIGENDIAN 0x08 /* big endian encoding */
+#define AMX_FLAG_NOCHECKS 0x10 /* no array bounds checking */
+#define AMX_FLAG_BROWSE 0x4000 /* browsing/relocating or executing */
+#define AMX_FLAG_RELOC 0x8000 /* jump/call addresses relocated */
+
+#define AMX_EXEC_MAIN -1 /* start at program entry point */
+#define AMX_EXEC_CONT -2 /* continue from last address */
+
+#define AMX_USERTAG(a,b,c,d) ((a) | ((b)<<8) | ((long)(c)<<16) | ((long)(d)<<24))
+
+#define AMX_EXPANDMARGIN 64
+
+/* for native functions that use floating point parameters, the following
+ * two macros are convenient for casting a "cell" into a "float" type _without_
+ * changing the bit pattern
+ */
+#define amx_ftoc(f) ( * ((cell*)&f) ) /* float to cell */
+#define amx_ctof(c) ( * ((float*)&c) ) /* cell to float */
+
+#define amx_StrParam(amx,param,result) { \
+ cell *amx_cstr_; int amx_length_; \
+ amx_GetAddr((amx), (param), &amx_cstr_); \
+ amx_StrLen(amx_cstr_, &amx_length_); \
+ if (amx_length_ > 0 && \
+ ((result) = (char *)alloca(amx_length_ + 1))) \
+ amx_GetString((result), amx_cstr_); \
+ else (result) = NULL; \
+}
+
+#endif /* __AMX_H */
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <Eina.h>
+
+#include "embryo_cc_prefix.h"
+
+/* local subsystem functions */
+
+/* local subsystem globals */
+
+static Eina_Prefix *pfx = NULL;
+
+/* externally accessible functions */
+int
+e_prefix_determine(char *argv0)
+{
+ if (pfx) return 1;
+ eina_init();
+ pfx = eina_prefix_new(argv0, e_prefix_determine,
+ "EMBRYO", "embryo", "include/default.inc",
+ PACKAGE_BIN_DIR,
+ PACKAGE_LIB_DIR,
+ PACKAGE_DATA_DIR,
+ PACKAGE_DATA_DIR);
+ if (!pfx) return 0;
+ return 1;
+}
+
+void
+e_prefix_shutdown(void)
+{
+ eina_prefix_free(pfx);
+ pfx = NULL;
+ eina_shutdown();
+}
+
+const char *
+e_prefix_get(void)
+{
+ return eina_prefix_get(pfx);
+}
+
+const char *
+e_prefix_bin_get(void)
+{
+ return eina_prefix_bin_get(pfx);
+}
+
+const char *
+e_prefix_data_get(void)
+{
+ return eina_prefix_data_get(pfx);
+}
+
+const char *
+e_prefix_lib_get(void)
+{
+ return eina_prefix_lib_get(pfx);
+}
--- /dev/null
+int e_prefix_determine(char *argv0);
+void e_prefix_shutdown(void);
+const char *e_prefix_get(void);
+const char *e_prefix_bin_get(void);
+const char *e_prefix_data_get(void);
+const char *e_prefix_lib_get(void);
--- /dev/null
+/* Small compiler
+ *
+ * Drafted after the Small-C compiler Version 2.01, originally created
+ * by Ron Cain, july 1980, and enhanced by James E. Hendrix.
+ *
+ * This version comes close to a complete rewrite.
+ *
+ * Copyright R. Cain, 1980
+ * Copyright J.E. Hendrix, 1982, 1983
+ * Copyright T. Riemersma, 1997-2003
+ *
+ * Version: $Id$
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+#ifndef EMBRYO_CC_SC_H
+#define EMBRYO_CC_SC_H
+
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <setjmp.h>
+
+#ifndef _MSC_VER
+# include <stdint.h>
+#else
+# include <stddef.h>
+# include <Evil.h>
+#endif
+
+#include "embryo_cc_amx.h"
+
+/* Note: the "cell" and "ucell" types are defined in AMX.H */
+
+#define PUBLIC_CHAR '@' /* character that defines a function "public" */
+#define CTRL_CHAR '\\' /* default control character */
+
+#define DIRSEP_CHAR '/' /* directory separator character */
+
+#define sDIMEN_MAX 2 /* maximum number of array dimensions */
+#define sDEF_LITMAX 500 /* initial size of the literal pool, in "cells" */
+#define sLINEMAX (640 * 1024) /* input line length (in characters) */
+#define sDEF_AMXSTACK 4096 /* default stack size for AMX files */
+#define sSTKMAX 80 /* stack for nested #includes and other uses */
+#define PREPROC_TERM '\x7f' /* termination character for preprocessor expressions (the "DEL" code) */
+#define sDEF_PREFIX "default.inc" /* default prefix filename */
+
+typedef intptr_t stkitem; /* type of items stored on the stack */
+
+typedef struct __s_arginfo
+{ /* function argument info */
+ char name[sNAMEMAX + 1];
+ char ident; /* iVARIABLE, iREFERENCE, iREFARRAY or iVARARGS */
+ char usage; /* uCONST */
+ int *tags; /* argument tag id. list */
+ int numtags; /* number of tags in the tag list */
+ int dim[sDIMEN_MAX];
+ int numdim; /* number of dimensions */
+ unsigned char hasdefault; /* bit0: is there a default value? bit6: "tagof"; bit7: "sizeof" */
+ union
+ {
+ cell val; /* default value */
+ struct
+ {
+ char *symname; /* name of another symbol */
+ short level; /* indirection level for that symbol */
+ } size; /* used for "sizeof" default value */
+ struct
+ {
+ cell *data; /* values of default array */
+ int size; /* complete length of default array */
+ int arraysize; /* size to reserve on the heap */
+ cell addr; /* address of the default array in the data segment */
+ } array;
+ } defvalue; /* default value, or pointer to default array */
+ int defvalue_tag; /* tag of the default value */
+} arginfo;
+
+/* Equate table, tagname table, library table */
+typedef struct __s_constvalue
+{
+ struct __s_constvalue *next;
+ char name[sNAMEMAX + 1];
+ cell value;
+ short index;
+} constvalue;
+
+/* Symbol table format
+ *
+ * The symbol name read from the input file is stored in "name", the
+ * value of "addr" is written to the output file. The address in "addr"
+ * depends on the class of the symbol:
+ * global offset into the data segment
+ * local offset relative to the stack frame
+ * label generated hexadecimal number
+ * function offset into code segment
+ */
+typedef struct __s_symbol
+{
+ struct __s_symbol *next;
+ struct __s_symbol *parent; /* hierarchical types (multi-dimensional arrays) */
+ char name[sNAMEMAX + 1];
+ unsigned int hash; /* value derived from name, for quicker searching */
+ cell addr; /* address or offset (or value for constant, index for native function) */
+ char vclass; /* sLOCAL if "addr" refers to a local symbol */
+ char ident; /* see below for possible values */
+ char usage; /* see below for possible values */
+ int compound; /* compound level (braces nesting level) */
+ int tag; /* tagname id */
+ union
+ {
+ int declared; /* label: how many local variables are declared */
+ int idxtag; /* array: tag of array indices */
+ constvalue *lib; /* native function: library it is part of *///??? use "stringlist"
+ } x; /* 'x' for 'extra' */
+ union
+ {
+ arginfo *arglist; /* types of all parameters for functions */
+ struct
+ {
+ cell length; /* arrays: length (size) */
+ short level; /* number of dimensions below this level */
+ } array;
+ } dim; /* for 'dimension', both functions and arrays */
+ int fnumber; /* static global variables: file number in which the declaration is visible */
+ struct __s_symbol **refer; /* referrer list, functions that "use" this symbol */
+ int numrefers; /* number of entries in the referrer list */
+} symbol;
+
+/* Possible entries for "ident". These are used in the "symbol", "value"
+ * and arginfo structures. Not every constant is valid for every use.
+ * In an argument list, the list is terminated with a "zero" ident; labels
+ * cannot be passed as function arguments, so the value 0 is overloaded.
+ */
+#define iLABEL 0
+#define iVARIABLE 1 /* cell that has an address and that can be fetched directly (lvalue) */
+#define iREFERENCE 2 /* iVARIABLE, but must be dereferenced */
+#define iARRAY 3
+#define iREFARRAY 4 /* an array passed by reference (i.e. a pointer) */
+#define iARRAYCELL 5 /* array element, cell that must be fetched indirectly */
+#define iARRAYCHAR 6 /* array element, character from cell from array */
+#define iEXPRESSION 7 /* expression result, has no address (rvalue) */
+#define iCONSTEXPR 8 /* constant expression (or constant symbol) */
+#define iFUNCTN 9
+#define iREFFUNC 10 /* function passed as a parameter */
+#define iVARARGS 11 /* function specified ... as argument(s) */
+
+/* Possible entries for "usage"
+ *
+ * This byte is used as a serie of bits, the syntax is different for
+ * functions and other symbols:
+ *
+ * VARIABLE
+ * bits: 0 (uDEFINE) the variable is defined in the source file
+ * 1 (uREAD) the variable is "read" (accessed) in the source file
+ * 2 (uWRITTEN) the variable is altered (assigned a value)
+ * 3 (uCONST) the variable is constant (may not be assigned to)
+ * 4 (uPUBLIC) the variable is public
+ * 6 (uSTOCK) the variable is discardable (without warning)
+ *
+ * FUNCTION
+ * bits: 0 (uDEFINE) the function is defined ("implemented") in the source file
+ * 1 (uREAD) the function is invoked in the source file
+ * 2 (uRETVALUE) the function returns a value (or should return a value)
+ * 3 (uPROTOTYPED) the function was prototyped
+ * 4 (uPUBLIC) the function is public
+ * 5 (uNATIVE) the function is native
+ * 6 (uSTOCK) the function is discardable (without warning)
+ * 7 (uMISSING) the function is not implemented in this source file
+ *
+ * CONSTANT
+ * bits: 0 (uDEFINE) the symbol is defined in the source file
+ * 1 (uREAD) the constant is "read" (accessed) in the source file
+ * 3 (uPREDEF) the constant is pre-defined and should be kept between passes
+ */
+#define uDEFINE 0x01
+#define uREAD 0x02
+#define uWRITTEN 0x04
+#define uRETVALUE 0x04 /* function returns (or should return) a value */
+#define uCONST 0x08
+#define uPROTOTYPED 0x08
+#define uPREDEF 0x08 /* constant is pre-defined */
+#define uPUBLIC 0x10
+#define uNATIVE 0x20
+#define uSTOCK 0x40
+#define uMISSING 0x80
+/* uRETNONE is not stored in the "usage" field of a symbol. It is
+ * used during parsing a function, to detect a mix of "return;" and
+ * "return value;" in a few special cases.
+ */
+#define uRETNONE 0x10
+
+#define uTAGOF 0x40 /* set in the "hasdefault" field of the arginfo struct */
+#define uSIZEOF 0x80 /* set in the "hasdefault" field of the arginfo struct */
+
+#define uMAINFUNC "main"
+
+#define sGLOBAL 0 /* global/local variable/constant class */
+#define sLOCAL 1
+#define sSTATIC 2 /* global life, local scope */
+
+typedef struct
+{
+ symbol *sym; /* symbol in symbol table, NULL for (constant) expression */
+ cell constval; /* value of the constant expression (if ident==iCONSTEXPR)
+ * also used for the size of a literal array */
+ int tag; /* tagname id (of the expression) */
+ char ident; /* iCONSTEXPR, iVARIABLE, iARRAY, iARRAYCELL,
+ * iEXPRESSION or iREFERENCE */
+ char boolresult; /* boolean result for relational operators */
+ cell *arrayidx; /* last used array indices, for checking self assignment */
+} value;
+
+/* "while" statement queue (also used for "for" and "do - while" loops) */
+enum
+{
+ wqBRK, /* used to restore stack for "break" */
+ wqCONT, /* used to restore stack for "continue" */
+ wqLOOP, /* loop start label number */
+ wqEXIT, /* loop exit label number (jump if false) */
+ /* --- */
+ wqSIZE /* "while queue" size */
+};
+
+#define wqTABSZ (24*wqSIZE) /* 24 nested loop statements */
+
+enum
+{
+ statIDLE, /* not compiling yet */
+ statFIRST, /* first pass */
+ statWRITE, /* writing output */
+ statSKIP, /* skipping output */
+};
+
+typedef struct __s_stringlist
+{
+ struct __s_stringlist *next;
+ char *line;
+} stringlist;
+
+typedef struct __s_stringpair
+{
+ struct __s_stringpair *next;
+ char *first;
+ char *second;
+ int matchlength;
+} stringpair;
+
+/* macros for code generation */
+#define opcodes(n) ((n)*sizeof(cell)) /* opcode size */
+#define opargs(n) ((n)*sizeof(cell)) /* size of typical argument */
+
+/* Tokens recognized by lex()
+ * Some of these constants are assigned as well to the variable "lastst"
+ */
+#define tFIRST 256 /* value of first multi-character operator */
+#define tMIDDLE 279 /* value of last multi-character operator */
+#define tLAST 320 /* value of last multi-character match-able token */
+/* multi-character operators */
+#define taMULT 256 /* *= */
+#define taDIV 257 /* /= */
+#define taMOD 258 /* %= */
+#define taADD 259 /* += */
+#define taSUB 260 /* -= */
+#define taSHL 261 /* <<= */
+#define taSHRU 262 /* >>>= */
+#define taSHR 263 /* >>= */
+#define taAND 264 /* &= */
+#define taXOR 265 /* ^= */
+#define taOR 266 /* |= */
+#define tlOR 267 /* || */
+#define tlAND 268 /* && */
+#define tlEQ 269 /* == */
+#define tlNE 270 /* != */
+#define tlLE 271 /* <= */
+#define tlGE 272 /* >= */
+#define tSHL 273 /* << */
+#define tSHRU 274 /* >>> */
+#define tSHR 275 /* >> */
+#define tINC 276 /* ++ */
+#define tDEC 277 /* -- */
+#define tELLIPS 278 /* ... */
+#define tDBLDOT 279 /* .. */
+/* reserved words (statements) */
+#define tASSERT 280
+#define tBREAK 281
+#define tCASE 282
+#define tCHAR 283
+#define tCONST 284
+#define tCONTINUE 285
+#define tDEFAULT 286
+#define tDEFINED 287
+#define tDO 288
+#define tELSE 289
+#define tENUM 290
+#define tEXIT 291
+#define tFOR 292
+#define tFORWARD 293
+#define tGOTO 294
+#define tIF 295
+#define tNATIVE 296
+#define tNEW 297
+#define tOPERATOR 298
+#define tPUBLIC 299
+#define tRETURN 300
+#define tSIZEOF 301
+#define tSLEEP 302
+#define tSTATIC 303
+#define tSTOCK 304
+#define tSWITCH 305
+#define tTAGOF 306
+#define tWHILE 307
+/* compiler directives */
+#define tpASSERT 308 /* #assert */
+#define tpDEFINE 309
+#define tpELSE 310 /* #else */
+#define tpEMIT 311
+#define tpENDIF 312
+#define tpENDINPUT 313
+#define tpENDSCRPT 314
+#define tpFILE 315
+#define tpIF 316 /* #if */
+#define tINCLUDE 317
+#define tpLINE 318
+#define tpPRAGMA 319
+#define tpUNDEF 320
+/* semicolon is a special case, because it can be optional */
+#define tTERM 321 /* semicolon or newline */
+#define tENDEXPR 322 /* forced end of expression */
+/* other recognized tokens */
+#define tNUMBER 323 /* integer number */
+#define tRATIONAL 324 /* rational number */
+#define tSYMBOL 325
+#define tLABEL 326
+#define tSTRING 327
+#define tEXPR 328 /* for assigment to "lastst" only */
+
+/* (reversed) evaluation of staging buffer */
+#define sSTARTREORDER 1
+#define sENDREORDER 2
+#define sEXPRSTART 0xc0 /* top 2 bits set, rest is free */
+#define sMAXARGS 64 /* relates to the bit pattern of sEXPRSTART */
+
+/* codes for ffabort() */
+#define xEXIT 1 /* exit code in PRI */
+#define xASSERTION 2 /* abort caused by failing assertion */
+#define xSTACKERROR 3 /* stack/heap overflow */
+#define xBOUNDSERROR 4 /* array index out of bounds */
+#define xMEMACCESS 5 /* data access error */
+#define xINVINSTR 6 /* invalid instruction */
+#define xSTACKUNDERFLOW 7 /* stack underflow */
+#define xHEAPUNDERFLOW 8 /* heap underflow */
+#define xCALLBACKERR 9 /* no, or invalid, callback */
+#define xSLEEP 12 /* sleep, exit code in PRI, tag in ALT */
+
+/* Miscellaneous */
+#if !defined TRUE
+#define FALSE 0
+#define TRUE 1
+#endif
+#define sIN_CSEG 1 /* if parsing CODE */
+#define sIN_DSEG 2 /* if parsing DATA */
+#define sCHKBOUNDS 1 /* bit position in "debug" variable: check bounds */
+#define sSYMBOLIC 2 /* bit position in "debug" variable: symbolic info */
+#define sNOOPTIMIZE 4 /* bit position in "debug" variable: no optimization */
+#define sRESET 0 /* reset error flag */
+#define sFORCESET 1 /* force error flag on */
+#define sEXPRMARK 2 /* mark start of expression */
+#define sEXPRRELEASE 3 /* mark end of expression */
+
+#if INT_MAX<0x8000u
+#define PUBLICTAG 0x8000u
+#define FIXEDTAG 0x4000u
+#else
+#define PUBLICTAG 0x80000000Lu
+#define FIXEDTAG 0x40000000Lu
+#endif
+#define TAGMASK (~PUBLICTAG)
+
+
+/*
+ * Functions you call from the "driver" program
+ */
+ int sc_compile(int argc, char **argv);
+ int sc_addconstant(char *name, cell value, int tag);
+ int sc_addtag(char *name);
+
+/*
+ * Functions called from the compiler (to be implemented by you)
+ */
+
+/* general console output */
+ int sc_printf(const char *message, ...);
+
+/* error report function */
+ int sc_error(int number, char *message, char *filename,
+ int firstline, int lastline, va_list argptr);
+
+/* input from source file */
+ void *sc_opensrc(char *filename); /* reading only */
+ void sc_closesrc(void *handle); /* never delete */
+ void sc_resetsrc(void *handle, void *position); /* reset to a position marked earlier */
+ char *sc_readsrc(void *handle, char *target, int maxchars);
+ void *sc_getpossrc(void *handle); /* mark the current position */
+ int sc_eofsrc(void *handle);
+
+/* output to intermediate (.ASM) file */
+ void *sc_openasm(int fd); /* read/write */
+ void sc_closeasm(void *handle);
+ void sc_resetasm(void *handle);
+ int sc_writeasm(void *handle, char *str);
+ char *sc_readasm(void *handle, char *target, int maxchars);
+
+/* output to binary (.AMX) file */
+ void *sc_openbin(char *filename);
+ void sc_closebin(void *handle, int deletefile);
+ void sc_resetbin(void *handle);
+ int sc_writebin(void *handle, void *buffer, int size);
+ long sc_lengthbin(void *handle); /* return the length of the file */
+
+/* function prototypes in SC1.C */
+symbol *fetchfunc(char *name, int tag);
+char *operator_symname(char *symname, char *opername, int tag1,
+ int tag2, int numtags, int resulttag);
+char *funcdisplayname(char *dest, char *funcname);
+int constexpr(cell * val, int *tag);
+constvalue *append_constval(constvalue * table, char *name, cell val,
+ short index);
+constvalue *find_constval(constvalue * table, char *name, short index);
+void delete_consttable(constvalue * table);
+void add_constant(char *name, cell val, int vclass, int tag);
+void exporttag(int tag);
+
+/* function prototypes in SC2.C */
+void pushstk(stkitem val);
+stkitem popstk(void);
+int plungequalifiedfile(char *name); /* explicit path included */
+int plungefile(char *name, int try_currentpath, int try_includepaths); /* search through "include" paths */
+void preprocess(void);
+void lexinit(void);
+int lex(cell * lexvalue, char **lexsym);
+void lexpush(void);
+void lexclr(int clreol);
+int matchtoken(int token);
+int tokeninfo(cell * val, char **str);
+int needtoken(int token);
+void stowlit(cell value);
+int alphanum(char c);
+void delete_symbol(symbol * root, symbol * sym);
+void delete_symbols(symbol * root, int level, int del_labels,
+ int delete_functions);
+int refer_symbol(symbol * entry, symbol * bywhom);
+void markusage(symbol * sym, int usage);
+unsigned int namehash(char *name);
+symbol *findglb(char *name);
+symbol *findloc(char *name);
+symbol *findconst(char *name);
+symbol *finddepend(symbol * parent);
+symbol *addsym(char *name, cell addr, int ident, int vclass,
+ int tag, int usage);
+symbol *addvariable(char *name, cell addr, int ident, int vclass,
+ int tag, int dim[], int numdim, int idxtag[]);
+int getlabel(void);
+char *itoh(ucell val);
+
+/* function prototypes in SC3.C */
+int check_userop(void (*oper) (void), int tag1, int tag2,
+ int numparam, value * lval, int *resulttag);
+int matchtag(int formaltag, int actualtag, int allowcoerce);
+int expression(int *constant, cell * val, int *tag,
+ int chkfuncresult);
+int hier14(value * lval1); /* the highest expression level */
+
+/* function prototypes in SC4.C */
+void writeleader(void);
+void writetrailer(void);
+void begcseg(void);
+void begdseg(void);
+void setactivefile(int fnumber);
+cell nameincells(char *name);
+void setfile(char *name, int fileno);
+void setline(int line, int fileno);
+void setlabel(int index);
+void endexpr(int fullexpr);
+void startfunc(char *fname);
+void endfunc(void);
+void alignframe(int numbytes);
+void defsymbol(char *name, int ident, int vclass, cell offset,
+ int tag);
+void symbolrange(int level, cell size);
+void rvalue(value * lval);
+void address(symbol * ptr);
+void store(value * lval);
+void memcopy(cell size);
+void copyarray(symbol * sym, cell size);
+void fillarray(symbol * sym, cell size, cell value);
+void const1(cell val);
+void const2(cell val);
+void moveto1(void);
+void push1(void);
+void push2(void);
+void pushval(cell val);
+void pop1(void);
+void pop2(void);
+void swap1(void);
+void ffswitch(int label);
+void ffcase(cell value, char *labelname, int newtable);
+void ffcall(symbol * sym, int numargs);
+void ffret(void);
+void ffabort(int reason);
+void ffbounds(cell size);
+void jumplabel(int number);
+void defstorage(void);
+void modstk(int delta);
+void setstk(cell value);
+void modheap(int delta);
+void setheap_pri(void);
+void setheap(cell value);
+void cell2addr(void);
+void cell2addr_alt(void);
+void addr2cell(void);
+void char2addr(void);
+void charalign(void);
+void addconst(cell value);
+
+/* Code generation functions for arithmetic operators.
+ *
+ * Syntax: o[u|s|b]_name
+ * | | | +--- name of operator
+ * | | +----- underscore
+ * | +--------- "u"nsigned operator, "s"igned operator or "b"oth
+ * +------------- "o"perator
+ */
+void os_mult(void); /* multiplication (signed) */
+void os_div(void); /* division (signed) */
+void os_mod(void); /* modulus (signed) */
+void ob_add(void); /* addition */
+void ob_sub(void); /* subtraction */
+void ob_sal(void); /* shift left (arithmetic) */
+void os_sar(void); /* shift right (arithmetic, signed) */
+void ou_sar(void); /* shift right (logical, unsigned) */
+void ob_or(void); /* bitwise or */
+void ob_xor(void); /* bitwise xor */
+void ob_and(void); /* bitwise and */
+void ob_eq(void); /* equality */
+void ob_ne(void); /* inequality */
+void relop_prefix(void);
+void relop_suffix(void);
+void os_le(void); /* less or equal (signed) */
+void os_ge(void); /* greater or equal (signed) */
+void os_lt(void); /* less (signed) */
+void os_gt(void); /* greater (signed) */
+
+void lneg(void);
+void neg(void);
+void invert(void);
+void nooperation(void);
+void inc(value * lval);
+void dec(value * lval);
+void jmp_ne0(int number);
+void jmp_eq0(int number);
+void outval(cell val, int newline);
+
+/* function prototypes in SC5.C */
+int error(int number, ...);
+void errorset(int code);
+
+/* function prototypes in SC6.C */
+void assemble(FILE * fout, FILE * fin);
+
+/* function prototypes in SC7.C */
+void stgbuffer_cleanup(void);
+void stgmark(char mark);
+void stgwrite(char *st);
+void stgout(int index);
+void stgdel(int index, cell code_index);
+int stgget(int *index, cell * code_index);
+void stgset(int onoff);
+int phopt_init(void);
+int phopt_cleanup(void);
+
+/* function prototypes in SCLIST.C */
+stringpair *insert_alias(char *name, char *alias);
+stringpair *find_alias(char *name);
+int lookup_alias(char *target, char *name);
+void delete_aliastable(void);
+stringlist *insert_path(char *path);
+char *get_path(int index);
+void delete_pathtable(void);
+stringpair *insert_subst(char *pattern, char *substitution,
+ int prefixlen);
+int get_subst(int index, char **pattern, char **substitution);
+stringpair *find_subst(char *name, int length);
+int delete_subst(char *name, int length);
+void delete_substtable(void);
+
+/* external variables (defined in scvars.c) */
+extern symbol loctab; /* local symbol table */
+extern symbol glbtab; /* global symbol table */
+extern cell *litq; /* the literal queue */
+extern char pline[]; /* the line read from the input file */
+extern char *lptr; /* points to the current position in "pline" */
+extern constvalue tagname_tab; /* tagname table */
+extern constvalue libname_tab; /* library table (#pragma library "..." syntax) *///??? use "stringlist" type
+extern constvalue *curlibrary; /* current library */
+extern symbol *curfunc; /* pointer to current function */
+extern char *inpfname; /* name of the file currently read from */
+extern char outfname[]; /* output file name */
+extern char sc_ctrlchar; /* the control character (or escape character) */
+extern int litidx; /* index to literal table */
+extern int litmax; /* current size of the literal table */
+extern int stgidx; /* index to the staging buffer */
+extern int labnum; /* number of (internal) labels */
+extern int staging; /* true if staging output */
+extern cell declared; /* number of local cells declared */
+extern cell glb_declared; /* number of global cells declared */
+extern cell code_idx; /* number of bytes with generated code */
+extern int ntv_funcid; /* incremental number of native function */
+extern int errnum; /* number of errors */
+extern int warnnum; /* number of warnings */
+extern int sc_debug; /* debug/optimization options (bit field) */
+extern int charbits; /* number of bits for a character */
+extern int sc_packstr; /* strings are packed by default? */
+extern int sc_asmfile; /* create .ASM file? */
+extern int sc_listing; /* create .LST file? */
+extern int sc_compress; /* compress bytecode? */
+extern int sc_needsemicolon; /* semicolon required to terminate expressions? */
+extern int sc_dataalign; /* data alignment value */
+extern int sc_alignnext; /* must frame of the next function be aligned? */
+extern int curseg; /* 1 if currently parsing CODE, 2 if parsing DATA */
+extern cell sc_stksize; /* stack size */
+extern int freading; /* is there an input file ready for reading? */
+extern int fline; /* the line number in the current file */
+extern int fnumber; /* number of files in the file table (debugging) */
+extern int fcurrent; /* current file being processed (debugging) */
+extern int intest; /* true if inside a test */
+extern int sideeffect; /* true if an expression causes a side-effect */
+extern int stmtindent; /* current indent of the statement */
+extern int indent_nowarn; /* skip warning "217 loose indentation" */
+extern int sc_tabsize; /* number of spaces that a TAB represents */
+extern int sc_allowtags; /* allow/detect tagnames in lex() */
+extern int sc_status; /* read/write status */
+extern int sc_rationaltag; /* tag for rational numbers */
+extern int rational_digits; /* number of fractional digits */
+
+extern FILE *inpf; /* file read from (source or include) */
+extern FILE *inpf_org; /* main source file */
+extern FILE *outf; /* file written to */
+
+extern jmp_buf errbuf; /* target of longjmp() on a fatal error */
+
+#define sc_isspace(x) isspace ((int)((unsigned char)x))
+#define sc_isalpha(x) isalpha ((int)((unsigned char)x))
+#define sc_isdigit(x) isdigit ((int)((unsigned char)x))
+#define sc_isupper(x) isupper ((int)((unsigned char)x))
+#define sc_isxdigit(x) isxdigit((int)((unsigned char)x))
+
+#endif
--- /dev/null
+/* Small compiler
+ * Function and variable definition and declaration, statement parser.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied
+ * warranty. In no event will the authors be held liable for any
+ * damages arising from the use of this software. Permission is granted
+ * to anyone to use this software for any purpose, including commercial
+ * applications, and to alter it and redistribute it freely, subject to
+ * the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented;
+ * you must not claim that you wrote the original software.
+ * If you use this software in a product, an acknowledgment in the
+ * product documentation would be appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and
+ * must not be misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source
+ * distribution.
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif /* HAVE_EVIL */
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_prefix.h"
+
+#define VERSION_STR "2.4"
+#define VERSION_INT 240
+
+static void resetglobals(void);
+static void initglobals(void);
+static void setopt(int argc, char **argv,
+ char *iname, char *oname,
+ char *pname, char *rname);
+static void setconfig(char *root);
+static void about(void);
+static void setconstants(void);
+static void parse(void);
+static void dumplits(void);
+static void dumpzero(int count);
+static void declfuncvar(int tok, char *symname,
+ int tag, int fpublic,
+ int fstatic, int fstock, int fconst);
+static void declglb(char *firstname, int firsttag,
+ int fpublic, int fstatic, int stock, int fconst);
+static int declloc(int fstatic);
+static void decl_const(int table);
+static void decl_enum(int table);
+static cell needsub(int *tag);
+static void initials(int ident, int tag,
+ cell * size, int dim[], int numdim);
+static cell initvector(int ident, int tag, cell size, int fillzero);
+static cell init(int ident, int *tag);
+static void funcstub(int native);
+static int newfunc(char *firstname, int firsttag,
+ int fpublic, int fstatic, int stock);
+static int declargs(symbol * sym);
+static void doarg(char *name, int ident, int offset,
+ int tags[], int numtags,
+ int fpublic, int fconst, arginfo * arg);
+static void reduce_referrers(symbol * root);
+static int testsymbols(symbol * root, int level,
+ int testlabs, int testconst);
+static void destructsymbols(symbol * root, int level);
+static constvalue *find_constval_byval(constvalue * table, cell val);
+static void statement(int *lastindent, int allow_decl);
+static void compound(void);
+static void doexpr(int comma, int chkeffect,
+ int allowarray, int mark_endexpr,
+ int *tag, int chkfuncresult);
+static void doassert(void);
+static void doexit(void);
+static void test(int label, int parens, int invert);
+static void doif(void);
+static void dowhile(void);
+static void dodo(void);
+static void dofor(void);
+static void doswitch(void);
+static void dogoto(void);
+static void dolabel(void);
+static symbol *fetchlab(char *name);
+static void doreturn(void);
+static void dobreak(void);
+static void docont(void);
+static void dosleep(void);
+static void addwhile(int *ptr);
+static void delwhile(void);
+static int *readwhile(void);
+
+static int lastst = 0; /* last executed statement type */
+static int nestlevel = 0; /* number of active (open) compound statements */
+static int rettype = 0; /* the type that a "return" expression should have */
+static int skipinput = 0; /* number of lines to skip from the first input file */
+static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
+static int *wqptr; /* pointer to next entry */
+static char binfname[PATH_MAX]; /* binary file name */
+
+int
+main(int argc, char *argv[], char *env[] __UNUSED__)
+{
+ e_prefix_determine(argv[0]);
+ return sc_compile(argc, argv);
+}
+
+int
+sc_error(int number, char *message, char *filename, int firstline,
+ int lastline, va_list argptr)
+{
+ static char *prefix[3] = { "error", "fatal error", "warning" };
+
+ if (number != 0)
+ {
+ char *pre;
+
+ pre = prefix[number / 100];
+ if (firstline >= 0)
+ fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
+ lastline, pre, number);
+ else
+ fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
+ number);
+ } /* if */
+ vfprintf(stderr, message, argptr);
+ fflush(stderr);
+ return 0;
+}
+
+void *
+sc_opensrc(char *filename)
+{
+ return fopen(filename, "rb");
+}
+
+void
+sc_closesrc(void *handle)
+{
+ assert(handle != NULL);
+ fclose((FILE *) handle);
+}
+
+void
+sc_resetsrc(void *handle, void *position)
+{
+ assert(handle != NULL);
+ fsetpos((FILE *) handle, (fpos_t *) position);
+}
+
+char *
+sc_readsrc(void *handle, char *target, int maxchars)
+{
+ return fgets(target, maxchars, (FILE *) handle);
+}
+
+void *
+sc_getpossrc(void *handle)
+{
+ static fpos_t lastpos; /* may need to have a LIFO stack of
+ * such positions */
+
+ fgetpos((FILE *) handle, &lastpos);
+ return &lastpos;
+}
+
+int
+sc_eofsrc(void *handle)
+{
+ return feof((FILE *) handle);
+}
+
+void *
+sc_openasm(int fd)
+{
+ return fdopen(fd, "w+");
+}
+
+void
+sc_closeasm(void *handle)
+{
+ if (handle)
+ fclose((FILE *) handle);
+}
+
+void
+sc_resetasm(void *handle)
+{
+ fflush((FILE *) handle);
+ fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writeasm(void *handle, char *st)
+{
+ return fputs(st, (FILE *) handle) >= 0;
+}
+
+char *
+sc_readasm(void *handle, char *target, int maxchars)
+{
+ return fgets(target, maxchars, (FILE *) handle);
+}
+
+void *
+sc_openbin(char *filename)
+{
+ return fopen(filename, "wb");
+}
+
+void
+sc_closebin(void *handle, int deletefile)
+{
+ fclose((FILE *) handle);
+ if (deletefile)
+ unlink(binfname);
+}
+
+void
+sc_resetbin(void *handle)
+{
+ fflush((FILE *) handle);
+ fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writebin(void *handle, void *buffer, int size)
+{
+ return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
+}
+
+long
+sc_lengthbin(void *handle)
+{
+ return ftell((FILE *) handle);
+}
+
+/* "main" of the compiler
+ */
+int
+sc_compile(int argc, char *argv[])
+{
+ int entry, i, jmpcode, fd_out;
+ int retcode;
+ char incfname[PATH_MAX];
+ char reportname[PATH_MAX];
+ FILE *binf;
+ void *inpfmark;
+ char lcl_ctrlchar;
+ int lcl_packstr, lcl_needsemicolon, lcl_tabsize;
+ char *tmpdir;
+
+ /* set global variables to their initial value */
+ binf = NULL;
+ initglobals();
+ errorset(sRESET);
+ errorset(sEXPRRELEASE);
+ lexinit();
+
+ /* make sure that we clean up on a fatal error; do this before the
+ * first call to error(). */
+ if ((jmpcode = setjmp(errbuf)) != 0)
+ goto cleanup;
+
+ /* allocate memory for fixed tables */
+ inpfname = (char *)malloc(PATH_MAX);
+ litq = (cell *) malloc(litmax * sizeof(cell));
+ if (!litq)
+ error(103); /* insufficient memory */
+ if (!phopt_init())
+ error(103); /* insufficient memory */
+
+ setopt(argc, argv, inpfname, binfname, incfname, reportname);
+
+ /* open the output file */
+
+#ifndef HAVE_EVIL
+ tmpdir = getenv("TMPDIR");
+ if (!tmpdir) tmpdir = "/tmp";
+#else
+ tmpdir = (char *)evil_tmpdir_get();
+#endif /* ! HAVE_EVIL */
+
+ snprintf(outfname, PATH_MAX, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
+ fd_out = mkstemp(outfname);
+ if (fd_out < 0)
+ error(101, outfname);
+
+ setconfig(argv[0]); /* the path to the include files */
+ lcl_ctrlchar = sc_ctrlchar;
+ lcl_packstr = sc_packstr;
+ lcl_needsemicolon = sc_needsemicolon;
+ lcl_tabsize = sc_tabsize;
+ inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
+ if (!inpf)
+ error(100, inpfname);
+ freading = TRUE;
+ outf = (FILE *) sc_openasm(fd_out); /* first write to assembler
+ * file (may be temporary) */
+ if (!outf)
+ error(101, outfname);
+ /* immediately open the binary file, for other programs to check */
+ binf = (FILE *) sc_openbin(binfname);
+ if (!binf)
+ error(101, binfname);
+ setconstants(); /* set predefined constants and tagnames */
+ for (i = 0; i < skipinput; i++) /* skip lines in the input file */
+ if (sc_readsrc(inpf, pline, sLINEMAX))
+ fline++; /* keep line number up to date */
+ skipinput = fline;
+ sc_status = statFIRST;
+ /* do the first pass through the file */
+ inpfmark = sc_getpossrc(inpf);
+ if (incfname[0] != '\0')
+ {
+ if (strcmp(incfname, sDEF_PREFIX) == 0)
+ {
+ plungefile(incfname, FALSE, TRUE); /* parse "default.inc" */
+ }
+ else
+ {
+ if (!plungequalifiedfile(incfname)) /* parse "prefix" include
+ * file */
+ error(100, incfname); /* cannot read from ... (fatal error) */
+ } /* if */
+ } /* if */
+ preprocess(); /* fetch first line */
+ parse(); /* process all input */
+
+ /* second pass */
+ sc_status = statWRITE; /* set, to enable warnings */
+
+ /* ??? for re-parsing the listing file instead of the original source
+ * file (and doing preprocessing twice):
+ * - close input file, close listing file
+ * - re-open listing file for reading (inpf)
+ * - open assembler file (outf)
+ */
+
+ /* reset "defined" flag of all functions and global variables */
+ reduce_referrers(&glbtab);
+ delete_symbols(&glbtab, 0, TRUE, FALSE);
+#if !defined NO_DEFINE
+ delete_substtable();
+#endif
+ resetglobals();
+ sc_ctrlchar = lcl_ctrlchar;
+ sc_packstr = lcl_packstr;
+ sc_needsemicolon = lcl_needsemicolon;
+ sc_tabsize = lcl_tabsize;
+ errorset(sRESET);
+ /* reset the source file */
+ inpf = inpf_org;
+ freading = TRUE;
+ sc_resetsrc(inpf, inpfmark); /* reset file position */
+ fline = skipinput; /* reset line number */
+ lexinit(); /* clear internal flags of lex() */
+ sc_status = statWRITE; /* allow to write --this variable was reset
+ * by resetglobals() */
+ writeleader();
+ setfile(inpfname, fnumber);
+ if (incfname[0] != '\0')
+ {
+ if (strcmp(incfname, sDEF_PREFIX) == 0)
+ plungefile(incfname, FALSE, TRUE); /* parse "default.inc" (again) */
+ else
+ plungequalifiedfile(incfname); /* parse implicit include
+ * file (again) */
+ } /* if */
+ preprocess(); /* fetch first line */
+ parse(); /* process all input */
+ /* inpf is already closed when readline() attempts to pop of a file */
+ writetrailer(); /* write remaining stuff */
+
+ entry = testsymbols(&glbtab, 0, TRUE, FALSE); /* test for unused
+ * or undefined functions and variables */
+ if (!entry)
+ error(13); /* no entry point (no public functions) */
+
+ cleanup:
+ if (inpf) /* main source file is not closed, do it now */
+ sc_closesrc(inpf);
+ /* write the binary file (the file is already open) */
+ if (errnum == 0 && jmpcode == 0)
+ {
+ assert(binf != NULL);
+ sc_resetasm(outf); /* flush and loop back, for reading */
+ assemble(binf, outf); /* assembler file is now input */
+ } /* if */
+ if (outf)
+ sc_closeasm(outf);
+ unlink (outfname);
+ if (binf)
+ sc_closebin(binf, errnum != 0);
+
+ if (inpfname)
+ free(inpfname);
+ if (litq)
+ free(litq);
+ phopt_cleanup();
+ stgbuffer_cleanup();
+ assert(jmpcode != 0 || loctab.next == NULL); /* on normal flow,
+ * local symbols
+ * should already have been deleted */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* delete local variables
+ * if not yet done (i.e.
+ * on a fatal error) */
+ delete_symbols(&glbtab, 0, TRUE, TRUE);
+ delete_consttable(&tagname_tab);
+ delete_consttable(&libname_tab);
+ delete_aliastable();
+ delete_pathtable();
+#if !defined NO_DEFINE
+ delete_substtable();
+#endif
+ if (errnum != 0)
+ {
+ printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
+ retcode = 2;
+ }
+ else if (warnnum != 0)
+ {
+ printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
+ retcode = 1;
+ }
+ else
+ {
+ retcode = jmpcode;
+ } /* if */
+ return retcode;
+}
+
+int
+sc_addconstant(char *name, cell value, int tag)
+{
+ errorset(sFORCESET); /* make sure error engine is silenced */
+ sc_status = statIDLE;
+ add_constant(name, value, sGLOBAL, tag);
+ return 1;
+}
+
+int
+sc_addtag(char *name)
+{
+ cell val;
+ constvalue *ptr;
+ int last, tag;
+
+ if (!name)
+ {
+ /* no tagname was given, check for one */
+ if (lex(&val, &name) != tLABEL)
+ {
+ lexpush();
+ return 0; /* untagged */
+ } /* if */
+ } /* if */
+
+ last = 0;
+ ptr = tagname_tab.next;
+ while (ptr)
+ {
+ tag = (int)(ptr->value & TAGMASK);
+ if (strcmp(name, ptr->name) == 0)
+ return tag; /* tagname is known, return its sequence number */
+ tag &= (int)~FIXEDTAG;
+ if (tag > last)
+ last = tag;
+ ptr = ptr->next;
+ } /* while */
+
+ /* tagname currently unknown, add it */
+ tag = last + 1; /* guaranteed not to exist already */
+ if (sc_isupper(*name))
+ tag |= (int)FIXEDTAG;
+ append_constval(&tagname_tab, name, (cell) tag, 0);
+ return tag;
+}
+
+static void
+resetglobals(void)
+{
+ /* reset the subset of global variables that is modified by the
+ * first pass */
+ curfunc = NULL; /* pointer to current function */
+ lastst = 0; /* last executed statement type */
+ nestlevel = 0; /* number of active (open) compound statements */
+ rettype = 0; /* the type that a "return" expression should have */
+ litidx = 0; /* index to literal table */
+ stgidx = 0; /* index to the staging buffer */
+ labnum = 0; /* number of (internal) labels */
+ staging = 0; /* true if staging output */
+ declared = 0; /* number of local cells declared */
+ glb_declared = 0; /* number of global cells declared */
+ code_idx = 0; /* number of bytes with generated code */
+ ntv_funcid = 0; /* incremental number of native function */
+ curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
+ freading = FALSE; /* no input file ready yet */
+ fline = 0; /* the line number in the current file */
+ fnumber = 0; /* the file number in the file table (debugging) */
+ fcurrent = 0; /* current file being processed (debugging) */
+ intest = 0; /* true if inside a test */
+ sideeffect = 0; /* true if an expression causes a side-effect */
+ stmtindent = 0; /* current indent of the statement */
+ indent_nowarn = TRUE; /* do not skip warning "217 loose indentation" */
+ sc_allowtags = TRUE; /* allow/detect tagnames */
+ sc_status = statIDLE;
+}
+
+static void
+initglobals(void)
+{
+ resetglobals();
+
+ skipinput = 0; /* number of lines to skip from the first
+ * input file */
+ sc_ctrlchar = CTRL_CHAR; /* the escape character */
+ litmax = sDEF_LITMAX; /* current size of the literal table */
+ errnum = 0; /* number of errors */
+ warnnum = 0; /* number of warnings */
+/* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
+ sc_debug = 0; /* by default: no debug */
+ charbits = 8; /* a "char" is 8 bits */
+ sc_packstr = FALSE; /* strings are unpacked by default */
+/* sc_compress=TRUE; compress output bytecodes */
+ sc_compress = FALSE; /* compress output bytecodes */
+ sc_needsemicolon = FALSE; /* semicolon required to terminate
+ * expressions? */
+ sc_dataalign = 4;
+ sc_stksize = sDEF_AMXSTACK; /* default stack size */
+ sc_tabsize = 8; /* assume a TAB is 8 spaces */
+ sc_rationaltag = 0; /* assume no support for rational numbers */
+ rational_digits = 0; /* number of fractional digits */
+
+ outfname[0] = '\0'; /* output file name */
+ inpf = NULL; /* file read from */
+ inpfname = NULL; /* pointer to name of the file currently
+ * read from */
+ outf = NULL; /* file written to */
+ litq = NULL; /* the literal queue */
+ glbtab.next = NULL; /* clear global variables/constants table */
+ loctab.next = NULL; /* " local " / " " */
+ tagname_tab.next = NULL; /* tagname table */
+ libname_tab.next = NULL; /* library table (#pragma library "..."
+ * syntax) */
+
+ pline[0] = '\0'; /* the line read from the input file */
+ lptr = NULL; /* points to the current position in "pline" */
+ curlibrary = NULL; /* current library */
+ inpf_org = NULL; /* main source file */
+
+ wqptr = wq; /* initialize while queue pointer */
+
+}
+
+static void
+parseoptions(int argc, char **argv, char *iname, char *oname,
+ char *pname __UNUSED__, char *rname __UNUSED__)
+{
+ char str[PATH_MAX];
+ int i, stack_size;
+ size_t len;
+
+ /* use embryo include dir always */
+ snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
+ insert_path(str);
+ insert_path("./");
+
+ for (i = 1; i < argc; i++)
+ {
+ if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* include directory */
+ i++;
+ strncpy(str, argv[i], sizeof(str));
+
+ len = strlen(str);
+ if (str[len - 1] != DIRSEP_CHAR)
+ {
+ str[len] = DIRSEP_CHAR;
+ str[len + 1] = '\0';
+ }
+
+ insert_path(str);
+ }
+ else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* output file */
+ i++;
+ strcpy(oname, argv[i]); /* FIXME */
+ }
+ else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* stack size */
+ i++;
+ stack_size = atoi(argv[i]);
+
+ if (stack_size > 64)
+ sc_stksize = (cell) stack_size;
+ else
+ about();
+ }
+ else if (!*iname)
+ {
+ /* input file */
+ strcpy(iname, argv[i]); /* FIXME */
+ }
+ else
+ {
+ /* only allow one input filename */
+ about();
+ }
+ }
+}
+
+static void
+setopt(int argc, char **argv, char *iname, char *oname,
+ char *pname, char *rname)
+{
+ *iname = '\0';
+ *oname = '\0';
+ *pname = '\0';
+ *rname = '\0';
+ strcpy(pname, sDEF_PREFIX);
+
+ parseoptions(argc, argv, iname, oname, pname, rname);
+ if (iname[0] == '\0')
+ about();
+}
+
+static void
+setconfig(char *root)
+{
+ char path[PATH_MAX];
+ char *ptr;
+ int len;
+
+ path[sizeof(path) - 1] = 0;
+
+ /* add the default "include" directory */
+ if (root)
+ {
+ /* path + filename (hopefully) */
+ strncpy(path, root, sizeof(path) - 1);
+ path[sizeof(path) - 1] = 0;
+ }
+/* terminate just behind last \ or : */
+ if ((ptr = strrchr(path, DIRSEP_CHAR))
+ || (ptr = strchr(path, ':')))
+ {
+ /* If there was no terminating "\" or ":",
+ * the filename probably does not
+ * contain the path; so we just don't add it
+ * to the list in that case
+ */
+ *(ptr + 1) = '\0';
+ if (strlen(path) < (sizeof(path) - 1 - 7))
+ {
+ strcat(path, "include");
+ }
+ len = strlen(path);
+ path[len] = DIRSEP_CHAR;
+ path[len + 1] = '\0';
+ insert_path(path);
+ } /* if */
+}
+
+static void
+about(void)
+{
+ printf("Usage: embryo_cc <filename> [options]\n\n");
+ printf("Options:\n");
+#if 0
+ printf
+ (" -A<num> alignment in bytes of the data segment and the\
+ stack\n");
+
+ printf
+ (" -a output assembler code (skip code generation\
+ pass)\n");
+
+ printf
+ (" -C[+/-] compact encoding for output file (default=%c)\n",
+ sc_compress ? '+' : '-');
+ printf(" -c8 [default] a character is 8-bits\
+ (ASCII/ISO Latin-1)\n");
+
+ printf(" -c16 a character is 16-bits (Unicode)\n");
+#if defined dos_setdrive
+ printf(" -Dpath active directory path\n");
+#endif
+ printf
+ (" -d0 no symbolic information, no run-time checks\n");
+ printf(" -d1 [default] run-time checks, no symbolic\
+ information\n");
+ printf
+ (" -d2 full debug information and dynamic checking\n");
+ printf(" -d3 full debug information, dynamic checking,\
+ no optimization\n");
+#endif
+ printf(" -i <name> path for include files\n");
+#if 0
+ printf(" -l create list file (preprocess only)\n");
+#endif
+ printf(" -o <name> set base name of output file\n");
+#if 0
+ printf
+ (" -P[+/-] strings are \"packed\" by default (default=%c)\n",
+ sc_packstr ? '+' : '-');
+ printf(" -p<name> set name of \"prefix\" file\n");
+ if (!waitkey())
+ longjmp(errbuf, 3);
+#endif
+ printf
+ (" -S <num> stack/heap size in cells (default=%d, min=65)\n",
+ (int)sc_stksize);
+#if 0
+ printf(" -s<num> skip lines from the input file\n");
+ printf
+ (" -t<num> TAB indent size (in character positions)\n");
+ printf(" -\\ use '\\' for escape characters\n");
+ printf(" -^ use '^' for escape characters\n");
+ printf(" -;[+/-] require a semicolon to end each statement\
+ (default=%c)\n", sc_needsemicolon ? '+' : '-');
+
+ printf
+ (" sym=val define constant \"sym\" with value \"val\"\n");
+ printf(" sym= define constant \"sym\" with value 0\n");
+#endif
+ longjmp(errbuf, 3); /* user abort */
+}
+
+static void
+setconstants(void)
+{
+ int debug;
+
+ assert(sc_status == statIDLE);
+ append_constval(&tagname_tab, "_", 0, 0); /* "untagged" */
+ append_constval(&tagname_tab, "bool", 1, 0);
+
+ add_constant("true", 1, sGLOBAL, 1); /* boolean flags */
+ add_constant("false", 0, sGLOBAL, 1);
+ add_constant("EOS", 0, sGLOBAL, 0); /* End Of String, or '\0' */
+ add_constant("cellbits", 32, sGLOBAL, 0);
+ add_constant("cellmax", INT_MAX, sGLOBAL, 0);
+ add_constant("cellmin", INT_MIN, sGLOBAL, 0);
+ add_constant("charbits", charbits, sGLOBAL, 0);
+ add_constant("charmin", 0, sGLOBAL, 0);
+ add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
+
+ add_constant("__Small", VERSION_INT, sGLOBAL, 0);
+
+ debug = 0;
+ if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
+ debug = 2;
+ else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
+ debug = 1;
+ add_constant("debug", debug, sGLOBAL, 0);
+}
+
+/* parse - process all input text
+ *
+ * At this level, only static declarations and function definitions
+ * are legal.
+ */
+static void
+parse(void)
+{
+ int tok, tag, fconst, fstock, fstatic;
+ cell val;
+ char *str;
+
+ while (freading)
+ {
+ /* first try whether a declaration possibly is native or public */
+ tok = lex(&val, &str); /* read in (new) token */
+ switch (tok)
+ {
+ case 0:
+ /* ignore zero's */
+ break;
+ case tNEW:
+ fconst = matchtoken(tCONST);
+ declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
+ break;
+ case tSTATIC:
+ /* This can be a static function or a static global variable;
+ * we know which of the two as soon as we have parsed up to the
+ * point where an opening parenthesis of a function would be
+ * expected. To back out after deciding it was a declaration of
+ * a static variable after all, we have to store the symbol name
+ * and tag.
+ */
+ fstock = matchtoken(tSTOCK);
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tPUBLIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
+ break;
+ case tCONST:
+ decl_const(sGLOBAL);
+ break;
+ case tENUM:
+ decl_enum(sGLOBAL);
+ break;
+ case tPUBLIC:
+ /* This can be a public function or a public variable;
+ * see the comment above (for static functions/variables)
+ * for details.
+ */
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
+ break;
+ case tSTOCK:
+ /* This can be a stock function or a stock *global) variable;
+ * see the comment above (for static functions/variables) for
+ * details.
+ */
+ fstatic = matchtoken(tSTATIC);
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tPUBLIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
+ break;
+ case tLABEL:
+ case tSYMBOL:
+ case tOPERATOR:
+ lexpush();
+ if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
+ {
+ error(10); /* illegal function or declaration */
+ lexclr(TRUE); /* drop the rest of the line */
+ } /* if */
+ break;
+ case tNATIVE:
+ funcstub(TRUE); /* create a dummy function */
+ break;
+ case tFORWARD:
+ funcstub(FALSE);
+ break;
+ case '}':
+ error(54); /* unmatched closing brace */
+ break;
+ case '{':
+ error(55); /* start of function body without function header */
+ break;
+ default:
+ if (freading)
+ {
+ error(10); /* illegal function or declaration */
+ lexclr(TRUE); /* drop the rest of the line */
+ } /* if */
+ } /* switch */
+ } /* while */
+}
+
+/* dumplits
+ *
+ * Dump the literal pool (strings etc.)
+ *
+ * Global references: litidx (referred to only)
+ */
+static void
+dumplits(void)
+{
+ int j, k;
+
+ k = 0;
+ while (k < litidx)
+ {
+ /* should be in the data segment */
+ assert(curseg == 2);
+ defstorage();
+ j = 16; /* 16 values per line */
+ while (j && k < litidx)
+ {
+ outval(litq[k], FALSE);
+ stgwrite(" ");
+ k++;
+ j--;
+ if (j == 0 || k >= litidx)
+ stgwrite("\n"); /* force a newline after 10 dumps */
+ /* Note: stgwrite() buffers a line until it is complete. It recognizes
+ * the end of line as a sequence of "\n\0", so something like "\n\t"
+ * so should not be passed to stgwrite().
+ */
+ } /* while */
+ } /* while */
+}
+
+/* dumpzero
+ *
+ * Dump zero's for default initial values
+ */
+static void
+dumpzero(int count)
+{
+ int i;
+
+ if (count <= 0)
+ return;
+ assert(curseg == 2);
+ defstorage();
+ i = 0;
+ while (count-- > 0)
+ {
+ outval(0, FALSE);
+ i = (i + 1) % 16;
+ stgwrite((i == 0 || count == 0) ? "\n" : " ");
+ if (i == 0 && count > 0)
+ defstorage();
+ } /* while */
+}
+
+static void
+aligndata(int numbytes)
+{
+ if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+ {
+ while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+ stowlit(0);
+ } /* if */
+
+}
+
+static void
+declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
+ int fstock, int fconst)
+{
+ char name[sNAMEMAX + 1];
+
+ if (tok != tSYMBOL && tok != tOPERATOR)
+ {
+ if (freading)
+ error(20, symname); /* invalid symbol name */
+ return;
+ } /* if */
+ if (tok == tOPERATOR)
+ {
+ lexpush();
+ if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
+ error(10); /* illegal function or declaration */
+ }
+ else
+ {
+ assert(strlen(symname) <= sNAMEMAX);
+ strcpy(name, symname);
+ if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
+ declglb(name, tag, fpublic, fstatic, fstock, fconst);
+ /* if not a static function, try a static variable */
+ } /* if */
+}
+
+/* declglb - declare global symbols
+ *
+ * Declare a static (global) variable. Global variables are stored in
+ * the DATA segment.
+ *
+ * global references: glb_declared (altered)
+ */
+static void
+declglb(char *firstname, int firsttag, int fpublic, int fstatic,
+ int stock, int fconst)
+{
+ int ident, tag, ispublic;
+ int idxtag[sDIMEN_MAX];
+ char name[sNAMEMAX + 1];
+ cell val, size, cidx;
+ char *str;
+ int dim[sDIMEN_MAX];
+ int numdim, level;
+ int filenum;
+ symbol *sym;
+
+#if !defined NDEBUG
+ cell glbdecl = 0;
+#endif
+
+ filenum = fcurrent; /* save file number at the start of the
+ * declaration */
+ do
+ {
+ size = 1; /* single size (no array) */
+ numdim = 0; /* no dimensions */
+ ident = iVARIABLE;
+ if (firstname)
+ {
+ assert(strlen(firstname) <= sNAMEMAX);
+ strcpy(name, firstname); /* save symbol name */
+ tag = firsttag;
+ firstname = NULL;
+ }
+ else
+ {
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(name, str); /* save symbol name */
+ } /* if */
+ sym = findglb(name);
+ if (!sym)
+ sym = findconst(name);
+ if (sym && (sym->usage & uDEFINE) != 0)
+ error(21, name); /* symbol already defined */
+ ispublic = fpublic;
+ if (name[0] == PUBLIC_CHAR)
+ {
+ ispublic = TRUE; /* implicitly public variable */
+ if (stock || fstatic)
+ error(42); /* invalid combination of class specifiers */
+ } /* if */
+ while (matchtoken('['))
+ {
+ ident = iARRAY;
+ if (numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return;
+ } /* if */
+ if (numdim > 0 && dim[numdim - 1] == 0)
+ error(52); /* only last dimension may be variable length */
+ size = needsub(&idxtag[numdim]); /* get size; size==0 for
+ * "var[]" */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ if (ispublic)
+ error(56, name); /* arrays cannot be public */
+ dim[numdim++] = (int)size;
+ } /* while */
+ /* if this variable is never used (which can be detected only in
+ * the second stage), shut off code generation; make an exception
+ * for public variables
+ */
+ cidx = 0; /* only to avoid a compiler warning */
+ if (sc_status == statWRITE && sym
+ && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
+ {
+ sc_status = statSKIP;
+ cidx = code_idx;
+#if !defined NDEBUG
+ glbdecl = glb_declared;
+#endif
+ } /* if */
+ defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
+ begdseg(); /* real (initialized) data in data segment */
+ assert(litidx == 0); /* literal queue should be empty */
+ if (sc_alignnext)
+ {
+ litidx = 0;
+ aligndata(sc_dataalign);
+ dumplits(); /* dump the literal queue */
+ sc_alignnext = FALSE;
+ litidx = 0; /* global initial data is dumped, so restart at zero */
+ } /* if */
+ initials(ident, tag, &size, dim, numdim); /* stores values in
+ * the literal queue */
+ if (numdim == 1)
+ dim[0] = (int)size;
+ dumplits(); /* dump the literal queue */
+ dumpzero((int)size - litidx);
+ litidx = 0;
+ if (!sym)
+ { /* define only if not yet defined */
+ sym =
+ addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
+ tag, dim, numdim, idxtag);
+ }
+ else
+ { /* if declared but not yet defined, adjust the
+ * variable's address */
+ sym->addr = sizeof(cell) * glb_declared;
+ sym->usage |= uDEFINE;
+ } /* if */
+ if (ispublic)
+ sym->usage |= uPUBLIC;
+ if (fconst)
+ sym->usage |= uCONST;
+ if (stock)
+ sym->usage |= uSTOCK;
+ if (fstatic)
+ sym->fnumber = filenum;
+ if (ident == iARRAY)
+ for (level = 0; level < numdim; level++)
+ symbolrange(level, dim[level]);
+ if (sc_status == statSKIP)
+ {
+ sc_status = statWRITE;
+ code_idx = cidx;
+ assert(glb_declared == glbdecl);
+ }
+ else
+ {
+ glb_declared += (int)size; /* add total number of cells */
+ } /* if */
+ }
+ while (matchtoken(',')); /* enddo *//* more? */
+ needtoken(tTERM); /* if not comma, must be semicolumn */
+}
+
+/* declloc - declare local symbols
+ *
+ * Declare local (automatic) variables. Since these variables are
+ * relative to the STACK, there is no switch to the DATA segment.
+ * These variables cannot be initialized either.
+ *
+ * global references: declared (altered)
+ * funcstatus (referred to only)
+ */
+static int
+declloc(int fstatic)
+{
+ int ident, tag;
+ int idxtag[sDIMEN_MAX];
+ char name[sNAMEMAX + 1];
+ symbol *sym;
+ cell val, size;
+ char *str;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ int cur_lit = 0;
+ int dim[sDIMEN_MAX];
+ int numdim, level;
+ int fconst;
+
+ fconst = matchtoken(tCONST);
+ do
+ {
+ ident = iVARIABLE;
+ size = 1;
+ numdim = 0; /* no dimensions */
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(name, str); /* save symbol name */
+ if (name[0] == PUBLIC_CHAR)
+ error(56, name); /* local variables cannot be public */
+ /* Note: block locals may be named identical to locals at higher
+ * compound blocks (as with standard C); so we must check (and add)
+ * the "nesting level" of local variables to verify the
+ * multi-definition of symbols.
+ */
+ if ((sym = findloc(name)) && sym->compound == nestlevel)
+ error(21, name); /* symbol already defined */
+ /* Although valid, a local variable whose name is equal to that
+ * of a global variable or to that of a local variable at a lower
+ * level might indicate a bug.
+ */
+ if (((sym = findloc(name)) && sym->compound != nestlevel)
+ || findglb(name))
+ error(219, name); /* variable shadows another symbol */
+ while (matchtoken('['))
+ {
+ ident = iARRAY;
+ if (numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return ident;
+ } /* if */
+ if (numdim > 0 && dim[numdim - 1] == 0)
+ error(52); /* only last dimension may be variable length */
+ size = needsub(&idxtag[numdim]); /* get size; size==0 for "var[]" */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ dim[numdim++] = (int)size;
+ } /* while */
+ if (ident == iARRAY || fstatic)
+ {
+ if (sc_alignnext)
+ {
+ aligndata(sc_dataalign);
+ sc_alignnext = FALSE;
+ } /* if */
+ cur_lit = litidx; /* save current index in the literal table */
+ initials(ident, tag, &size, dim, numdim);
+ if (size == 0)
+ return ident; /* error message already given */
+ if (numdim == 1)
+ dim[0] = (int)size;
+ } /* if */
+ /* reserve memory (on the stack) for the variable */
+ if (fstatic)
+ {
+ /* write zeros for uninitialized fields */
+ while (litidx < cur_lit + size)
+ stowlit(0);
+ sym =
+ addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
+ ident, sSTATIC, tag, dim, numdim, idxtag);
+ defsymbol(name, ident, sSTATIC,
+ (cur_lit + glb_declared) * sizeof(cell), tag);
+ }
+ else
+ {
+ declared += (int)size; /* variables are put on stack,
+ * adjust "declared" */
+ sym =
+ addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
+ dim, numdim, idxtag);
+ defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
+ modstk(-(int)size * sizeof(cell));
+ } /* if */
+ /* now that we have reserved memory for the variable, we can
+ * proceed to initialize it */
+ sym->compound = nestlevel; /* for multiple declaration/shadowing */
+ if (fconst)
+ sym->usage |= uCONST;
+ if (ident == iARRAY)
+ for (level = 0; level < numdim; level++)
+ symbolrange(level, dim[level]);
+ if (!fstatic)
+ { /* static variables already initialized */
+ if (ident == iVARIABLE)
+ {
+ /* simple variable, also supports initialization */
+ int ctag = tag; /* set to "tag" by default */
+ int explicit_init = FALSE; /* is the variable explicitly
+ * initialized? */
+ if (matchtoken('='))
+ {
+ doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
+ explicit_init = TRUE;
+ }
+ else
+ {
+ const1(0); /* uninitialized variable, set to zero */
+ } /* if */
+ /* now try to save the value (still in PRI) in the variable */
+ lval.sym = sym;
+ lval.ident = iVARIABLE;
+ lval.constval = 0;
+ lval.tag = tag;
+ check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
+ store(&lval);
+ endexpr(TRUE); /* full expression ends after the store */
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ /* if the variable was not explicitly initialized, reset the
+ * "uWRITTEN" flag that store() set */
+ if (!explicit_init)
+ sym->usage &= ~uWRITTEN;
+ }
+ else
+ {
+ /* an array */
+ if (litidx - cur_lit < size)
+ fillarray(sym, size * sizeof(cell), 0);
+ if (cur_lit < litidx)
+ {
+ /* check whether the complete array is set to a single value;
+ * if it is, more compact code can be generated */
+ cell first = litq[cur_lit];
+ int i;
+
+ for (i = cur_lit; i < litidx && litq[i] == first; i++)
+ /* nothing */ ;
+ if (i == litidx)
+ {
+ /* all values are the same */
+ fillarray(sym, (litidx - cur_lit) * sizeof(cell),
+ first);
+ litidx = cur_lit; /* reset literal table */
+ }
+ else
+ {
+ /* copy the literals to the array */
+ const1((cur_lit + glb_declared) * sizeof(cell));
+ copyarray(sym, (litidx - cur_lit) * sizeof(cell));
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* if */
+ }
+ while (matchtoken(',')); /* enddo *//* more? */
+ needtoken(tTERM); /* if not comma, must be semicolumn */
+ return ident;
+}
+
+static cell
+calc_arraysize(int dim[], int numdim, int cur)
+{
+ if (cur == numdim)
+ return 0;
+ return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
+}
+
+/* initials
+ *
+ * Initialize global objects and local arrays.
+ * size==array cells (count), if 0 on input, the routine counts
+ * the number of elements
+ * tag==required tagname id (not the returned tag)
+ *
+ * Global references: litidx (altered)
+ */
+static void
+initials(int ident, int tag, cell * size, int dim[], int numdim)
+{
+ int ctag;
+ int curlit = litidx;
+ int d;
+
+ if (!matchtoken('='))
+ {
+ if (ident == iARRAY && dim[numdim - 1] == 0)
+ {
+ /* declared as "myvar[];" which is senseless (note: this *does* make
+ * sense in the case of a iREFARRAY, which is a function parameter)
+ */
+ error(9); /* array has zero length -> invalid size */
+ } /* if */
+ if (numdim > 1)
+ {
+ /* initialize the indirection tables */
+#if sDIMEN_MAX>2
+#error Array algorithms for more than 2 dimensions are not implemented
+#endif
+ assert(numdim == 2);
+ *size = calc_arraysize(dim, numdim, 0);
+ for (d = 0; d < dim[0]; d++)
+ stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
+ } /* if */
+ return;
+ } /* if */
+
+ if (ident == iVARIABLE)
+ {
+ assert(*size == 1);
+ init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ }
+ else
+ {
+ assert(numdim > 0);
+ if (numdim == 1)
+ {
+ *size = initvector(ident, tag, dim[0], FALSE);
+ }
+ else
+ {
+ cell offs, dsize;
+
+ /* The simple algorithm below only works for arrays with one or
+ * two dimensions. This should be some recursive algorithm.
+ */
+ if (dim[numdim - 1] != 0)
+ /* set size to (known) full size */
+ *size = calc_arraysize(dim, numdim, 0);
+ /* dump indirection tables */
+ for (d = 0; d < dim[0]; d++)
+ stowlit(0);
+ /* now dump individual vectors */
+ needtoken('{');
+ offs = dim[0];
+ for (d = 0; d < dim[0]; d++)
+ {
+ litq[curlit + d] = offs * sizeof(cell);
+ dsize = initvector(ident, tag, dim[1], TRUE);
+ offs += dsize - 1;
+ if (d + 1 < dim[0])
+ needtoken(',');
+ if (matchtoken('{') || matchtoken(tSTRING))
+ /* expect a '{' or a string */
+ lexpush();
+ else
+ break;
+ } /* for */
+ matchtoken(',');
+ needtoken('}');
+ } /* if */
+ } /* if */
+
+ if (*size == 0)
+ *size = litidx - curlit; /* number of elements defined */
+}
+
+/* initvector
+ * Initialize a single dimensional array
+ */
+static cell
+initvector(int ident, int tag, cell size, int fillzero)
+{
+ cell prev1 = 0, prev2 = 0;
+ int ctag;
+ int ellips = FALSE;
+ int curlit = litidx;
+
+ assert(ident == iARRAY || ident == iREFARRAY);
+ if (matchtoken('{'))
+ {
+ do
+ {
+ if (matchtoken('}'))
+ { /* to allow for trailing ',' after the initialization */
+ lexpush();
+ break;
+ } /* if */
+ if ((ellips = matchtoken(tELLIPS)) != 0)
+ break;
+ prev2 = prev1;
+ prev1 = init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ }
+ while (matchtoken(',')); /* do */
+ needtoken('}');
+ }
+ else
+ {
+ init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tagname mismatch */
+ } /* if */
+ /* fill up the literal queue with a series */
+ if (ellips)
+ {
+ cell step =
+ ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
+ if (size == 0 || (litidx - curlit) == 0)
+ error(41); /* invalid ellipsis, array size unknown */
+ else if ((litidx - curlit) == (int)size)
+ error(18); /* initialisation data exceeds declared size */
+ while ((litidx - curlit) < (int)size)
+ {
+ prev1 += step;
+ stowlit(prev1);
+ } /* while */
+ } /* if */
+ if (fillzero && size > 0)
+ {
+ while ((litidx - curlit) < (int)size)
+ stowlit(0);
+ } /* if */
+ if (size == 0)
+ {
+ size = litidx - curlit; /* number of elements defined */
+ }
+ else if (litidx - curlit > (int)size)
+ { /* e.g. "myvar[3]={1,2,3,4};" */
+ error(18); /* initialisation data exceeds declared size */
+ litidx = (int)size + curlit; /* avoid overflow in memory moves */
+ } /* if */
+ return size;
+}
+
+/* init
+ *
+ * Evaluate one initializer.
+ */
+static cell
+init(int ident, int *tag)
+{
+ cell i = 0;
+
+ if (matchtoken(tSTRING))
+ {
+ /* lex() automatically stores strings in the literal table (and
+ * increases "litidx") */
+ if (ident == iVARIABLE)
+ {
+ error(6); /* must be assigned to an array */
+ litidx = 1; /* reset literal queue */
+ } /* if */
+ *tag = 0;
+ }
+ else if (constexpr(&i, tag))
+ {
+ stowlit(i); /* store expression result in literal table */
+ } /* if */
+ return i;
+}
+
+/* needsub
+ *
+ * Get required array size
+ */
+static cell
+needsub(int *tag)
+{
+ cell val;
+
+ *tag = 0;
+ if (matchtoken(']')) /* we've already seen "[" */
+ return 0; /* null size (like "char msg[]") */
+ constexpr(&val, tag); /* get value (must be constant expression) */
+ if (val < 0)
+ {
+ error(9); /* negative array size is invalid; assumed zero */
+ val = 0;
+ } /* if */
+ needtoken(']');
+ return val; /* return array size */
+}
+
+/* decl_const - declare a single constant
+ *
+ */
+static void
+decl_const(int vclass)
+{
+ char constname[sNAMEMAX + 1];
+ cell val;
+ char *str;
+ int tag, exprtag;
+ int symbolline;
+
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ symbolline = fline; /* save line where symbol was found */
+ strcpy(constname, str); /* save symbol name */
+ needtoken('=');
+ constexpr(&val, &exprtag); /* get value */
+ needtoken(tTERM);
+ /* add_constant() checks for duplicate definitions */
+ if (!matchtag(tag, exprtag, FALSE))
+ {
+ /* temporarily reset the line number to where the symbol was
+ * defined */
+ int orgfline = fline;
+
+ fline = symbolline;
+ error(213); /* tagname mismatch */
+ fline = orgfline;
+ } /* if */
+ add_constant(constname, val, vclass, tag);
+}
+
+/* decl_enum - declare enumerated constants
+ *
+ */
+static void
+decl_enum(int vclass)
+{
+ char enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
+ cell val, value, size;
+ char *str;
+ int tok, tag, explicittag;
+ cell increment, multiplier;
+
+ /* get an explicit tag, if any (we need to remember whether an
+ * explicit tag was passed, even if that explicit tag was "_:", so we
+ * cannot call sc_addtag() here
+ */
+ if (lex(&val, &str) == tLABEL)
+ {
+ tag = sc_addtag(str);
+ explicittag = TRUE;
+ }
+ else
+ {
+ lexpush();
+ tag = 0;
+ explicittag = FALSE;
+ } /* if */
+
+ /* get optional enum name (also serves as a tag if no explicit
+ * tag was set) */
+ if (lex(&val, &str) == tSYMBOL)
+ { /* read in (new) token */
+ strcpy(enumname, str); /* save enum name (last constant) */
+ if (!explicittag)
+ tag = sc_addtag(enumname);
+ }
+ else
+ {
+ lexpush(); /* analyze again */
+ enumname[0] = '\0';
+ } /* if */
+
+ /* get increment and multiplier */
+ increment = 1;
+ multiplier = 1;
+ if (matchtoken('('))
+ {
+ if (matchtoken(taADD))
+ {
+ constexpr(&increment, NULL);
+ }
+ else if (matchtoken(taMULT))
+ {
+ constexpr(&multiplier, NULL);
+ }
+ else if (matchtoken(taSHL))
+ {
+ constexpr(&val, NULL);
+ while (val-- > 0)
+ multiplier *= 2;
+ } /* if */
+ needtoken(')');
+ } /* if */
+
+ needtoken('{');
+ /* go through all constants */
+ value = 0; /* default starting value */
+ do
+ {
+ if (matchtoken('}'))
+ { /* quick exit if '}' follows ',' */
+ lexpush();
+ break;
+ } /* if */
+ tok = lex(&val, &str); /* read in (new) token */
+ if (tok != tSYMBOL && tok != tLABEL)
+ error(20, str); /* invalid symbol name */
+ strcpy(constname, str); /* save symbol name */
+ size = increment; /* default increment of 'val' */
+ if (tok == tLABEL || matchtoken(':'))
+ constexpr(&size, NULL); /* get size */
+ if (matchtoken('='))
+ constexpr(&value, NULL); /* get value */
+ /* add_constant() checks whether a variable (global or local) or
+ * a constant with the same name already exists */
+ add_constant(constname, value, vclass, tag);
+ if (multiplier == 1)
+ value += size;
+ else
+ value *= size * multiplier;
+ }
+ while (matchtoken(','));
+ needtoken('}'); /* terminates the constant list */
+ matchtoken(';'); /* eat an optional ; */
+
+ /* set the enum name to the last value plus one */
+ if (enumname[0] != '\0')
+ add_constant(enumname, value, vclass, tag);
+}
+
+/*
+ * Finds a function in the global symbol table or creates a new entry.
+ * It does some basic processing and error checking.
+ */
+symbol *
+fetchfunc(char *name, int tag)
+{
+ symbol *sym;
+ cell offset;
+
+ offset = code_idx;
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ offset += opcodes(1) + opargs(3) + nameincells(name);
+ /* ^^^ The address for the symbol is the code address. But the
+ * "symbol" instruction itself generates code. Therefore the
+ * offset is pre-adjusted to the value it will have after the
+ * symbol instruction.
+ */
+ } /* if */
+ if ((sym = findglb(name)))
+ { /* already in symbol table? */
+ if (sym->ident != iFUNCTN)
+ {
+ error(21, name); /* yes, but not as a function */
+ return NULL; /* make sure the old symbol is not damaged */
+ }
+ else if ((sym->usage & uDEFINE) != 0)
+ {
+ error(21, name); /* yes, and it's already defined */
+ }
+ else if ((sym->usage & uNATIVE) != 0)
+ {
+ error(21, name); /* yes, and it is an native */
+ } /* if */
+ assert(sym->vclass == sGLOBAL);
+ if ((sym->usage & uDEFINE) == 0)
+ {
+ /* as long as the function stays undefined, update the address
+ * and the tag */
+ sym->addr = offset;
+ sym->tag = tag;
+ } /* if */
+ }
+ else
+ {
+ /* don't set the "uDEFINE" flag; it may be a prototype */
+ sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
+ /* assume no arguments */
+ sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
+ sym->dim.arglist[0].ident = 0;
+ /* set library ID to NULL (only for native functions) */
+ sym->x.lib = NULL;
+ } /* if */
+ return sym;
+}
+
+/* This routine adds symbolic information for each argument.
+ */
+static void
+define_args(void)
+{
+ symbol *sym;
+
+ /* At this point, no local variables have been declared. All
+ * local symbols are function arguments.
+ */
+ sym = loctab.next;
+ while (sym)
+ {
+ assert(sym->ident != iLABEL);
+ assert(sym->vclass == sLOCAL);
+ defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
+ if (sym->ident == iREFARRAY)
+ {
+ symbol *sub = sym;
+
+ while (sub)
+ {
+ symbolrange(sub->dim.array.level, sub->dim.array.length);
+ sub = finddepend(sub);
+ } /* while */
+ } /* if */
+ sym = sym->next;
+ } /* while */
+}
+
+static int
+operatorname(char *name)
+{
+ int opertok;
+ char *str;
+ cell val;
+
+ assert(name != NULL);
+
+ /* check the operator */
+ opertok = lex(&val, &str);
+ switch (opertok)
+ {
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case '%':
+ case '>':
+ case '<':
+ case '!':
+ case '~':
+ case '=':
+ name[0] = (char)opertok;
+ name[1] = '\0';
+ break;
+ case tINC:
+ strcpy(name, "++");
+ break;
+ case tDEC:
+ strcpy(name, "--");
+ break;
+ case tlEQ:
+ strcpy(name, "==");
+ break;
+ case tlNE:
+ strcpy(name, "!=");
+ break;
+ case tlLE:
+ strcpy(name, "<=");
+ break;
+ case tlGE:
+ strcpy(name, ">=");
+ break;
+ default:
+ name[0] = '\0';
+ error(61); /* operator cannot be redefined
+ * (or bad operator name) */
+ return 0;
+ } /* switch */
+
+ return opertok;
+}
+
+static int
+operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
+{
+ int tags[2] = { 0, 0 };
+ int count = 0;
+ arginfo *arg;
+ char tmpname[sNAMEMAX + 1];
+ symbol *oldsym;
+
+ if (opertok == 0)
+ return TRUE;
+
+ /* count arguments and save (first two) tags */
+ while (arg = &sym->dim.arglist[count], arg->ident != 0)
+ {
+ if (count < 2)
+ {
+ if (arg->numtags > 1)
+ error(65, count + 1); /* function argument may only have
+ * a single tag */
+ else if (arg->numtags == 1)
+ tags[count] = arg->tags[0];
+ } /* if */
+ if (opertok == '~' && count == 0)
+ {
+ if (arg->ident != iREFARRAY)
+ error(73, arg->name); /* must be an array argument */
+ }
+ else
+ {
+ if (arg->ident != iVARIABLE)
+ error(66, arg->name); /* must be non-reference argument */
+ } /* if */
+ if (arg->hasdefault)
+ error(59, arg->name); /* arguments of an operator may not
+ * have a default value */
+ count++;
+ } /* while */
+
+ /* for '!', '++' and '--', count must be 1
+ * for '-', count may be 1 or 2
+ * for '=', count must be 1, and the resulttag is also important
+ * for all other (binary) operators and the special '~'
+ * operator, count must be 2
+ */
+ switch (opertok)
+ {
+ case '!':
+ case '=':
+ case tINC:
+ case tDEC:
+ if (count != 1)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ break;
+ case '-':
+ if (count != 1 && count != 2)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ break;
+ default:
+ if (count != 2)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ } /* switch */
+
+ if (tags[0] == 0
+ && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
+ error(64); /* cannot change predefined operators */
+
+ /* change the operator name */
+ assert(opername[0] != '\0');
+ operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
+ if ((oldsym = findglb(tmpname)))
+ {
+ int i;
+
+ if ((oldsym->usage & uDEFINE) != 0)
+ {
+ char errname[2 * sNAMEMAX + 16];
+
+ funcdisplayname(errname, tmpname);
+ error(21, errname); /* symbol already defined */
+ } /* if */
+ sym->usage |= oldsym->usage; /* copy flags from the previous
+ * definition */
+ for (i = 0; i < oldsym->numrefers; i++)
+ if (oldsym->refer[i])
+ refer_symbol(sym, oldsym->refer[i]);
+ delete_symbol(&glbtab, oldsym);
+ } /* if */
+ if ((sc_debug & sSYMBOLIC) != 0)
+ sym->addr += nameincells(tmpname) - nameincells(sym->name);
+ strcpy(sym->name, tmpname);
+ sym->hash = namehash(sym->name); /* calculate new hash */
+
+ /* operators should return a value, except the '~' operator */
+ if (opertok != '~')
+ sym->usage |= uRETVALUE;
+
+ return TRUE;
+}
+
+static int
+check_operatortag(int opertok, int resulttag, char *opername)
+{
+ assert(opername != NULL && opername[0] != '\0');
+ switch (opertok)
+ {
+ case '!':
+ case '<':
+ case '>':
+ case tlEQ:
+ case tlNE:
+ case tlLE:
+ case tlGE:
+ if (resulttag != sc_addtag("bool"))
+ {
+ error(63, opername, "bool:"); /* operator X requires
+ * a "bool:" result tag */
+ return FALSE;
+ } /* if */
+ break;
+ case '~':
+ if (resulttag != 0)
+ {
+ error(63, opername, "_:"); /* operator "~" requires
+ * a "_:" result tag */
+ return FALSE;
+ } /* if */
+ break;
+ } /* switch */
+ return TRUE;
+}
+
+static char *
+tag2str(char *dest, int tag)
+{
+ tag &= TAGMASK;
+ assert(tag >= 0);
+ sprintf(dest, "0%x", tag);
+ return sc_isdigit(dest[1]) ? &dest[1] : dest;
+}
+
+char *
+operator_symname(char *symname, char *opername, int tag1, int tag2,
+ int numtags, int resulttag)
+{
+ char tagstr1[10], tagstr2[10];
+ int opertok;
+
+ assert(numtags >= 1 && numtags <= 2);
+ opertok = (opername[1] == '\0') ? opername[0] : 0;
+ if (opertok == '=')
+ sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
+ tag2str(tagstr2, tag1));
+ else if (numtags == 1 || opertok == '~')
+ sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
+ else
+ sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
+ tag2str(tagstr2, tag2));
+ return symname;
+}
+
+static int
+parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
+{
+ char *ptr, *name;
+ int unary;
+
+ /* tags are only positive, so if the function name starts with a '-',
+ * the operator is an unary '-' or '--' operator.
+ */
+ if (*fname == '-')
+ {
+ *tag1 = 0;
+ unary = TRUE;
+ ptr = fname;
+ }
+ else
+ {
+ *tag1 = (int)strtol(fname, &ptr, 16);
+ unary = ptr == fname; /* unary operator if it doesn't start
+ * with a tag name */
+ } /* if */
+ assert(!unary || *tag1 == 0);
+ assert(*ptr != '\0');
+ for (name = opname; !sc_isdigit(*ptr);)
+ *name++ = *ptr++;
+ *name = '\0';
+ *tag2 = (int)strtol(ptr, NULL, 16);
+ return unary;
+}
+
+char *
+funcdisplayname(char *dest, char *funcname)
+{
+ int tags[2];
+ char opname[10];
+ constvalue *tagsym[2];
+ int unary;
+
+ if (sc_isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
+ || *funcname == '\0')
+ {
+ if (dest != funcname)
+ strcpy(dest, funcname);
+ return dest;
+ } /* if */
+
+ unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
+ tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
+ assert(tagsym[1] != NULL);
+ if (unary)
+ {
+ sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
+ }
+ else
+ {
+ tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
+ /* special case: the assignment operator has the return value
+ * as the 2nd tag */
+ if (opname[0] == '=' && opname[1] == '\0')
+ sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
+ tagsym[1]->name);
+ else
+ sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
+ tagsym[1]->name);
+ } /* if */
+ return dest;
+}
+
+static void
+funcstub(int native)
+{
+ int tok, tag;
+ char *str;
+ cell val;
+ char symbolname[sNAMEMAX + 1];
+ symbol *sym;
+ int opertok;
+
+ opertok = 0;
+ lastst = 0;
+ litidx = 0; /* clear the literal pool */
+
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (native)
+ {
+ if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
+ (tok == tSYMBOL && *str == PUBLIC_CHAR))
+ error(42); /* invalid combination of class specifiers */
+ }
+ else
+ {
+ if (tok == tPUBLIC || tok == tSTATIC)
+ tok = lex(&val, &str);
+ } /* if */
+ if (tok == tOPERATOR)
+ {
+ opertok = operatorname(symbolname);
+ if (opertok == 0)
+ return; /* error message already given */
+ check_operatortag(opertok, tag, symbolname);
+ }
+ else
+ {
+ if (tok != tSYMBOL && freading)
+ {
+ error(10); /* illegal function or declaration */
+ return;
+ } /* if */
+ strcpy(symbolname, str);
+ } /* if */
+ needtoken('('); /* only functions may be native/forward */
+
+ sym = fetchfunc(symbolname, tag); /* get a pointer to the
+ * function entry */
+ if (!sym)
+ return;
+ if (native)
+ {
+ sym->usage = uNATIVE | uRETVALUE | uDEFINE;
+ sym->x.lib = curlibrary;
+ } /* if */
+
+ declargs(sym);
+ /* "declargs()" found the ")" */
+ if (!operatoradjust(opertok, sym, symbolname, tag))
+ sym->usage &= ~uDEFINE;
+ /* for a native operator, also need to specify an "exported"
+ * function name; for a native function, this is optional
+ */
+ if (native)
+ {
+ if (opertok != 0)
+ {
+ needtoken('=');
+ lexpush(); /* push back, for matchtoken() to retrieve again */
+ } /* if */
+ if (matchtoken('='))
+ {
+ /* allow number or symbol */
+ if (matchtoken(tSYMBOL))
+ {
+ tokeninfo(&val, &str);
+ if (strlen(str) > sEXPMAX)
+ {
+ error(220, str, sEXPMAX);
+ str[sEXPMAX] = '\0';
+ } /* if */
+ insert_alias(sym->name, str);
+ }
+ else
+ {
+ constexpr(&val, NULL);
+ sym->addr = val;
+ /*
+ * ?? Must mark this address, so that it won't be generated again
+ * and it won't be written to the output file. At the moment,
+ * I have assumed that this syntax is only valid if val < 0.
+ * To properly mix "normal" native functions and indexed native
+ * functions, one should use negative indices anyway.
+ * Special code for a negative index in sym->addr exists in
+ * SC4.C (ffcall()) and in SC6.C (the loops for counting the
+ * number of native variables and for writing them).
+ */
+ } /* if */
+ } /* if */
+ } /* if */
+ needtoken(tTERM);
+
+ litidx = 0; /* clear the literal pool */
+ /* clear local variables queue */
+ delete_symbols(&loctab, 0, TRUE, TRUE);
+}
+
+/* newfunc - begin a function
+ *
+ * This routine is called from "parse" and tries to make a function
+ * out of the following text
+ *
+ * Global references: funcstatus,lastst,litidx
+ * rettype (altered)
+ * curfunc (altered)
+ * declared (altered)
+ * glb_declared (altered)
+ * sc_alignnext (altered)
+ */
+static int
+newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
+{
+ symbol *sym;
+ int argcnt, tok, tag, funcline;
+ int opertok, opererror;
+ char symbolname[sNAMEMAX + 1];
+ char *str;
+ cell val, cidx, glbdecl;
+ int filenum;
+
+ litidx = 0; /* clear the literal pool ??? */
+ opertok = 0;
+ lastst = 0; /* no statement yet */
+ cidx = 0; /* just to avoid compiler warnings */
+ glbdecl = 0;
+ filenum = fcurrent; /* save file number at start of declaration */
+
+ if (firstname)
+ {
+ assert(strlen(firstname) <= sNAMEMAX);
+ strcpy(symbolname, firstname); /* save symbol name */
+ tag = firsttag;
+ }
+ else
+ {
+ tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
+ tok = lex(&val, &str);
+ assert(!fpublic);
+ if (tok == tNATIVE || (tok == tPUBLIC && stock))
+ error(42); /* invalid combination of class specifiers */
+ if (tok == tOPERATOR)
+ {
+ opertok = operatorname(symbolname);
+ if (opertok == 0)
+ return TRUE; /* error message already given */
+ check_operatortag(opertok, tag, symbolname);
+ }
+ else
+ {
+ if (tok != tSYMBOL && freading)
+ {
+ error(20, str); /* invalid symbol name */
+ return FALSE;
+ } /* if */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(symbolname, str);
+ } /* if */
+ } /* if */
+ /* check whether this is a function or a variable declaration */
+ if (!matchtoken('('))
+ return FALSE;
+ /* so it is a function, proceed */
+ funcline = fline; /* save line at which the function is defined */
+ if (symbolname[0] == PUBLIC_CHAR)
+ {
+ fpublic = TRUE; /* implicitly public function */
+ if (stock)
+ error(42); /* invalid combination of class specifiers */
+ } /* if */
+ sym = fetchfunc(symbolname, tag); /* get a pointer to the
+ * function entry */
+ if (!sym)
+ return TRUE;
+ if (fpublic)
+ sym->usage |= uPUBLIC;
+ if (fstatic)
+ sym->fnumber = filenum;
+ /* declare all arguments */
+ argcnt = declargs(sym);
+ opererror = !operatoradjust(opertok, sym, symbolname, tag);
+ if (strcmp(symbolname, uMAINFUNC) == 0)
+ {
+ if (argcnt > 0)
+ error(5); /* "main()" function may not have any arguments */
+ sym->usage |= uREAD; /* "main()" is the program's entry point:
+ * always used */
+ } /* if */
+ /* "declargs()" found the ")"; if a ";" appears after this, it was a
+ * prototype */
+ if (matchtoken(';'))
+ {
+ if (!sc_needsemicolon)
+ error(218); /* old style prototypes used with optional
+ * semicolumns */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* prototype is done;
+ * forget everything */
+ return TRUE;
+ } /* if */
+ /* so it is not a prototype, proceed */
+ /* if this is a function that is not referred to (this can only be
+ * detected in the second stage), shut code generation off */
+ if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
+ {
+ sc_status = statSKIP;
+ cidx = code_idx;
+ glbdecl = glb_declared;
+ } /* if */
+ begcseg();
+ sym->usage |= uDEFINE; /* set the definition flag */
+ if (fpublic)
+ sym->usage |= uREAD; /* public functions are always "used" */
+ if (stock)
+ sym->usage |= uSTOCK;
+ if (opertok != 0 && opererror)
+ sym->usage &= ~uDEFINE;
+ defsymbol(sym->name, iFUNCTN, sGLOBAL,
+ code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
+ /* ^^^ The address for the symbol is the code address. But the
+ * "symbol" instruction itself generates code. Therefore the
+ * offset is pre-adjusted to the value it will have after the
+ * symbol instruction.
+ */
+ startfunc(sym->name); /* creates stack frame */
+ if ((sc_debug & sSYMBOLIC) != 0)
+ setline(funcline, fcurrent);
+ if (sc_alignnext)
+ {
+ alignframe(sc_dataalign);
+ sc_alignnext = FALSE;
+ } /* if */
+ declared = 0; /* number of local cells */
+ rettype = (sym->usage & uRETVALUE); /* set "return type" variable */
+ curfunc = sym;
+ define_args(); /* add the symbolic info for the function arguments */
+ statement(NULL, FALSE);
+ if ((rettype & uRETVALUE) != 0)
+ sym->usage |= uRETVALUE;
+ if (declared != 0)
+ {
+ /* This happens only in a very special (and useless) case, where a
+ * function has only a single statement in its body (no compound
+ * block) and that statement declares a new variable
+ */
+ modstk((int)declared * sizeof(cell)); /* remove all local
+ * variables */
+ declared = 0;
+ } /* if */
+ if ((lastst != tRETURN) && (lastst != tGOTO))
+ {
+ const1(0);
+ ffret();
+ if ((sym->usage & uRETVALUE) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user
+ * defined operators */
+ funcdisplayname(symname, sym->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ } /* if */
+ endfunc();
+ if (litidx)
+ { /* if there are literals defined */
+ glb_declared += litidx;
+ begdseg(); /* flip to DATA segment */
+ dumplits(); /* dump literal strings */
+ litidx = 0;
+ } /* if */
+ testsymbols(&loctab, 0, TRUE, TRUE); /* test for unused arguments
+ * and labels */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* clear local variables
+ * queue */
+ assert(loctab.next == NULL);
+ curfunc = NULL;
+ if (sc_status == statSKIP)
+ {
+ sc_status = statWRITE;
+ code_idx = cidx;
+ glb_declared = glbdecl;
+ } /* if */
+ return TRUE;
+}
+
+static int
+argcompare(arginfo * a1, arginfo * a2)
+{
+ int result, level;
+
+ result = strcmp(a1->name, a2->name) == 0;
+ if (result)
+ result = a1->ident == a2->ident;
+ if (result)
+ result = a1->usage == a2->usage;
+ if (result)
+ result = a1->numtags == a2->numtags;
+ if (result)
+ {
+ int i;
+
+ for (i = 0; i < a1->numtags && result; i++)
+ result = a1->tags[i] == a2->tags[i];
+ } /* if */
+ if (result)
+ result = a1->hasdefault == a2->hasdefault;
+ if (a1->hasdefault)
+ {
+ if (a1->ident == iREFARRAY)
+ {
+ if (result)
+ result = a1->defvalue.array.size == a2->defvalue.array.size;
+ if (result)
+ result =
+ a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
+ /* also check the dimensions of both arrays */
+ if (result)
+ result = a1->numdim == a2->numdim;
+ for (level = 0; result && level < a1->numdim; level++)
+ result = a1->dim[level] == a2->dim[level];
+ /* ??? should also check contents of the default array
+ * (these troubles go away in a 2-pass compiler that forbids
+ * double declarations, but Small currently does not forbid them)
+ */
+ }
+ else
+ {
+ if (result)
+ {
+ if ((a1->hasdefault & uSIZEOF) != 0
+ || (a1->hasdefault & uTAGOF) != 0)
+ result = a1->hasdefault == a2->hasdefault
+ && strcmp(a1->defvalue.size.symname,
+ a2->defvalue.size.symname) == 0
+ && a1->defvalue.size.level == a2->defvalue.size.level;
+ else
+ result = a1->defvalue.val == a2->defvalue.val;
+ } /* if */
+ } /* if */
+ if (result)
+ result = a1->defvalue_tag == a2->defvalue_tag;
+ } /* if */
+ return result;
+}
+
+/* declargs()
+ *
+ * This routine adds an entry in the local symbol table for each
+ * argument found in the argument list.
+ * It returns the number of arguments.
+ */
+static int
+declargs(symbol * sym)
+{
+#define MAXTAGS 16
+ char *ptr;
+ int argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
+ cell val;
+ arginfo arg, *arglist;
+ char name[sNAMEMAX + 1];
+ int ident, fpublic, fconst;
+ int idx;
+
+ /* if the function is already defined earlier, get the number of
+ * arguments of the existing definition
+ */
+ oldargcnt = 0;
+ if ((sym->usage & uPROTOTYPED) != 0)
+ while (sym->dim.arglist[oldargcnt].ident != 0)
+ oldargcnt++;
+ argcnt = 0; /* zero aruments up to now */
+ ident = iVARIABLE;
+ numtags = 0;
+ fconst = FALSE;
+ fpublic = (sym->usage & uPUBLIC) != 0;
+ /* the '(' parantheses has already been parsed */
+ if (!matchtoken(')'))
+ {
+ do
+ { /* there are arguments; process them */
+ /* any legal name increases argument count (and stack offset) */
+ tok = lex(&val, &ptr);
+ switch (tok)
+ {
+ case 0:
+ /* nothing */
+ break;
+ case '&':
+ if (ident != iVARIABLE || numtags > 0)
+ error(1, "-identifier-", "&");
+ ident = iREFERENCE;
+ break;
+ case tCONST:
+ if (ident != iVARIABLE || numtags > 0)
+ error(1, "-identifier-", "const");
+ fconst = TRUE;
+ break;
+ case tLABEL:
+ if (numtags > 0)
+ error(1, "-identifier-", "-tagname-");
+ tags[0] = sc_addtag(ptr);
+ numtags = 1;
+ break;
+ case '{':
+ if (numtags > 0)
+ error(1, "-identifier-", "-tagname-");
+ numtags = 0;
+ while (numtags < MAXTAGS)
+ {
+ if (!matchtoken('_') && !needtoken(tSYMBOL))
+ break;
+ tokeninfo(&val, &ptr);
+ tags[numtags++] = sc_addtag(ptr);
+ if (matchtoken('}'))
+ break;
+ needtoken(',');
+ } /* for */
+ needtoken(':');
+ tok = tLABEL; /* for outer loop:
+ * flag that we have seen a tagname */
+ break;
+ case tSYMBOL:
+ if (argcnt >= sMAXARGS)
+ error(45); /* too many function arguments */
+ strcpy(name, ptr); /* save symbol name */
+ if (name[0] == PUBLIC_CHAR)
+ error(56, name); /* function arguments cannot be public */
+ if (numtags == 0)
+ tags[numtags++] = 0; /* default tag */
+ /* Stack layout:
+ * base + 0*sizeof(cell) == previous "base"
+ * base + 1*sizeof(cell) == function return address
+ * base + 2*sizeof(cell) == number of arguments
+ * base + 3*sizeof(cell) == first argument of the function
+ * So the offset of each argument is:
+ * "(argcnt+3) * sizeof(cell)".
+ */
+ doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
+ fpublic, fconst, &arg);
+ if (fpublic && arg.hasdefault)
+ error(59, name); /* arguments of a public function may not
+ * have a default value */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ {
+ /* redimension the argument list, add the entry */
+ sym->dim.arglist =
+ (arginfo *) realloc(sym->dim.arglist,
+ (argcnt + 2) * sizeof(arginfo));
+ if (!sym->dim.arglist)
+ error(103); /* insufficient memory */
+ sym->dim.arglist[argcnt] = arg;
+ sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
+ * terminated */
+ }
+ else
+ {
+ /* check the argument with the earlier definition */
+ if (argcnt > oldargcnt
+ || !argcompare(&sym->dim.arglist[argcnt], &arg))
+ error(25); /* function definition does not match prototype */
+ /* may need to free default array argument and the tag list */
+ if (arg.ident == iREFARRAY && arg.hasdefault)
+ free(arg.defvalue.array.data);
+ else if (arg.ident == iVARIABLE
+ && ((arg.hasdefault & uSIZEOF) != 0
+ || (arg.hasdefault & uTAGOF) != 0))
+ free(arg.defvalue.size.symname);
+ free(arg.tags);
+ } /* if */
+ argcnt++;
+ ident = iVARIABLE;
+ numtags = 0;
+ fconst = FALSE;
+ break;
+ case tELLIPS:
+ if (ident != iVARIABLE)
+ error(10); /* illegal function or declaration */
+ if (numtags == 0)
+ tags[numtags++] = 0; /* default tag */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ {
+ /* redimension the argument list, add the entry iVARARGS */
+ sym->dim.arglist =
+ (arginfo *) realloc(sym->dim.arglist,
+ (argcnt + 2) * sizeof(arginfo));
+ if (!sym->dim.arglist)
+ error(103); /* insufficient memory */
+ sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
+ * terminated */
+ sym->dim.arglist[argcnt].ident = iVARARGS;
+ sym->dim.arglist[argcnt].hasdefault = FALSE;
+ sym->dim.arglist[argcnt].defvalue.val = 0;
+ sym->dim.arglist[argcnt].defvalue_tag = 0;
+ sym->dim.arglist[argcnt].numtags = numtags;
+ sym->dim.arglist[argcnt].tags =
+ (int *)malloc(numtags * sizeof tags[0]);
+ if (!sym->dim.arglist[argcnt].tags)
+ error(103); /* insufficient memory */
+ memcpy(sym->dim.arglist[argcnt].tags, tags,
+ numtags * sizeof tags[0]);
+ }
+ else
+ {
+ if (argcnt > oldargcnt
+ || sym->dim.arglist[argcnt].ident != iVARARGS)
+ error(25); /* function definition does not match prototype */
+ } /* if */
+ argcnt++;
+ break;
+ default:
+ error(10); /* illegal function or declaration */
+ } /* switch */
+ }
+ while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(','))); /* more? */
+ /* if the next token is not ",", it should be ")" */
+ needtoken(')');
+ } /* if */
+ /* resolve any "sizeof" arguments (now that all arguments are known) */
+ assert(sym->dim.arglist != NULL);
+ arglist = sym->dim.arglist;
+ for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
+ {
+ if ((arglist[idx].hasdefault & uSIZEOF) != 0
+ || (arglist[idx].hasdefault & uTAGOF) != 0)
+ {
+ int altidx;
+
+ /* Find the argument with the name mentioned after the "sizeof".
+ * Note that we cannot use findloc here because we need the
+ * arginfo struct, not the symbol.
+ */
+ ptr = arglist[idx].defvalue.size.symname;
+ for (altidx = 0;
+ altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
+ altidx++)
+ /* nothing */ ;
+ if (altidx >= argcnt)
+ {
+ error(17, ptr); /* undefined symbol */
+ }
+ else
+ {
+ /* check the level against the number of dimensions */
+ /* the level must be zero for "tagof" values */
+ assert(arglist[idx].defvalue.size.level == 0
+ || (arglist[idx].hasdefault & uSIZEOF) != 0);
+ if (arglist[idx].defvalue.size.level > 0
+ && arglist[idx].defvalue.size.level >=
+ arglist[altidx].numdim)
+ error(28); /* invalid subscript */
+ if (arglist[altidx].ident != iREFARRAY)
+ {
+ assert(arglist[altidx].ident == iVARIABLE
+ || arglist[altidx].ident == iREFERENCE);
+ error(223, ptr); /* redundant sizeof */
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* for */
+
+ sym->usage |= uPROTOTYPED;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ return argcnt;
+}
+
+/* doarg - declare one argument type
+ *
+ * this routine is called from "declargs()" and adds an entry in the
+ * local symbol table for one argument. "fpublic" indicates whether
+ * the function for this argument list is public.
+ * The arguments themselves are never public.
+ */
+static void
+doarg(char *name, int ident, int offset, int tags[], int numtags,
+ int fpublic, int fconst, arginfo * arg)
+{
+ symbol *argsym;
+ cell size;
+ int idxtag[sDIMEN_MAX];
+
+ strcpy(arg->name, name);
+ arg->hasdefault = FALSE; /* preset (most common case) */
+ arg->defvalue.val = 0; /* clear */
+ arg->defvalue_tag = 0;
+ arg->numdim = 0;
+ if (matchtoken('['))
+ {
+ if (ident == iREFERENCE)
+ error(67, name); /*illegal declaration ("&name[]" is unsupported) */
+ do
+ {
+ if (arg->numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return;
+ } /* if */
+ /* there is no check for non-zero major dimensions here, only if
+ * the array parameter has a default value, we enforce that all
+ * array dimensions, except the last, are non-zero
+ */
+ size = needsub(&idxtag[arg->numdim]); /* may be zero here,
+ *it is a pointer anyway */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ arg->dim[arg->numdim] = (int)size;
+ arg->numdim += 1;
+ }
+ while (matchtoken('['));
+ ident = iREFARRAY; /* "reference to array" (is a pointer) */
+ if (matchtoken('='))
+ {
+ int level;
+
+ lexpush(); /* initials() needs the "=" token again */
+ assert(numtags > 0);
+ /* for the moment, when a default value is given for the array,
+ * all dimension sizes, except the last, must be non-zero
+ * (function initials() requires to know the major dimensions)
+ */
+ for (level = 0; level < arg->numdim - 1; level++)
+ if (arg->dim[level] == 0)
+ error(52); /* only last dimension may be variable length */
+ initials(ident, tags[0], &size, arg->dim, arg->numdim);
+ assert(size >= litidx);
+ /* allocate memory to hold the initial values */
+ arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
+ if (arg->defvalue.array.data)
+ {
+ int i;
+
+ memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
+ arg->hasdefault = TRUE; /* argument has default value */
+ arg->defvalue.array.size = litidx;
+ arg->defvalue.array.addr = -1;
+ /* calculate size to reserve on the heap */
+ arg->defvalue.array.arraysize = 1;
+ for (i = 0; i < arg->numdim; i++)
+ arg->defvalue.array.arraysize *= arg->dim[i];
+ if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
+ arg->defvalue.array.arraysize = arg->defvalue.array.size;
+ } /* if */
+ litidx = 0; /* reset */
+ } /* if */
+ }
+ else
+ {
+ if (matchtoken('='))
+ {
+ unsigned char size_tag_token;
+
+ assert(ident == iVARIABLE || ident == iREFERENCE);
+ arg->hasdefault = TRUE; /* argument has a default value */
+ size_tag_token =
+ (unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
+ if (size_tag_token == 0)
+ size_tag_token =
+ (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
+ if (size_tag_token != 0)
+ {
+ int paranthese;
+
+ if (ident == iREFERENCE)
+ error(66, name); /* argument may not be a reference */
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ if (needtoken(tSYMBOL))
+ {
+ /* save the name of the argument whose size id to take */
+ char *name;
+ cell val;
+
+ tokeninfo(&val, &name);
+ if (!(arg->defvalue.size.symname = strdup(name)))
+ error(103); /* insufficient memory */
+ arg->defvalue.size.level = 0;
+ if (size_tag_token == uSIZEOF)
+ {
+ while (matchtoken('['))
+ {
+ arg->defvalue.size.level += (short)1;
+ needtoken(']');
+ } /* while */
+ } /* if */
+ if (ident == iVARIABLE) /* make sure we set this only if
+ * not a reference */
+ arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
+ } /* if */
+ while (paranthese--)
+ needtoken(')');
+ }
+ else
+ {
+ constexpr(&arg->defvalue.val, &arg->defvalue_tag);
+ assert(numtags > 0);
+ if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
+ error(213); /* tagname mismatch */
+ } /* if */
+ } /* if */
+ } /* if */
+ arg->ident = (char)ident;
+ arg->usage = (char)(fconst ? uCONST : 0);
+ arg->numtags = numtags;
+ arg->tags = (int *)malloc(numtags * sizeof tags[0]);
+ if (!arg->tags)
+ error(103); /* insufficient memory */
+ memcpy(arg->tags, tags, numtags * sizeof tags[0]);
+ argsym = findloc(name);
+ if (argsym)
+ {
+ error(21, name); /* symbol already defined */
+ }
+ else
+ {
+ if ((argsym = findglb(name)) && argsym->ident != iFUNCTN)
+ error(219, name); /* variable shadows another symbol */
+ /* add details of type and address */
+ assert(numtags > 0);
+ argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
+ arg->dim, arg->numdim, idxtag);
+ argsym->compound = 0;
+ if (ident == iREFERENCE)
+ argsym->usage |= uREAD; /* because references are passed back */
+ if (fpublic)
+ argsym->usage |= uREAD; /* arguments of public functions
+ * are always "used" */
+ if (fconst)
+ argsym->usage |= uCONST;
+ } /* if */
+}
+
+static int
+count_referrers(symbol * entry)
+{
+ int i, count;
+
+ count = 0;
+ for (i = 0; i < entry->numrefers; i++)
+ if (entry->refer[i])
+ count++;
+ return count;
+}
+
+/* Every symbol has a referrer list, that contains the functions that
+ * use the symbol. Now, if function "apple" is accessed by functions
+ * "banana" and "citron", but neither function "banana" nor "citron" are
+ * used by anyone else, then, by inference, function "apple" is not used
+ * either. */
+static void
+reduce_referrers(symbol * root)
+{
+ int i, restart;
+ symbol *sym, *ref;
+
+ do
+ {
+ restart = 0;
+ for (sym = root->next; sym; sym = sym->next)
+ {
+ if (sym->parent)
+ continue; /* hierarchical data type */
+ if (sym->ident == iFUNCTN
+ && (sym->usage & uNATIVE) == 0
+ && (sym->usage & uPUBLIC) == 0
+ && strcmp(sym->name, uMAINFUNC) != 0
+ && count_referrers(sym) == 0)
+ {
+ sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
+ * there is no referrer */
+ /* find all symbols that are referred by this symbol */
+ for (ref = root->next; ref; ref = ref->next)
+ {
+ if (ref->parent)
+ continue; /* hierarchical data type */
+ assert(ref->refer != NULL);
+ for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
+ i++)
+ /* nothing */ ;
+ if (i < ref->numrefers)
+ {
+ assert(ref->refer[i] == sym);
+ ref->refer[i] = NULL;
+ restart++;
+ } /* if */
+ } /* for */
+ }
+ else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
+ && (sym->usage & uPUBLIC) == 0
+ && !sym->parent && count_referrers(sym) == 0)
+ {
+ sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
+ * there is no referrer */
+ } /* if */
+ } /* for */
+ /* after removing a symbol, check whether more can be removed */
+ }
+ while (restart > 0);
+}
+
+/* testsymbols - test for unused local or global variables
+ *
+ * "Public" functions are excluded from the check, since these
+ * may be exported to other object modules.
+ * Labels are excluded from the check if the argument 'testlabs'
+ * is 0. Thus, labels are not tested until the end of the function.
+ * Constants may also be excluded (convenient for global constants).
+ *
+ * When the nesting level drops below "level", the check stops.
+ *
+ * The function returns whether there is an "entry" point for the file.
+ * This flag will only be 1 when browsing the global symbol table.
+ */
+static int
+testsymbols(symbol * root, int level, int testlabs, int testconst)
+{
+ char symname[2 * sNAMEMAX + 16];
+ int entry = FALSE;
+
+ symbol *sym = root->next;
+
+ while (sym && sym->compound >= level)
+ {
+ switch (sym->ident)
+ {
+ case iLABEL:
+ if (testlabs)
+ {
+ if ((sym->usage & uDEFINE) == 0)
+ error(19, sym->name); /* not a label: ... */
+ else if ((sym->usage & uREAD) == 0)
+ error(203, sym->name); /* symbol isn't used: ... */
+ } /* if */
+ break;
+ case iFUNCTN:
+ if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
+ {
+ funcdisplayname(symname, sym->name);
+ if (symname[0] != '\0')
+ error(203, symname); /* symbol isn't used ...
+ * (and not native/stock) */
+ } /* if */
+ if ((sym->usage & uPUBLIC) != 0
+ || strcmp(sym->name, uMAINFUNC) == 0)
+ entry = TRUE; /* there is an entry point */
+ break;
+ case iCONSTEXPR:
+ if (testconst && (sym->usage & uREAD) == 0)
+ error(203, sym->name); /* symbol isn't used: ... */
+ break;
+ default:
+ /* a variable */
+ if (sym->parent)
+ break; /* hierarchical data type */
+ if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
+ error(203, sym->name); /* symbol isn't used (and not stock
+ * or public) */
+ else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
+ error(204, sym->name); /* value assigned to symbol is
+ * never used */
+#if 0 /*// ??? not sure whether it is a good idea to
+ * force people use "const" */
+ else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
+ && sym->ident == iREFARRAY)
+ error(214, sym->name); /* make array argument "const" */
+#endif
+ } /* if */
+ sym = sym->next;
+ } /* while */
+
+ return entry;
+}
+
+static cell
+calc_array_datasize(symbol * sym, cell * offset)
+{
+ cell length;
+
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ length = sym->dim.array.length;
+ if (sym->dim.array.level > 0)
+ {
+ cell sublength =
+ calc_array_datasize(finddepend(sym), offset);
+ if (offset)
+ *offset = length * (*offset + sizeof(cell));
+ if (sublength > 0)
+ length *= length * sublength;
+ else
+ length = 0;
+ }
+ else
+ {
+ if (offset)
+ *offset = 0;
+ } /* if */
+ return length;
+}
+
+static void
+destructsymbols(symbol * root, int level)
+{
+ cell offset = 0;
+ int savepri = FALSE;
+ symbol *sym = root->next;
+
+ while (sym && sym->compound >= level)
+ {
+ if (sym->ident == iVARIABLE || sym->ident == iARRAY)
+ {
+ char symbolname[16];
+ symbol *opsym;
+ cell elements;
+
+ /* check that the '~' operator is defined for this tag */
+ operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
+ if ((opsym = findglb(symbolname)))
+ {
+ /* save PRI, in case of a return statement */
+ if (!savepri)
+ {
+ push1(); /* right-hand operand is in PRI */
+ savepri = TRUE;
+ } /* if */
+ /* if the variable is an array, get the number of elements */
+ if (sym->ident == iARRAY)
+ {
+ elements = calc_array_datasize(sym, &offset);
+ /* "elements" can be zero when the variable is declared like
+ * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
+ * one should declare all dimensions!
+ */
+ if (elements == 0)
+ error(46, sym->name); /* array size is unknown */
+ }
+ else
+ {
+ elements = 1;
+ offset = 0;
+ } /* if */
+ pushval(elements);
+ /* call the '~' operator */
+ address(sym);
+ addconst(offset); /*add offset to array data to the address */
+ push1();
+ pushval(2 * sizeof(cell)); /* 2 parameters */
+ ffcall(opsym, 1);
+ if (sc_status != statSKIP)
+ markusage(opsym, uREAD); /* do not mark as "used" when this
+ * call itself is skipped */
+ if (opsym->x.lib)
+ opsym->x.lib->value += 1; /* increment "usage count"
+ * of the library */
+ } /* if */
+ } /* if */
+ sym = sym->next;
+ } /* while */
+ /* restore PRI, if it was saved */
+ if (savepri)
+ pop1();
+}
+
+static constvalue *
+insert_constval(constvalue * prev, constvalue * next, char *name,
+ cell val, short idx)
+{
+ constvalue *cur;
+
+ if (!(cur = (constvalue *)malloc(sizeof(constvalue))))
+ error(103); /* insufficient memory (fatal error) */
+ memset(cur, 0, sizeof(constvalue));
+ strcpy(cur->name, name);
+ cur->value = val;
+ cur->index = idx;
+ cur->next = next;
+ prev->next = cur;
+ return cur;
+}
+
+constvalue *
+append_constval(constvalue * table, char *name, cell val, short idx)
+{
+ constvalue *cur, *prev;
+
+ /* find the end of the constant table */
+ for (prev = table, cur = table->next; cur;
+ prev = cur, cur = cur->next)
+ /* nothing */ ;
+ return insert_constval(prev, NULL, name, val, idx);
+}
+
+constvalue *
+find_constval(constvalue * table, char *name, short idx)
+{
+ constvalue *ptr = table->next;
+
+ while (ptr)
+ {
+ if (strcmp(name, ptr->name) == 0 && ptr->index == idx)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+static constvalue *
+find_constval_byval(constvalue * table, cell val)
+{
+ constvalue *ptr = table->next;
+
+ while (ptr)
+ {
+ if (ptr->value == val)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+#if 0 /* never used */
+static int
+delete_constval(constvalue * table, char *name)
+{
+ constvalue *prev = table;
+ constvalue *cur = prev->next;
+
+ while (cur != NULL)
+ {
+ if (strcmp(name, cur->name) == 0)
+ {
+ prev->next = cur->next;
+ free(cur);
+ return TRUE;
+ } /* if */
+ prev = cur;
+ cur = cur->next;
+ } /* while */
+ return FALSE;
+}
+#endif
+
+void
+delete_consttable(constvalue * table)
+{
+ constvalue *cur = table->next, *next;
+
+ while (cur)
+ {
+ next = cur->next;
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(table, 0, sizeof(constvalue));
+}
+
+/* add_constant
+ *
+ * Adds a symbol to the #define symbol table.
+ */
+void
+add_constant(char *name, cell val, int vclass, int tag)
+{
+ symbol *sym;
+
+ /* Test whether a global or local symbol with the same name exists. Since
+ * constants are stored in the symbols table, this also finds previously
+ * defind constants. */
+ sym = findglb(name);
+ if (!sym)
+ sym = findloc(name);
+ if (sym)
+ {
+ /* silently ignore redefinitions of constants with the same value */
+ if (sym->ident == iCONSTEXPR)
+ {
+ if (sym->addr != val)
+ error(201, name); /* redefinition of constant (different value) */
+ }
+ else
+ {
+ error(21, name); /* symbol already defined */
+ } /* if */
+ return;
+ } /* if */
+
+ /* constant doesn't exist yet, an entry must be created */
+ sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
+ if (sc_status == statIDLE)
+ sym->usage |= uPREDEF;
+}
+
+/* statement - The Statement Parser
+ *
+ * This routine is called whenever the parser needs to know what
+ * statement it encounters (i.e. whenever program syntax requires a
+ * statement).
+ */
+static void
+statement(int *lastindent, int allow_decl)
+{
+ int tok;
+ cell val;
+ char *st;
+
+ if (!freading)
+ {
+ error(36); /* empty statement */
+ return;
+ } /* if */
+ errorset(sRESET);
+
+ tok = lex(&val, &st);
+ if (tok != '{')
+ setline(fline, fcurrent);
+ /* lex() has set stmtindent */
+ if (lastindent && tok != tLABEL)
+ {
+#if 0
+ if (*lastindent >= 0 && *lastindent != stmtindent &&
+ !indent_nowarn && sc_tabsize > 0)
+ error(217); /* loose indentation */
+#endif
+ *lastindent = stmtindent;
+ indent_nowarn = TRUE; /* if warning was blocked, re-enable it */
+ } /* if */
+ switch (tok)
+ {
+ case 0:
+ /* nothing */
+ break;
+ case tNEW:
+ if (allow_decl)
+ {
+ declloc(FALSE);
+ lastst = tNEW;
+ }
+ else
+ {
+ error(3); /* declaration only valid in a block */
+ } /* if */
+ break;
+ case tSTATIC:
+ if (allow_decl)
+ {
+ declloc(TRUE);
+ lastst = tNEW;
+ }
+ else
+ {
+ error(3); /* declaration only valid in a block */
+ } /* if */
+ break;
+ case '{':
+ if (!matchtoken('}')) /* {} is the empty statement */
+ compound();
+ /* lastst (for "last statement") does not change */
+ break;
+ case ';':
+ error(36); /* empty statement */
+ break;
+ case tIF:
+ doif();
+ lastst = tIF;
+ break;
+ case tWHILE:
+ dowhile();
+ lastst = tWHILE;
+ break;
+ case tDO:
+ dodo();
+ lastst = tDO;
+ break;
+ case tFOR:
+ dofor();
+ lastst = tFOR;
+ break;
+ case tSWITCH:
+ doswitch();
+ lastst = tSWITCH;
+ break;
+ case tCASE:
+ case tDEFAULT:
+ error(14); /* not in switch */
+ break;
+ case tGOTO:
+ dogoto();
+ lastst = tGOTO;
+ break;
+ case tLABEL:
+ dolabel();
+ lastst = tLABEL;
+ break;
+ case tRETURN:
+ doreturn();
+ lastst = tRETURN;
+ break;
+ case tBREAK:
+ dobreak();
+ lastst = tBREAK;
+ break;
+ case tCONTINUE:
+ docont();
+ lastst = tCONTINUE;
+ break;
+ case tEXIT:
+ doexit();
+ lastst = tEXIT;
+ break;
+ case tASSERT:
+ doassert();
+ lastst = tASSERT;
+ break;
+ case tSLEEP:
+ dosleep();
+ lastst = tSLEEP;
+ break;
+ case tCONST:
+ decl_const(sLOCAL);
+ break;
+ case tENUM:
+ decl_enum(sLOCAL);
+ break;
+ default: /* non-empty expression */
+ lexpush(); /* analyze token later */
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
+ needtoken(tTERM);
+ lastst = tEXPR;
+ } /* switch */
+}
+
+static void
+compound(void)
+{
+ int indent = -1;
+ cell save_decl = declared;
+ int count_stmt = 0;
+
+ nestlevel += 1; /* increase compound statement level */
+ while (matchtoken('}') == 0)
+ { /* repeat until compound statement is closed */
+ if (!freading)
+ {
+ needtoken('}'); /* gives error: "expected token }" */
+ break;
+ }
+ else
+ {
+ if (count_stmt > 0
+ && (lastst == tRETURN || lastst == tBREAK
+ || lastst == tCONTINUE))
+ error(225); /* unreachable code */
+ statement(&indent, TRUE); /* do a statement */
+ count_stmt++;
+ } /* if */
+ } /* while */
+ if (lastst != tRETURN)
+ destructsymbols(&loctab, nestlevel);
+ if (lastst != tRETURN && lastst != tGOTO)
+ /* delete local variable space */
+ modstk((int)(declared - save_decl) * sizeof(cell));
+
+ testsymbols(&loctab, nestlevel, FALSE, TRUE); /* look for unused
+ * block locals */
+ declared = save_decl;
+ delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+ /* erase local symbols, but
+ * retain block local labels
+ * (within the function) */
+
+ nestlevel -= 1; /* decrease compound statement level */
+}
+
+/* doexpr
+ *
+ * Global references: stgidx (referred to only)
+ */
+static void
+doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
+ int *tag, int chkfuncresult)
+{
+ int constant, idx, ident;
+ int localstaging = FALSE;
+ cell val;
+
+ if (!staging)
+ {
+ stgset(TRUE); /* start stage-buffering */
+ localstaging = TRUE;
+ assert(stgidx == 0);
+ } /* if */
+ idx = stgidx;
+ errorset(sEXPRMARK);
+ do
+ {
+ /* on second round through, mark the end of the previous expression */
+ if (idx != stgidx)
+ endexpr(TRUE);
+ sideeffect = FALSE;
+ ident = expression(&constant, &val, tag, chkfuncresult);
+ if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
+ error(33, "-unknown-"); /* array must be indexed */
+ if (chkeffect && !sideeffect)
+ error(215); /* expression has no effect */
+ }
+ while (comma && matchtoken(',')); /* more? */
+ if (mark_endexpr)
+ endexpr(TRUE); /* optionally, mark the end of the expression */
+ errorset(sEXPRRELEASE);
+ if (localstaging)
+ {
+ stgout(idx);
+ stgset(FALSE); /* stop staging */
+ } /* if */
+}
+
+/* constexpr
+ */
+int
+constexpr(cell * val, int *tag)
+{
+ int constant, idx;
+ cell cidx;
+
+ stgset(TRUE); /* start stage-buffering */
+ stgget(&idx, &cidx); /* mark position in code generator */
+ errorset(sEXPRMARK);
+ expression(&constant, val, tag, FALSE);
+ stgdel(idx, cidx); /* scratch generated code */
+ stgset(FALSE); /* stop stage-buffering */
+ if (constant == 0)
+ error(8); /* must be constant expression */
+ errorset(sEXPRRELEASE);
+ return constant;
+}
+
+/* test
+ *
+ * In the case a "simple assignment" operator ("=") is used within a
+ * test, * the warning "possibly unintended assignment" is displayed.
+ * This routine sets the global variable "intest" to true, it is
+ * restored upon termination. In the case the assignment was intended,
+ * use parantheses around the expression to avoid the warning;
+ * primary() sets "intest" to 0.
+ *
+ * Global references: intest (altered, but restored upon termination)
+ */
+static void
+test(int label, int parens, int invert)
+{
+ int idx, tok;
+ cell cidx;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ int localstaging = FALSE;
+
+ if (!staging)
+ {
+ stgset(TRUE); /* start staging */
+ localstaging = TRUE;
+#if !defined NDEBUG
+ stgget(&idx, &cidx); /* should start at zero if started
+ * locally */
+ assert(idx == 0);
+#endif
+ } /* if */
+
+ pushstk((stkitem) intest);
+ intest = 1;
+ if (parens)
+ needtoken('(');
+ do
+ {
+ stgget(&idx, &cidx); /* mark position (of last expression) in
+ * code generator */
+ if (hier14(&lval))
+ rvalue(&lval);
+ tok = matchtoken(',');
+ if (tok)
+ endexpr(TRUE);
+ }
+ while (tok); /* do */
+ if (parens)
+ needtoken(')');
+ if (lval.ident == iARRAY || lval.ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval.sym->name) ? lval.sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ if (lval.ident == iCONSTEXPR)
+ { /* constant expression */
+ intest = (int)(long)popstk(); /* restore stack */
+ stgdel(idx, cidx);
+ if (lval.constval)
+ { /* code always executed */
+ error(206); /* redundant test: always non-zero */
+ }
+ else
+ {
+ error(205); /* redundant code: never executed */
+ jumplabel(label);
+ } /* if */
+ if (localstaging)
+ {
+ stgout(0); /* write "jumplabel" code */
+ stgset(FALSE); /* stop staging */
+ } /* if */
+ return;
+ } /* if */
+ if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
+ if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
+ invert = !invert; /* user-defined ! operator inverted result */
+ if (invert)
+ jmp_ne0(label); /* jump to label if true (different from 0) */
+ else
+ jmp_eq0(label); /* jump to label if false (equal to 0) */
+ endexpr(TRUE); /* end expression (give optimizer a chance) */
+ intest = (int)(long)popstk(); /* double typecast to avoid warning
+ * with Microsoft C */
+ if (localstaging)
+ {
+ stgout(0); /* output queue from the very beginning (see
+ * assert() when localstaging is set to TRUE) */
+ stgset(FALSE); /* stop staging */
+ } /* if */
+}
+
+static void
+doif(void)
+{
+ int flab1, flab2;
+ int ifindent;
+
+ ifindent = stmtindent; /* save the indent of the "if" instruction */
+ flab1 = getlabel(); /* get label number for false branch */
+ test(flab1, TRUE, FALSE); /*get expression, branch to flab1 if false */
+ statement(NULL, FALSE); /* if true, do a statement */
+ if (matchtoken(tELSE) == 0)
+ { /* if...else ? */
+ setlabel(flab1); /* no, simple if..., print false label */
+ }
+ else
+ {
+ /* to avoid the "dangling else" error, we want a warning if the "else"
+ * has a lower indent than the matching "if" */
+#if 0
+ if (stmtindent < ifindent && sc_tabsize > 0)
+ error(217); /* loose indentation */
+#endif
+ flab2 = getlabel();
+ if ((lastst != tRETURN) && (lastst != tGOTO))
+ jumplabel(flab2);
+ setlabel(flab1); /* print false label */
+ statement(NULL, FALSE); /* do "else" clause */
+ setlabel(flab2); /* print true label */
+ } /* endif */
+}
+
+static void
+dowhile(void)
+{
+ int wq[wqSIZE]; /* allocate local queue */
+
+ addwhile(wq); /* add entry to queue for "break" */
+ setlabel(wq[wqLOOP]); /* loop label */
+ /* The debugger uses the "line" opcode to be able to "break" out of
+ * a loop. To make sure that each loop has a line opcode, even for the
+ * tiniest loop, set it below the top of the loop */
+ setline(fline, fcurrent);
+ test(wq[wqEXIT], TRUE, FALSE); /* branch to wq[wqEXIT] if false */
+ statement(NULL, FALSE); /* if so, do a statement */
+ jumplabel(wq[wqLOOP]); /* and loop to "while" start */
+ setlabel(wq[wqEXIT]); /* exit label */
+ delwhile(); /* delete queue entry */
+}
+
+/*
+ * Note that "continue" will in this case not jump to the top of the
+ * loop, but to the end: just before the TRUE-or-FALSE testing code.
+ */
+static void
+dodo(void)
+{
+ int wq[wqSIZE], top;
+
+ addwhile(wq); /* see "dowhile" for more info */
+ top = getlabel(); /* make a label first */
+ setlabel(top); /* loop label */
+ statement(NULL, FALSE);
+ needtoken(tWHILE);
+ setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
+ setline(fline, fcurrent);
+ test(wq[wqEXIT], TRUE, FALSE);
+ jumplabel(top);
+ setlabel(wq[wqEXIT]);
+ delwhile();
+ needtoken(tTERM);
+}
+
+static void
+dofor(void)
+{
+ int wq[wqSIZE], skiplab;
+ cell save_decl;
+ int save_nestlevel, idx;
+ int *ptr;
+
+ save_decl = declared;
+ save_nestlevel = nestlevel;
+
+ addwhile(wq);
+ skiplab = getlabel();
+ needtoken('(');
+ if (matchtoken(';') == 0)
+ {
+ /* new variable declarations are allowed here */
+ if (matchtoken(tNEW))
+ {
+ /* The variable in expr1 of the for loop is at a
+ * 'compound statement' level of it own.
+ */
+ nestlevel++;
+ declloc(FALSE); /* declare local variable */
+ }
+ else
+ {
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 1 */
+ needtoken(';');
+ } /* if */
+ } /* if */
+ /* Adjust the "declared" field in the "while queue", in case that
+ * local variables were declared in the first expression of the
+ * "for" loop. These are deleted in separately, so a "break" or a
+ * "continue" must ignore these fields.
+ */
+ ptr = readwhile();
+ assert(ptr != NULL);
+ ptr[wqBRK] = (int)declared;
+ ptr[wqCONT] = (int)declared;
+ jumplabel(skiplab); /* skip expression 3 1st time */
+ setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
+ setline(fline, fcurrent);
+ /* Expressions 2 and 3 are reversed in the generated code:
+ * expression 3 precedes expression 2.
+ * When parsing, the code is buffered and marks for
+ * the start of each expression are insterted in the buffer.
+ */
+ assert(!staging);
+ stgset(TRUE); /* start staging */
+ assert(stgidx == 0);
+ idx = stgidx;
+ stgmark(sSTARTREORDER);
+ stgmark((char)(sEXPRSTART + 0)); /* mark start of 2nd expression
+ * in stage */
+ setlabel(skiplab); /*jump to this point after 1st expression */
+ if (matchtoken(';') == 0)
+ {
+ test(wq[wqEXIT], FALSE, FALSE); /* expression 2
+ *(jump to wq[wqEXIT] if false) */
+ needtoken(';');
+ } /* if */
+ stgmark((char)(sEXPRSTART + 1)); /* mark start of 3th expression
+ * in stage */
+ if (matchtoken(')') == 0)
+ {
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 3 */
+ needtoken(')');
+ } /* if */
+ stgmark(sENDREORDER); /* mark end of reversed evaluation */
+ stgout(idx);
+ stgset(FALSE); /* stop staging */
+ statement(NULL, FALSE);
+ jumplabel(wq[wqLOOP]);
+ setlabel(wq[wqEXIT]);
+ delwhile();
+
+ assert(nestlevel >= save_nestlevel);
+ if (nestlevel > save_nestlevel)
+ {
+ /* Clean up the space and the symbol table for the local
+ * variable in "expr1".
+ */
+ destructsymbols(&loctab, nestlevel);
+ modstk((int)(declared - save_decl) * sizeof(cell));
+ declared = save_decl;
+ delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+ nestlevel = save_nestlevel; /* reset 'compound statement'
+ * nesting level */
+ } /* if */
+}
+
+/* The switch statement is incompatible with its C sibling:
+ * 1. the cases are not drop through
+ * 2. only one instruction may appear below each case, use a compound
+ * instruction to execute multiple instructions
+ * 3. the "case" keyword accepts a comma separated list of values to
+ * match, it also accepts a range using the syntax "1 .. 4"
+ *
+ * SWITCH param
+ * PRI = expression result
+ * param = table offset (code segment)
+ *
+ */
+static void
+doswitch(void)
+{
+ int lbl_table, lbl_exit, lbl_case;
+ int tok, swdefault, casecount;
+ cell val;
+ char *str;
+ constvalue caselist = { NULL, "", 0, 0 }; /*case list starts empty */
+ constvalue *cse, *csp;
+ char labelname[sNAMEMAX + 1];
+
+ needtoken('(');
+ doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE); /* evaluate
+ * switch expression */
+ needtoken(')');
+ /* generate the code for the switch statement, the label is the
+ * address of the case table (to be generated later).
+ */
+ lbl_table = getlabel();
+ lbl_case = 0; /* just to avoid a compiler warning */
+ ffswitch(lbl_table);
+
+ needtoken('{');
+ lbl_exit = getlabel(); /*get label number for jumping out of switch */
+ swdefault = FALSE;
+ casecount = 0;
+ do
+ {
+ tok = lex(&val, &str); /* read in (new) token */
+ switch (tok)
+ {
+ case tCASE:
+ if (swdefault != FALSE)
+ error(15); /* "default" case must be last in switch
+ * statement */
+ lbl_case = getlabel();
+ sc_allowtags = FALSE; /* do not allow tagnames here */
+ do
+ {
+ casecount++;
+
+ /* ??? enforce/document that, in a switch, a statement cannot
+ * start an opening brace (marks the start of a compound
+ * statement) and search for the right-most colon before that
+ * statement.
+ * Now, by replacing the ':' by a special COLON token, you can
+ * parse all expressions until that special token.
+ */
+
+ constexpr(&val, NULL);
+ /* Search the insertion point (the table is kept in sorted
+ * order, so that advanced abstract machines can sift the
+ * case table with a binary search). Check for duplicate
+ * case values at the same time.
+ */
+ for (csp = &caselist, cse = caselist.next;
+ cse && cse->value < val;
+ csp = cse, cse = cse->next)
+ /* nothing */ ;
+ if (cse && cse->value == val)
+ error(40, val); /* duplicate "case" label */
+ /* Since the label is stored as a string in the
+ * "constvalue", the size of an identifier must
+ * be at least 8, as there are 8
+ * hexadecimal digits in a 32-bit number.
+ */
+#if sNAMEMAX < 8
+#error Length of identifier (sNAMEMAX) too small.
+#endif
+ insert_constval(csp, cse, itoh(lbl_case), val, 0);
+ if (matchtoken(tDBLDOT))
+ {
+ cell end;
+
+ constexpr(&end, NULL);
+ if (end <= val)
+ error(50); /* invalid range */
+ while (++val <= end)
+ {
+ casecount++;
+ /* find the new insertion point */
+ for (csp = &caselist, cse = caselist.next;
+ cse && cse->value < val;
+ csp = cse, cse = cse->next)
+ /* nothing */ ;
+ if (cse && cse->value == val)
+ error(40, val); /* duplicate "case" label */
+ insert_constval(csp, cse, itoh(lbl_case), val, 0);
+ } /* if */
+ } /* if */
+ }
+ while (matchtoken(','));
+ needtoken(':'); /* ':' ends the case */
+ sc_allowtags = TRUE; /* reset */
+ setlabel(lbl_case);
+ statement(NULL, FALSE);
+ jumplabel(lbl_exit);
+ break;
+ case tDEFAULT:
+ if (swdefault != FALSE)
+ error(16); /* multiple defaults in switch */
+ lbl_case = getlabel();
+ setlabel(lbl_case);
+ needtoken(':');
+ swdefault = TRUE;
+ statement(NULL, FALSE);
+ /* Jump to lbl_exit, even thouh this is the last clause in the
+ *switch, because the jump table is generated between the last
+ * clause of the switch and the exit label.
+ */
+ jumplabel(lbl_exit);
+ break;
+ case '}':
+ /* nothing, but avoid dropping into "default" */
+ break;
+ default:
+ error(2);
+ indent_nowarn = TRUE; /* disable this check */
+ tok = '}'; /* break out of the loop after an error */
+ } /* switch */
+ }
+ while (tok != '}');
+
+#if !defined NDEBUG
+ /* verify that the case table is sorted (unfortunately, duplicates can
+ * occur; there really shouldn't be duplicate cases, but the compiler
+ * may not crash or drop into an assertion for a user error). */
+ for (cse = caselist.next; cse && cse->next; cse = cse->next)
+ ; /* empty. no idea whether this is correct, but we MUST NOT do
+ * the setlabel(lbl_table) call in the loop body. doing so breaks
+ * switch statements that only have one case statement following.
+ */
+#endif
+
+ /* generate the table here, before lbl_exit (general jump target) */
+ setlabel(lbl_table);
+
+ if (swdefault == FALSE)
+ {
+ /* store lbl_exit as the "none-matched" label in the switch table */
+ strcpy(labelname, itoh(lbl_exit));
+ }
+ else
+ {
+ /* lbl_case holds the label of the "default" clause */
+ strcpy(labelname, itoh(lbl_case));
+ } /* if */
+ ffcase(casecount, labelname, TRUE);
+ /* generate the rest of the table */
+ for (cse = caselist.next; cse; cse = cse->next)
+ ffcase(cse->value, cse->name, FALSE);
+
+ setlabel(lbl_exit);
+ delete_consttable(&caselist); /* clear list of case labels */
+}
+
+static void
+doassert(void)
+{
+ int flab1, idx;
+ cell cidx;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+
+ if ((sc_debug & sCHKBOUNDS) != 0)
+ {
+ flab1 = getlabel(); /* get label number for "OK" branch */
+ test(flab1, FALSE, TRUE); /* get expression and branch
+ * to flab1 if true */
+ setline(fline, fcurrent); /* make sure we abort on the correct
+ * line number */
+ ffabort(xASSERTION);
+ setlabel(flab1);
+ }
+ else
+ {
+ stgset(TRUE); /* start staging */
+ stgget(&idx, &cidx); /* mark position in code generator */
+ do
+ {
+ if (hier14(&lval))
+ rvalue(&lval);
+ stgdel(idx, cidx); /* just scrap the code */
+ }
+ while (matchtoken(','));
+ stgset(FALSE); /* stop staging */
+ } /* if */
+ needtoken(tTERM);
+}
+
+static void
+dogoto(void)
+{
+ char *st;
+ cell val;
+ symbol *sym;
+
+ if (lex(&val, &st) == tSYMBOL)
+ {
+ sym = fetchlab(st);
+ jumplabel((int)sym->addr);
+ sym->usage |= uREAD; /* set "uREAD" bit */
+ /*
+ * // ??? if the label is defined (check sym->usage & uDEFINE), check
+ * // sym->compound (nesting level of the label) against nestlevel;
+ * // if sym->compound < nestlevel, call the destructor operator
+ */
+ }
+ else
+ {
+ error(20, st); /* illegal symbol name */
+ } /* if */
+ needtoken(tTERM);
+}
+
+static void
+dolabel(void)
+{
+ char *st;
+ cell val;
+ symbol *sym;
+
+ tokeninfo(&val, &st); /* retrieve label name again */
+ if (find_constval(&tagname_tab, st, 0))
+ error(221, st); /* label name shadows tagname */
+ sym = fetchlab(st);
+ setlabel((int)sym->addr);
+ /* since one can jump around variable declarations or out of compound
+ * blocks, the stack must be manually adjusted
+ */
+ setstk(-declared * sizeof(cell));
+ sym->usage |= uDEFINE; /* label is now defined */
+}
+
+/* fetchlab
+ *
+ * Finds a label from the (local) symbol table or adds one to it.
+ * Labels are local in scope.
+ *
+ * Note: The "_usage" bit is set to zero. The routines that call
+ * "fetchlab()" must set this bit accordingly.
+ */
+static symbol *
+fetchlab(char *name)
+{
+ symbol *sym;
+
+ sym = findloc(name); /* labels are local in scope */
+ if (sym)
+ {
+ if (sym->ident != iLABEL)
+ error(19, sym->name); /* not a label: ... */
+ }
+ else
+ {
+ sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
+ sym->x.declared = (int)declared;
+ sym->compound = nestlevel;
+ } /* if */
+ return sym;
+}
+
+/* doreturn
+ *
+ * Global references: rettype (altered)
+ */
+static void
+doreturn(void)
+{
+ int tag;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ if ((rettype & uRETNONE) != 0)
+ error(208); /* mix "return;" and "return value;" */
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ rettype |= uRETVALUE; /* function returns a value */
+ /* check tagname with function tagname */
+ assert(curfunc != NULL);
+ if (!matchtag(curfunc->tag, tag, TRUE))
+ error(213); /* tagname mismatch */
+ }
+ else
+ {
+ /* this return statement contains no expression */
+ const1(0);
+ if ((rettype & uRETVALUE) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user
+ * defined operators */
+ assert(curfunc != NULL);
+ funcdisplayname(symname, curfunc->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ rettype |= uRETNONE; /* function does not return anything */
+ } /* if */
+ destructsymbols(&loctab, 0); /*call destructor for *all* locals */
+ modstk((int)declared * sizeof(cell)); /* end of function, remove
+ *all* * local variables*/
+ ffret();
+}
+
+static void
+dobreak(void)
+{
+ int *ptr;
+
+ ptr = readwhile(); /* readwhile() gives an error if not in loop */
+ needtoken(tTERM);
+ if (!ptr)
+ return;
+ destructsymbols(&loctab, nestlevel);
+ modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
+ jumplabel(ptr[wqEXIT]);
+}
+
+static void
+docont(void)
+{
+ int *ptr;
+
+ ptr = readwhile(); /* readwhile() gives an error if not in loop */
+ needtoken(tTERM);
+ if (!ptr)
+ return;
+ destructsymbols(&loctab, nestlevel);
+ modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
+ jumplabel(ptr[wqLOOP]);
+}
+
+void
+exporttag(int tag)
+{
+ /* find the tag by value in the table, then set the top bit to mark it
+ * "public"
+ */
+ if (tag != 0)
+ {
+ constvalue *ptr;
+
+ assert((tag & PUBLICTAG) == 0);
+ for (ptr = tagname_tab.next;
+ ptr && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
+ /* nothing */ ;
+ if (ptr)
+ ptr->value |= PUBLICTAG;
+ } /* if */
+}
+
+static void
+doexit(void)
+{
+ int tag = 0;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ }
+ else
+ {
+ const1(0);
+ } /* if */
+ const2(tag);
+ exporttag(tag);
+ destructsymbols(&loctab, 0); /* call destructor for *all* locals */
+ ffabort(xEXIT);
+}
+
+static void
+dosleep(void)
+{
+ int tag = 0;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ }
+ else
+ {
+ const1(0);
+ } /* if */
+ const2(tag);
+ exporttag(tag);
+ ffabort(xSLEEP);
+}
+
+static void
+addwhile(int *ptr)
+{
+ int k;
+
+ ptr[wqBRK] = (int)declared; /* stack pointer (for "break") */
+ ptr[wqCONT] = (int)declared; /* for "continue", possibly adjusted later */
+ ptr[wqLOOP] = getlabel();
+ ptr[wqEXIT] = getlabel();
+ if (wqptr >= (wq + wqTABSZ - wqSIZE))
+ error(102, "loop table"); /* loop table overflow (too many active loops) */
+ k = 0;
+ while (k < wqSIZE)
+ { /* copy "ptr" to while queue table */
+ *wqptr = *ptr;
+ wqptr += 1;
+ ptr += 1;
+ k += 1;
+ } /* while */
+}
+
+static void
+delwhile(void)
+{
+ if (wqptr > wq)
+ wqptr -= wqSIZE;
+}
+
+static int *
+readwhile(void)
+{
+ if (wqptr <= wq)
+ {
+ error(24); /* out of context */
+ return NULL;
+ }
+ else
+ {
+ return (wqptr - wqSIZE);
+ } /* if */
+}
--- /dev/null
+/* Small compiler - File input, preprocessing and lexical analysis functions
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include "embryo_cc_sc.h"
+#include "Embryo.h"
+
+static int match(char *st, int end);
+static cell litchar(char **lptr, int rawmode);
+static int alpha(char c);
+
+static int icomment; /* currently in multiline comment? */
+static int iflevel; /* nesting level if #if/#else/#endif */
+static int skiplevel; /* level at which we started skipping */
+static int elsedone; /* level at which we have seen an #else */
+static char term_expr[] = "";
+static int listline = -1; /* "current line" for the list file */
+
+/* pushstk & popstk
+ *
+ * Uses a LIFO stack to store information. The stack is used by doinclude(),
+ * doswitch() (to hold the state of "swactive") and some other routines.
+ *
+ * Porting note: I made the bold assumption that an integer will not be
+ * larger than a pointer (it may be smaller). That is, the stack element
+ * is typedef'ed as a pointer type, but I also store integers on it. See
+ * SC.H for "stkitem"
+ *
+ * Global references: stack,stkidx (private to pushstk() and popstk())
+ */
+static stkitem stack[sSTKMAX];
+static int stkidx;
+void
+pushstk(stkitem val)
+{
+ if (stkidx >= sSTKMAX)
+ error(102, "parser stack"); /* stack overflow (recursive include?) */
+ stack[stkidx] = val;
+ stkidx += 1;
+}
+
+stkitem
+popstk(void)
+{
+ if (stkidx == 0)
+ return (stkitem) - 1; /* stack is empty */
+ stkidx -= 1;
+ return stack[stkidx];
+}
+
+int
+plungequalifiedfile(char *name)
+{
+ static char *extensions[] = { ".inc", ".sma", ".small" };
+ FILE *fp;
+ char *ext;
+ int ext_idx;
+
+ ext_idx = 0;
+ do
+ {
+ fp = (FILE *) sc_opensrc(name);
+ ext = strchr(name, '\0'); /* save position */
+ if (!fp)
+ {
+ /* try to append an extension */
+ strcpy(ext, extensions[ext_idx]);
+ fp = (FILE *) sc_opensrc(name);
+ if (!fp)
+ *ext = '\0'; /* on failure, restore filename */
+ } /* if */
+ ext_idx++;
+ }
+ while ((!fp) &&
+ (ext_idx < (int)(sizeof extensions / sizeof extensions[0])));
+ if (!fp)
+ {
+ *ext = '\0'; /* restore filename */
+ return FALSE;
+ } /* if */
+ pushstk((stkitem) inpf);
+ pushstk((stkitem) inpfname); /* pointer to current file name */
+ pushstk((stkitem) curlibrary);
+ pushstk((stkitem) iflevel);
+ assert(skiplevel == 0);
+ pushstk((stkitem) icomment);
+ pushstk((stkitem) fcurrent);
+ pushstk((stkitem) fline);
+ inpfname = strdup(name); /* set name of include file */
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ inpf = fp; /* set input file pointer to include file */
+ fnumber++;
+ fline = 0; /* set current line number to 0 */
+ fcurrent = fnumber;
+ icomment = FALSE;
+ setfile(inpfname, fcurrent);
+ listline = -1; /* force a #line directive when changing the file */
+ setactivefile(fcurrent);
+ return TRUE;
+}
+
+int
+plungefile(char *name, int try_currentpath, int try_includepaths)
+{
+ int result = FALSE;
+ int i;
+ char *ptr;
+
+ if (try_currentpath)
+ result = plungequalifiedfile(name);
+
+ if (try_includepaths && name[0] != DIRSEP_CHAR)
+ {
+ for (i = 0; !result && (ptr = get_path(i)); i++)
+ {
+ char path[PATH_MAX];
+
+ strncpy(path, ptr, sizeof path);
+ path[sizeof path - 1] = '\0'; /* force '\0' termination */
+ strncat(path, name, sizeof(path) - strlen(path));
+ path[sizeof path - 1] = '\0';
+ result = plungequalifiedfile(path);
+ } /* while */
+ } /* if */
+ return result;
+}
+
+static void
+check_empty(char *lptr)
+{
+ /* verifies that the string contains only whitespace */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr != '\0')
+ error(38); /* extra characters on line */
+}
+
+/* doinclude
+ *
+ * Gets the name of an include file, pushes the old file on the stack and
+ * sets some options. This routine doesn't use lex(), since lex() doesn't
+ * recognize file names (and directories).
+ *
+ * Global references: inpf (altered)
+ * inpfname (altered)
+ * fline (altered)
+ * lptr (altered)
+ */
+static void
+doinclude(void)
+{
+ char name[PATH_MAX], c;
+ int i, result;
+
+ while (*lptr <= ' ' && *lptr != 0) /* skip leading whitespace */
+ lptr++;
+ if (*lptr == '<' || *lptr == '\"')
+ {
+ c = (char)((*lptr == '\"') ? '\"' : '>'); /* termination character */
+ lptr++;
+ while (*lptr <= ' ' && *lptr != 0) /* skip whitespace after quote */
+ lptr++;
+ }
+ else
+ {
+ c = '\0';
+ } /* if */
+
+ i = 0;
+ while ((*lptr != c) && (*lptr != '\0') && (i < (int)(sizeof(name) - 1))) /* find the end of the string */
+ name[i++] = *lptr++;
+ while (i > 0 && name[i - 1] <= ' ')
+ i--; /* strip trailing whitespace */
+ assert((i >= 0) && (i < (int)(sizeof(name))));
+ name[i] = '\0'; /* zero-terminate the string */
+
+ if (*lptr != c)
+ { /* verify correct string termination */
+ error(37); /* invalid string */
+ return;
+ } /* if */
+ if (c != '\0')
+ check_empty(lptr + 1); /* verify that the rest of the line is whitespace */
+
+ /* Include files between "..." or without quotes are read from the current
+ * directory, or from a list of "include directories". Include files
+ * between <...> are only read from the list of include directories.
+ */
+ result = plungefile(name, (c != '>'), TRUE);
+ if (!result)
+ error(100, name); /* cannot read from ... (fatal error) */
+}
+
+/* readline
+ *
+ * Reads in a new line from the input file pointed to by "inpf". readline()
+ * concatenates lines that end with a \ with the next line. If no more data
+ * can be read from the file, readline() attempts to pop off the previous file
+ * from the stack. If that fails too, it sets "freading" to 0.
+ *
+ * Global references: inpf,fline,inpfname,freading,icomment (altered)
+ */
+static void
+readline(char *line)
+{
+ int i, num, cont;
+ char *ptr;
+
+ if (lptr == term_expr)
+ return;
+ num = sLINEMAX;
+ cont = FALSE;
+ do
+ {
+ if (!inpf || sc_eofsrc(inpf))
+ {
+ if (cont)
+ error(49); /* invalid line continuation */
+ if (inpf && inpf != inpf_org)
+ sc_closesrc(inpf);
+ i = (int)(long)popstk();
+ if (i == -1)
+ { /* All's done; popstk() returns "stack is empty" */
+ freading = FALSE;
+ *line = '\0';
+ /* when there is nothing more to read, the #if/#else stack should
+ * be empty and we should not be in a comment
+ */
+ assert(iflevel >= 0);
+ if (iflevel > 0)
+ error(1, "#endif", "-end of file-");
+ else if (icomment)
+ error(1, "*/", "-end of file-");
+ return;
+ } /* if */
+ fline = i;
+ fcurrent = (int)(long)popstk();
+ icomment = (int)(long)popstk();
+ assert(skiplevel == 0); /* skiplevel was not stored on stack, because it should always be zero at this point */
+ iflevel = (int)(long)popstk();
+ curlibrary = (constvalue *) popstk();
+ free(inpfname); /* return memory allocated for the include file name */
+ inpfname = (char *)popstk();
+ inpf = (FILE *) popstk();
+ setactivefile(fcurrent);
+ listline = -1; /* force a #line directive when changing the file */
+ elsedone = 0;
+ } /* if */
+
+ if (!sc_readsrc(inpf, line, num))
+ {
+ *line = '\0'; /* delete line */
+ cont = FALSE;
+ }
+ else
+ {
+ /* check whether to erase leading spaces */
+ if (cont)
+ {
+ char *ptr = line;
+
+ while (*ptr == ' ' || *ptr == '\t')
+ ptr++;
+ if (ptr != line)
+ memmove(line, ptr, strlen(ptr) + 1);
+ } /* if */
+ cont = FALSE;
+ /* check whether a full line was read */
+ if (!strchr(line, '\n') && !sc_eofsrc(inpf))
+ error(75); /* line too long */
+ /* check if the next line must be concatenated to this line */
+ if ((ptr = strchr(line, '\n')) && ptr > line)
+ {
+ assert(*(ptr + 1) == '\0'); /* '\n' should be last in the string */
+ while (ptr > line
+ && (*ptr == '\n' || *ptr == ' ' || *ptr == '\t'))
+ ptr--; /* skip trailing whitespace */
+ if (*ptr == '\\')
+ {
+ cont = TRUE;
+ /* set '\a' at the position of '\\' to make it possible to check
+ * for a line continuation in a single line comment (error 49)
+ */
+ *ptr++ = '\a';
+ *ptr = '\0'; /* erase '\n' (and any trailing whitespace) */
+ } /* if */
+ } /* if */
+ num -= strlen(line);
+ line += strlen(line);
+ } /* if */
+ fline += 1;
+ }
+ while (num >= 0 && cont);
+}
+
+/* stripcom
+ *
+ * Replaces all comments from the line by space characters. It updates
+ * a global variable ("icomment") for multiline comments.
+ *
+ * This routine also supports the C++ extension for single line comments.
+ * These comments are started with "//" and end at the end of the line.
+ *
+ * Global references: icomment (private to "stripcom")
+ */
+static void
+stripcom(char *line)
+{
+ char c;
+
+ while (*line)
+ {
+ if (icomment)
+ {
+ if (*line == '*' && *(line + 1) == '/')
+ {
+ icomment = FALSE; /* comment has ended */
+ *line = ' '; /* replace '*' and '/' characters by spaces */
+ *(line + 1) = ' ';
+ line += 2;
+ }
+ else
+ {
+ if (*line == '/' && *(line + 1) == '*')
+ error(216); /* nested comment */
+ *line = ' '; /* replace comments by spaces */
+ line += 1;
+ } /* if */
+ }
+ else
+ {
+ if (*line == '/' && *(line + 1) == '*')
+ {
+ icomment = TRUE; /* start comment */
+ *line = ' '; /* replace '/' and '*' characters by spaces */
+ *(line + 1) = ' ';
+ line += 2;
+ }
+ else if (*line == '/' && *(line + 1) == '/')
+ { /* comment to end of line */
+ if (strchr(line, '\a'))
+ error(49); /* invalid line continuation */
+ *line++ = '\n'; /* put "newline" at first slash */
+ *line = '\0'; /* put "zero-terminator" at second slash */
+ }
+ else
+ {
+ if (*line == '\"' || *line == '\'')
+ { /* leave literals unaltered */
+ c = *line; /* ending quote, single or double */
+ line += 1;
+ while ((*line != c || *(line - 1) == '\\')
+ && *line != '\0')
+ line += 1;
+ line += 1; /* skip final quote */
+ }
+ else
+ {
+ line += 1;
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* while */
+}
+
+/* btoi
+ *
+ * Attempts to interpret a numeric symbol as a boolean value. On success
+ * it returns the number of characters processed (so the line pointer can be
+ * adjusted) and the value is stored in "val". Otherwise it returns 0 and
+ * "val" is garbage.
+ *
+ * A boolean value must start with "0b"
+ */
+static int
+btoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (*ptr == '0' && *(ptr + 1) == 'b')
+ {
+ ptr += 2;
+ while (*ptr == '0' || *ptr == '1' || *ptr == '_')
+ {
+ if (*ptr != '_')
+ *val = (*val << 1) | (*ptr - '0');
+ ptr++;
+ } /* while */
+ }
+ else
+ {
+ return 0;
+ } /* if */
+ if (alphanum(*ptr)) /* number must be delimited by non-alphanumeric char */
+ return 0;
+ else
+ return (int)(ptr - curptr);
+}
+
+/* dtoi
+ *
+ * Attempts to interpret a numeric symbol as a decimal value. On success
+ * it returns the number of characters processed and the value is stored in
+ * "val". Otherwise it returns 0 and "val" is garbage.
+ */
+static int
+dtoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ *val = (*val * 10) + (*ptr - '0');
+ ptr++;
+ } /* while */
+ if (alphanum(*ptr)) /* number must be delimited by non-alphanumerical */
+ return 0;
+ if (*ptr == '.' && sc_isdigit(*(ptr + 1)))
+ return 0; /* but a fractional part must not be present */
+ return (int)(ptr - curptr);
+}
+
+/* htoi
+ *
+ * Attempts to interpret a numeric symbol as a hexadecimal value. On
+ * success it returns the number of characters processed and the value is
+ * stored in "val". Otherwise it return 0 and "val" is garbage.
+ */
+static int
+htoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ if (*ptr == '0' && *(ptr + 1) == 'x')
+ { /* C style hexadecimal notation */
+ ptr += 2;
+ while (sc_isxdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ assert(sc_isxdigit(*ptr));
+ *val = *val << 4;
+ if (sc_isdigit(*ptr))
+ *val += (*ptr - '0');
+ else
+ *val += (tolower(*ptr) - 'a' + 10);
+ } /* if */
+ ptr++;
+ } /* while */
+ }
+ else
+ {
+ return 0;
+ } /* if */
+ if (alphanum(*ptr))
+ return 0;
+ else
+ return (int)(ptr - curptr);
+}
+
+#if defined LINUX
+static double
+pow10(int value)
+{
+ double res = 1.0;
+
+ while (value >= 4)
+ {
+ res *= 10000.0;
+ value -= 5;
+ } /* while */
+ while (value >= 2)
+ {
+ res *= 100.0;
+ value -= 2;
+ } /* while */
+ while (value >= 1)
+ {
+ res *= 10.0;
+ value -= 1;
+ } /* while */
+ return res;
+}
+#endif
+
+/* ftoi
+ *
+ * Attempts to interpret a numeric symbol as a rational number, either as
+ * IEEE 754 single precision floating point or as a fixed point integer.
+ * On success it returns the number of characters processed and the value is
+ * stored in "val". Otherwise it returns 0 and "val" is unchanged.
+ *
+ * Small has stricter definition for floating point numbers than most:
+ * o the value must start with a digit; ".5" is not a valid number, you
+ * should write "0.5"
+ * o a period must appear in the value, even if an exponent is given; "2e3"
+ * is not a valid number, you should write "2.0e3"
+ * o at least one digit must follow the period; "6." is not a valid number,
+ * you should write "6.0"
+ */
+static int
+ftoi(cell * val, char *curptr)
+{
+ char *ptr;
+ double fnum, ffrac, fmult;
+ unsigned long dnum, dbase;
+ int i, ignore;
+
+ assert(rational_digits >= 0 && rational_digits < 9);
+ for (i = 0, dbase = 1; i < rational_digits; i++)
+ dbase *= 10;
+ fnum = 0.0;
+ dnum = 0L;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ fnum = (fnum * 10.0) + (*ptr - '0');
+ dnum = (dnum * 10L) + (*ptr - '0') * dbase;
+ } /* if */
+ ptr++;
+ } /* while */
+ if (*ptr != '.')
+ return 0; /* there must be a period */
+ ptr++;
+ if (!sc_isdigit(*ptr)) /* there must be at least one digit after the dot */
+ return 0;
+ ffrac = 0.0;
+ fmult = 1.0;
+ ignore = FALSE;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ ffrac = (ffrac * 10.0) + (*ptr - '0');
+ fmult = fmult / 10.0;
+ dbase /= 10L;
+ dnum += (*ptr - '0') * dbase;
+ if (dbase == 0L && sc_rationaltag && rational_digits > 0
+ && !ignore)
+ {
+ error(222); /* number of digits exceeds rational number precision */
+ ignore = TRUE;
+ } /* if */
+ } /* if */
+ ptr++;
+ } /* while */
+ fnum += ffrac * fmult; /* form the number so far */
+ if (*ptr == 'e')
+ { /* optional fractional part */
+ int exp, sign;
+
+ ptr++;
+ if (*ptr == '-')
+ {
+ sign = -1;
+ ptr++;
+ }
+ else
+ {
+ sign = 1;
+ } /* if */
+ if (!sc_isdigit(*ptr)) /* 'e' should be followed by a digit */
+ return 0;
+ exp = 0;
+ while (sc_isdigit(*ptr))
+ {
+ exp = (exp * 10) + (*ptr - '0');
+ ptr++;
+ } /* while */
+#if defined LINUX
+ fmult = pow10(exp * sign);
+#else
+ fmult = pow(10, exp * sign);
+#endif
+ fnum *= fmult;
+ dnum *= (unsigned long)(fmult + 0.5);
+ } /* if */
+
+ /* decide how to store the number */
+ if (sc_rationaltag == 0)
+ {
+ error(70); /* rational number support was not enabled */
+ *val = 0;
+ }
+ else if (rational_digits == 0)
+ {
+ float f = (float) fnum;
+ /* floating point */
+ *val = EMBRYO_FLOAT_TO_CELL(f);
+#if !defined NDEBUG
+ /* I assume that the C/C++ compiler stores "float" values in IEEE 754
+ * format (as mandated in the ANSI standard). Test this assumption anyway.
+ */
+ {
+ float test1 = 0.0, test2 = 50.0;
+ Embryo_Cell c1 = EMBRYO_FLOAT_TO_CELL(test1);
+ Embryo_Cell c2 = EMBRYO_FLOAT_TO_CELL(test2);
+
+ if (c1 != 0x00000000L)
+ {
+ fprintf(stderr,
+ "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+ "point math as embryo expects. this could be bad.\n"
+ "\n"
+ "(float 0.0 != 0x00000000 bitpattern, 0x%08x instead)\n"
+ "\n"
+ "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+ "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+ , c1);
+ }
+ else if (c2 != 0x42480000L)
+ {
+ fprintf(stderr,
+ "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+ "point math as embryo expects. This could be bad.\n"
+ "\n"
+ "(float 50.0 != 0x42480000 bitpattern, 0x%08x instead)\n"
+ "\n"
+ "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+ "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+ , c2);
+ }
+ }
+#endif
+ }
+ else
+ {
+ /* fixed point */
+ *val = (cell) dnum;
+ } /* if */
+
+ return (int)(ptr - curptr);
+}
+
+/* number
+ *
+ * Reads in a number (binary, decimal or hexadecimal). It returns the number
+ * of characters processed or 0 if the symbol couldn't be interpreted as a
+ * number (in this case the argument "val" remains unchanged). This routine
+ * relies on the 'early dropout' implementation of the logical or (||)
+ * operator.
+ *
+ * Note: the routine doesn't check for a sign (+ or -). The - is checked
+ * for at "hier2()" (in fact, it is viewed as an operator, not as a
+ * sign) and the + is invalid (as in K&R C, and unlike ANSI C).
+ */
+static int
+number(cell * val, char *curptr)
+{
+ int i;
+ cell value;
+
+ if ((i = btoi(&value, curptr)) != 0 /* binary? */
+ || (i = htoi(&value, curptr)) != 0 /* hexadecimal? */
+ || (i = dtoi(&value, curptr)) != 0) /* decimal? */
+ {
+ *val = value;
+ return i;
+ }
+ else
+ {
+ return 0; /* else not a number */
+ } /* if */
+}
+
+static void
+chrcat(char *str, char chr)
+{
+ str = strchr(str, '\0');
+ *str++ = chr;
+ *str = '\0';
+}
+
+static int
+preproc_expr(cell * val, int *tag)
+{
+ int result;
+ int idx;
+ cell code_index;
+ char *term;
+
+ /* Disable staging; it should be disabled already because
+ * expressions may not be cut off half-way between conditional
+ * compilations. Reset the staging index, but keep the code
+ * index.
+ */
+ if (stgget(&idx, &code_index))
+ {
+ error(57); /* unfinished expression */
+ stgdel(0, code_index);
+ stgset(FALSE);
+ } /* if */
+ /* append a special symbol to the string, so the expression
+ * analyzer won't try to read a next line when it encounters
+ * an end-of-line
+ */
+ assert(strlen(pline) < sLINEMAX);
+ term = strchr(pline, '\0');
+ assert(term != NULL);
+ chrcat(pline, PREPROC_TERM); /* the "DEL" code (see SC.H) */
+ result = constexpr(val, tag); /* get value (or 0 on error) */
+ *term = '\0'; /* erase the token (if still present) */
+ lexclr(FALSE); /* clear any "pushed" tokens */
+ return result;
+}
+
+/* getstring
+ * Returns returns a pointer behind the closing quote or to the other
+ * character that caused the input to be ended.
+ */
+static char *
+getstring(char *dest, int max)
+{
+ assert(dest != NULL);
+ *dest = '\0';
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++; /* skip whitespace */
+ if (*lptr != '"')
+ {
+ error(37); /* invalid string */
+ }
+ else
+ {
+ int len = 0;
+
+ lptr++; /* skip " */
+ while (*lptr != '"' && *lptr != '\0')
+ {
+ if (len < max - 1)
+ dest[len++] = *lptr;
+ lptr++;
+ } /* if */
+ dest[len] = '\0';
+ if (*lptr == '"')
+ lptr++; /* skip closing " */
+ else
+ error(37); /* invalid string */
+ } /* if */
+ return lptr;
+}
+
+enum
+{
+ CMD_NONE,
+ CMD_TERM,
+ CMD_EMPTYLINE,
+ CMD_CONDFALSE,
+ CMD_INCLUDE,
+ CMD_DEFINE,
+ CMD_IF,
+ CMD_DIRECTIVE,
+};
+
+/* command
+ *
+ * Recognizes the compiler directives. The function returns:
+ * CMD_NONE the line must be processed
+ * CMD_TERM a pending expression must be completed before processing further lines
+ * Other value: the line must be skipped, because:
+ * CMD_CONDFALSE false "#if.." code
+ * CMD_EMPTYLINE line is empty
+ * CMD_INCLUDE the line contains a #include directive
+ * CMD_DEFINE the line contains a #subst directive
+ * CMD_IF the line contains a #if/#else/#endif directive
+ * CMD_DIRECTIVE the line contains some other compiler directive
+ *
+ * Global variables: iflevel, skiplevel, elsedone (altered)
+ * lptr (altered)
+ */
+static int
+command(void)
+{
+ int tok, ret;
+ cell val;
+ char *str;
+ int idx;
+ cell code_index;
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr += 1;
+ if (*lptr == '\0')
+ return CMD_EMPTYLINE; /* empty line */
+ if (*lptr != '#')
+ return skiplevel > 0 ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */
+ /* compiler directive found */
+ indent_nowarn = TRUE; /* allow loose indentation" */
+ lexclr(FALSE); /* clear any "pushed" tokens */
+ /* on a pending expression, force to return a silent ';' token and force to
+ * re-read the line
+ */
+ if (!sc_needsemicolon && stgget(&idx, &code_index))
+ {
+ lptr = term_expr;
+ return CMD_TERM;
+ } /* if */
+ tok = lex(&val, &str);
+ ret = skiplevel > 0 ? CMD_CONDFALSE : CMD_DIRECTIVE; /* preset 'ret' to CMD_DIRECTIVE (most common case) */
+ switch (tok)
+ {
+ case tpIF: /* conditional compilation */
+ ret = CMD_IF;
+ iflevel += 1;
+ if (skiplevel)
+ break; /* break out of switch */
+ preproc_expr(&val, NULL); /* get value (or 0 on error) */
+ if (!val)
+ skiplevel = iflevel;
+ check_empty(lptr);
+ break;
+ case tpELSE:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26); /* no matching #if */
+ errorset(sRESET);
+ }
+ else
+ {
+ if (elsedone == iflevel)
+ error(60); /* multiple #else directives between #if ... #endif */
+ elsedone = iflevel;
+ if (skiplevel == iflevel)
+ skiplevel = 0;
+ else if (skiplevel == 0)
+ skiplevel = iflevel;
+ } /* if */
+ check_empty(lptr);
+ break;
+#if 0 /* ??? *really* need to use a stack here */
+ case tpELSEIF:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26); /* no matching #if */
+ errorset(sRESET);
+ }
+ else if (elsedone == iflevel)
+ {
+ error(61); /* #elseif directive may not follow an #else */
+ errorset(sRESET);
+ }
+ else
+ {
+ preproc_expr(&val, NULL); /* get value (or 0 on error) */
+ if (skiplevel == 0)
+ skiplevel = iflevel; /* we weren't skipping, start skipping now */
+ else if (val)
+ skiplevel = 0; /* we were skipping, condition is valid -> stop skipping */
+ /* else: we were skipping and condition is invalid -> keep skipping */
+ check_empty(lptr);
+ } /* if */
+ break;
+#endif
+ case tpENDIF:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26);
+ errorset(sRESET);
+ }
+ else
+ {
+ if (skiplevel == iflevel)
+ skiplevel = 0;
+ if (elsedone == iflevel)
+ elsedone = 0; /* ??? actually, should build a stack of #if/#endif and keep
+ * the state whether an #else was seen per nesting level */
+ iflevel -= 1;
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tINCLUDE: /* #include directive */
+ ret = CMD_INCLUDE;
+ if (skiplevel == 0)
+ doinclude();
+ break;
+ case tpFILE:
+ if (skiplevel == 0)
+ {
+ char pathname[PATH_MAX];
+
+ lptr = getstring(pathname, sizeof pathname);
+ if (pathname[0] != '\0')
+ {
+ free(inpfname);
+ inpfname = strdup(pathname);
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ } /* if */
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tpLINE:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) != tNUMBER)
+ error(8); /* invalid/non-constant expression */
+ fline = (int)val;
+
+ while (*lptr == ' ' && *lptr != '\0')
+ lptr++; /* skip whitespace */
+ if (*lptr == '"')
+ {
+ char pathname[PATH_MAX];
+
+ lptr = getstring(pathname, sizeof pathname);
+ if (pathname[0] != '\0')
+ {
+ free(inpfname);
+ inpfname = strdup(pathname);
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ } /* if */
+ }
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tpASSERT:
+ if (skiplevel == 0 && (sc_debug & sCHKBOUNDS) != 0)
+ {
+ preproc_expr(&val, NULL); /* get constant expression (or 0 on error) */
+ if (!val)
+ error(7); /* assertion failed */
+ check_empty(lptr);
+ } /* if */
+ break;
+ case tpPRAGMA:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) == tSYMBOL)
+ {
+ if (strcmp(str, "ctrlchar") == 0)
+ {
+ if (lex(&val, &str) != tNUMBER)
+ error(27); /* invalid character constant */
+ sc_ctrlchar = (char)val;
+ }
+ else if (strcmp(str, "compress") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_compress = (int)val; /* switch code packing on/off */
+ }
+ else if (strcmp(str, "dynamic") == 0)
+ {
+ preproc_expr(&sc_stksize, NULL);
+ }
+ else if (strcmp(str, "library") == 0)
+ {
+ char name[sNAMEMAX + 1];
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr == '"')
+ {
+ lptr = getstring(name, sizeof name);
+ }
+ else
+ {
+ int i;
+
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (alphanum(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ } /* if */
+ if (name[0] == '\0')
+ {
+ curlibrary = NULL;
+ }
+ else
+ {
+ if (strlen(name) > sEXPMAX)
+ error(220, name, sEXPMAX); /* exported symbol is truncated */
+ /* add the name if it does not yet exist in the table */
+ if (!find_constval(&libname_tab, name, 0))
+ curlibrary =
+ append_constval(&libname_tab, name, 0, 0);
+ } /* if */
+ }
+ else if (strcmp(str, "pack") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL); /* default = packed/unpacked */
+ sc_packstr = (int)val;
+ }
+ else if (strcmp(str, "rational") == 0)
+ {
+ char name[sNAMEMAX + 1];
+ cell digits = 0;
+ int i;
+
+ /* first gather all information, start with the tag name */
+ while ((*lptr <= ' ') && (*lptr != '\0'))
+ lptr++;
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (alphanum(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ /* then the precision (for fixed point arithmetic) */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr == '(')
+ {
+ preproc_expr(&digits, NULL);
+ if (digits <= 0 || digits > 9)
+ {
+ error(68); /* invalid rational number precision */
+ digits = 0;
+ } /* if */
+ if (*lptr == ')')
+ lptr++;
+ } /* if */
+ /* add the tag (make it public) and check the values */
+ i = sc_addtag(name);
+ exporttag(i);
+ if (sc_rationaltag == 0
+ || (sc_rationaltag == i
+ && rational_digits == (int)digits))
+ {
+ sc_rationaltag = i;
+ rational_digits = (int)digits;
+ }
+ else
+ {
+ error(69); /* rational number format already set, can only be set once */
+ } /* if */
+ }
+ else if (strcmp(str, "semicolon") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_needsemicolon = (int)val;
+ }
+ else if (strcmp(str, "tabsize") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_tabsize = (int)val;
+ }
+ else if (strcmp(str, "align") == 0)
+ {
+ sc_alignnext = TRUE;
+ }
+ else if (strcmp(str, "unused") == 0)
+ {
+ char name[sNAMEMAX + 1];
+ int i, comma;
+ symbol *sym;
+
+ do
+ {
+ /* get the name */
+ while ((*lptr <= ' ') && (*lptr != '\0'))
+ lptr++;
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (sc_isalpha(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ /* get the symbol */
+ sym = findloc(name);
+ if (!sym)
+ sym = findglb(name);
+ if (sym)
+ {
+ sym->usage |= uREAD;
+ if (sym->ident == iVARIABLE
+ || sym->ident == iREFERENCE
+ || sym->ident == iARRAY
+ || sym->ident == iREFARRAY)
+ sym->usage |= uWRITTEN;
+ }
+ else
+ {
+ error(17, name); /* undefined symbol */
+ } /* if */
+ /* see if a comma follows the name */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ comma = (*lptr == ',');
+ if (comma)
+ lptr++;
+ }
+ while (comma);
+ }
+ else
+ {
+ error(207); /* unknown #pragma */
+ } /* if */
+ }
+ else
+ {
+ error(207); /* unknown #pragma */
+ } /* if */
+ check_empty(lptr);
+ } /* if */
+ break;
+ case tpENDINPUT:
+ case tpENDSCRPT:
+ if (skiplevel == 0)
+ {
+ check_empty(lptr);
+ assert(inpf != NULL);
+ if (inpf != inpf_org)
+ sc_closesrc(inpf);
+ inpf = NULL;
+ } /* if */
+ break;
+#if !defined NOEMIT
+ case tpEMIT:
+ {
+ /* write opcode to output file */
+ char name[40];
+ int i;
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ for (i = 0; i < 40 && (sc_isalpha(*lptr) || *lptr == '.'); i++, lptr++)
+ name[i] = (char)tolower(*lptr);
+ name[i] = '\0';
+ stgwrite("\t");
+ stgwrite(name);
+ stgwrite(" ");
+ code_idx += opcodes(1);
+ /* write parameter (if any) */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr != '\0')
+ {
+ symbol *sym;
+
+ tok = lex(&val, &str);
+ switch (tok)
+ {
+ case tNUMBER:
+ case tRATIONAL:
+ outval(val, FALSE);
+ code_idx += opargs(1);
+ break;
+ case tSYMBOL:
+ sym = findloc(str);
+ if (!sym)
+ sym = findglb(str);
+ if (!sym || (sym->ident != iFUNCTN
+ && sym->ident != iREFFUNC
+ && (sym->usage & uDEFINE) == 0))
+ {
+ error(17, str); /* undefined symbol */
+ }
+ else
+ {
+ outval(sym->addr, FALSE);
+ /* mark symbol as "used", unknown whether for read or write */
+ markusage(sym, uREAD | uWRITTEN);
+ code_idx += opargs(1);
+ } /* if */
+ break;
+ default:
+ {
+ char s2[20];
+ extern char *sc_tokens[]; /* forward declaration */
+
+ if (tok < 256)
+ sprintf(s2, "%c", (char)tok);
+ else
+ strcpy(s2, sc_tokens[tok - tFIRST]);
+ error(1, sc_tokens[tSYMBOL - tFIRST], s2);
+ break;
+ } /* case */
+ } /* switch */
+ } /* if */
+ stgwrite("\n");
+ check_empty(lptr);
+ break;
+ } /* case */
+#endif
+#if !defined NO_DEFINE
+ case tpDEFINE:
+ {
+ ret = CMD_DEFINE;
+ if (skiplevel == 0)
+ {
+ char *pattern, *substitution;
+ char *start, *end;
+ int count, prefixlen;
+ stringpair *def;
+
+ /* find the pattern to match */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ start = lptr; /* save starting point of the match pattern */
+ count = 0;
+ while (*lptr > ' ' && *lptr != '\0')
+ {
+ litchar(&lptr, FALSE); /* litchar() advances "lptr" and handles escape characters */
+ count++;
+ } /* while */
+ end = lptr;
+ /* check pattern to match */
+ if (!sc_isalpha(*start) && *start != '_')
+ {
+ error(74); /* pattern must start with an alphabetic character */
+ break;
+ } /* if */
+ /* store matched pattern */
+ pattern = malloc(count + 1);
+ if (!pattern)
+ error(103); /* insufficient memory */
+ lptr = start;
+ count = 0;
+ while (lptr != end)
+ {
+ assert(lptr < end);
+ assert(*lptr != '\0');
+ pattern[count++] = (char)litchar(&lptr, FALSE);
+ } /* while */
+ pattern[count] = '\0';
+ /* special case, erase trailing variable, because it could match anything */
+ if (count >= 2 && sc_isdigit(pattern[count - 1])
+ && pattern[count - 2] == '%')
+ pattern[count - 2] = '\0';
+ /* find substitution string */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ start = lptr; /* save starting point of the match pattern */
+ count = 0;
+ end = NULL;
+ while (*lptr != '\0')
+ {
+ /* keep position of the start of trailing whitespace */
+ if (*lptr <= ' ')
+ {
+ if (!end)
+ end = lptr;
+ }
+ else
+ {
+ end = NULL;
+ } /* if */
+ count++;
+ lptr++;
+ } /* while */
+ if (!end)
+ end = lptr;
+ /* store matched substitution */
+ substitution = malloc(count + 1); /* +1 for '\0' */
+ if (!substitution)
+ error(103); /* insufficient memory */
+ lptr = start;
+ count = 0;
+ while (lptr != end)
+ {
+ assert(lptr < end);
+ assert(*lptr != '\0');
+ substitution[count++] = *lptr++;
+ } /* while */
+ substitution[count] = '\0';
+ /* check whether the definition already exists */
+ for (prefixlen = 0, start = pattern;
+ sc_isalpha(*start) || sc_isdigit(*start) || *start == '_';
+ prefixlen++, start++)
+ /* nothing */ ;
+ assert(prefixlen > 0);
+ if ((def = find_subst(pattern, prefixlen)))
+ {
+ if (strcmp(def->first, pattern) != 0
+ || strcmp(def->second, substitution) != 0)
+ error(201, pattern); /* redefinition of macro (non-identical) */
+ delete_subst(pattern, prefixlen);
+ } /* if */
+ /* add the pattern/substitution pair to the list */
+ assert(pattern[0] != '\0');
+ insert_subst(pattern, substitution, prefixlen);
+ free(pattern);
+ free(substitution);
+ } /* if */
+ break;
+ } /* case */
+ case tpUNDEF:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) == tSYMBOL)
+ {
+ if (!delete_subst(str, strlen(str)))
+ error(17, str); /* undefined symbol */
+ }
+ else
+ {
+ error(20, str); /* invalid symbol name */
+ } /* if */
+ check_empty(lptr);
+ } /* if */
+ break;
+#endif
+ default:
+ error(31); /* unknown compiler directive */
+ ret = skiplevel > 0 ? CMD_DIRECTIVE : CMD_NONE; /* line must be processed (if skiplevel==0) */
+ } /* switch */
+ return ret;
+}
+
+#if !defined NO_DEFINE
+static int
+is_startstring(char *string)
+{
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* "..." */
+
+ if (*string == '!')
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* !"..." */
+ if (*string == sc_ctrlchar)
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* !\"..." */
+ } /* if */
+ }
+ else if (*string == sc_ctrlchar)
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* \"..." */
+ if (*string == '!')
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* \!"..." */
+ } /* if */
+ } /* if */
+
+ return FALSE;
+}
+
+static char *
+skipstring(char *string)
+{
+ char endquote;
+ int rawstring = FALSE;
+
+ while (*string == '!' || *string == sc_ctrlchar)
+ {
+ rawstring = (*string == sc_ctrlchar);
+ string++;
+ } /* while */
+
+ endquote = *string;
+ assert(endquote == '\"' || endquote == '\'');
+ string++; /* skip open quote */
+ while (*string != endquote && *string != '\0')
+ litchar(&string, rawstring);
+ return string;
+}
+
+static char *
+skippgroup(char *string)
+{
+ int nest = 0;
+ char open = *string;
+ char close;
+
+ switch (open)
+ {
+ case '(':
+ close = ')';
+ break;
+ case '{':
+ close = '}';
+ break;
+ case '[':
+ close = ']';
+ break;
+ case '<':
+ close = '>';
+ break;
+ default:
+ assert(0);
+ close = '\0'; /* only to avoid a compiler warning */
+ } /* switch */
+
+ string++;
+ while (*string != close || nest > 0)
+ {
+ if (*string == open)
+ nest++;
+ else if (*string == close)
+ nest--;
+ else if (is_startstring(string))
+ string = skipstring(string);
+ if (*string == '\0')
+ break;
+ string++;
+ } /* while */
+ return string;
+}
+
+static char *
+strdel(char *str, size_t len)
+{
+ size_t length = strlen(str);
+
+ if (len > length)
+ len = length;
+ memmove(str, str + len, length - len + 1); /* include EOS byte */
+ return str;
+}
+
+static char *
+strins(char *dest, char *src, size_t srclen)
+{
+ size_t destlen = strlen(dest);
+
+ assert(srclen <= strlen(src));
+ memmove(dest + srclen, dest, destlen + 1); /* include EOS byte */
+ memcpy(dest, src, srclen);
+ return dest;
+}
+
+static int
+substpattern(char *line, size_t buffersize, char *pattern, char *substitution)
+{
+ int prefixlen;
+ char *p, *s, *e, *args[10];
+ int match, arg, len;
+
+ memset(args, 0, sizeof args);
+
+ /* check the length of the prefix */
+ for (prefixlen = 0, s = pattern; sc_isalpha(*s) || sc_isdigit(*s) || *s == '_';
+ prefixlen++, s++)
+ /* nothing */ ;
+ assert(prefixlen > 0);
+ assert(strncmp(line, pattern, prefixlen) == 0);
+
+ /* pattern prefix matches; match the rest of the pattern, gather
+ * the parameters
+ */
+ s = line + prefixlen;
+ p = pattern + prefixlen;
+ match = TRUE; /* so far, pattern matches */
+ while (match && *s != '\0' && *p != '\0')
+ {
+ if (*p == '%')
+ {
+ p++; /* skip '%' */
+ if (sc_isdigit(*p))
+ {
+ arg = *p - '0';
+ assert(arg >= 0 && arg <= 9);
+ p++; /* skip parameter id */
+ assert(*p != '\0');
+ /* match the source string up to the character after the digit
+ * (skipping strings in the process
+ */
+ e = s;
+ while (*e != *p && *e != '\0' && *e != '\n')
+ {
+ if (is_startstring(e)) /* skip strings */
+ e = skipstring(e);
+ else if (strchr("({[", *e)) /* skip parenthized groups */
+ e = skippgroup(e);
+ if (*e != '\0')
+ e++; /* skip non-alphapetic character (or closing quote of
+ * a string, or the closing paranthese of a group) */
+ } /* while */
+ /* store the parameter (overrule any earlier) */
+ if (args[arg])
+ free(args[arg]);
+ len = (int)(e - s);
+ args[arg] = malloc(len + 1);
+ if (!args[arg])
+ error(103); /* insufficient memory */
+ strncpy(args[arg], s, len);
+ args[arg][len] = '\0';
+ /* character behind the pattern was matched too */
+ if (*e == *p)
+ {
+ s = e + 1;
+ }
+ else if (*e == '\n' && *p == ';' && *(p + 1) == '\0'
+ && !sc_needsemicolon)
+ {
+ s = e; /* allow a trailing ; in the pattern match to end of line */
+ }
+ else
+ {
+ assert(*e == '\0' || *e == '\n');
+ match = FALSE;
+ s = e;
+ } /* if */
+ p++;
+ }
+ else
+ {
+ match = FALSE;
+ } /* if */
+ }
+ else if (*p == ';' && *(p + 1) == '\0' && !sc_needsemicolon)
+ {
+ /* source may be ';' or end of the line */
+ while (*s <= ' ' && *s != '\0')
+ s++; /* skip white space */
+ if (*s != ';' && *s != '\0')
+ match = FALSE;
+ p++; /* skip the semicolon in the pattern */
+ }
+ else
+ {
+ cell ch;
+
+ /* skip whitespace between two non-alphanumeric characters, except
+ * for two identical symbols
+ */
+ assert(p > pattern);
+ if (!alphanum(*p) && *(p - 1) != *p)
+ while (*s <= ' ' && *s != '\0')
+ s++; /* skip white space */
+ ch = litchar(&p, FALSE); /* this increments "p" */
+ if (*s != ch)
+ match = FALSE;
+ else
+ s++; /* this character matches */
+ } /* if */
+ } /* while */
+
+ if (match && *p == '\0')
+ {
+ /* if the last character to match is an alphanumeric character, the
+ * current character in the source may not be alphanumeric
+ */
+ assert(p > pattern);
+ if (alphanum(*(p - 1)) && alphanum(*s))
+ match = FALSE;
+ } /* if */
+
+ if (match)
+ {
+ /* calculate the length of the substituted string */
+ for (e = substitution, len = 0; *e != '\0'; e++)
+ {
+ if (*e == '%' && sc_isdigit(*(e + 1)))
+ {
+ arg = *(e + 1) - '0';
+ assert(arg >= 0 && arg <= 9);
+ if (args[arg])
+ len += strlen(args[arg]);
+ e++; /* skip %, digit is skipped later */
+ }
+ else
+ {
+ len++;
+ } /* if */
+ } /* for */
+ /* check length of the string after substitution */
+ if (strlen(line) + len - (int)(s - line) > buffersize)
+ {
+ error(75); /* line too long */
+ }
+ else
+ {
+ /* substitute pattern */
+ strdel(line, (int)(s - line));
+ for (e = substitution, s = line; *e != '\0'; e++)
+ {
+ if (*e == '%' && sc_isdigit(*(e + 1)))
+ {
+ arg = *(e + 1) - '0';
+ assert(arg >= 0 && arg <= 9);
+ if (args[arg])
+ {
+ strins(s, args[arg], strlen(args[arg]));
+ s += strlen(args[arg]);
+ } /* if */
+ e++; /* skip %, digit is skipped later */
+ }
+ else
+ {
+ strins(s, e, 1);
+ s++;
+ } /* if */
+ } /* for */
+ } /* if */
+ } /* if */
+
+ for (arg = 0; arg < 10; arg++)
+ if (args[arg])
+ free(args[arg]);
+
+ return match;
+}
+
+static void
+substallpatterns(char *line, int buffersize)
+{
+ char *start, *end;
+ int prefixlen;
+ stringpair *subst;
+
+ start = line;
+ while (*start != '\0')
+ {
+ /* find the start of a prefix (skip all non-alphabetic characters),
+ * also skip strings
+ */
+ while (!sc_isalpha(*start) && *start != '_' && *start != '\0')
+ {
+ /* skip strings */
+ if (is_startstring(start))
+ {
+ start = skipstring(start);
+ if (*start == '\0')
+ break; /* abort loop on error */
+ } /* if */
+ start++; /* skip non-alphapetic character (or closing quote of a string) */
+ } /* while */
+ if (*start == '\0')
+ break; /* abort loop on error */
+ /* get the prefix (length), look for a matching definition */
+ prefixlen = 0;
+ end = start;
+ while (sc_isalpha(*end) || sc_isdigit(*end) || *end == '_')
+ {
+ prefixlen++;
+ end++;
+ } /* while */
+ assert(prefixlen > 0);
+ subst = find_subst(start, prefixlen);
+ if (subst)
+ {
+ /* properly match the pattern and substitute */
+ if (!substpattern
+ (start, buffersize - (start - line), subst->first,
+ subst->second))
+ start = end; /* match failed, skip this prefix */
+ /* match succeeded: do not update "start", because the substitution text
+ * may be matched by other macros
+ */
+ }
+ else
+ {
+ start = end; /* no macro with this prefix, skip this prefix */
+ } /* if */
+ } /* while */
+}
+#endif
+
+/* preprocess
+ *
+ * Reads a line by readline() into "pline" and performs basic preprocessing:
+ * deleting comments, skipping lines with false "#if.." code and recognizing
+ * other compiler directives. There is an indirect recursion: lex() calls
+ * preprocess() if a new line must be read, preprocess() calls command(),
+ * which at his turn calls lex() to identify the token.
+ *
+ * Global references: lptr (altered)
+ * pline (altered)
+ * freading (referred to only)
+ */
+void
+preprocess(void)
+{
+ int iscommand;
+
+ if (!freading)
+ return;
+ do
+ {
+ readline(pline);
+ stripcom(pline); /* ??? no need for this when reading back from list file (in the second pass) */
+ lptr = pline; /* set "line pointer" to start of the parsing buffer */
+ iscommand = command();
+ if (iscommand != CMD_NONE)
+ errorset(sRESET); /* reset error flag ("panic mode") on empty line or directive */
+#if !defined NO_DEFINE
+ if (iscommand == CMD_NONE)
+ {
+ assert(lptr != term_expr);
+ substallpatterns(pline, sLINEMAX);
+ lptr = pline; /* reset "line pointer" to start of the parsing buffer */
+ } /* if */
+#endif
+ }
+ while (iscommand != CMD_NONE && iscommand != CMD_TERM && freading); /* enddo */
+}
+
+static char *
+unpackedstring(char *lptr, int rawstring)
+{
+ while (*lptr != '\0')
+ {
+ /* check for doublequotes indicating the end of the string */
+ if (*lptr == '\"')
+ {
+ /* check whether there's another pair of quotes following.
+ * If so, paste the two strings together, thus
+ * "pants""off" becomes "pantsoff"
+ */
+ if (*(lptr + 1) == '\"')
+ lptr += 2;
+ else
+ break;
+ }
+
+ if (*lptr == '\a')
+ { /* ignore '\a' (which was inserted at a line concatenation) */
+ lptr++;
+ continue;
+ } /* if */
+ stowlit(litchar(&lptr, rawstring)); /* litchar() alters "lptr" */
+ } /* while */
+ stowlit(0); /* terminate string */
+ return lptr;
+}
+
+static char *
+packedstring(char *lptr, int rawstring)
+{
+ int i;
+ ucell val, c;
+
+ i = sizeof(ucell) - (charbits / 8); /* start at most significant byte */
+ val = 0;
+ while (*lptr != '\0')
+ {
+ /* check for doublequotes indicating the end of the string */
+ if (*lptr == '\"')
+ {
+ /* check whether there's another pair of quotes following.
+ * If so, paste the two strings together, thus
+ * "pants""off" becomes "pantsoff"
+ */
+ if (*(lptr + 1) == '\"')
+ lptr += 2;
+ else
+ break;
+ }
+
+ if (*lptr == '\a')
+ { /* ignore '\a' (which was inserted at a line concatenation) */
+ lptr++;
+ continue;
+ } /* if */
+ c = litchar(&lptr, rawstring); /* litchar() alters "lptr" */
+ if (c >= (ucell) (1 << charbits))
+ error(43); /* character constant exceeds range */
+ val |= (c << 8 * i);
+ if (i == 0)
+ {
+ stowlit(val);
+ val = 0;
+ } /* if */
+ i = (i + sizeof(ucell) - (charbits / 8)) % sizeof(ucell);
+ } /* if */
+ /* save last code; make sure there is at least one terminating zero character */
+ if (i != (int)(sizeof(ucell) - (charbits / 8)))
+ stowlit(val); /* at least one zero character in "val" */
+ else
+ stowlit(0); /* add full cell of zeros */
+ return lptr;
+}
+
+/* lex(lexvalue,lexsym) Lexical Analysis
+ *
+ * lex() first deletes leading white space, then checks for multi-character
+ * operators, keywords (including most compiler directives), numbers,
+ * labels, symbols and literals (literal characters are converted to a number
+ * and are returned as such). If every check fails, the line must contain
+ * a single-character operator. So, lex() returns this character. In the other
+ * case (something did match), lex() returns the number of the token. All
+ * these tokens have been assigned numbers above 255.
+ *
+ * Some tokens have "attributes":
+ * tNUMBER the value of the number is return in "lexvalue".
+ * tRATIONAL the value is in IEEE 754 encoding or in fixed point
+ * encoding in "lexvalue".
+ * tSYMBOL the first sNAMEMAX characters of the symbol are
+ * stored in a buffer, a pointer to this buffer is
+ * returned in "lexsym".
+ * tLABEL the first sNAMEMAX characters of the label are
+ * stored in a buffer, a pointer to this buffer is
+ * returned in "lexsym".
+ * tSTRING the string is stored in the literal pool, the index
+ * in the literal pool to this string is stored in
+ * "lexvalue".
+ *
+ * lex() stores all information (the token found and possibly its attribute)
+ * in global variables. This allows a token to be examined twice. If "_pushed"
+ * is true, this information is returned.
+ *
+ * Global references: lptr (altered)
+ * fline (referred to only)
+ * litidx (referred to only)
+ * _lextok, _lexval, _lexstr
+ * _pushed
+ */
+
+static int _pushed;
+static int _lextok;
+static cell _lexval;
+static char _lexstr[sLINEMAX + 1];
+static int _lexnewline;
+
+void
+lexinit(void)
+{
+ stkidx = 0; /* index for pushstk() and popstk() */
+ iflevel = 0; /* preprocessor: nesting of "#if" */
+ skiplevel = 0; /* preprocessor: skipping lines or compiling lines */
+ icomment = FALSE; /* currently not in a multiline comment */
+ _pushed = FALSE; /* no token pushed back into lex */
+ _lexnewline = FALSE;
+}
+
+char *sc_tokens[] = {
+ "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
+ "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
+ "...", "..",
+ "assert", "break", "case", "char", "const", "continue", "default",
+ "defined", "do", "else", "enum", "exit", "for", "forward", "goto",
+ "if", "native", "new", "operator", "public", "return", "sizeof",
+ "sleep", "static", "stock", "switch", "tagof", "while",
+ "#assert", "#define", "#else", "#emit", "#endif", "#endinput",
+ "#endscript", "#file", "#if", "#include", "#line", "#pragma", "#undef",
+ ";", ";", "-integer value-", "-rational value-", "-identifier-",
+ "-label-", "-string-"
+};
+
+int
+lex(cell * lexvalue, char **lexsym)
+{
+ int i, toolong, newline, rawstring;
+ char **tokptr;
+
+ if (_pushed)
+ {
+ _pushed = FALSE; /* reset "_pushed" flag */
+ *lexvalue = _lexval;
+ *lexsym = _lexstr;
+ return _lextok;
+ } /* if */
+
+ _lextok = 0; /* preset all values */
+ _lexval = 0;
+ _lexstr[0] = '\0';
+ *lexvalue = _lexval;
+ *lexsym = _lexstr;
+ _lexnewline = FALSE;
+ if (!freading)
+ return 0;
+
+ newline = (lptr == pline); /* does lptr point to start of line buffer */
+ while (*lptr <= ' ')
+ { /* delete leading white space */
+ if (*lptr == '\0')
+ {
+ preprocess(); /* preprocess resets "lptr" */
+ if (!freading)
+ return 0;
+ if (lptr == term_expr) /* special sequence to terminate a pending expression */
+ return (_lextok = tENDEXPR);
+ _lexnewline = TRUE; /* set this after preprocess(), because
+ * preprocess() calls lex() recursively */
+ newline = TRUE;
+ }
+ else
+ {
+ lptr += 1;
+ } /* if */
+ } /* while */
+ if (newline)
+ {
+ stmtindent = 0;
+ for (i = 0; i < (int)(lptr - pline); i++)
+ if (pline[i] == '\t' && sc_tabsize > 0)
+ stmtindent +=
+ (int)(sc_tabsize - (stmtindent + sc_tabsize) % sc_tabsize);
+ else
+ stmtindent++;
+ } /* if */
+
+ i = tFIRST;
+ tokptr = sc_tokens;
+ while (i <= tMIDDLE)
+ { /* match multi-character operators */
+ if (match(*tokptr, FALSE))
+ {
+ _lextok = i;
+ return _lextok;
+ } /* if */
+ i += 1;
+ tokptr += 1;
+ } /* while */
+ while (i <= tLAST)
+ { /* match reserved words and compiler directives */
+ if (match(*tokptr, TRUE))
+ {
+ _lextok = i;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ return _lextok;
+ } /* if */
+ i += 1;
+ tokptr += 1;
+ } /* while */
+
+ if ((i = number(&_lexval, lptr)) != 0)
+ { /* number */
+ _lextok = tNUMBER;
+ *lexvalue = _lexval;
+ lptr += i;
+ }
+ else if ((i = ftoi(&_lexval, lptr)) != 0)
+ {
+ _lextok = tRATIONAL;
+ *lexvalue = _lexval;
+ lptr += i;
+ }
+ else if (alpha(*lptr))
+ { /* symbol or label */
+ /* Note: only sNAMEMAX characters are significant. The compiler
+ * generates a warning if a symbol exceeds this length.
+ */
+ _lextok = tSYMBOL;
+ i = 0;
+ toolong = 0;
+ while (alphanum(*lptr))
+ {
+ _lexstr[i] = *lptr;
+ lptr += 1;
+ if (i < sNAMEMAX)
+ i += 1;
+ else
+ toolong = 1;
+ } /* while */
+ _lexstr[i] = '\0';
+ if (toolong)
+ error(200, _lexstr, sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
+ if (_lexstr[0] == PUBLIC_CHAR && _lexstr[1] == '\0')
+ {
+ _lextok = PUBLIC_CHAR; /* '@' all alone is not a symbol, it is an operator */
+ }
+ else if (_lexstr[0] == '_' && _lexstr[1] == '\0')
+ {
+ _lextok = '_'; /* '_' by itself is not a symbol, it is a placeholder */
+ } /* if */
+ if (*lptr == ':' && sc_allowtags && _lextok != PUBLIC_CHAR)
+ {
+ _lextok = tLABEL; /* it wasn't a normal symbol, it was a label/tagname */
+ lptr += 1; /* skip colon */
+ } /* if */
+ }
+ else if (*lptr == '\"' || (*lptr == sc_ctrlchar && *(lptr + 1) == '\"'))
+ { /* unpacked string literal */
+ _lextok = tSTRING;
+ rawstring = (*lptr == sc_ctrlchar);
+ *lexvalue = _lexval = litidx;
+ lptr += 1; /* skip double quote */
+ if (rawstring)
+ lptr += 1; /* skip "escape" character too */
+ lptr =
+ sc_packstr ? packedstring(lptr, rawstring) : unpackedstring(lptr,
+ rawstring);
+ if (*lptr == '\"')
+ lptr += 1; /* skip final quote */
+ else
+ error(37); /* invalid (non-terminated) string */
+ }
+ else if ((*lptr == '!' && *(lptr + 1) == '\"')
+ || (*lptr == '!' && *(lptr + 1) == sc_ctrlchar && *(lptr + 2) == '\"')
+ || (*lptr == sc_ctrlchar && *(lptr + 1) == '!'
+ && *(lptr + 2) == '\"'))
+ { /* packed string literal */
+ _lextok = tSTRING;
+ rawstring = (*lptr == sc_ctrlchar || *(lptr + 1) == sc_ctrlchar);
+ *lexvalue = _lexval = litidx;
+ lptr += 2; /* skip exclamation point and double quote */
+ if (rawstring)
+ lptr += 1; /* skip "escape" character too */
+ lptr =
+ sc_packstr ? unpackedstring(lptr, rawstring) : packedstring(lptr,
+ rawstring);
+ if (*lptr == '\"')
+ lptr += 1; /* skip final quote */
+ else
+ error(37); /* invalid (non-terminated) string */
+ }
+ else if (*lptr == '\'')
+ { /* character literal */
+ lptr += 1; /* skip quote */
+ _lextok = tNUMBER;
+ *lexvalue = _lexval = litchar(&lptr, FALSE);
+ if (*lptr == '\'')
+ lptr += 1; /* skip final quote */
+ else
+ error(27); /* invalid character constant (must be one character) */
+ }
+ else if (*lptr == ';')
+ { /* semicolumn resets "error" flag */
+ _lextok = ';';
+ lptr += 1;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ }
+ else
+ {
+ _lextok = *lptr; /* if every match fails, return the character */
+ lptr += 1; /* increase the "lptr" pointer */
+ } /* if */
+ return _lextok;
+}
+
+/* lexpush
+ *
+ * Pushes a token back, so the next call to lex() will return the token
+ * last examined, instead of a new token.
+ *
+ * Only one token can be pushed back.
+ *
+ * In fact, lex() already stores the information it finds into global
+ * variables, so all that is to be done is set a flag that informs lex()
+ * to read and return the information from these variables, rather than
+ * to read in a new token from the input file.
+ */
+void
+lexpush(void)
+{
+ assert(_pushed == FALSE);
+ _pushed = TRUE;
+}
+
+/* lexclr
+ *
+ * Sets the variable "_pushed" to 0 to make sure lex() will read in a new
+ * symbol (a not continue with some old one). This is required upon return
+ * from Assembler mode.
+ */
+void
+lexclr(int clreol)
+{
+ _pushed = FALSE;
+ if (clreol)
+ {
+ lptr = strchr(pline, '\0');
+ assert(lptr != NULL);
+ } /* if */
+}
+
+/* matchtoken
+ *
+ * This routine is useful if only a simple check is needed. If the token
+ * differs from the one expected, it is pushed back.
+ */
+int
+matchtoken(int token)
+{
+ cell val;
+ char *str;
+ int tok;
+
+ tok = lex(&val, &str);
+ if (tok == token || (token == tTERM && (tok == ';' || tok == tENDEXPR)))
+ {
+ return 1;
+ }
+ else if (!sc_needsemicolon && token == tTERM && (_lexnewline || !freading))
+ {
+ lexpush(); /* push "tok" back, we use the "hidden" newline token */
+ return 1;
+ }
+ else
+ {
+ lexpush();
+ return 0;
+ } /* if */
+}
+
+/* tokeninfo
+ *
+ * Returns additional information of a token after using "matchtoken()"
+ * or needtoken(). It does no harm using this routine after a call to
+ * "lex()", but lex() already returns the same information.
+ *
+ * The token itself is the return value. Normally, this one is already known.
+ */
+int
+tokeninfo(cell * val, char **str)
+{
+ /* if the token was pushed back, tokeninfo() returns the token and
+ * parameters of the *next* token, not of the *current* token.
+ */
+ assert(!_pushed);
+ *val = _lexval;
+ *str = _lexstr;
+ return _lextok;
+}
+
+/* needtoken
+ *
+ * This routine checks for a required token and gives an error message if
+ * it isn't there (and returns FALSE in that case).
+ *
+ * Global references: _lextok;
+ */
+int
+needtoken(int token)
+{
+ char s1[20], s2[20];
+
+ if (matchtoken(token))
+ {
+ return TRUE;
+ }
+ else
+ {
+ /* token already pushed back */
+ assert(_pushed);
+ if (token < 256)
+ sprintf(s1, "%c", (char)token); /* single character token */
+ else
+ strcpy(s1, sc_tokens[token - tFIRST]); /* multi-character symbol */
+ if (!freading)
+ strcpy(s2, "-end of file-");
+ else if (_lextok < 256)
+ sprintf(s2, "%c", (char)_lextok);
+ else
+ strcpy(s2, sc_tokens[_lextok - tFIRST]);
+ error(1, s1, s2); /* expected ..., but found ... */
+ return FALSE;
+ } /* if */
+}
+
+/* match
+ *
+ * Compares a series of characters from the input file with the characters
+ * in "st" (that contains a token). If the token on the input file matches
+ * "st", the input file pointer "lptr" is adjusted to point to the next
+ * token, otherwise "lptr" remains unaltered.
+ *
+ * If the parameter "end: is true, match() requires that the first character
+ * behind the recognized token is non-alphanumeric.
+ *
+ * Global references: lptr (altered)
+ */
+static int
+match(char *st, int end)
+{
+ int k;
+ char *ptr;
+
+ k = 0;
+ ptr = lptr;
+ while (st[k])
+ {
+ if (st[k] != *ptr)
+ return 0;
+ k += 1;
+ ptr += 1;
+ } /* while */
+ if (end)
+ { /* symbol must terminate with non-alphanumeric char */
+ if (alphanum(*ptr))
+ return 0;
+ } /* if */
+ lptr = ptr; /* match found, skip symbol */
+ return 1;
+}
+
+/* stowlit
+ *
+ * Stores a value into the literal queue. The literal queue is used for
+ * literal strings used in functions and for initializing array variables.
+ *
+ * Global references: litidx (altered)
+ * litq (altered)
+ */
+void
+stowlit(cell value)
+{
+ if (litidx >= litmax)
+ {
+ cell *p;
+
+ litmax += sDEF_LITMAX;
+ p = (cell *) realloc(litq, litmax * sizeof(cell));
+ if (!p)
+ error(102, "literal table"); /* literal table overflow (fatal error) */
+ litq = p;
+ } /* if */
+ assert(litidx < litmax);
+ litq[litidx++] = value;
+}
+
+/* litchar
+ *
+ * Return current literal character and increase the pointer to point
+ * just behind this literal character.
+ *
+ * Note: standard "escape sequences" are suported, but the backslash may be
+ * replaced by another character; the syntax '\ddd' is supported,
+ * but ddd must be decimal!
+ */
+static cell
+litchar(char **lptr, int rawmode)
+{
+ cell c = 0;
+ unsigned char *cptr;
+
+ cptr = (unsigned char *)*lptr;
+ if (rawmode || *cptr != sc_ctrlchar)
+ { /* no escape character */
+ c = *cptr;
+ cptr += 1;
+ }
+ else
+ {
+ cptr += 1;
+ if (*cptr == sc_ctrlchar)
+ {
+ c = *cptr; /* \\ == \ (the escape character itself) */
+ cptr += 1;
+ }
+ else
+ {
+ switch (*cptr)
+ {
+ case 'a': /* \a == audible alarm */
+ c = 7;
+ cptr += 1;
+ break;
+ case 'b': /* \b == backspace */
+ c = 8;
+ cptr += 1;
+ break;
+ case 'e': /* \e == escape */
+ c = 27;
+ cptr += 1;
+ break;
+ case 'f': /* \f == form feed */
+ c = 12;
+ cptr += 1;
+ break;
+ case 'n': /* \n == NewLine character */
+ c = 10;
+ cptr += 1;
+ break;
+ case 'r': /* \r == carriage return */
+ c = 13;
+ cptr += 1;
+ break;
+ case 't': /* \t == horizontal TAB */
+ c = 9;
+ cptr += 1;
+ break;
+ case 'v': /* \v == vertical TAB */
+ c = 11;
+ cptr += 1;
+ break;
+ case '\'': /* \' == ' (single quote) */
+ case '"': /* \" == " (single quote) */
+ case '%': /* \% == % (percent) */
+ c = *cptr;
+ cptr += 1;
+ break;
+ default:
+ if (sc_isdigit(*cptr))
+ { /* \ddd */
+ c = 0;
+ while (*cptr >= '0' && *cptr <= '9') /* decimal! */
+ c = c * 10 + *cptr++ - '0';
+ if (*cptr == ';')
+ cptr++; /* swallow a trailing ';' */
+ }
+ else
+ {
+ error(27); /* invalid character constant */
+ } /* if */
+ } /* switch */
+ } /* if */
+ } /* if */
+ *lptr = (char *)cptr;
+ assert(c >= 0 && c < 256);
+ return c;
+}
+
+/* alpha
+ *
+ * Test if character "c" is alphabetic ("a".."z"), an underscore ("_")
+ * or an "at" sign ("@"). The "@" is an extension to standard C.
+ */
+static int
+alpha(char c)
+{
+ return (sc_isalpha(c) || c == '_' || c == PUBLIC_CHAR);
+}
+
+/* alphanum
+ *
+ * Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")
+ */
+int
+alphanum(char c)
+{
+ return (alpha(c) || sc_isdigit(c));
+}
+
+/* The local variable table must be searched backwards, so that the deepest
+ * nesting of local variables is searched first. The simplest way to do
+ * this is to insert all new items at the head of the list.
+ * In the global list, the symbols are kept in sorted order, so that the
+ * public functions are written in sorted order.
+ */
+static symbol *
+add_symbol(symbol * root, symbol * entry, int sort)
+{
+ symbol *newsym;
+
+ if (sort)
+ while (root->next && strcmp(entry->name, root->next->name) > 0)
+ root = root->next;
+
+ if (!(newsym = (symbol *)malloc(sizeof(symbol))))
+ {
+ error(103);
+ return NULL;
+ } /* if */
+ memcpy(newsym, entry, sizeof(symbol));
+ newsym->next = root->next;
+ root->next = newsym;
+ return newsym;
+}
+
+static void
+free_symbol(symbol * sym)
+{
+ arginfo *arg;
+
+ /* free all sub-symbol allocated memory blocks, depending on the
+ * kind of the symbol
+ */
+ assert(sym != NULL);
+ if (sym->ident == iFUNCTN)
+ {
+ /* run through the argument list; "default array" arguments
+ * must be freed explicitly; the tag list must also be freed */
+ assert(sym->dim.arglist != NULL);
+ for (arg = sym->dim.arglist; arg->ident != 0; arg++)
+ {
+ if (arg->ident == iREFARRAY && arg->hasdefault)
+ free(arg->defvalue.array.data);
+ else if (arg->ident == iVARIABLE
+ && ((arg->hasdefault & uSIZEOF) != 0
+ || (arg->hasdefault & uTAGOF) != 0))
+ free(arg->defvalue.size.symname);
+ assert(arg->tags != NULL);
+ free(arg->tags);
+ } /* for */
+ free(sym->dim.arglist);
+ } /* if */
+ assert(sym->refer != NULL);
+ free(sym->refer);
+ free(sym);
+}
+
+void
+delete_symbol(symbol * root, symbol * sym)
+{
+ /* find the symbol and its predecessor
+ * (this function assumes that you will never delete a symbol that is not
+ * in the table pointed at by "root")
+ */
+ assert(root != sym);
+ while (root->next != sym)
+ {
+ root = root->next;
+ assert(root != NULL);
+ } /* while */
+
+ /* unlink it, then free it */
+ root->next = sym->next;
+ free_symbol(sym);
+}
+
+void
+delete_symbols(symbol * root, int level, int delete_labels,
+ int delete_functions)
+{
+ symbol *sym;
+
+ /* erase only the symbols with a deeper nesting level than the
+ * specified nesting level */
+ while (root->next)
+ {
+ sym = root->next;
+ if (sym->compound < level)
+ break;
+ if ((delete_labels || sym->ident != iLABEL)
+ && (delete_functions || sym->ident != iFUNCTN
+ || (sym->usage & uNATIVE) != 0) && (delete_functions
+ || sym->ident != iCONSTEXPR
+ || (sym->usage & uPREDEF) ==
+ 0) && (delete_functions
+ || (sym->ident !=
+ iVARIABLE
+ && sym->ident !=
+ iARRAY)))
+ {
+ root->next = sym->next;
+ free_symbol(sym);
+ }
+ else
+ {
+ /* if the function was prototyped, but not implemented in this source,
+ * mark it as such, so that its use can be flagged
+ */
+ if (sym->ident == iFUNCTN && (sym->usage & uDEFINE) == 0)
+ sym->usage |= uMISSING;
+ if (sym->ident == iFUNCTN || sym->ident == iVARIABLE
+ || sym->ident == iARRAY)
+ sym->usage &= ~uDEFINE; /* clear "defined" flag */
+ /* for user defined operators, also remove the "prototyped" flag, as
+ * user-defined operators *must* be declared before use
+ */
+ if (sym->ident == iFUNCTN && !sc_isalpha(*sym->name)
+ && *sym->name != '_' && *sym->name != PUBLIC_CHAR)
+ sym->usage &= ~uPROTOTYPED;
+ root = sym; /* skip the symbol */
+ } /* if */
+ } /* if */
+}
+
+/* The purpose of the hash is to reduce the frequency of a "name"
+ * comparison (which is costly). There is little interest in avoiding
+ * clusters in similar names, which is why this function is plain simple.
+ */
+unsigned int
+namehash(char *name)
+{
+ unsigned char *ptr = (unsigned char *)name;
+ int len = strlen(name);
+
+ if (len == 0)
+ return 0L;
+ assert(len < 256);
+ return (len << 24Lu) + (ptr[0] << 16Lu) + (ptr[len - 1] << 8Lu) +
+ (ptr[len >> 1Lu]);
+}
+
+static symbol *
+find_symbol(symbol * root, char *name, int fnumber)
+{
+ symbol *ptr = root->next;
+ unsigned long hash = namehash(name);
+
+ while (ptr)
+ {
+ if (hash == ptr->hash && strcmp(name, ptr->name) == 0
+ && !ptr->parent && (ptr->fnumber < 0
+ || ptr->fnumber == fnumber))
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+static symbol *
+find_symbol_child(symbol * root, symbol * sym)
+{
+ symbol *ptr = root->next;
+
+ while (ptr)
+ {
+ if (ptr->parent == sym)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+/* Adds "bywhom" to the list of referrers of "entry". Typically,
+ * bywhom will be the function that uses a variable or that calls
+ * the function.
+ */
+int
+refer_symbol(symbol * entry, symbol * bywhom)
+{
+ int count;
+
+ assert(bywhom != NULL); /* it makes no sense to add a "void" referrer */
+ assert(entry != NULL);
+ assert(entry->refer != NULL);
+
+ /* see if it is already there */
+ for (count = 0; count < entry->numrefers && entry->refer[count] != bywhom;
+ count++)
+ /* nothing */ ;
+ if (count < entry->numrefers)
+ {
+ assert(entry->refer[count] == bywhom);
+ return TRUE;
+ } /* if */
+
+ /* see if there is an empty spot in the referrer list */
+ for (count = 0; count < entry->numrefers && entry->refer[count];
+ count++)
+ /* nothing */ ;
+ assert(count <= entry->numrefers);
+ if (count == entry->numrefers)
+ {
+ symbol **refer;
+ int newsize = 2 * entry->numrefers;
+
+ assert(newsize > 0);
+ /* grow the referrer list */
+ refer = (symbol **) realloc(entry->refer, newsize * sizeof(symbol *));
+ if (!refer)
+ return FALSE; /* insufficient memory */
+ /* initialize the new entries */
+ entry->refer = refer;
+ for (count = entry->numrefers; count < newsize; count++)
+ entry->refer[count] = NULL;
+ count = entry->numrefers; /* first empty spot */
+ entry->numrefers = newsize;
+ } /* if */
+
+ /* add the referrer */
+ assert(entry->refer[count] == NULL);
+ entry->refer[count] = bywhom;
+ return TRUE;
+}
+
+void
+markusage(symbol * sym, int usage)
+{
+ sym->usage |= (char)usage;
+ /* check if (global) reference must be added to the symbol */
+ if ((usage & (uREAD | uWRITTEN)) != 0)
+ {
+ /* only do this for global symbols */
+ if (sym->vclass == sGLOBAL)
+ {
+ /* "curfunc" should always be valid, since statements may not occurs
+ * outside functions; in the case of syntax errors, however, the
+ * compiler may arrive through this function
+ */
+ if (curfunc)
+ refer_symbol(sym, curfunc);
+ } /* if */
+ } /* if */
+}
+
+/* findglb
+ *
+ * Returns a pointer to the global symbol (if found) or NULL (if not found)
+ */
+symbol *
+findglb(char *name)
+{
+ return find_symbol(&glbtab, name, fcurrent);
+}
+
+/* findloc
+ *
+ * Returns a pointer to the local symbol (if found) or NULL (if not found).
+ * See add_symbol() how the deepest nesting level is searched first.
+ */
+symbol *
+findloc(char *name)
+{
+ return find_symbol(&loctab, name, -1);
+}
+
+symbol *
+findconst(char *name)
+{
+ symbol *sym;
+
+ sym = find_symbol(&loctab, name, -1); /* try local symbols first */
+ if (!sym || sym->ident != iCONSTEXPR) /* not found, or not a constant */
+ sym = find_symbol(&glbtab, name, fcurrent);
+ if (!sym || sym->ident != iCONSTEXPR)
+ return NULL;
+ assert(sym->parent == NULL); /* constants have no hierarchy */
+ return sym;
+}
+
+symbol *
+finddepend(symbol * parent)
+{
+ symbol *sym;
+
+ sym = find_symbol_child(&loctab, parent); /* try local symbols first */
+ if (!sym) /* not found */
+ sym = find_symbol_child(&glbtab, parent);
+ return sym;
+}
+
+/* addsym
+ *
+ * Adds a symbol to the symbol table (either global or local variables,
+ * or global and local constants).
+ */
+symbol *
+addsym(char *name, cell addr, int ident, int vclass, int tag, int usage)
+{
+ symbol entry, **refer;
+
+ /* global variables/constants/functions may only be defined once */
+ assert(!(ident == iFUNCTN || ident == iCONSTEXPR) || vclass != sGLOBAL
+ || findglb(name) == NULL);
+ /* labels may only be defined once */
+ assert(ident != iLABEL || findloc(name) == NULL);
+
+ /* create an empty referrer list */
+ if (!(refer = (symbol **)malloc(sizeof(symbol *))))
+ {
+ error(103); /* insufficient memory */
+ return NULL;
+ } /* if */
+ *refer = NULL;
+
+ /* first fill in the entry */
+ strcpy(entry.name, name);
+ entry.hash = namehash(name);
+ entry.addr = addr;
+ entry.vclass = (char)vclass;
+ entry.ident = (char)ident;
+ entry.tag = tag;
+ entry.usage = (char)usage;
+ entry.compound = 0; /* may be overridden later */
+ entry.fnumber = -1; /* assume global visibility (ignored for local symbols) */
+ entry.numrefers = 1;
+ entry.refer = refer;
+ entry.parent = NULL;
+
+ /* then insert it in the list */
+ if (vclass == sGLOBAL)
+ return add_symbol(&glbtab, &entry, TRUE);
+ else
+ return add_symbol(&loctab, &entry, FALSE);
+}
+
+symbol *
+addvariable(char *name, cell addr, int ident, int vclass, int tag,
+ int dim[], int numdim, int idxtag[])
+{
+ symbol *sym, *parent, *top;
+ int level;
+
+ /* global variables may only be defined once */
+ assert(vclass != sGLOBAL || (sym = findglb(name)) == NULL
+ || (sym->usage & uDEFINE) == 0);
+
+ if (ident == iARRAY || ident == iREFARRAY)
+ {
+ parent = NULL;
+ sym = NULL; /* to avoid a compiler warning */
+ for (level = 0; level < numdim; level++)
+ {
+ top = addsym(name, addr, ident, vclass, tag, uDEFINE);
+ top->dim.array.length = dim[level];
+ top->dim.array.level = (short)(numdim - level - 1);
+ top->x.idxtag = idxtag[level];
+ top->parent = parent;
+ parent = top;
+ if (level == 0)
+ sym = top;
+ } /* for */
+ }
+ else
+ {
+ sym = addsym(name, addr, ident, vclass, tag, uDEFINE);
+ } /* if */
+ return sym;
+}
+
+/* getlabel
+ *
+ * Return next available internal label number.
+ */
+int
+getlabel(void)
+{
+ return labnum++;
+}
+
+/* itoh
+ *
+ * Converts a number to a hexadecimal string and returns a pointer to that
+ * string.
+ */
+char *
+itoh(ucell val)
+{
+ static char itohstr[15]; /* hex number is 10 characters long at most */
+ char *ptr;
+ int i, nibble[8]; /* a 32-bit hexadecimal cell has 8 nibbles */
+ int max;
+
+#if defined(BIT16)
+ max = 4;
+#else
+ max = 8;
+#endif
+ ptr = itohstr;
+ for (i = 0; i < max; i += 1)
+ {
+ nibble[i] = (int)(val & 0x0f); /* nibble 0 is lowest nibble */
+ val >>= 4;
+ } /* endfor */
+ i = max - 1;
+ while (nibble[i] == 0 && i > 0) /* search for highest non-zero nibble */
+ i -= 1;
+ while (i >= 0)
+ {
+ if (nibble[i] >= 10)
+ *ptr++ = (char)('a' + (nibble[i] - 10));
+ else
+ *ptr++ = (char)('0' + nibble[i]);
+ i -= 1;
+ } /* while */
+ *ptr = '\0'; /* and a zero-terminator */
+ return itohstr;
+}
--- /dev/null
+/* Small compiler - Recursive descend expresion parser
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <limits.h> /* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+static int skim(int *opstr, void (*testfunc) (int), int dropval,
+ int endval, int (*hier) (value *), value * lval);
+static void dropout(int lvalue, void (*testfunc) (int val), int exit1,
+ value * lval);
+static int plnge(int *opstr, int opoff, int (*hier) (value * lval),
+ value * lval, char *forcetag, int chkbitwise);
+static int plnge1(int (*hier) (value * lval), value * lval);
+static void plnge2(void (*oper) (void),
+ int (*hier) (value * lval),
+ value * lval1, value * lval2);
+static cell calc(cell left, void (*oper) (), cell right,
+ char *boolresult);
+static int hier13(value * lval);
+static int hier12(value * lval);
+static int hier11(value * lval);
+static int hier10(value * lval);
+static int hier9(value * lval);
+static int hier8(value * lval);
+static int hier7(value * lval);
+static int hier6(value * lval);
+static int hier5(value * lval);
+static int hier4(value * lval);
+static int hier3(value * lval);
+static int hier2(value * lval);
+static int hier1(value * lval1);
+static int primary(value * lval);
+static void clear_value(value * lval);
+static void callfunction(symbol * sym);
+static int dbltest(void (*oper) (), value * lval1, value * lval2);
+static int commutative(void (*oper) ());
+static int constant(value * lval);
+
+static char lastsymbol[sNAMEMAX + 1]; /* name of last function/variable */
+static int bitwise_opercount; /* count of bitwise operators in an expression */
+
+/* Function addresses of binary operators for signed operations */
+static void (*op1[17]) (void) =
+{
+ os_mult, os_div, os_mod, /* hier3, index 0 */
+ ob_add, ob_sub, /* hier4, index 3 */
+ ob_sal, os_sar, ou_sar, /* hier5, index 5 */
+ ob_and, /* hier6, index 8 */
+ ob_xor, /* hier7, index 9 */
+ ob_or, /* hier8, index 10 */
+ os_le, os_ge, os_lt, os_gt, /* hier9, index 11 */
+ ob_eq, ob_ne, /* hier10, index 15 */
+};
+/* These two functions are defined because the functions inc() and dec() in
+ * SC4.C have a different prototype than the other code generation functions.
+ * The arrays for user-defined functions use the function pointers for
+ * identifying what kind of operation is requested; these functions must all
+ * have the same prototype. As inc() and dec() are special cases already, it
+ * is simplest to add two "do-nothing" functions.
+ */
+static void
+user_inc(void)
+{
+}
+static void
+user_dec(void)
+{
+}
+
+/*
+ * Searches for a binary operator a list of operators. The list is stored in
+ * the array "list". The last entry in the list should be set to 0.
+ *
+ * The index of an operator in "list" (if found) is returned in "opidx". If
+ * no operator is found, nextop() returns 0.
+ */
+static int
+nextop(int *opidx, int *list)
+{
+ *opidx = 0;
+ while (*list)
+ {
+ if (matchtoken(*list))
+ {
+ return TRUE; /* found! */
+ }
+ else
+ {
+ list += 1;
+ *opidx += 1;
+ } /* if */
+ } /* while */
+ return FALSE; /* entire list scanned, nothing found */
+}
+
+int
+check_userop(void (*oper) (void), int tag1, int tag2, int numparam,
+ value * lval, int *resulttag)
+{
+ static char *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "",
+ "", "", "", "<=", ">=", "<", ">", "==", "!="
+ };
+ static int binoper_savepri[] =
+ { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+ FALSE, FALSE, FALSE, FALSE, FALSE,
+ TRUE, TRUE, TRUE, TRUE, FALSE, FALSE
+ };
+ static char *unoperstr[] = { "!", "-", "++", "--" };
+ static void (*unopers[]) (void) =
+ {
+ lneg, neg, user_inc, user_dec};
+ char opername[4] = "", symbolname[sNAMEMAX + 1];
+ int i, swapparams, savepri, savealt;
+ int paramspassed;
+ symbol *sym;
+
+ /* since user-defined operators on untagged operands are forbidden, we have
+ * a quick exit.
+ */
+ assert(numparam == 1 || numparam == 2);
+ if (tag1 == 0 && (numparam == 1 || tag2 == 0))
+ return FALSE;
+
+ savepri = savealt = FALSE;
+ /* find the name with the operator */
+ if (numparam == 2)
+ {
+ if (!oper)
+ {
+ /* assignment operator: a special case */
+ strcpy(opername, "=");
+ if (lval
+ && (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR))
+ savealt = TRUE;
+ }
+ else
+ {
+ assert((sizeof binoperstr / sizeof binoperstr[0]) ==
+ (sizeof op1 / sizeof op1[0]));
+ for (i = 0; i < (int)(sizeof op1 / sizeof op1[0]); i++)
+ {
+ if (oper == op1[i])
+ {
+ strcpy(opername, binoperstr[i]);
+ savepri = binoper_savepri[i];
+ break;
+ } /* if */
+ } /* for */
+ } /* if */
+ }
+ else
+ {
+ assert(oper != NULL);
+ assert(numparam == 1);
+ /* try a select group of unary operators */
+ assert((sizeof unoperstr / sizeof unoperstr[0]) ==
+ (sizeof unopers / sizeof unopers[0]));
+ if (opername[0] == '\0')
+ {
+ for (i = 0; i < (int)(sizeof unopers / sizeof unopers[0]); i++)
+ {
+ if (oper == unopers[i])
+ {
+ strcpy(opername, unoperstr[i]);
+ break;
+ } /* if */
+ } /* for */
+ } /* if */
+ } /* if */
+ /* if not found, quit */
+ if (opername[0] == '\0')
+ return FALSE;
+
+ /* create a symbol name from the tags and the operator name */
+ assert(numparam == 1 || numparam == 2);
+ operator_symname(symbolname, opername, tag1, tag2, numparam, tag2);
+ swapparams = FALSE;
+ sym = findglb(symbolname);
+ if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+ { /* ??? should not check uDEFINE; first pass clears these bits */
+ /* check for commutative operators */
+ if (tag1 == tag2 || !oper || !commutative(oper))
+ return FALSE; /* not commutative, cannot swap operands */
+ /* if arrived here, the operator is commutative and the tags are different,
+ * swap tags and try again
+ */
+ assert(numparam == 2); /* commutative operator must be a binary operator */
+ operator_symname(symbolname, opername, tag2, tag1, numparam, tag1);
+ swapparams = TRUE;
+ sym = findglb(symbolname);
+ if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+ return FALSE;
+ } /* if */
+
+ /* check existence and the proper declaration of this function */
+ if ((sym->usage & uMISSING) != 0 || (sym->usage & uPROTOTYPED) == 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ if ((sym->usage & uMISSING) != 0)
+ error(4, symname); /* function not defined */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ error(71, symname); /* operator must be declared before use */
+ } /* if */
+
+ /* we don't want to use the redefined operator in the function that
+ * redefines the operator itself, otherwise the snippet below gives
+ * an unexpected recursion:
+ * fixed:operator+(fixed:a, fixed:b)
+ * return a + b
+ */
+ if (sym == curfunc)
+ return FALSE;
+
+ /* for increment and decrement operators, the symbol must first be loaded
+ * (and stored back afterwards)
+ */
+ if (oper == user_inc || oper == user_dec)
+ {
+ assert(!savepri);
+ assert(lval != NULL);
+ if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+ push1(); /* save current address in PRI */
+ rvalue(lval); /* get the symbol's value in PRI */
+ } /* if */
+
+ assert(!savepri || !savealt); /* either one MAY be set, but not both */
+ if (savepri)
+ {
+ /* the chained comparison operators require that the ALT register is
+ * unmodified, so we save it here; actually, we save PRI because the normal
+ * instruction sequence (without user operator) swaps PRI and ALT
+ */
+ push1(); /* right-hand operand is in PRI */
+ }
+ else if (savealt)
+ {
+ /* for the assignment operator, ALT may contain an address at which the
+ * result must be stored; this address must be preserved across the
+ * call
+ */
+ assert(lval != NULL); /* this was checked earlier */
+ assert(lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR); /* checked earlier */
+ push2();
+ } /* if */
+
+ /* push parameters, call the function */
+ paramspassed = (!oper) ? 1 : numparam;
+ switch (paramspassed)
+ {
+ case 1:
+ push1();
+ break;
+ case 2:
+ /* note that 1) a function expects that the parameters are pushed
+ * in reversed order, and 2) the left operand is in the secondary register
+ * and the right operand is in the primary register */
+ if (swapparams)
+ {
+ push2();
+ push1();
+ }
+ else
+ {
+ push1();
+ push2();
+ } /* if */
+ break;
+ default:
+ assert(0);
+ } /* switch */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ pushval((cell) paramspassed * sizeof(cell));
+ assert(sym->ident == iFUNCTN);
+ ffcall(sym, paramspassed);
+ if (sc_status != statSKIP)
+ markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
+ if (sym->x.lib)
+ sym->x.lib->value += 1; /* increment "usage count" of the library */
+ sideeffect = TRUE; /* assume functions carry out a side-effect */
+ assert(resulttag != NULL);
+ *resulttag = sym->tag; /* save tag of the called function */
+
+ if (savepri || savealt)
+ pop2(); /* restore the saved PRI/ALT that into ALT */
+ if (oper == user_inc || oper == user_dec)
+ {
+ assert(lval != NULL);
+ if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+ pop2(); /* restore address (in ALT) */
+ store(lval); /* store PRI in the symbol */
+ moveto1(); /* make sure PRI is restored on exit */
+ } /* if */
+ return TRUE;
+}
+
+int
+matchtag(int formaltag, int actualtag, int allowcoerce)
+{
+ if (formaltag != actualtag)
+ {
+ /* if the formal tag is zero and the actual tag is not "fixed", the actual
+ * tag is "coerced" to zero
+ */
+ if (!allowcoerce || formaltag != 0 || (actualtag & FIXEDTAG) != 0)
+ return FALSE;
+ } /* if */
+ return TRUE;
+}
+
+/*
+ * The AMX pseudo-processor has no direct support for logical (boolean)
+ * operations. These have to be done via comparing and jumping. Since we are
+ * already jumping through the code, we might as well implement an "early
+ * drop-out" evaluation (also called "short-circuit"). This conforms to
+ * standard C:
+ *
+ * expr1 || expr2 expr2 will only be evaluated if expr1 is false.
+ * expr1 && expr2 expr2 will only be evaluated if expr1 is true.
+ *
+ * expr1 || expr2 && expr3 expr2 will only be evaluated if expr1 is false
+ * and expr3 will only be evaluated if expr1 is
+ * false and expr2 is true.
+ *
+ * Code generation for the last example proceeds thus:
+ *
+ * evaluate expr1
+ * operator || found
+ * jump to "l1" if result of expr1 not equal to 0
+ * evaluate expr2
+ * -> operator && found; skip to higher level in hierarchy diagram
+ * jump to "l2" if result of expr2 equal to 0
+ * evaluate expr3
+ * jump to "l2" if result of expr3 equal to 0
+ * set expression result to 1 (true)
+ * jump to "l3"
+ * l2: set expression result to 0 (false)
+ * l3:
+ * <- drop back to previous hierarchy level
+ * jump to "l1" if result of expr2 && expr3 not equal to 0
+ * set expression result to 0 (false)
+ * jump to "l4"
+ * l1: set expression result to 1 (true)
+ * l4:
+ *
+ */
+
+/* Skim over terms adjoining || and && operators
+ * dropval The value of the expression after "dropping out". An "or" drops
+ * out when the left hand is TRUE, so dropval must be 1 on "or"
+ * expressions.
+ * endval The value of the expression when no expression drops out. In an
+ * "or" expression, this happens when both the left hand and the
+ * right hand are FALSE, so endval must be 0 for "or" expressions.
+ */
+static int
+skim(int *opstr, void (*testfunc) (int), int dropval, int endval,
+ int (*hier) (value *), value * lval)
+{
+ int lvalue, hits, droplab, endlab, opidx;
+ int allconst;
+ cell constval;
+ int index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ hits = FALSE; /* no logical operators "hit" yet */
+ allconst = TRUE; /* assume all values "const" */
+ constval = 0;
+ droplab = 0; /* to avoid a compiler warning */
+ for (;;)
+ {
+ lvalue = plnge1(hier, lval); /* evaluate left expression */
+
+ allconst = allconst && (lval->ident == iCONSTEXPR);
+ if (allconst)
+ {
+ if (hits)
+ {
+ /* one operator was already found */
+ if (testfunc == jmp_ne0)
+ lval->constval = lval->constval || constval;
+ else
+ lval->constval = lval->constval && constval;
+ } /* if */
+ constval = lval->constval; /* save result accumulated so far */
+ } /* if */
+
+ if (nextop(&opidx, opstr))
+ {
+ if (!hits)
+ {
+ /* this is the first operator in the list */
+ hits = TRUE;
+ droplab = getlabel();
+ } /* if */
+ dropout(lvalue, testfunc, droplab, lval);
+ }
+ else if (hits)
+ { /* no (more) identical operators */
+ dropout(lvalue, testfunc, droplab, lval); /* found at least one operator! */
+ const1(endval);
+ jumplabel(endlab = getlabel());
+ setlabel(droplab);
+ const1(dropval);
+ setlabel(endlab);
+ lval->sym = NULL;
+ lval->tag = 0;
+ if (allconst)
+ {
+ lval->ident = iCONSTEXPR;
+ lval->constval = constval;
+ stgdel(index, cidx); /* scratch generated code and calculate */
+ }
+ else
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ } /* if */
+ return FALSE;
+ }
+ else
+ {
+ return lvalue; /* none of the operators in "opstr" were found */
+ } /* if */
+
+ } /* while */
+}
+
+/*
+ * Reads into the primary register the variable pointed to by lval if
+ * plunging through the hierarchy levels detected an lvalue. Otherwise
+ * if a constant was detected, it is loaded. If there is no constant and
+ * no lvalue, the primary register must already contain the expression
+ * result.
+ *
+ * After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which
+ * compare the primary register against 0, and jump to the "early drop-out"
+ * label "exit1" if the condition is true.
+ */
+static void
+dropout(int lvalue, void (*testfunc) (int val), int exit1, value * lval)
+{
+ if (lvalue)
+ rvalue(lval);
+ else if (lval->ident == iCONSTEXPR)
+ const1(lval->constval);
+ (*testfunc) (exit1);
+}
+
+static void
+checkfunction(value * lval)
+{
+ symbol *sym = lval->sym;
+
+ if (!sym || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+ return; /* no known symbol, or not a function result */
+
+ if ((sym->usage & uDEFINE) != 0)
+ {
+ /* function is defined, can now check the return value (but make an
+ * exception for directly recursive functions)
+ */
+ if (sym != curfunc && (sym->usage & uRETVALUE) == 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ }
+ else
+ {
+ /* function not yet defined, set */
+ sym->usage |= uRETVALUE; /* make sure that a future implementation of
+ * the function uses "return <value>" */
+ } /* if */
+}
+
+/*
+ * Plunge to a lower level
+ */
+static int
+plnge(int *opstr, int opoff, int (*hier) (value * lval), value * lval,
+ char *forcetag, int chkbitwise)
+{
+ int lvalue, opidx;
+ int count;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+
+ lvalue = plnge1(hier, lval);
+ if (nextop(&opidx, opstr) == 0)
+ return lvalue; /* no operator in "opstr" found */
+ if (lvalue)
+ rvalue(lval);
+ count = 0;
+ do
+ {
+ if (chkbitwise && count++ > 0 && bitwise_opercount != 0)
+ error(212);
+ opidx += opoff; /* add offset to index returned by nextop() */
+ plnge2(op1[opidx], hier, lval, &lval2);
+ if (op1[opidx] == ob_and || op1[opidx] == ob_or)
+ bitwise_opercount++;
+ if (forcetag)
+ lval->tag = sc_addtag(forcetag);
+ }
+ while (nextop(&opidx, opstr)); /* do */
+ return FALSE; /* result of expression is not an lvalue */
+}
+
+/* plnge_rel
+ *
+ * Binary plunge to lower level; this is very simular to plnge, but
+ * it has special code generation sequences for chained operations.
+ */
+static int
+plnge_rel(int *opstr, int opoff, int (*hier) (value * lval), value * lval)
+{
+ int lvalue, opidx;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ int count;
+
+ /* this function should only be called for relational operators */
+ assert(op1[opoff] == os_le);
+ lvalue = plnge1(hier, lval);
+ if (nextop(&opidx, opstr) == 0)
+ return lvalue; /* no operator in "opstr" found */
+ if (lvalue)
+ rvalue(lval);
+ count = 0;
+ lval->boolresult = TRUE;
+ do
+ {
+ /* same check as in plnge(), but "chkbitwise" is always TRUE */
+ if (count > 0 && bitwise_opercount != 0)
+ error(212);
+ if (count > 0)
+ {
+ relop_prefix();
+ *lval = lval2; /* copy right hand expression of the previous iteration */
+ } /* if */
+ opidx += opoff;
+ plnge2(op1[opidx], hier, lval, &lval2);
+ if (count++ > 0)
+ relop_suffix();
+ }
+ while (nextop(&opidx, opstr)); /* enddo */
+ lval->constval = lval->boolresult;
+ lval->tag = sc_addtag("bool"); /* force tag to be "bool" */
+ return FALSE; /* result of expression is not an lvalue */
+}
+
+/* plnge1
+ *
+ * Unary plunge to lower level
+ * Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()
+ */
+static int
+plnge1(int (*hier) (value * lval), value * lval)
+{
+ int lvalue, index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ lvalue = (*hier) (lval);
+ if (lval->ident == iCONSTEXPR)
+ stgdel(index, cidx); /* load constant later */
+ return lvalue;
+}
+
+/* plnge2
+ *
+ * Binary plunge to lower level
+ * Called by: plnge(), plnge_rel(), hier14() and hier1()
+ */
+static void
+plnge2(void (*oper) (void),
+ int (*hier) (value * lval), value * lval1, value * lval2)
+{
+ int index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ if (lval1->ident == iCONSTEXPR)
+ { /* constant on left side; it is not yet loaded */
+ if (plnge1(hier, lval2))
+ rvalue(lval2); /* load lvalue now */
+ else if (lval2->ident == iCONSTEXPR)
+ const1(lval2->constval << dbltest(oper, lval2, lval1));
+ const2(lval1->constval << dbltest(oper, lval2, lval1));
+ /* ^ doubling of constants operating on integer addresses */
+ /* is restricted to "add" and "subtract" operators */
+ }
+ else
+ { /* non-constant on left side */
+ push1();
+ if (plnge1(hier, lval2))
+ rvalue(lval2);
+ if (lval2->ident == iCONSTEXPR)
+ { /* constant on right side */
+ if (commutative(oper))
+ { /* test for commutative operators */
+ value lvaltmp = { NULL, 0, 0, 0, 0, NULL };
+ stgdel(index, cidx); /* scratch push1() and constant fetch (then
+ * fetch the constant again */
+ const2(lval2->constval << dbltest(oper, lval1, lval2));
+ /* now, the primary register has the left operand and the secondary
+ * register the right operand; swap the "lval" variables so that lval1
+ * is associated with the secondary register and lval2 with the
+ * primary register, as is the "normal" case.
+ */
+ lvaltmp = *lval1;
+ *lval1 = *lval2;
+ *lval2 = lvaltmp;
+ }
+ else
+ {
+ const1(lval2->constval << dbltest(oper, lval1, lval2));
+ pop2(); /* pop result of left operand into secondary register */
+ } /* if */
+ }
+ else
+ { /* non-constants on both sides */
+ pop2();
+ if (dbltest(oper, lval1, lval2))
+ cell2addr(); /* double primary register */
+ if (dbltest(oper, lval2, lval1))
+ cell2addr_alt(); /* double secondary register */
+ } /* if */
+ } /* if */
+ if (oper)
+ {
+ /* If used in an expression, a function should return a value.
+ * If the function has been defined, we can check this. If the
+ * function was not defined, we can set this requirement (so that
+ * a future function definition can check this bit.
+ */
+ checkfunction(lval1);
+ checkfunction(lval2);
+ if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval1->sym) ? lval1->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ }
+ else if (lval2->ident == iARRAY || lval2->ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval2->sym) ? lval2->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ /* ??? ^^^ should do same kind of error checking with functions */
+
+ /* check whether an "operator" function is defined for the tag names
+ * (a constant expression cannot be optimized in that case)
+ */
+ if (check_userop(oper, lval1->tag, lval2->tag, 2, NULL, &lval1->tag))
+ {
+ lval1->ident = iEXPRESSION;
+ lval1->constval = 0;
+ }
+ else if (lval1->ident == iCONSTEXPR && lval2->ident == iCONSTEXPR)
+ {
+ /* only constant expression if both constant */
+ stgdel(index, cidx); /* scratch generated code and calculate */
+ if (!matchtag(lval1->tag, lval2->tag, FALSE))
+ error(213); /* tagname mismatch */
+ lval1->constval =
+ calc(lval1->constval, oper, lval2->constval,
+ &lval1->boolresult);
+ }
+ else
+ {
+ if (!matchtag(lval1->tag, lval2->tag, FALSE))
+ error(213); /* tagname mismatch */
+ (*oper) (); /* do the (signed) operation */
+ lval1->ident = iEXPRESSION;
+ } /* if */
+ } /* if */
+}
+
+static cell
+truemodulus(cell a, cell b)
+{
+ return (a % b + b) % b;
+}
+
+static cell
+calc(cell left, void (*oper) (), cell right, char *boolresult)
+{
+ if (oper == ob_or)
+ return (left | right);
+ else if (oper == ob_xor)
+ return (left ^ right);
+ else if (oper == ob_and)
+ return (left & right);
+ else if (oper == ob_eq)
+ return (left == right);
+ else if (oper == ob_ne)
+ return (left != right);
+ else if (oper == os_le)
+ return *boolresult &= (char)(left <= right), right;
+ else if (oper == os_ge)
+ return *boolresult &= (char)(left >= right), right;
+ else if (oper == os_lt)
+ return *boolresult &= (char)(left < right), right;
+ else if (oper == os_gt)
+ return *boolresult &= (char)(left > right), right;
+ else if (oper == os_sar)
+ return (left >> (int)right);
+ else if (oper == ou_sar)
+ return ((ucell) left >> (ucell) right);
+ else if (oper == ob_sal)
+ return ((ucell) left << (int)right);
+ else if (oper == ob_add)
+ return (left + right);
+ else if (oper == ob_sub)
+ return (left - right);
+ else if (oper == os_mult)
+ return (left * right);
+ else if (oper == os_div)
+ return (left - truemodulus(left, right)) / right;
+ else if (oper == os_mod)
+ return truemodulus(left, right);
+ else
+ error(29); /* invalid expression, assumed 0 (this should never occur) */
+ return 0;
+}
+
+int
+expression(int *constant, cell * val, int *tag, int chkfuncresult)
+{
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+
+ if (hier14(&lval))
+ rvalue(&lval);
+ if (lval.ident == iCONSTEXPR)
+ { /* constant expression */
+ *constant = TRUE;
+ *val = lval.constval;
+ }
+ else
+ {
+ *constant = FALSE;
+ *val = 0;
+ } /* if */
+ if (tag)
+ *tag = lval.tag;
+ if (chkfuncresult)
+ checkfunction(&lval);
+ return lval.ident;
+}
+
+static cell
+array_totalsize(symbol * sym)
+{
+ cell length;
+
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ length = sym->dim.array.length;
+ if (sym->dim.array.level > 0)
+ {
+ cell sublength = array_totalsize(finddepend(sym));
+
+ if (sublength > 0)
+ length = length + length * sublength;
+ else
+ length = 0;
+ } /* if */
+ return length;
+}
+
+static cell
+array_levelsize(symbol * sym, int level)
+{
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ assert(level <= sym->dim.array.level);
+ while (level-- > 0)
+ {
+ sym = finddepend(sym);
+ assert(sym != NULL);
+ } /* if */
+ return sym->dim.array.length;
+}
+
+/* hier14
+ *
+ * Lowest hierarchy level (except for the , operator).
+ *
+ * Global references: intest (referred to only)
+ */
+int
+hier14(value * lval1)
+{
+ int lvalue;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ value lval3 = { NULL, 0, 0, 0, 0, NULL };
+ void (*oper) (void);
+ int tok, level, i;
+ cell val;
+ char *st;
+ int bwcount;
+ cell arrayidx1[sDIMEN_MAX], arrayidx2[sDIMEN_MAX]; /* last used array indices */
+ cell *org_arrayidx;
+
+ bwcount = bitwise_opercount;
+ bitwise_opercount = 0;
+ for (i = 0; i < sDIMEN_MAX; i++)
+ arrayidx1[i] = arrayidx2[i] = 0;
+ org_arrayidx = lval1->arrayidx; /* save current pointer, to reset later */
+ if (!lval1->arrayidx)
+ lval1->arrayidx = arrayidx1;
+ lvalue = plnge1(hier13, lval1);
+ if (lval1->ident != iARRAYCELL && lval1->ident != iARRAYCHAR)
+ lval1->arrayidx = NULL;
+ if (lval1->ident == iCONSTEXPR) /* load constant here */
+ const1(lval1->constval);
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case taOR:
+ oper = ob_or;
+ break;
+ case taXOR:
+ oper = ob_xor;
+ break;
+ case taAND:
+ oper = ob_and;
+ break;
+ case taADD:
+ oper = ob_add;
+ break;
+ case taSUB:
+ oper = ob_sub;
+ break;
+ case taMULT:
+ oper = os_mult;
+ break;
+ case taDIV:
+ oper = os_div;
+ break;
+ case taMOD:
+ oper = os_mod;
+ break;
+ case taSHRU:
+ oper = ou_sar;
+ break;
+ case taSHR:
+ oper = os_sar;
+ break;
+ case taSHL:
+ oper = ob_sal;
+ break;
+ case '=': /* simple assignment */
+ oper = NULL;
+ if (intest)
+ error(211); /* possibly unintended assignment */
+ break;
+ default:
+ lexpush();
+ bitwise_opercount = bwcount;
+ lval1->arrayidx = org_arrayidx; /* restore array index pointer */
+ return lvalue;
+ } /* switch */
+
+ /* if we get here, it was an assignment; first check a few special cases
+ * and then the general */
+ if (lval1->ident == iARRAYCHAR)
+ {
+ /* special case, assignment to packed character in a cell is permitted */
+ lvalue = TRUE;
+ }
+ else if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ /* array assignment is permitted too (with restrictions) */
+ if (oper)
+ return error(23); /* array assignment must be simple assigment */
+ assert(lval1->sym != NULL);
+ if (array_totalsize(lval1->sym) == 0)
+ return error(46, lval1->sym->name); /* unknown array size */
+ lvalue = TRUE;
+ } /* if */
+
+ /* operand on left side of assignment must be lvalue */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ /* may not change "constant" parameters */
+ assert(lval1->sym != NULL);
+ if ((lval1->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ lval3 = *lval1; /* save symbol to enable storage of expresion result */
+ lval1->arrayidx = org_arrayidx; /* restore array index pointer */
+ if (lval1->ident == iARRAYCELL || lval1->ident == iARRAYCHAR
+ || lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ /* if indirect fetch: save PRI (cell address) */
+ if (oper)
+ {
+ push1();
+ rvalue(lval1);
+ } /* if */
+ lval2.arrayidx = arrayidx2;
+ plnge2(oper, hier14, lval1, &lval2);
+ if (lval2.ident != iARRAYCELL && lval2.ident != iARRAYCHAR)
+ lval2.arrayidx = NULL;
+ if (oper)
+ pop2();
+ if (!oper && lval3.arrayidx && lval2.arrayidx
+ && lval3.ident == lval2.ident && lval3.sym == lval2.sym)
+ {
+ int same = TRUE;
+
+ assert(lval3.arrayidx == arrayidx1);
+ assert(lval2.arrayidx == arrayidx2);
+ for (i = 0; i < sDIMEN_MAX; i++)
+ same = same && (lval3.arrayidx[i] == lval2.arrayidx[i]);
+ if (same)
+ error(226, lval3.sym->name); /* self-assignment */
+ } /* if */
+ }
+ else
+ {
+ if (oper)
+ {
+ rvalue(lval1);
+ plnge2(oper, hier14, lval1, &lval2);
+ }
+ else
+ {
+ /* if direct fetch and simple assignment: no "push"
+ * and "pop" needed -> call hier14() directly, */
+ if (hier14(&lval2))
+ rvalue(&lval2); /* instead of plnge2(). */
+ checkfunction(&lval2);
+ /* check whether lval2 and lval3 (old lval1) refer to the same variable */
+ if (lval2.ident == iVARIABLE && lval3.ident == lval2.ident
+ && lval3.sym == lval2.sym)
+ {
+ assert(lval3.sym != NULL);
+ error(226, lval3.sym->name); /* self-assignment */
+ } /* if */
+ } /* if */
+ } /* if */
+ if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+ {
+ /* left operand is an array, right operand should be an array variable
+ * of the same size and the same dimension, an array literal (of the
+ * same size) or a literal string.
+ */
+ int exactmatch = TRUE;
+
+ if (lval2.ident != iARRAY && lval2.ident != iREFARRAY)
+ error(33, lval3.sym->name); /* array must be indexed */
+ if (lval2.sym)
+ {
+ val = lval2.sym->dim.array.length; /* array variable */
+ level = lval2.sym->dim.array.level;
+ }
+ else
+ {
+ val = lval2.constval; /* literal array */
+ level = 0;
+ /* If val is negative, it means that lval2 is a
+ * literal string. The string array size may be
+ * smaller than the destination array.
+ */
+ if (val < 0)
+ {
+ val = -val;
+ exactmatch = FALSE;
+ } /* if */
+ } /* if */
+ if (lval3.sym->dim.array.level != level)
+ return error(48); /* array dimensions must match */
+ else if (lval3.sym->dim.array.length < val
+ || (exactmatch && lval3.sym->dim.array.length > val))
+ return error(47); /* array sizes must match */
+ if (level > 0)
+ {
+ /* check the sizes of all sublevels too */
+ symbol *sym1 = lval3.sym;
+ symbol *sym2 = lval2.sym;
+ int i;
+
+ assert(sym1 != NULL && sym2 != NULL);
+ /* ^^^ sym2 must be valid, because only variables can be
+ * multi-dimensional (there are no multi-dimensional arrays),
+ * sym1 must be valid because it must be an lvalue
+ */
+ assert(exactmatch);
+ for (i = 0; i < level; i++)
+ {
+ sym1 = finddepend(sym1);
+ sym2 = finddepend(sym2);
+ assert(sym1 != NULL && sym2 != NULL);
+ /* ^^^ both arrays have the same dimensions (this was checked
+ * earlier) so the dependend should always be found
+ */
+ if (sym1->dim.array.length != sym2->dim.array.length)
+ error(47); /* array sizes must match */
+ } /* for */
+ /* get the total size in cells of the multi-dimensional array */
+ val = array_totalsize(lval3.sym);
+ assert(val > 0); /* already checked */
+ } /* if */
+ }
+ else
+ {
+ /* left operand is not an array, right operand should then not be either */
+ if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+ error(6); /* must be assigned to an array */
+ } /* if */
+ if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+ {
+ memcopy(val * sizeof(cell));
+ }
+ else
+ {
+ check_userop(NULL, lval2.tag, lval3.tag, 2, &lval3, &lval2.tag);
+ store(&lval3); /* now, store the expression result */
+ } /* if */
+ if (!oper && !matchtag(lval3.tag, lval2.tag, TRUE))
+ error(213); /* tagname mismatch (if "oper", warning already given in plunge2()) */
+ if (lval3.sym)
+ markusage(lval3.sym, uWRITTEN);
+ sideeffect = TRUE;
+ bitwise_opercount = bwcount;
+ return FALSE; /* expression result is never an lvalue */
+}
+
+static int
+hier13(value * lval)
+{
+ int lvalue, flab1, flab2;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ int array1, array2;
+
+ lvalue = plnge1(hier12, lval);
+ if (matchtoken('?'))
+ {
+ flab1 = getlabel();
+ flab2 = getlabel();
+ if (lvalue)
+ {
+ rvalue(lval);
+ }
+ else if (lval->ident == iCONSTEXPR)
+ {
+ const1(lval->constval);
+ error(lval->constval ? 206 : 205); /* redundant test */
+ } /* if */
+ jmp_eq0(flab1); /* go to second expression if primary register==0 */
+ if (hier14(lval))
+ rvalue(lval);
+ jumplabel(flab2);
+ setlabel(flab1);
+ needtoken(':');
+ if (hier14(&lval2))
+ rvalue(&lval2);
+ array1 = (lval->ident == iARRAY || lval->ident == iREFARRAY);
+ array2 = (lval2.ident == iARRAY || lval2.ident == iREFARRAY);
+ if (array1 && !array2)
+ {
+ char *ptr =
+ (lval->sym->name) ? lval->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ }
+ else if (!array1 && array2)
+ {
+ char *ptr =
+ (lval2.sym->name) ? lval2.sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ /* ??? if both are arrays, should check dimensions */
+ if (!matchtag(lval->tag, lval2.tag, FALSE))
+ error(213); /* tagname mismatch ('true' and 'false' expressions) */
+ setlabel(flab2);
+ if (lval->ident == iARRAY)
+ lval->ident = iREFARRAY; /* iARRAY becomes iREFARRAY */
+ else if (lval->ident != iREFARRAY)
+ lval->ident = iEXPRESSION; /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */
+ return FALSE; /* conditional expression is no lvalue */
+ }
+ else
+ {
+ return lvalue;
+ } /* endif */
+}
+
+/* the order of the operators in these lists is important and must cohere */
+/* with the order of the operators in the array "op1" */
+static int list3[] = { '*', '/', '%', 0 };
+static int list4[] = { '+', '-', 0 };
+static int list5[] = { tSHL, tSHR, tSHRU, 0 };
+static int list6[] = { '&', 0 };
+static int list7[] = { '^', 0 };
+static int list8[] = { '|', 0 };
+static int list9[] = { tlLE, tlGE, '<', '>', 0 };
+static int list10[] = { tlEQ, tlNE, 0 };
+static int list11[] = { tlAND, 0 };
+static int list12[] = { tlOR, 0 };
+
+static int
+hier12(value * lval)
+{
+ return skim(list12, jmp_ne0, 1, 0, hier11, lval);
+}
+
+static int
+hier11(value * lval)
+{
+ return skim(list11, jmp_eq0, 0, 1, hier10, lval);
+}
+
+static int
+hier10(value * lval)
+{ /* ==, != */
+ return plnge(list10, 15, hier9, lval, "bool", TRUE);
+} /* ^ this variable is the starting index in the op1[]
+ * array of the operators of this hierarchy level */
+
+static int
+hier9(value * lval)
+{ /* <=, >=, <, > */
+ return plnge_rel(list9, 11, hier8, lval);
+}
+
+static int
+hier8(value * lval)
+{ /* | */
+ return plnge(list8, 10, hier7, lval, NULL, FALSE);
+}
+
+static int
+hier7(value * lval)
+{ /* ^ */
+ return plnge(list7, 9, hier6, lval, NULL, FALSE);
+}
+
+static int
+hier6(value * lval)
+{ /* & */
+ return plnge(list6, 8, hier5, lval, NULL, FALSE);
+}
+
+static int
+hier5(value * lval)
+{ /* <<, >>, >>> */
+ return plnge(list5, 5, hier4, lval, NULL, FALSE);
+}
+
+static int
+hier4(value * lval)
+{ /* +, - */
+ return plnge(list4, 3, hier3, lval, NULL, FALSE);
+}
+
+static int
+hier3(value * lval)
+{ /* *, /, % */
+ return plnge(list3, 0, hier2, lval, NULL, FALSE);
+}
+
+static int
+hier2(value * lval)
+{
+ int lvalue, tok;
+ int tag, paranthese;
+ cell val;
+ char *st;
+ symbol *sym;
+ int saveresult;
+
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case tINC: /* ++lval */
+ if (!hier2(lval))
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ if (!check_userop(user_inc, lval->tag, 0, 1, lval, &lval->tag))
+ inc(lval); /* increase variable first */
+ rvalue(lval); /* and read the result into PRI */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case tDEC: /* --lval */
+ if (!hier2(lval))
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ if (!check_userop(user_dec, lval->tag, 0, 1, lval, &lval->tag))
+ dec(lval); /* decrease variable first */
+ rvalue(lval); /* and read the result into PRI */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case '~': /* ~ (one's complement) */
+ if (hier2(lval))
+ rvalue(lval);
+ invert(); /* bitwise NOT */
+ lval->constval = ~lval->constval;
+ return FALSE;
+ case '!': /* ! (logical negate) */
+ if (hier2(lval))
+ rvalue(lval);
+ if (check_userop(lneg, lval->tag, 0, 1, NULL, &lval->tag))
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ }
+ else
+ {
+ lneg(); /* 0 -> 1, !0 -> 0 */
+ lval->constval = !lval->constval;
+ lval->tag = sc_addtag("bool");
+ } /* if */
+ return FALSE;
+ case '-': /* unary - (two's complement) */
+ if (hier2(lval))
+ rvalue(lval);
+ /* make a special check for a constant expression with the tag of a
+ * rational number, so that we can simple swap the sign of that constant.
+ */
+ if (lval->ident == iCONSTEXPR && lval->tag == sc_rationaltag
+ && sc_rationaltag != 0)
+ {
+ if (rational_digits == 0)
+ {
+ float *f = (float *)&lval->constval;
+
+ *f = -*f; /* this modifies lval->constval */
+ }
+ else
+ {
+ /* the negation of a fixed point number is just an integer negation */
+ lval->constval = -lval->constval;
+ } /* if */
+ }
+ else if (check_userop(neg, lval->tag, 0, 1, NULL, &lval->tag))
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ }
+ else
+ {
+ neg(); /* arithmic negation */
+ lval->constval = -lval->constval;
+ } /* if */
+ return FALSE;
+ case tLABEL: /* tagname override */
+ tag = sc_addtag(st);
+ lvalue = hier2(lval);
+ lval->tag = tag;
+ return lvalue;
+ case tDEFINED:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL)
+ return error(20, st); /* illegal symbol name */
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (sym && sym->ident != iFUNCTN && sym->ident != iREFFUNC
+ && (sym->usage & uDEFINE) == 0)
+ sym = NULL; /* symbol is not a function, it is in the table, but not "defined" */
+ val = !!sym;
+ if (!val && find_subst(st, strlen(st)))
+ val = 1;
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = val;
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ case tSIZEOF:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL)
+ return error(20, st); /* illegal symbol name */
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (!sym)
+ return error(17, st); /* undefined symbol */
+ if (sym->ident == iCONSTEXPR)
+ error(39); /* constant symbol has no size */
+ else if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+ error(72); /* "function" symbol has no size */
+ else if ((sym->usage & uDEFINE) == 0)
+ return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = 1; /* preset */
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ int level;
+
+ for (level = 0; matchtoken('['); level++)
+ needtoken(']');
+ if (level > sym->dim.array.level)
+ error(28); /* invalid subscript */
+ else
+ lval->constval = array_levelsize(sym, level);
+ if (lval->constval == 0 && !strchr(lptr, PREPROC_TERM))
+ error(224, st); /* indeterminate array size in "sizeof" expression */
+ } /* if */
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ case tTAGOF:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL && tok != tLABEL)
+ return error(20, st); /* illegal symbol name */
+ if (tok == tLABEL)
+ {
+ tag = sc_addtag(st);
+ }
+ else
+ {
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (!sym)
+ return error(17, st); /* undefined symbol */
+ if ((sym->usage & uDEFINE) == 0)
+ return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
+ tag = sym->tag;
+ } /* if */
+ exporttag(tag);
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = tag;
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ default:
+ lexpush();
+ lvalue = hier1(lval);
+ /* check for postfix operators */
+ if (matchtoken(';'))
+ {
+ /* Found a ';', do not look further for postfix operators */
+ lexpush(); /* push ';' back after successful match */
+ return lvalue;
+ }
+ else if (matchtoken(tTERM))
+ {
+ /* Found a newline that ends a statement (this is the case when
+ * semicolons are optional). Note that an explicit semicolon was
+ * handled above. This case is similar, except that the token must
+ * not be pushed back.
+ */
+ return lvalue;
+ }
+ else
+ {
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case tINC: /* lval++ */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ /* on incrementing array cells, the address in PRI must be saved for
+ * incremening the value, whereas the current value must be in PRI
+ * on exit.
+ */
+ saveresult = (lval->ident == iARRAYCELL
+ || lval->ident == iARRAYCHAR);
+ if (saveresult)
+ push1(); /* save address in PRI */
+ rvalue(lval); /* read current value into PRI */
+ if (saveresult)
+ swap1(); /* save PRI on the stack, restore address in PRI */
+ if (!check_userop
+ (user_inc, lval->tag, 0, 1, lval, &lval->tag))
+ inc(lval); /* increase variable afterwards */
+ if (saveresult)
+ pop1(); /* restore PRI (result of rvalue()) */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case tDEC: /* lval-- */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ saveresult = (lval->ident == iARRAYCELL
+ || lval->ident == iARRAYCHAR);
+ if (saveresult)
+ push1(); /* save address in PRI */
+ rvalue(lval); /* read current value into PRI */
+ if (saveresult)
+ swap1(); /* save PRI on the stack, restore address in PRI */
+ if (!check_userop
+ (user_dec, lval->tag, 0, 1, lval, &lval->tag))
+ dec(lval); /* decrease variable afterwards */
+ if (saveresult)
+ pop1(); /* restore PRI (result of rvalue()) */
+ sideeffect = TRUE;
+ return FALSE;
+ case tCHAR: /* char (compute required # of cells */
+ if (lval->ident == iCONSTEXPR)
+ {
+ lval->constval *= charbits / 8; /* from char to bytes */
+ lval->constval =
+ (lval->constval + sizeof(cell) - 1) / sizeof(cell);
+ }
+ else
+ {
+ if (lvalue)
+ rvalue(lval); /* fetch value if not already in PRI */
+ char2addr(); /* from characters to bytes */
+ addconst(sizeof(cell) - 1); /* make sure the value is rounded up */
+ addr2cell(); /* truncate to number of cells */
+ } /* if */
+ return FALSE;
+ default:
+ lexpush();
+ return lvalue;
+ } /* switch */
+ } /* if */
+ } /* switch */
+}
+
+/* hier1
+ *
+ * The highest hierarchy level: it looks for pointer and array indices
+ * and function calls.
+ * Generates code to fetch a pointer value if it is indexed and code to
+ * add to the pointer value or the array address (the address is already
+ * read at primary()). It also generates code to fetch a function address
+ * if that hasn't already been done at primary() (check lval[4]) and calls
+ * callfunction() to call the function.
+ */
+static int
+hier1(value * lval1)
+{
+ int lvalue, index, tok, symtok;
+ cell val, cidx;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ char *st;
+ char close;
+ symbol *sym;
+
+ lvalue = primary(lval1);
+ symtok = tokeninfo(&val, &st); /* get token read by primary() */
+ restart:
+ sym = lval1->sym;
+ if (matchtoken('[') || matchtoken('{') || matchtoken('('))
+ {
+ tok = tokeninfo(&val, &st); /* get token read by matchtoken() */
+ if (!sym && symtok != tSYMBOL)
+ {
+ /* we do not have a valid symbol and we appear not to have read a valid
+ * symbol name (so it is unlikely that we would have read a name of an
+ * undefined symbol) */
+ error(29); /* expression error, assumed 0 */
+ lexpush(); /* analyse '(', '{' or '[' again later */
+ return FALSE;
+ } /* if */
+ if (tok == '[' || tok == '{')
+ { /* subscript */
+ close = (char)((tok == '[') ? ']' : '}');
+ if (!sym)
+ { /* sym==NULL if lval is a constant or a literal */
+ error(28); /* cannot subscript */
+ needtoken(close);
+ return FALSE;
+ }
+ else if (sym->ident != iARRAY && sym->ident != iREFARRAY)
+ {
+ error(28); /* cannot subscript, variable is not an array */
+ needtoken(close);
+ return FALSE;
+ }
+ else if (sym->dim.array.level > 0 && close != ']')
+ {
+ error(51); /* invalid subscript, must use [ ] */
+ needtoken(close);
+ return FALSE;
+ } /* if */
+ stgget(&index, &cidx); /* mark position in code generator */
+ push1(); /* save base address of the array */
+ if (hier14(&lval2)) /* create expression for the array index */
+ rvalue(&lval2);
+ if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+ error(33, lval2.sym->name); /* array must be indexed */
+ needtoken(close);
+ if (!matchtag(sym->x.idxtag, lval2.tag, TRUE))
+ error(213);
+ if (lval2.ident == iCONSTEXPR)
+ { /* constant expression */
+ stgdel(index, cidx); /* scratch generated code */
+ if (lval1->arrayidx)
+ { /* keep constant index, for checking */
+ assert(sym->dim.array.level >= 0
+ && sym->dim.array.level < sDIMEN_MAX);
+ lval1->arrayidx[sym->dim.array.level] = lval2.constval;
+ } /* if */
+ if (close == ']')
+ {
+ /* normal array index */
+ if (lval2.constval < 0 || (sym->dim.array.length != 0
+ && sym->dim.array.length <= lval2.constval))
+ error(32, sym->name); /* array index out of bounds */
+ if (lval2.constval != 0)
+ {
+ /* don't add offsets for zero subscripts */
+#if defined(BIT16)
+ const2(lval2.constval << 1);
+#else
+ const2(lval2.constval << 2);
+#endif
+ ob_add();
+ } /* if */
+ }
+ else
+ {
+ /* character index */
+ if (lval2.constval < 0 || (sym->dim.array.length != 0
+ && sym->dim.array.length * ((8 * sizeof(cell)) /
+ charbits) <=
+ (ucell) lval2.constval))
+ error(32, sym->name); /* array index out of bounds */
+ if (lval2.constval != 0)
+ {
+ /* don't add offsets for zero subscripts */
+ if (charbits == 16)
+ const2(lval2.constval << 1); /* 16-bit character */
+ else
+ const2(lval2.constval); /* 8-bit character */
+ ob_add();
+ } /* if */
+ charalign(); /* align character index into array */
+ } /* if */
+ }
+ else
+ {
+ /* array index is not constant */
+ lval1->arrayidx = NULL; /* reset, so won't be checked */
+ if (close == ']')
+ {
+ if (sym->dim.array.length != 0)
+ ffbounds(sym->dim.array.length - 1); /* run time check for array bounds */
+ cell2addr(); /* normal array index */
+ }
+ else
+ {
+ if (sym->dim.array.length != 0)
+ ffbounds(sym->dim.array.length * (32 / charbits) - 1);
+ char2addr(); /* character array index */
+ } /* if */
+ pop2();
+ ob_add(); /* base address was popped into secondary register */
+ if (close != ']')
+ charalign(); /* align character index into array */
+ } /* if */
+ /* the indexed item may be another array (multi-dimensional arrays) */
+ assert(lval1->sym == sym && sym != NULL); /* should still be set */
+ if (sym->dim.array.level > 0)
+ {
+ assert(close == ']'); /* checked earlier */
+ /* read the offset to the subarray and add it to the current address */
+ lval1->ident = iARRAYCELL;
+ push1(); /* the optimizer makes this to a MOVE.alt */
+ rvalue(lval1);
+ pop2();
+ ob_add();
+ /* adjust the "value" structure and find the referenced array */
+ lval1->ident = iREFARRAY;
+ lval1->sym = finddepend(sym);
+ assert(lval1->sym != NULL);
+ assert(lval1->sym->dim.array.level ==
+ sym->dim.array.level - 1);
+ /* try to parse subsequent array indices */
+ lvalue = FALSE; /* for now, a iREFARRAY is no lvalue */
+ goto restart;
+ } /* if */
+ assert(sym->dim.array.level == 0);
+ /* set type to fetch... INDIRECTLY */
+ lval1->ident = (char)((close == ']') ? iARRAYCELL : iARRAYCHAR);
+ lval1->tag = sym->tag;
+ /* a cell in an array is an lvalue, a character in an array is not
+ * always a *valid* lvalue */
+ return TRUE;
+ }
+ else
+ { /* tok=='(' -> function(...) */
+ if (!sym
+ || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+ {
+ if (!sym && sc_status == statFIRST)
+ {
+ /* could be a "use before declaration"; in that case, create a stub
+ * function so that the usage can be marked.
+ */
+ sym = fetchfunc(lastsymbol, 0);
+ if (sym)
+ markusage(sym, uREAD);
+ } /* if */
+ return error(12); /* invalid function call */
+ }
+ else if ((sym->usage & uMISSING) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ error(4, symname); /* function not defined */
+ } /* if */
+ callfunction(sym);
+ lval1->ident = iEXPRESSION;
+ lval1->constval = 0;
+ lval1->tag = sym->tag;
+ return FALSE; /* result of function call is no lvalue */
+ } /* if */
+ } /* if */
+ if (sym && lval1->ident == iFUNCTN)
+ {
+ assert(sym->ident == iFUNCTN);
+ address(sym);
+ lval1->sym = NULL;
+ lval1->ident = iREFFUNC;
+ /* ??? however... function pointers (or function references are not (yet) allowed */
+ error(29); /* expression error, assumed 0 */
+ return FALSE;
+ } /* if */
+ return lvalue;
+}
+
+/* primary
+ *
+ * Returns 1 if the operand is an lvalue (everything except arrays, functions
+ * constants and -of course- errors).
+ * Generates code to fetch the address of arrays. Code for constants is
+ * already generated by constant().
+ * This routine first clears the entire lval array (all fields are set to 0).
+ *
+ * Global references: intest (may be altered, but restored upon termination)
+ */
+static int
+primary(value * lval)
+{
+ char *st;
+ int lvalue, tok;
+ cell val;
+ symbol *sym;
+
+ if (matchtoken('('))
+ { /* sub-expression - (expression,...) */
+ pushstk((stkitem) intest);
+ pushstk((stkitem) sc_allowtags);
+
+ intest = 0; /* no longer in "test" expression */
+ sc_allowtags = TRUE; /* allow tagnames to be used in parenthised expressions */
+ do
+ lvalue = hier14(lval);
+ while (matchtoken(','));
+ needtoken(')');
+ lexclr(FALSE); /* clear lex() push-back, it should have been
+ * cleared already by needtoken() */
+ sc_allowtags = (int)(long)popstk();
+ intest = (int)(long)popstk();
+ return lvalue;
+ } /* if */
+
+ clear_value(lval); /* clear lval */
+ tok = lex(&val, &st);
+ if (tok == tSYMBOL)
+ {
+ /* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol
+ * to sNAMEMAX significant characters */
+ assert(strlen(st) < sizeof lastsymbol);
+ strcpy(lastsymbol, st);
+ } /* if */
+ if (tok == tSYMBOL && !findconst(st))
+ {
+ /* first look for a local variable */
+ if ((sym = findloc(st)))
+ {
+ if (sym->ident == iLABEL)
+ {
+ error(29); /* expression error, assumed 0 */
+ const1(0); /* load 0 */
+ return FALSE; /* return 0 for labels (expression error) */
+ } /* if */
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ address(sym); /* get starting address in primary register */
+ return FALSE; /* return 0 for array (not lvalue) */
+ }
+ else
+ {
+ return TRUE; /* return 1 if lvalue (not label or array) */
+ } /* if */
+ } /* if */
+ /* now try a global variable */
+ if ((sym = findglb(st)))
+ {
+ if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+ {
+ /* if the function is only in the table because it was inserted as a
+ * stub in the first pass (i.e. it was "used" but never declared or
+ * implemented, issue an error
+ */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ error(17, st);
+ }
+ else
+ {
+ if ((sym->usage & uDEFINE) == 0)
+ error(17, st);
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ address(sym); /* get starting address in primary register */
+ return FALSE; /* return 0 for array (not lvalue) */
+ }
+ else
+ {
+ return TRUE; /* return 1 if lvalue (not function or array) */
+ } /* if */
+ } /* if */
+ }
+ else
+ {
+ return error(17, st); /* undefined symbol */
+ } /* endif */
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN || sym->ident != iREFFUNC);
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ return FALSE; /* return 0 for function (not an lvalue) */
+ } /* if */
+ lexpush(); /* push the token, it is analyzed by constant() */
+ if (constant(lval) == 0)
+ {
+ error(29); /* expression error, assumed 0 */
+ const1(0); /* load 0 */
+ } /* if */
+ return FALSE; /* return 0 for constants (or errors) */
+}
+
+static void
+clear_value(value * lval)
+{
+ lval->sym = NULL;
+ lval->constval = 0L;
+ lval->tag = 0;
+ lval->ident = 0;
+ lval->boolresult = FALSE;
+ /* do not clear lval->arrayidx, it is preset in hier14() */
+}
+
+static void
+setdefarray(cell * string, cell size, cell array_sz, cell * dataaddr,
+ int fconst)
+{
+ /* The routine must copy the default array data onto the heap, as to avoid
+ * that a function can change the default value. An optimization is that
+ * the default array data is "dumped" into the data segment only once (on the
+ * first use).
+ */
+ assert(string != NULL);
+ assert(size > 0);
+ /* check whether to dump the default array */
+ assert(dataaddr != NULL);
+ if (sc_status == statWRITE && *dataaddr < 0)
+ {
+ int i;
+
+ *dataaddr = (litidx + glb_declared) * sizeof(cell);
+ for (i = 0; i < size; i++)
+ stowlit(*string++);
+ } /* if */
+
+ /* if the function is known not to modify the array (meaning that it also
+ * does not modify the default value), directly pass the address of the
+ * array in the data segment.
+ */
+ if (fconst)
+ {
+ const1(*dataaddr);
+ }
+ else
+ {
+ /* Generate the code:
+ * CONST.pri dataaddr ;address of the default array data
+ * HEAP array_sz*sizeof(cell) ;heap address in ALT
+ * MOVS size*sizeof(cell) ;copy data from PRI to ALT
+ * MOVE.PRI ;PRI = address on the heap
+ */
+ const1(*dataaddr);
+ /* "array_sz" is the size of the argument (the value between the brackets
+ * in the declaration), "size" is the size of the default array data.
+ */
+ assert(array_sz >= size);
+ modheap((int)array_sz * sizeof(cell));
+ /* ??? should perhaps fill with zeros first */
+ memcopy(size * sizeof(cell));
+ moveto1();
+ } /* if */
+}
+
+static int
+findnamedarg(arginfo * arg, char *name)
+{
+ int i;
+
+ for (i = 0; arg[i].ident != 0 && arg[i].ident != iVARARGS; i++)
+ if (strcmp(arg[i].name, name) == 0)
+ return i;
+ return -1;
+}
+
+static int
+checktag(int tags[], int numtags, int exprtag)
+{
+ int i;
+
+ assert(tags != 0);
+ assert(numtags > 0);
+ for (i = 0; i < numtags; i++)
+ if (matchtag(tags[i], exprtag, TRUE))
+ return TRUE; /* matching tag */
+ return FALSE; /* no tag matched */
+}
+
+enum
+{
+ ARG_UNHANDLED,
+ ARG_IGNORED,
+ ARG_DONE,
+};
+
+/* callfunction
+ *
+ * Generates code to call a function. This routine handles default arguments
+ * and positional as well as named parameters.
+ */
+static void
+callfunction(symbol * sym)
+{
+ int close, lvalue;
+ int argpos; /* index in the output stream (argpos==nargs if positional parameters) */
+ int argidx = 0; /* index in "arginfo" list */
+ int nargs = 0; /* number of arguments */
+ int heapalloc = 0;
+ int namedparams = FALSE;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ arginfo *arg;
+ char arglist[sMAXARGS];
+ constvalue arrayszlst = { NULL, "", 0, 0 }; /* array size list starts empty */
+ cell lexval;
+ char *lexstr;
+
+ assert(sym != NULL);
+ arg = sym->dim.arglist;
+ assert(arg != NULL);
+ stgmark(sSTARTREORDER);
+ for (argpos = 0; argpos < sMAXARGS; argpos++)
+ arglist[argpos] = ARG_UNHANDLED;
+ if (!matchtoken(')'))
+ {
+ do
+ {
+ if (matchtoken('.'))
+ {
+ namedparams = TRUE;
+ if (needtoken(tSYMBOL))
+ tokeninfo(&lexval, &lexstr);
+ else
+ lexstr = "";
+ argpos = findnamedarg(arg, lexstr);
+ if (argpos < 0)
+ {
+ error(17, lexstr); /* undefined symbol */
+ break; /* exit loop, argpos is invalid */
+ } /* if */
+ needtoken('=');
+ argidx = argpos;
+ }
+ else
+ {
+ if (namedparams)
+ error(44); /* positional parameters must precede named parameters */
+ argpos = nargs;
+ } /* if */
+ stgmark((char)(sEXPRSTART + argpos)); /* mark beginning of new expression in stage */
+ if (arglist[argpos] != ARG_UNHANDLED)
+ error(58); /* argument already set */
+ if (matchtoken('_'))
+ {
+ arglist[argpos] = ARG_IGNORED; /* flag argument as "present, but ignored" */
+ if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS)
+ {
+ error(202); /* argument count mismatch */
+ }
+ else if (!arg[argidx].hasdefault)
+ {
+ error(34, nargs + 1); /* argument has no default value */
+ } /* if */
+ if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS)
+ argidx++;
+ /* The rest of the code to handle default values is at the bottom
+ * of this routine where default values for unspecified parameters
+ * are (also) handled. Note that above, the argument is flagged as
+ * ARG_IGNORED.
+ */
+ }
+ else
+ {
+ arglist[argpos] = ARG_DONE; /* flag argument as "present" */
+ lvalue = hier14(&lval);
+ switch (arg[argidx].ident)
+ {
+ case 0:
+ error(202); /* argument count mismatch */
+ break;
+ case iVARARGS:
+ /* always pass by reference */
+ if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+ {
+ assert(lval.sym != NULL);
+ if ((lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ {
+ /* treat a "const" variable passed to a function with a non-const
+ * "variable argument list" as a constant here */
+ assert(lvalue);
+ rvalue(&lval); /* get value in PRI */
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ }
+ else if (lvalue)
+ {
+ address(lval.sym);
+ }
+ else
+ {
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ }
+ else if (lval.ident == iCONSTEXPR
+ || lval.ident == iEXPRESSION
+ || lval.ident == iARRAYCHAR)
+ {
+ /* fetch value if needed */
+ if (lval.ident == iARRAYCHAR)
+ rvalue(&lval);
+ /* allocate a cell on the heap and store the
+ * value (already in PRI) there */
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ /* ??? handle const array passed by reference */
+ /* otherwise, the address is already in PRI */
+ if (lval.sym)
+ markusage(lval.sym, uWRITTEN);
+/*
+ * Dont need this warning - its varargs. there is no way of knowing the
+ * required tag/type...
+ *
+ if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
+ error(213);
+ */
+ break;
+ case iVARIABLE:
+ if (lval.ident == iLABEL || lval.ident == iFUNCTN
+ || lval.ident == iREFFUNC || lval.ident == iARRAY
+ || lval.ident == iREFARRAY)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lvalue)
+ rvalue(&lval); /* get value (direct or indirect) */
+ /* otherwise, the expression result is already in PRI */
+ assert(arg[argidx].numtags > 0);
+ check_userop(NULL, lval.tag, arg[argidx].tags[0], 2,
+ NULL, &lval.tag);
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ argidx++; /* argument done */
+ break;
+ case iREFERENCE:
+ if (!lvalue || lval.ident == iARRAYCHAR)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lval.sym && (lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+ {
+ if (lvalue)
+ {
+ assert(lval.sym != NULL);
+ address(lval.sym);
+ }
+ else
+ {
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ } /* if */
+ /* otherwise, the address is already in PRI */
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ argidx++; /* argument done */
+ if (lval.sym)
+ markusage(lval.sym, uWRITTEN);
+ break;
+ case iREFARRAY:
+ if (lval.ident != iARRAY && lval.ident != iREFARRAY
+ && lval.ident != iARRAYCELL)
+ {
+ error(35, argidx + 1); /* argument type mismatch */
+ break;
+ } /* if */
+ if (lval.sym && (lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ error(35, argidx + 1); /* argument type mismatch */
+ /* Verify that the dimensions match with those in arg[argidx].
+ * A literal array always has a single dimension.
+ * An iARRAYCELL parameter is also assumed to have a single dimension.
+ */
+ if (!lval.sym || lval.ident == iARRAYCELL)
+ {
+ if (arg[argidx].numdim != 1)
+ {
+ error(48); /* array dimensions must match */
+ }
+ else if (arg[argidx].dim[0] != 0)
+ {
+ assert(arg[argidx].dim[0] > 0);
+ if (lval.ident == iARRAYCELL)
+ {
+ error(47); /* array sizes must match */
+ }
+ else
+ {
+ assert(lval.constval != 0); /* literal array must have a size */
+ /* A literal array must have exactly the same size as the
+ * function argument; a literal string may be smaller than
+ * the function argument.
+ */
+ if ((lval.constval > 0
+ && arg[argidx].dim[0] != lval.constval)
+ || (lval.constval < 0
+ && arg[argidx].dim[0] <
+ -lval.constval))
+ error(47); /* array sizes must match */
+ } /* if */
+ } /* if */
+ if (lval.ident != iARRAYCELL)
+ {
+ /* save array size, for default values with uSIZEOF flag */
+ cell array_sz = lval.constval;
+
+ assert(array_sz != 0); /* literal array must have a size */
+ if (array_sz < 0)
+ array_sz = -array_sz;
+ append_constval(&arrayszlst, arg[argidx].name,
+ array_sz, 0);
+ } /* if */
+ }
+ else
+ {
+ symbol *sym = lval.sym;
+ short level = 0;
+
+ assert(sym != NULL);
+ if (sym->dim.array.level + 1 != arg[argidx].numdim)
+ error(48); /* array dimensions must match */
+ /* the lengths for all dimensions must match, unless the dimension
+ * length was defined at zero (which means "undefined")
+ */
+ while (sym->dim.array.level > 0)
+ {
+ assert(level < sDIMEN_MAX);
+ if (arg[argidx].dim[level] != 0
+ && sym->dim.array.length !=
+ arg[argidx].dim[level])
+ error(47); /* array sizes must match */
+ append_constval(&arrayszlst, arg[argidx].name,
+ sym->dim.array.length, level);
+ sym = finddepend(sym);
+ assert(sym != NULL);
+ level++;
+ } /* if */
+ /* the last dimension is checked too, again, unless it is zero */
+ assert(level < sDIMEN_MAX);
+ assert(sym != NULL);
+ if (arg[argidx].dim[level] != 0
+ && sym->dim.array.length !=
+ arg[argidx].dim[level])
+ error(47); /* array sizes must match */
+ append_constval(&arrayszlst, arg[argidx].name,
+ sym->dim.array.length, level);
+ } /* if */
+ /* address already in PRI */
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ // ??? set uWRITTEN?
+ argidx++; /* argument done */
+ break;
+ } /* switch */
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ } /* if */
+ assert(arglist[argpos] != ARG_UNHANDLED);
+ nargs++;
+ close = matchtoken(')');
+ if (!close) /* if not paranthese... */
+ if (!needtoken(',')) /* ...should be comma... */
+ break; /* ...but abort loop if neither */
+ }
+ while (!close && freading && !matchtoken(tENDEXPR)); /* do */
+ } /* if */
+ /* check remaining function arguments (they may have default values) */
+ for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+ argidx++)
+ {
+ if (arglist[argidx] == ARG_DONE)
+ continue; /* already seen and handled this argument */
+ /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;
+ * these are handled last
+ */
+ if ((arg[argidx].hasdefault & uSIZEOF) != 0
+ || (arg[argidx].hasdefault & uTAGOF) != 0)
+ {
+ assert(arg[argidx].ident == iVARIABLE);
+ continue;
+ } /* if */
+ stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
+ if (arg[argidx].hasdefault)
+ {
+ if (arg[argidx].ident == iREFARRAY)
+ {
+ short level;
+
+ setdefarray(arg[argidx].defvalue.array.data,
+ arg[argidx].defvalue.array.size,
+ arg[argidx].defvalue.array.arraysize,
+ &arg[argidx].defvalue.array.addr,
+ (arg[argidx].usage & uCONST) != 0);
+ if ((arg[argidx].usage & uCONST) == 0)
+ heapalloc += arg[argidx].defvalue.array.arraysize;
+ /* keep the lengths of all dimensions of a multi-dimensional default array */
+ assert(arg[argidx].numdim > 0);
+ if (arg[argidx].numdim == 1)
+ {
+ append_constval(&arrayszlst, arg[argidx].name,
+ arg[argidx].defvalue.array.arraysize, 0);
+ }
+ else
+ {
+ for (level = 0; level < arg[argidx].numdim; level++)
+ {
+ assert(level < sDIMEN_MAX);
+ append_constval(&arrayszlst, arg[argidx].name,
+ arg[argidx].dim[level], level);
+ } /* for */
+ } /* if */
+ }
+ else if (arg[argidx].ident == iREFERENCE)
+ {
+ setheap(arg[argidx].defvalue.val);
+ /* address of the value on the heap in PRI */
+ heapalloc++;
+ }
+ else
+ {
+ int dummytag = arg[argidx].tags[0];
+
+ const1(arg[argidx].defvalue.val);
+ assert(arg[argidx].numtags > 0);
+ check_userop(NULL, arg[argidx].defvalue_tag,
+ arg[argidx].tags[0], 2, NULL, &dummytag);
+ assert(dummytag == arg[argidx].tags[0]);
+ } /* if */
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ }
+ else
+ {
+ error(202, argidx); /* argument count mismatch */
+ } /* if */
+ if (arglist[argidx] == ARG_UNHANDLED)
+ nargs++;
+ arglist[argidx] = ARG_DONE;
+ } /* for */
+ /* now a second loop to catch the arguments with default values that are
+ * the "sizeof" or "tagof" of other arguments
+ */
+ for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+ argidx++)
+ {
+ constvalue *asz;
+ cell array_sz;
+
+ if (arglist[argidx] == ARG_DONE)
+ continue; /* already seen and handled this argument */
+ stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
+ assert(arg[argidx].ident == iVARIABLE); /* if "sizeof", must be single cell */
+ /* if unseen, must be "sizeof" or "tagof" */
+ assert((arg[argidx].hasdefault & uSIZEOF) != 0
+ || (arg[argidx].hasdefault & uTAGOF) != 0);
+ if ((arg[argidx].hasdefault & uSIZEOF) != 0)
+ {
+ /* find the argument; if it isn't found, the argument's default value
+ * was a "sizeof" of a non-array (a warning for this was already given
+ * when declaring the function)
+ */
+ asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname,
+ arg[argidx].defvalue.size.level);
+ if (asz)
+ {
+ array_sz = asz->value;
+ if (array_sz == 0)
+ error(224, arg[argidx].name); /* indeterminate array size in "sizeof" expression */
+ }
+ else
+ {
+ array_sz = 1;
+ } /* if */
+ }
+ else
+ {
+ symbol *sym;
+
+ assert((arg[argidx].hasdefault & uTAGOF) != 0);
+ sym = findloc(arg[argidx].defvalue.size.symname);
+ if (!sym)
+ sym = findglb(arg[argidx].defvalue.size.symname);
+ array_sz = (sym) ? sym->tag : 0;
+ exporttag(array_sz);
+ } /* if */
+ const1(array_sz);
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE);
+ if (arglist[argidx] == ARG_UNHANDLED)
+ nargs++;
+ arglist[argidx] = ARG_DONE;
+ } /* for */
+ stgmark(sENDREORDER); /* mark end of reversed evaluation */
+ pushval((cell) nargs * sizeof(cell));
+ ffcall(sym, nargs);
+ if (sc_status != statSKIP)
+ markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
+ if (sym->x.lib)
+ sym->x.lib->value += 1; /* increment "usage count" of the library */
+ modheap(-heapalloc * sizeof(cell));
+ sideeffect = TRUE; /* assume functions carry out a side-effect */
+ delete_consttable(&arrayszlst); /* clear list of array sizes */
+}
+
+/* dbltest
+ *
+ * Returns a non-zero value if lval1 an array and lval2 is not an array and
+ * the operation is addition or subtraction.
+ *
+ * Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell
+ * to an array offset.
+ */
+static int
+dbltest(void (*oper) (), value * lval1, value * lval2)
+{
+ if ((oper != ob_add) && (oper != ob_sub))
+ return 0;
+ if (lval1->ident != iARRAY)
+ return 0;
+ if (lval2->ident == iARRAY)
+ return 0;
+ return sizeof(cell) / 2; /* 1 for 16-bit, 2 for 32-bit */
+}
+
+/* commutative
+ *
+ * Test whether an operator is commutative, i.e. x oper y == y oper x.
+ * Commutative operators are: + (addition)
+ * * (multiplication)
+ * == (equality)
+ * != (inequality)
+ * & (bitwise and)
+ * ^ (bitwise xor)
+ * | (bitwise or)
+ *
+ * If in an expression, code for the left operand has been generated and
+ * the right operand is a constant and the operator is commutative, the
+ * precautionary "push" of the primary register is scrapped and the constant
+ * is read into the secondary register immediately.
+ */
+static int
+commutative(void (*oper) ())
+{
+ return oper == ob_add || oper == os_mult
+ || oper == ob_eq || oper == ob_ne
+ || oper == ob_and || oper == ob_xor || oper == ob_or;
+}
+
+/* constant
+ *
+ * Generates code to fetch a number, a literal character (which is returned
+ * by lex() as a number as well) or a literal string (lex() stores the
+ * strings in the literal queue). If the operand was a number, it is stored
+ * in lval->constval.
+ *
+ * The function returns 1 if the token was a constant or a string, 0
+ * otherwise.
+ */
+static int
+constant(value * lval)
+{
+ int tok, index, constant;
+ cell val, item, cidx;
+ char *st;
+ symbol *sym;
+
+ tok = lex(&val, &st);
+ if (tok == tSYMBOL && (sym = findconst(st)))
+ {
+ lval->constval = sym->addr;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ lval->tag = sym->tag;
+ markusage(sym, uREAD);
+ }
+ else if (tok == tNUMBER)
+ {
+ lval->constval = val;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ }
+ else if (tok == tRATIONAL)
+ {
+ lval->constval = val;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ lval->tag = sc_rationaltag;
+ }
+ else if (tok == tSTRING)
+ {
+ /* lex() stores starting index of string in the literal table in 'val' */
+ const1((val + glb_declared) * sizeof(cell));
+ lval->ident = iARRAY; /* pretend this is a global array */
+ lval->constval = val - litidx; /* constval == the negative value of the
+ * size of the literal array; using a negative
+ * value distinguishes between literal arrays
+ * and literal strings (this was done for
+ * array assignment). */
+ }
+ else if (tok == '{')
+ {
+ int tag, lasttag = -1;
+
+ val = litidx;
+ do
+ {
+ /* cannot call constexpr() here, because "staging" is already turned
+ * on at this point */
+ assert(staging);
+ stgget(&index, &cidx); /* mark position in code generator */
+ expression(&constant, &item, &tag, FALSE);
+ stgdel(index, cidx); /* scratch generated code */
+ if (constant == 0)
+ error(8); /* must be constant expression */
+ if (lasttag < 0)
+ lasttag = tag;
+ else if (!matchtag(lasttag, tag, FALSE))
+ error(213); /* tagname mismatch */
+ stowlit(item); /* store expression result in literal table */
+ }
+ while (matchtoken(','));
+ needtoken('}');
+ const1((val + glb_declared) * sizeof(cell));
+ lval->ident = iARRAY; /* pretend this is a global array */
+ lval->constval = litidx - val; /* constval == the size of the literal array */
+ }
+ else
+ {
+ return FALSE; /* no, it cannot be interpreted as a constant */
+ } /* if */
+ return TRUE; /* yes, it was a constant value */
+}
--- /dev/null
+/* Small compiler - code generation (unoptimized "assembler" code)
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <limits.h> /* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+/* When a subroutine returns to address 0, the AMX must halt. In earlier
+ * releases, the RET and RETN opcodes checked for the special case 0 address.
+ * Today, the compiler simply generates a HALT instruction at address 0. So
+ * a subroutine can savely return to 0, and then encounter a HALT.
+ */
+void
+writeleader(void)
+{
+ assert(code_idx == 0);
+ stgwrite(";program exit point\n");
+ stgwrite("\thalt 0\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* writetrailer
+ * Not much left of this once important function.
+ *
+ * Global references: sc_stksize (referred to only)
+ * sc_dataalign (referred to only)
+ * code_idx (altered)
+ * glb_declared (altered)
+ */
+void
+writetrailer(void)
+{
+ assert(sc_dataalign % opcodes(1) == 0); /* alignment must be a multiple of
+ * the opcode size */
+ assert(sc_dataalign != 0);
+
+ /* pad code to align data segment */
+ if ((code_idx % sc_dataalign) != 0)
+ {
+ begcseg();
+ while ((code_idx % sc_dataalign) != 0)
+ nooperation();
+ } /* if */
+
+ /* pad data segment to align the stack and the heap */
+ assert(litidx == 0); /* literal queue should have been emptied */
+ assert(sc_dataalign % sizeof(cell) == 0);
+ if (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ begdseg();
+ defstorage();
+ while (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ stgwrite("0 ");
+ glb_declared++;
+ } /* while */
+ } /* if */
+
+ stgwrite("\nSTKSIZE "); /* write stack size (align stack top) */
+ outval(sc_stksize - (sc_stksize % sc_dataalign), TRUE);
+}
+
+/*
+ * Start (or restart) the CODE segment.
+ *
+ * In fact, the code and data segment specifiers are purely informational;
+ * the "DUMP" instruction itself already specifies that the following values
+ * should go to the data segment. All otherinstructions go to the code
+ * segment.
+ *
+ * Global references: curseg
+ */
+void
+begcseg(void)
+{
+ if (curseg != sIN_CSEG)
+ {
+ stgwrite("\n");
+ stgwrite("CODE\t; ");
+ outval(code_idx, TRUE);
+ curseg = sIN_CSEG;
+ } /* endif */
+}
+
+/*
+ * Start (or restart) the DATA segment.
+ *
+ * Global references: curseg
+ */
+void
+begdseg(void)
+{
+ if (curseg != sIN_DSEG)
+ {
+ stgwrite("\n");
+ stgwrite("DATA\t; ");
+ outval(glb_declared - litidx, TRUE);
+ curseg = sIN_DSEG;
+ } /* if */
+}
+
+void
+setactivefile(int fnumber)
+{
+ stgwrite("curfile ");
+ outval(fnumber, TRUE);
+}
+
+cell
+nameincells(char *name)
+{
+ cell clen =
+ (strlen(name) + sizeof(cell)) & ~(sizeof(cell) - 1);
+ return clen;
+}
+
+void
+setfile(char *name, int fileno)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg();
+ stgwrite("file ");
+ outval(fileno, FALSE);
+ stgwrite(" ");
+ stgwrite(name);
+ stgwrite("\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(2) + nameincells(name);
+ } /* if */
+}
+
+void
+setline(int line, int fileno)
+{
+ if ((sc_debug & (sSYMBOLIC | sCHKBOUNDS)) != 0)
+ {
+ stgwrite("line ");
+ outval(line, FALSE);
+ stgwrite(" ");
+ outval(fileno, FALSE);
+ stgwrite("\t; ");
+ outval(code_idx, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* setlabel
+ *
+ * Post a code label (specified as a number), on a new line.
+ */
+void
+setlabel(int number)
+{
+ assert(number >= 0);
+ stgwrite("l.");
+ stgwrite((char *)itoh(number));
+ /* To assist verification of the assembled code, put the address of the
+ * label as a comment. However, labels that occur inside an expression
+ * may move (through optimization or through re-ordering). So write the
+ * address only if it is known to accurate.
+ */
+ if (!staging)
+ {
+ stgwrite("\t\t; ");
+ outval(code_idx, FALSE);
+ } /* if */
+ stgwrite("\n");
+}
+
+/* Write a token that signifies the end of an expression, or the end of a
+ * function parameter. This allows several simple optimizations by the peephole
+ * optimizer.
+ */
+void
+endexpr(int fullexpr)
+{
+ if (fullexpr)
+ stgwrite("\t;$exp\n");
+ else
+ stgwrite("\t;$par\n");
+}
+
+/* startfunc - declare a CODE entry point (function start)
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+startfunc(char *fname __UNUSED__)
+{
+ stgwrite("\tproc");
+ stgwrite("\n");
+ code_idx += opcodes(1);
+}
+
+/* endfunc
+ *
+ * Declare a CODE ending point (function end)
+ */
+void
+endfunc(void)
+{
+ stgwrite("\n"); /* skip a line */
+}
+
+/* alignframe
+ *
+ * Aligns the frame (and the stack) of the current function to a multiple
+ * of the specified byte count. Two caveats: the alignment ("numbytes") should
+ * be a power of 2, and this alignment must be done right after the frame
+ * is set up (before the first variable is declared)
+ */
+void
+alignframe(int numbytes)
+{
+#if !defined NDEBUG
+ /* "numbytes" should be a power of 2 for this code to work */
+ int i, count = 0;
+
+ for (i = 0; i < (int)(sizeof(numbytes) * 8); i++)
+ if (numbytes & (1 << i))
+ count++;
+ assert(count == 1);
+#endif
+
+ stgwrite("\tlctrl 4\n"); /* get STK in PRI */
+ stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
+ outval(~(numbytes - 1), TRUE);
+ stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
+ stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
+ stgwrite("\tsctrl 5\n"); /* ... and FRM */
+ code_idx += opcodes(5) + opargs(4);
+}
+
+/* Define a variable or function
+ */
+void
+defsymbol(char *name, int ident, int vclass, cell offset, int tag)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("symbol ");
+
+ stgwrite(name);
+ stgwrite(" ");
+
+ outval(offset, FALSE);
+ stgwrite(" ");
+
+ outval(vclass, FALSE);
+ stgwrite(" ");
+
+ outval(ident, TRUE);
+
+ code_idx += opcodes(1) + opargs(3) + nameincells(name); /* class and ident encoded in "flags" */
+
+ /* also write the optional tag */
+ if (tag != 0)
+ {
+ assert((tag & TAGMASK) != 0);
+ stgwrite("symtag ");
+ outval(tag & TAGMASK, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+ } /* if */
+}
+
+void
+symbolrange(int level, cell size)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("srange ");
+ outval(level, FALSE);
+ stgwrite(" ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* rvalue
+ *
+ * Generate code to get the value of a symbol into "primary".
+ */
+void
+rvalue(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect fetch, address already in PRI */
+ stgwrite("\tload.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect fetch of a character from a pack, address already in PRI */
+ stgwrite("\tlodb.i ");
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ /* indirect fetch, but address not yet in PRI */
+ assert(sym != NULL);
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ /* direct or stack relative fetch */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tload.s.pri ");
+ else
+ stgwrite("\tload.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Get the address of a symbol into the primary register (used for arrays,
+ * and for passing arguments by reference).
+ */
+void
+address(symbol * sym)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY || sym->ident == iREFERENCE)
+ {
+ /* reference to a variable or to an array; currently this is
+ * always a local variable */
+ stgwrite("\tload.s.pri ");
+ }
+ else
+ {
+ /* a local array or local variable */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.pri ");
+ else
+ stgwrite("\tconst.pri ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* store
+ *
+ * Saves the contents of "primary" into a memory cell, either directly
+ * or indirectly (at the address given in the alternate register).
+ */
+void
+store(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstor.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstrb.i ");
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ assert(sym != NULL);
+ markusage(sym, uWRITTEN);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tstor.s.pri ");
+ else
+ stgwrite("\tstor.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* source must in PRI, destination address in ALT. The "size"
+ * parameter is in bytes, not cells.
+ */
+void
+memcopy(cell size)
+{
+ stgwrite("\tmovs ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Address of the source must already have been loaded in PRI
+ * "size" is the size in bytes (not cells).
+ */
+void
+copyarray(symbol * sym, cell size)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ code_idx += opcodes(1) + opargs(1);
+ memcopy(size);
+}
+
+void
+fillarray(symbol * sym, cell size, cell val)
+{
+ const1(val); /* load val in PRI */
+
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ stgwrite("\tfill ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(2) + opargs(2);
+}
+
+/*
+ * Instruction to get an immediate value into the primary register
+ */
+void
+const1(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.pri\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.pri ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Instruction to get an immediate value into the secondary register
+ */
+void
+const2(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.alt\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.alt ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Copy value in secondary register to the primary register */
+void
+moveto1(void)
+{
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(1) + opargs(0);
+}
+
+/*
+ * Push primary register onto the stack
+ */
+void
+push1(void)
+{
+ stgwrite("\tpush.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push alternate register onto the stack
+ */
+void
+push2(void)
+{
+ stgwrite("\tpush.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push a constant value onto the stack
+ */
+void
+pushval(cell val)
+{
+ stgwrite("\tpush.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * pop stack to the primary register
+ */
+void
+pop1(void)
+{
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * pop stack to the secondary register
+ */
+void
+pop2(void)
+{
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * swap the top-of-stack with the value in primary register
+ */
+void
+swap1(void)
+{
+ stgwrite("\tswap.pri\n");
+ code_idx += opcodes(1);
+}
+
+/* Switch statements
+ * The "switch" statement generates a "case" table using the "CASE" opcode.
+ * The case table contains a list of records, each record holds a comparison
+ * value and a label to branch to on a match. The very first record is an
+ * exception: it holds the size of the table (excluding the first record) and
+ * the label to branch to when none of the values in the case table match.
+ * The case table is sorted on the comparison value. This allows more advanced
+ * abstract machines to sift the case table with a binary search.
+ */
+void
+ffswitch(int label)
+{
+ stgwrite("\tswitch ");
+ outval(label, TRUE); /* the label is the address of the case table */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffcase(cell val, char *labelname, int newtable)
+{
+ if (newtable)
+ {
+ stgwrite("\tcasetbl\n");
+ code_idx += opcodes(1);
+ } /* if */
+ stgwrite("\tcase ");
+ outval(val, FALSE);
+ stgwrite(" ");
+ stgwrite(labelname);
+ stgwrite("\n");
+ code_idx += opcodes(0) + opargs(2);
+}
+
+/*
+ * Call specified function
+ */
+void
+ffcall(symbol * sym, int numargs)
+{
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN);
+ if ((sym->usage & uNATIVE) != 0)
+ {
+ /* reserve a SYSREQ id if called for the first time */
+ if (sc_status == statWRITE && (sym->usage & uREAD) == 0
+ && sym->addr >= 0)
+ sym->addr = ntv_funcid++;
+ stgwrite("\tsysreq.c ");
+ outval(sym->addr, FALSE);
+ stgwrite("\n\tstack ");
+ outval((numargs + 1) * sizeof(cell), TRUE);
+ code_idx += opcodes(2) + opargs(2);
+ }
+ else
+ {
+ /* normal function */
+ stgwrite("\tcall ");
+ stgwrite(sym->name);
+ stgwrite("\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Return from function
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+ffret(void)
+{
+ stgwrite("\tretn\n");
+ code_idx += opcodes(1);
+}
+
+void
+ffabort(int reason)
+{
+ stgwrite("\thalt ");
+ outval(reason, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffbounds(cell size)
+{
+ if ((sc_debug & sCHKBOUNDS) != 0)
+ {
+ stgwrite("\tbounds ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jump to local label number (the number is converted to a name)
+ */
+void
+jumplabel(int number)
+{
+ stgwrite("\tjump ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Define storage (global and static variables)
+ */
+void
+defstorage(void)
+{
+ stgwrite("dump ");
+}
+
+/*
+ * Inclrement/decrement stack pointer. Note that this routine does
+ * nothing if the delta is zero.
+ */
+void
+modstk(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\tstack ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* set the stack to a hard offset from the frame */
+void
+setstk(cell val)
+{
+ stgwrite("\tlctrl 5\n"); /* get FRM */
+ assert(val <= 0); /* STK should always become <= FRM */
+ if (val < 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE); /* add (negative) offset */
+ code_idx += opcodes(1) + opargs(1);
+ // ??? write zeros in the space between STK and the val in PRI (the new stk)
+ // get val of STK in ALT
+ // zero PRI
+ // need new FILL opcode that takes a variable size
+ } /* if */
+ stgwrite("\tsctrl 4\n"); /* store in STK */
+ code_idx += opcodes(2) + opargs(2);
+}
+
+void
+modheap(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\theap ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+void
+setheap_pri(void)
+{
+ stgwrite("\theap "); /* ALT = HEA++ */
+ outval(sizeof(cell), TRUE);
+ stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
+ code_idx += opcodes(3) + opargs(1);
+}
+
+void
+setheap(cell val)
+{
+ stgwrite("\tconst.pri "); /* load default val in PRI */
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ setheap_pri();
+}
+
+/*
+ * Convert a cell number to a "byte" address; i.e. double or quadruple
+ * the primary register.
+ */
+void
+cell2addr(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.pri 1\n");
+#else
+ stgwrite("\tshl.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Double or quadruple the alternate register.
+ */
+void
+cell2addr_alt(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.alt 1\n");
+#else
+ stgwrite("\tshl.c.alt 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Convert "distance of addresses" to "number of cells" in between.
+ * Or convert a number of packed characters to the number of cells (with
+ * truncation).
+ */
+void
+addr2cell(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshr.c.pri 1\n");
+#else
+ stgwrite("\tshr.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Convert from character index to byte address. This routine does
+ * nothing if a character has the size of a byte.
+ */
+void
+char2addr(void)
+{
+ if (charbits == 16)
+ {
+ stgwrite("\tshl.c.pri 1\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Align PRI (which should hold a character index) to an address.
+ * The first character in a "pack" occupies the highest bits of
+ * the cell. This is at the lower memory address on Big Endian
+ * computers and on the higher address on Little Endian computers.
+ * The ALIGN.pri/alt instructions must solve this machine dependence;
+ * that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
+ * and on Little Endian computers they should toggle the address.
+ */
+void
+charalign(void)
+{
+ stgwrite("\talign.pri ");
+ outval(charbits / 8, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Add a constant to the primary register.
+ */
+void
+addconst(cell val)
+{
+ if (val != 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * signed multiply of primary and secundairy registers (result in primary)
+ */
+void
+os_mult(void)
+{
+ stgwrite("\tsmul\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * signed divide of alternate register by primary register (quotient in
+ * primary; remainder in alternate)
+ */
+void
+os_div(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * modulus of (alternate % primary), result in primary (signed)
+ */
+void
+os_mod(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI */
+ code_idx += opcodes(2);
+}
+
+/*
+ * Add primary and alternate registers (result in primary).
+ */
+void
+ob_add(void)
+{
+ stgwrite("\tadd\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * subtract primary register from alternate register (result in primary)
+ */
+void
+ob_sub(void)
+{
+ stgwrite("\tsub.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * arithmic shift left alternate register the number of bits
+ * given in the primary register (result in primary).
+ * There is no need for a "logical shift left" routine, since
+ * logical shift left is identical to arithmic shift left.
+ */
+void
+ob_sal(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshl\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * arithmic shift right alternate register the number of bits
+ * given in the primary register (result in primary).
+ */
+void
+os_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical (unsigned) shift right of the alternate register by the
+ * number of bits given in the primary register (result in primary).
+ */
+void
+ou_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * inclusive "or" of primary and secondary registers (result in primary)
+ */
+void
+ob_or(void)
+{
+ stgwrite("\tor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "exclusive or" of primary and alternate registers (result in primary)
+ */
+void
+ob_xor(void)
+{
+ stgwrite("\txor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "and" of primary and secundairy registers (result in primary)
+ */
+void
+ob_and(void)
+{
+ stgwrite("\tand\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT==PRI; result in primary register (1 or 0).
+ */
+void
+ob_eq(void)
+{
+ stgwrite("\teq\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT!=PRI
+ */
+void
+ob_ne(void)
+{
+ stgwrite("\tneq\n");
+ code_idx += opcodes(1);
+}
+
+/* The abstract machine defines the relational instructions so that PRI is
+ * on the left side and ALT on the right side of the operator. For example,
+ * SLESS sets PRI to either 1 or 0 depending on whether the expression
+ * "PRI < ALT" is true.
+ *
+ * The compiler generates comparisons with ALT on the left side of the
+ * relational operator and PRI on the right side. The XCHG instruction
+ * prefixing the relational operators resets this. We leave it to the
+ * peephole optimizer to choose more compact instructions where possible.
+ */
+
+/* Relational operator prefix for chained relational expressions. The
+ * "suffix" code restores the stack.
+ * For chained relational operators, the goal is to keep the comparison
+ * result "so far" in PRI and the value of the most recent operand in
+ * ALT, ready for a next comparison.
+ * The "prefix" instruction pushed the comparison result (PRI) onto the
+ * stack and moves the value of ALT into PRI. If there is a next comparison,
+ * PRI can now serve as the "left" operand of the relational operator.
+ */
+void
+relop_prefix(void)
+{
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(2);
+}
+
+void
+relop_suffix(void)
+{
+ stgwrite("\tswap.alt\n");
+ stgwrite("\tand\n");
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(3);
+}
+
+/*
+ * test ALT<PRI (signed)
+ */
+void
+os_lt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsless\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT<=PRI (signed)
+ */
+void
+os_le(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsleq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>PRI (signed)
+ */
+void
+os_gt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgrtr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>=PRI (signed)
+ */
+void
+os_ge(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgeq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical negation of primary register
+ */
+void
+lneg(void)
+{
+ stgwrite("\tnot\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * two's complement primary register
+ */
+void
+neg(void)
+{
+ stgwrite("\tneg\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * one's complement of primary register
+ */
+void
+invert(void)
+{
+ stgwrite("\tinvert\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * nop
+ */
+void
+nooperation(void)
+{
+ stgwrite("\tnop\n");
+ code_idx += opcodes(1);
+}
+
+/* increment symbol
+ */
+void
+inc(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect increment, address already in PRI */
+ stgwrite("\tinc.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect increment of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tinc.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* increment */
+ stgwrite("\tinc.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tinc.s ");
+ else
+ stgwrite("\tinc ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* decrement symbol
+ *
+ * in case of an integer pointer, the symbol must be incremented by 2.
+ */
+void
+dec(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect decrement, address already in PRI */
+ stgwrite("\tdec.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect decrement of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tdec.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* decrement */
+ stgwrite("\tdec.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tdec.s ");
+ else
+ stgwrite("\tdec ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jumps to "label" if PRI != 0
+ */
+void
+jmp_ne0(int number)
+{
+ stgwrite("\tjnz ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Jumps to "label" if PRI == 0
+ */
+void
+jmp_eq0(int number)
+{
+ stgwrite("\tjzer ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* write a value in hexadecimal; optionally adds a newline */
+void
+outval(cell val, int newline)
+{
+ stgwrite(itoh(val));
+ if (newline)
+ stgwrite("\n");
+}
--- /dev/null
+/* Small compiler - Error message system
+ * In fact a very simple system, using only 'panic mode'.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_sc5.scp"
+
+static int errflag;
+static int errstart; /* line number at which the instruction started */
+
+/* error
+ *
+ * Outputs an error message (note: msg is passed optionally).
+ * If an error is found, the variable "errflag" is set and subsequent
+ * errors are ignored until lex() finds a semicolumn or a keyword
+ * (lex() resets "errflag" in that case).
+ *
+ * Global references: inpfname (referred to only)
+ * fline (referred to only)
+ * fcurrent (referred to only)
+ * errflag (altered)
+ */
+int
+error(int number, ...)
+{
+ static int lastline, lastfile, errorcount;
+ char *msg;
+ va_list argptr;
+ char string[1024];
+ int start;
+
+ /* errflag is reset on each semicolon.
+ * In a two-pass compiler, an error should not be reported twice. Therefore
+ * the error reporting is enabled only in the second pass (and only when
+ * actually producing output). Fatal errors may never be ignored.
+ */
+ if (((errflag) || (sc_status != statWRITE)) &&
+ ((number < 100) || (number >= 200)))
+ return 0;
+
+ if (number < 100)
+ {
+ msg = errmsg[number - 1];
+ errflag = TRUE; /* set errflag (skip rest of erroneous expression) */
+ errnum++;
+ }
+ else if (number < 200)
+ {
+ msg = fatalmsg[number - 100];
+ errnum++; /* a fatal error also counts as an error */
+ }
+ else
+ {
+ msg = warnmsg[number - 200];
+ warnnum++;
+ }
+
+ strexpand(string, (unsigned char *)msg, sizeof string, SCPACK_TABLE);
+
+ va_start(argptr, number);
+
+ start = (errstart == fline) ? -1 : errstart;
+
+ if (sc_error(number, string, inpfname, start, fline, argptr))
+ {
+ sc_closeasm(outf);
+ outf = NULL;
+ longjmp(errbuf, 3);
+ }
+
+ va_end(argptr);
+
+ if (((number >= 100) && (number < 200)) || (errnum > 250))
+ {
+ va_start(argptr, number);
+ sc_error(0, "\nCompilation aborted.", NULL, 0, 0, argptr);
+ va_end(argptr);
+
+ if (outf)
+ {
+ sc_closeasm(outf);
+ outf = NULL;
+ } /* if */
+ longjmp(errbuf, 2); /* fatal error, quit */
+ } /* if */
+
+ /* check whether we are seeing many errors on the same line */
+ if (((errstart < 0) && (lastline != fline)) ||
+ (lastline < errstart) || (lastline > fline) || (fcurrent != lastfile))
+ errorcount = 0;
+ lastline = fline;
+ lastfile = fcurrent;
+ if (number < 200)
+ errorcount++;
+ if (errorcount >= 3)
+ error(107); /* too many error/warning messages on one line */
+ return 0;
+}
+
+void
+errorset(int code)
+{
+ switch (code)
+ {
+ case sRESET:
+ errflag = FALSE; /* start reporting errors */
+ break;
+ case sFORCESET:
+ errflag = TRUE; /* stop reporting errors */
+ break;
+ case sEXPRMARK:
+ errstart = fline; /* save start line number */
+ break;
+ case sEXPRRELEASE:
+ errstart = -1; /* forget start line number */
+ break;
+ default:
+ break;
+ }
+}
--- /dev/null
+/* Small compiler - Error message strings (plain and compressed formats)
+ *
+ * Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+int strexpand(char *dest, unsigned char *source, int maxlen,
+ unsigned char pairtable[128][2]);
+
+#define SCPACK_TABLE errstr_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char errstr_table[][2] = {
+ {101, 32}, {116, 32}, {111, 110}, {105, 110}, {97, 114}, {100, 32}, {105,
+ 130},
+ {101, 114}, {101, 110}, {115, 32}, {97, 108}, {97, 116}, {117, 110}, {115,
+ 34},
+ {37, 141}, {34, 142},
+ {109, 136}, {121, 32}, {97, 110}, {114, 101}, {99, 116}, {134, 32}, {110,
+ 111},
+ {101, 133}, {118, 138}, {115, 105}, {98, 108}, {111, 114}, {115, 116},
+ {41, 10}, {109, 98}, {100, 101},
+ {117, 115}, {150, 129}, {102, 140}, {117, 144}, {162, 148}, {103, 163}, {132,
+ 165},
+ {114, 97}, {105, 133}, {152, 168}, {99, 104}, {32, 143}, {97, 32}, {131,
+ 169},
+ {97, 115}, {164, 149},
+ {111, 108}, {101, 120}, {97, 154}, {135, 32}, {132, 167}, {111, 102}, {105,
+ 116},
+ {166, 129}, {101, 100}, {98, 128}, {178, 128}, {160, 129}, {105, 137},
+ {180, 145}, {121, 158}, {190, 176},
+ {109, 187}, {115, 191}, {118, 132}, {101, 10}, {115, 10}, {112, 147}, {155,
+ 32},
+ {181, 32}, {159, 102}, {194, 105}, {99, 130}, {103, 32}, {201, 186}, {116,
+ 111},
+ {34, 32}, {109, 97},
+ {153, 122}, {171, 10}, {104, 97}, {100, 105}, {108, 111}, {111, 112}, {200,
+ 131},
+ {139, 134}, {213, 135}, {101, 137}, {202, 156}, {143, 157}, {138, 32},
+ {192, 185}, {58, 209}, {105, 99},
+ {112, 111}, {115, 115}, {110, 117}, {115, 117}, {146, 129}, {226, 158}, {229,
+ 179},
+ {177, 197}, {231, 225}, {132, 97}, {98, 101}, {99, 111}, {216, 139}, {109,
+ 139},
+ {116, 10}, {99, 146},
+ {44, 32}, {237, 170}, {131, 203}, {116, 104}, {117, 108}, {152, 117}, {108,
+ 128},
+ {118, 128}, {101, 144}, {233, 148}, {174, 153}, {110, 32}, {131, 32},
+ {146, 32}, {239, 161}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+static char *errmsg[] = {
+#ifdef SCPACK
+/*001*/ "expected token: \"%s\", but found \"%s\"\n",
+/*002*/ "only a single statement (or expression) can follow each \"case\"\n",
+/*003*/ "declaration of a local variable must appear in a compound block\n",
+/*004*/ "function \"%s\" is not implemented\n",
+/*005*/ "function may not have arguments\n",
+/*006*/ "must be assigned to an array\n",
+/*007*/ "assertion failed\n",
+/*008*/ "must be a constant expression; assumed zero\n",
+/*009*/ "invalid array size (negative or zero)\n",
+/*010*/ "invalid function or declaration\n",
+/*011*/ "invalid outside functions\n",
+/*012*/ "invalid function call, not a valid address\n",
+/*013*/ "no entry point (no public functions)\n",
+/*014*/ "invalid statement; not in switch\n",
+/*015*/ "\"default\" case must be the last case in switch statement\n",
+/*016*/ "multiple defaults in \"switch\"\n",
+/*017*/ "undefined symbol \"%s\"\n",
+/*018*/ "initialization data exceeds declared size\n",
+/*019*/ "not a label: \"%s\"\n",
+/*020*/ "invalid symbol name \"%s\"\n",
+/*021*/ "symbol already defined: \"%s\"\n",
+/*022*/ "must be lvalue (non-constant)\n",
+/*023*/ "array assignment must be simple assignment\n",
+/*024*/ "\"break\" or \"continue\" is out of context\n",
+/*025*/ "function heading differs from prototype\n",
+/*026*/ "no matching \"#if...\"\n",
+/*027*/ "invalid character constant\n",
+/*028*/ "invalid subscript (not an array or too many subscripts)\n",
+/*029*/ "invalid expression, assumed zero\n",
+/*030*/ "compound statement not closed at the end of file\n",
+/*031*/ "unknown directive\n",
+/*032*/ "array index out of bounds (variable \"%s\")\n",
+/*033*/ "array must be indexed (variable \"%s\")\n",
+/*034*/ "argument does not have a default value (argument %d)\n",
+/*035*/ "argument type mismatch (argument %d)\n",
+/*036*/ "empty statement\n",
+/*037*/ "invalid string (possibly non-terminated string)\n",
+/*038*/ "extra characters on line\n",
+/*039*/ "constant symbol has no size\n",
+/*040*/ "duplicate \"case\" label (value %d)\n",
+/*041*/ "invalid ellipsis, array size is not known\n",
+/*042*/ "invalid combination of class specifiers\n",
+/*043*/ "character constant exceeds range for packed string\n",
+/*044*/ "positional parameters must precede all named parameters\n",
+/*045*/ "too many function arguments\n",
+/*046*/ "unknown array size (variable \"%s\")\n",
+/*047*/ "array sizes must match\n",
+/*048*/ "array dimensions must match\n",
+/*049*/ "invalid line continuation\n",
+/*050*/ "invalid range\n",
+/*051*/ "invalid subscript, use \"[ ]\" operators on major dimensions\n",
+/*052*/ "only the last dimension may be variable length\n",
+/*053*/ "exceeding maximum number of dimensions\n",
+/*054*/ "unmatched closing brace\n",
+/*055*/ "start of function body without function header\n",
+/*056*/
+ "arrays, local variables and function arguments cannot be public (variable \"%s\")\n",
+/*057*/ "unfinished expression before compiler directive\n",
+/*058*/ "duplicate argument; same argument is passed twice\n",
+/*059*/ "function argument may not have a default value (variable \"%s\")\n",
+/*060*/ "multiple \"#else\" directives between \"#if ... #endif\"\n",
+/*061*/ "operator cannot be redefined\n",
+/*062*/ "number of operands does not fit the operator\n",
+/*063*/ "function result tag of operator \"%s\" must be \"%s\"\n",
+/*064*/ "cannot change predefined operators\n",
+/*065*/ "function argument may only have a single tag (argument %d)\n",
+/*066*/
+ "function argument may not be a reference argument or an array (argument \"%s\")\n",
+/*067*/
+ "variable cannot be both a reference and an array (variable \"%s\")\n",
+/*068*/ "invalid rational number precision in #pragma\n",
+/*069*/ "rational number format already defined\n",
+/*070*/ "rational number support was not enabled\n",
+/*071*/
+ "user-defined operator must be declared before use (function \"%s\")\n",
+/*072*/ "\"sizeof\" operator is invalid on \"function\" symbols\n",
+/*073*/ "function argument must be an array (argument \"%s\")\n",
+/*074*/ "#define pattern must start with an alphabetic character\n",
+/*075*/ "input line too long (after substitutions)\n"
+#else
+ "\261pe\224\227\315k\210:\253\360bu\201fo\214\205\217\012",
+ "\202l\221\254s\203g\366\234\213\370\201(\306\350\206) \357 f\260\324w ea\252 \042c\256e\042\012",
+ "\237cl\204\213\225\307\254\324c\334\314\300appe\204 \374\254\353m\340\214\205\232ock\012",
+ "\257\217 \274\241impl\370t\270\012",
+ "\257\317\221\241\322\367\246t\304",
+ "\335\372gn\227\315 \375\264y\012",
+ "\256s\207t\225fail\270\012",
+ "\335\254\332\344\350\206; \256\343m\227z\207o\012",
+ "\255\275\320\200(neg\213i\367\306z\207o\235",
+ "\255\257\306\237cl\204\327\012",
+ "\255out\231d\200\244\206\304",
+ "\255\257c\212l\360\241\254\251add\223s\304",
+ "\226 \210tr\221\340\203\201(\226 pu\232\337 \244\206s\235",
+ "\255\234\213\370t; \241\374sw\266\252\012",
+ "\042\310a\364t\316c\256\200\335\363\200l\256\201c\256\200\374sw\266\252 \234\213\370\356",
+ "m\364tip\366\310a\364t\211\374\042sw\266\252\042\012",
+ "\214\326\227\301\321",
+ "\203\266i\212iz\213\225d\213\254\261ce\270\211\237cl\204\227\320\303",
+ "\241\254la\352l\336",
+ "\255\301 nam\200\217\012",
+ "\301 \212\223ad\221\326\270\336",
+ "\335l\365\200(n\202-\332\222t\235",
+ "\275\372gn\220\201\335\231mp\366\372gn\220\356",
+ "\042b\223ak\316\306\042\312t\203ue\316\274ou\201\307\312t\261\356",
+ "\257head\362\323ff\207\211from pro\315typ\303",
+ "\226 \361\362\042#if...\042\012",
+ "\255\252\371\263\332\222\356",
+ "\255\343bscrip\201(\241\375\275\306\315o m\222\221\343bscripts\235",
+ "\255\350\206\360\256\343m\227z\207o\012",
+ "\353m\340\214\205\234\213\370\201\241c\324s\227a\201\363\200\210\205\307fil\303",
+ "\214k\226w\373\323\223\224iv\303",
+ "\275\203\237x ou\201\307bo\214d\211(\314\333",
+ "\275\335\203\237x\227(\314\333",
+ "\267do\331\241\322\367\254\310a\364\201\365\200(\267%d\235",
+ "\267typ\200mis\361 (\267%d\235",
+ "empt\221\234\213\370\356",
+ "\255\234r\362(\340s\231\232\221n\202-t\207m\203\213\227\234r\203g\235",
+ "\261t\247 \252\371\207\211\202 l\203\303",
+ "\332\344\301 \322\211\226 \320\303",
+ "dupl\337\213\200\042c\256e\316la\352l (\365\200%d\235",
+ "\255ellip\231s\360\275\320\200\274\241k\226wn\012",
+ "\255\353\236\203\213\225\307cl\256\211specifi\207\304",
+ "\252\371\263\332\344\261ce\270\211r\222g\200f\306pack\227\234r\203g\012",
+ "\340\231t\206\334p\351met\207\211\300\305c\270\200\212l nam\227p\351met\207\304",
+ "\315o m\222\221\257\246t\304",
+ "\214k\226w\373\275\320\200(\314\333",
+ "\275\320\331\300\361\012",
+ "\275\323\220s\206\211\300\361\012",
+ "\255l\203\200\312t\203u\327\012",
+ "\255r\222g\303",
+ "\255\343bscript\360\240\200\042[ ]\316\354\233\211\202 \317j\306\323\220s\206\304",
+ "\202l\221\363\200l\256\201\323\220s\225\317\221\271\314l\210g\363\012",
+ "\261ce\270\362\317ximum \346\307\323\220s\206\304",
+ "\214\361\227c\324s\362b\247c\303",
+ "\234\204\201\307\257bod\221w\266hou\201\257head\207\012",
+ "\264ys\360\324c\334\311\262\331\222\205\257\246t\211\376\271pu\232\337 (\314\333",
+ "\214f\203ish\227\350\225\352f\233\200\353mpil\263\323\223\224iv\303",
+ "dupl\337\213\200\246t; sam\200\267\274p\256s\227tw\337\303",
+ "\257\267\317\221\241\322\367\254\310a\364\201\365\200(\314\333",
+ "m\364tip\366\042#else\316\323\223\224iv\331\352twe\210 \042#if ... #\210\323f\042\012",
+ "\354\306\376\271\223\326\270\012",
+ "\346\307\330\222d\211do\331\241fi\201\363\200\354\233\012",
+ "\257\223\343l\201ta\313\307\354\233\253 \335\217\012",
+ "\376\252\222g\200\305\326\227\354\233\304",
+ "\257\267\317\221\202l\221\322\367\254s\203g\366ta\313(\267%d\235",
+ "\257\267\317\221\241\271\254\223f\207\210c\200\267\306\375\275(\267\333",
+ "\314\376\271bo\363 \254\223f\207\210c\200\222\205\375\275(\314\333",
+ "\255r\327\334\346\305cis\225\374#p\247g\317\012",
+ "r\327\334\346f\233\317\201\212\223ad\221\326\270\012",
+ "r\327\334\346\343pp\233\201wa\211\241\210\262\270\012",
+ "\240\207-\326\227\354\306\335\237cl\204\227\352f\233\200\240\200(\257\333",
+ "\042\320e\265\316\354\306\274\255\202 \042\244\206\316\301\304",
+ "\257\267\335\375\275(\267\333",
+ "#\326\200p\213t\207\373\300\234\204\201w\266h \375\212p\322\352t\337 \252\371\207\012",
+ "\203pu\201l\203\200\315o l\202\313(aft\263\343b\234\266ut\206s\235"
+#endif
+};
+
+static char *fatalmsg[] = {
+#ifdef SCPACK
+/*100*/ "cannot read from file: \"%s\"\n",
+/*101*/ "cannot write to file: \"%s\"\n",
+/*102*/ "table overflow: \"%s\"\n",
+ /* table can be: loop table
+ * literal table
+ * staging buffer
+ * parser stack (recursive include?)
+ * option table (response file)
+ * peephole optimizer table
+ */
+/*103*/ "insufficient memory\n",
+/*104*/ "invalid assembler instruction \"%s\"\n",
+/*105*/ "numeric overflow, exceeding capacity\n",
+/*106*/ "compaction buffer overflow\n",
+/*107*/ "too many error messages on one line\n"
+#else
+ "\376\223a\205from file\336",
+ "\376wr\266\200\315 file\336",
+ "t\272ov\207f\324w\336",
+ "\203\343ff\337i\210\201mem\233y\012",
+ "\255\256sem\232\263\203\234ru\224\225\217\012",
+ "\342m\207\337 ov\207f\324w\360\261ce\270\362capac\266y\012",
+ "\353mpa\224\225buff\263ov\207f\324w\012",
+ "\315o m\222\221\207r\306me\341ag\331\202 \202\200l\203\303"
+#endif
+};
+
+static char *warnmsg[] = {
+#ifdef SCPACK
+/*200*/ "symbol \"%s\" is truncated to %d characters\n",
+/*201*/ "redefinition of constant/macro (symbol \"%s\")\n",
+/*202*/ "number of arguments does not match definition\n",
+/*203*/ "symbol is never used: \"%s\"\n",
+/*204*/ "symbol is assigned a value that is never used: \"%s\"\n",
+/*205*/ "redundant code: constant expression is zero\n",
+/*206*/ "redundant test: constant expression is non-zero\n",
+/*207*/ "unknown #pragma\n",
+/*208*/ "function uses both \"return;\" and \"return <value>;\"\n",
+/*209*/ "function \"%s\" should return a value\n",
+/*210*/ "possible use of symbol before initialization: \"%s\"\n",
+/*211*/ "possibly unintended assignment\n",
+/*212*/ "possibly unintended bitwise operation\n",
+/*213*/ "tag mismatch\n",
+/*214*/ "possibly a \"const\" array argument was intended: \"%s\"\n",
+/*215*/ "expression has no effect\n",
+/*216*/ "nested comment\n",
+/*217*/ "loose indentation\n",
+/*218*/ "old style prototypes used with optional semicolumns\n",
+/*219*/ "local variable \"%s\" shadows a variable at a preceding level\n",
+/*220*/ "exported or native symbol \"%s\" is truncated to %d characters\n",
+/*221*/ "label name \"%s\" shadows tag name\n",
+/*222*/ "number of digits exceeds rational number precision\n",
+/*223*/ "redundant \"sizeof\": argument size is always 1 (symbol \"%s\")\n",
+/*224*/
+ "indeterminate array size in \"sizeof\" expression (symbol \"%s\")\n",
+/*225*/ "unreachable code\n",
+/*226*/ "a variable is assigned to itself (symbol \"%s\")\n"
+#else
+ "\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+ "\223\326\266\225\307\332\222t/\317cro (\301\253\235",
+ "\346\307\246t\211do\331\241\361 \326\266\206\012",
+ "\301 \274nev\263\240\270\336",
+ "\301 \274\372gn\227\254\365\200t\322\201\274nev\263\240\270\336",
+ "\223d\214d\344\353\237: \332\344\350\225\274z\207o\012",
+ "\223d\214d\344te\234: \332\344\350\225\274n\202-z\207o\012",
+ "\214k\226w\373#p\247g\317\012",
+ "\257\240\331bo\363 \042\223turn;\316\222\205\042\223tur\373<\365e>;\042\012",
+ "\257\217 sho\364\205\223tur\373\254\365\303",
+ "\340s\231\232\200\240\200\307\301 \352f\233\200\203\266i\212iz\327\336",
+ "\340s\231\232\221\214\203t\210d\227\372gn\220\356",
+ "\340s\231\232\221\214\203t\210d\227b\266wis\200\330\327\012",
+ "ta\313mis\361\012",
+ "\340s\231\232\221\254\042\332\316\275\267wa\211\203t\210\237d\336",
+ "\350\225\322\211\226 effe\224\012",
+ "ne\234\227\353m\220\356",
+ "\324os\200\203d\210t\327\012",
+ "\260\205\234y\366pro\315typ\331\240\227w\266h \325t\206\334sem\337\260umn\304",
+ "\324c\334\314\217 s\322dow\211\254\314a\201\254\305c\270\362level\012",
+ "\261p\233t\227\306n\213i\367\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+ "la\352l nam\200\217 s\322dow\211ta\313nam\303",
+ "\346\307\323g\266\211\261ce\270\211r\327\334\346\305cis\206\012",
+ "\223d\214d\344\042\320e\265\042: \267\320\200\274\212way\2111 (\301\253\235",
+ "\203\237t\207m\203\213\200\275\320\200\374\042\320e\265\316\350\225(\301\253\235",
+ "\214\223a\252\272\353\237\012",
+ "\254\314\274\372gn\227\315 \266self (\301\253\235"
+#endif
+};
--- /dev/null
+/* Small compiler - Binary code generation (the "assembler")
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h> /* for macro max() */
+#include <string.h>
+#include <ctype.h>
+#include "embryo_cc_sc.h"
+
+typedef cell(*OPCODE_PROC) (FILE * fbin, char *params, cell opcode);
+
+typedef struct
+{
+ cell opcode;
+ char *name;
+ int segment; /* sIN_CSEG=parse in cseg, sIN_DSEG=parse in dseg */
+ OPCODE_PROC func;
+} OPCODE;
+
+static cell codeindex; /* similar to "code_idx" */
+static cell *lbltab; /* label table */
+static int writeerror;
+static int bytes_in, bytes_out;
+
+/* apparently, strtol() does not work correctly on very large (unsigned)
+ * hexadecimal values */
+static ucell
+hex2long(char *s, char **n)
+{
+ unsigned long result = 0L;
+ int negate = FALSE;
+ int digit;
+
+ /* ignore leading whitespace */
+ while (*s == ' ' || *s == '\t')
+ s++;
+
+ /* allow a negation sign to create the two's complement of numbers */
+ if (*s == '-')
+ {
+ negate = TRUE;
+ s++;
+ } /* if */
+
+ assert((*s >= '0' && *s <= '9') || (*s >= 'a' && *s <= 'f')
+ || (*s >= 'a' && *s <= 'f'));
+ for (;;)
+ {
+ if (*s >= '0' && *s <= '9')
+ digit = *s - '0';
+ else if (*s >= 'a' && *s <= 'f')
+ digit = *s - 'a' + 10;
+ else if (*s >= 'A' && *s <= 'F')
+ digit = *s - 'A' + 10;
+ else
+ break; /* probably whitespace */
+ result = (result << 4) | digit;
+ s++;
+ } /* for */
+ if (n)
+ *n = s;
+ if (negate)
+ result = (~result) + 1; /* take two's complement of the result */
+ return (ucell) result;
+}
+
+#ifdef WORDS_BIGENDIAN
+static short *
+align16(short *v)
+{
+ unsigned char *s = (unsigned char *)v;
+ unsigned char t;
+
+ /* swap two bytes */
+ t = s[0];
+ s[0] = s[1];
+ s[1] = t;
+ return v;
+}
+
+static long *
+align32(long *v)
+{
+ unsigned char *s = (unsigned char *)v;
+ unsigned char t;
+
+ /* swap outer two bytes */
+ t = s[0];
+ s[0] = s[3];
+ s[3] = t;
+ /* swap inner two bytes */
+ t = s[1];
+ s[1] = s[2];
+ s[2] = t;
+ return v;
+}
+#if defined BIT16
+#define aligncell(v) align16(v)
+#else
+#define aligncell(v) align32(v)
+#endif
+#else
+#define align16(v) (v)
+#define align32(v) (v)
+#define aligncell(v) (v)
+#endif
+
+static char *
+skipwhitespace(char *str)
+{
+ while (sc_isspace(*str))
+ str++;
+ return str;
+}
+
+static char *
+stripcomment(char *str)
+{
+ char *ptr = strchr(str, ';');
+
+ if (ptr)
+ {
+ *ptr++ = '\n'; /* terminate the line, but leave the '\n' */
+ *ptr = '\0';
+ } /* if */
+ return str;
+}
+
+static void
+write_encoded(FILE * fbin, ucell * c, int num)
+{
+ assert(sizeof(cell) <= 4); /* code must be adjusted for larger cells */
+ assert(fbin != NULL);
+ while (num-- > 0)
+ {
+ if (sc_compress)
+ {
+ ucell p = (ucell) * c;
+ unsigned char t[5]; /* a 32-bit cell is encoded in max. 5 bytes (3 bytes for a 16-bit cell) */
+ unsigned char code;
+ int index;
+
+ for (index = 0; index < 5; index++)
+ {
+ t[index] = (unsigned char)(p & 0x7f); /* store 7 bits */
+ p >>= 7;
+ } /* for */
+ /* skip leading zeros */
+ while (index > 1 && t[index - 1] == 0
+ && (t[index - 2] & 0x40) == 0)
+ index--;
+ /* skip leading -1s *//* ??? for BIT16, check for index==3 && t[index-1]==0x03 */
+ if (index == 5 && t[index - 1] == 0x0f
+ && (t[index - 2] & 0x40) != 0)
+ index--;
+ while (index > 1 && t[index - 1] == 0x7f
+ && (t[index - 2] & 0x40) != 0)
+ index--;
+ /* write high byte first, write continuation bits */
+ assert(index > 0);
+ while (index-- > 0)
+ {
+ code =
+ (unsigned char)((index == 0) ? t[index]
+ : (t[index] | 0x80));
+ writeerror |= !sc_writebin(fbin, &code, 1);
+ bytes_out++;
+ } /* while */
+ bytes_in += sizeof *c;
+ assert(AMX_EXPANDMARGIN > 2);
+ if (bytes_out - bytes_in >= AMX_EXPANDMARGIN - 2)
+ error(106); /* compression buffer overflow */
+ }
+ else
+ {
+ assert((sc_lengthbin(fbin) % sizeof(cell)) == 0);
+ writeerror |= !sc_writebin(fbin, aligncell(c), sizeof *c);
+ } /* if */
+ c++;
+ } /* while */
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+noop(FILE * fbin __UNUSED__, char *params __UNUSED__, cell opcode __UNUSED__)
+{
+ return 0;
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+parm0(FILE * fbin, char *params __UNUSED__, cell opcode)
+{
+ if (fbin)
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ return opcodes(1);
+}
+
+static cell
+parm1(FILE * fbin, char *params, cell opcode)
+{
+ ucell p = hex2long(params, NULL);
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+parm2(FILE * fbin, char *params, cell opcode)
+{
+ ucell p[2];
+
+ p[0] = hex2long(params, ¶ms);
+ p[1] = hex2long(params, NULL);
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, p, 2);
+ } /* if */
+ return opcodes(1) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_dump(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+ ucell p;
+ int num = 0;
+
+ while (*params != '\0')
+ {
+ p = hex2long(params, ¶ms);
+ if (fbin)
+ write_encoded(fbin, &p, 1);
+ num++;
+ while (sc_isspace(*params))
+ params++;
+ } /* while */
+ return num * sizeof(cell);
+}
+
+static cell
+do_call(FILE * fbin, char *params, cell opcode)
+{
+ char name[sNAMEMAX + 1];
+ int i;
+ symbol *sym;
+ ucell p;
+
+ for (i = 0; !sc_isspace(*params); i++, params++)
+ {
+ assert(*params != '\0');
+ assert(i < sNAMEMAX);
+ name[i] = *params;
+ } /* for */
+ name[i] = '\0';
+
+ /* look up the function address; note that the correct file number must
+ * already have been set (in order for static globals to be found).
+ */
+ sym = findglb(name);
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN || sym->ident == iREFFUNC);
+ assert(sym->vclass == sGLOBAL);
+
+ p = sym->addr;
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+do_jump(FILE * fbin, char *params, cell opcode)
+{
+ int i;
+ ucell p;
+
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+do_file(FILE * fbin, char *params, cell opcode)
+{
+ ucell p, clen;
+ int len;
+
+ p = hex2long(params, ¶ms);
+
+ /* remove leading and trailing white space from the filename */
+ while (sc_isspace(*params))
+ params++;
+ len = strlen(params);
+ while (len > 0 && sc_isspace(params[len - 1]))
+ len--;
+ params[len++] = '\0'; /* zero-terminate */
+ while (len % sizeof(cell) != 0)
+ params[len++] = '\0'; /* pad with zeros up to full cell */
+ assert(len > 0 && len < 256);
+ clen = len + sizeof(cell); /* add size of file ordinal */
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &clen, 1);
+ write_encoded(fbin, &p, 1);
+ write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+ } /* if */
+ return opcodes(1) + opargs(1) + clen; /* other argument is in clen */
+}
+
+static cell
+do_symbol(FILE * fbin, char *params, cell opcode)
+{
+ char *endptr;
+ ucell offset, clen, flags;
+ int len;
+ unsigned char mclass, type;
+
+ for (endptr = params; !sc_isspace(*endptr) && endptr != '\0'; endptr++)
+ /* nothing */ ;
+ assert(*endptr == ' ');
+
+ len = (int)(endptr - params);
+ assert(len > 0 && len < sNAMEMAX);
+ /* first get the other parameters from the line */
+ offset = hex2long(endptr, &endptr);
+ mclass = (unsigned char)hex2long(endptr, &endptr);
+ type = (unsigned char)hex2long(endptr, NULL);
+ flags = type + 256 * mclass;
+ /* now finish up the name (overwriting the input line) */
+ params[len++] = '\0'; /* zero-terminate */
+ while (len % sizeof(cell) != 0)
+ params[len++] = '\0'; /* pad with zeros up to full cell */
+ clen = len + 2 * sizeof(cell); /* add size of symbol address and flags */
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &clen, 1);
+ write_encoded(fbin, &offset, 1);
+ write_encoded(fbin, &flags, 1);
+ write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+ } /* if */
+
+#if !defined NDEBUG
+ /* function should start right after the symbolic information */
+ if (!fbin && mclass == 0 && type == iFUNCTN)
+ assert(offset == codeindex + opcodes(1) + opargs(1) + clen);
+#endif
+
+ return opcodes(1) + opargs(1) + clen; /* other 2 arguments are in clen */
+}
+
+static cell
+do_switch(FILE * fbin, char *params, cell opcode)
+{
+ int i;
+ ucell p;
+
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_case(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+ int i;
+ ucell p, v;
+
+ v = hex2long(params, ¶ms);
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, &v, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(0) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+curfile(FILE * fbin __UNUSED__, char *params, cell opcode __UNUSED__)
+{
+ fcurrent = (int)hex2long(params, NULL);
+ return 0;
+}
+
+static OPCODE opcodelist[] = {
+ /* node for "invalid instruction" */
+ {0, NULL, 0, noop},
+ /* opcodes in sorted order */
+ {78, "add", sIN_CSEG, parm0},
+ {87, "add.c", sIN_CSEG, parm1},
+ {14, "addr.alt", sIN_CSEG, parm1},
+ {13, "addr.pri", sIN_CSEG, parm1},
+ {30, "align.alt", sIN_CSEG, parm1},
+ {29, "align.pri", sIN_CSEG, parm1},
+ {81, "and", sIN_CSEG, parm0},
+ {121, "bounds", sIN_CSEG, parm1},
+ {49, "call", sIN_CSEG, do_call},
+ {50, "call.pri", sIN_CSEG, parm0},
+ {0, "case", sIN_CSEG, do_case},
+ {130, "casetbl", sIN_CSEG, parm0}, /* version 1 */
+ {118, "cmps", sIN_CSEG, parm1},
+ {0, "code", 0, noop},
+ {12, "const.alt", sIN_CSEG, parm1},
+ {11, "const.pri", sIN_CSEG, parm1},
+ {0, "curfile", sIN_CSEG, curfile},
+ {0, "data", 0, noop},
+ {114, "dec", sIN_CSEG, parm1},
+ {113, "dec.alt", sIN_CSEG, parm0},
+ {116, "dec.i", sIN_CSEG, parm0},
+ {112, "dec.pri", sIN_CSEG, parm0},
+ {115, "dec.s", sIN_CSEG, parm1},
+ {0, "dump", sIN_DSEG, do_dump},
+ {95, "eq", sIN_CSEG, parm0},
+ {106, "eq.c.alt", sIN_CSEG, parm1},
+ {105, "eq.c.pri", sIN_CSEG, parm1},
+ {124, "file", sIN_CSEG, do_file},
+ {119, "fill", sIN_CSEG, parm1},
+ {100, "geq", sIN_CSEG, parm0},
+ {99, "grtr", sIN_CSEG, parm0},
+ {120, "halt", sIN_CSEG, parm1},
+ {45, "heap", sIN_CSEG, parm1},
+ {27, "idxaddr", sIN_CSEG, parm0},
+ {28, "idxaddr.b", sIN_CSEG, parm1},
+ {109, "inc", sIN_CSEG, parm1},
+ {108, "inc.alt", sIN_CSEG, parm0},
+ {111, "inc.i", sIN_CSEG, parm0},
+ {107, "inc.pri", sIN_CSEG, parm0},
+ {110, "inc.s", sIN_CSEG, parm1},
+ {86, "invert", sIN_CSEG, parm0},
+ {55, "jeq", sIN_CSEG, do_jump},
+ {60, "jgeq", sIN_CSEG, do_jump},
+ {59, "jgrtr", sIN_CSEG, do_jump},
+ {58, "jleq", sIN_CSEG, do_jump},
+ {57, "jless", sIN_CSEG, do_jump},
+ {56, "jneq", sIN_CSEG, do_jump},
+ {54, "jnz", sIN_CSEG, do_jump},
+ {52, "jrel", sIN_CSEG, parm1}, /* always a number */
+ {64, "jsgeq", sIN_CSEG, do_jump},
+ {63, "jsgrtr", sIN_CSEG, do_jump},
+ {62, "jsleq", sIN_CSEG, do_jump},
+ {61, "jsless", sIN_CSEG, do_jump},
+ {51, "jump", sIN_CSEG, do_jump},
+ {128, "jump.pri", sIN_CSEG, parm0}, /* version 1 */
+ {53, "jzer", sIN_CSEG, do_jump},
+ {31, "lctrl", sIN_CSEG, parm1},
+ {98, "leq", sIN_CSEG, parm0},
+ {97, "less", sIN_CSEG, parm0},
+ {25, "lidx", sIN_CSEG, parm0},
+ {26, "lidx.b", sIN_CSEG, parm1},
+ {125, "line", sIN_CSEG, parm2},
+ {2, "load.alt", sIN_CSEG, parm1},
+ {9, "load.i", sIN_CSEG, parm0},
+ {1, "load.pri", sIN_CSEG, parm1},
+ {4, "load.s.alt", sIN_CSEG, parm1},
+ {3, "load.s.pri", sIN_CSEG, parm1},
+ {10, "lodb.i", sIN_CSEG, parm1},
+ {6, "lref.alt", sIN_CSEG, parm1},
+ {5, "lref.pri", sIN_CSEG, parm1},
+ {8, "lref.s.alt", sIN_CSEG, parm1},
+ {7, "lref.s.pri", sIN_CSEG, parm1},
+ {34, "move.alt", sIN_CSEG, parm0},
+ {33, "move.pri", sIN_CSEG, parm0},
+ {117, "movs", sIN_CSEG, parm1},
+ {85, "neg", sIN_CSEG, parm0},
+ {96, "neq", sIN_CSEG, parm0},
+ {134, "nop", sIN_CSEG, parm0}, /* version 6 */
+ {84, "not", sIN_CSEG, parm0},
+ {82, "or", sIN_CSEG, parm0},
+ {43, "pop.alt", sIN_CSEG, parm0},
+ {42, "pop.pri", sIN_CSEG, parm0},
+ {46, "proc", sIN_CSEG, parm0},
+ {40, "push", sIN_CSEG, parm1},
+ {37, "push.alt", sIN_CSEG, parm0},
+ {39, "push.c", sIN_CSEG, parm1},
+ {36, "push.pri", sIN_CSEG, parm0},
+ {38, "push.r", sIN_CSEG, parm1},
+ {41, "push.s", sIN_CSEG, parm1},
+ {133, "pushaddr", sIN_CSEG, parm1}, /* version 4 */
+ {47, "ret", sIN_CSEG, parm0},
+ {48, "retn", sIN_CSEG, parm0},
+ {32, "sctrl", sIN_CSEG, parm1},
+ {73, "sdiv", sIN_CSEG, parm0},
+ {74, "sdiv.alt", sIN_CSEG, parm0},
+ {104, "sgeq", sIN_CSEG, parm0},
+ {103, "sgrtr", sIN_CSEG, parm0},
+ {65, "shl", sIN_CSEG, parm0},
+ {69, "shl.c.alt", sIN_CSEG, parm1},
+ {68, "shl.c.pri", sIN_CSEG, parm1},
+ {66, "shr", sIN_CSEG, parm0},
+ {71, "shr.c.alt", sIN_CSEG, parm1},
+ {70, "shr.c.pri", sIN_CSEG, parm1},
+ {94, "sign.alt", sIN_CSEG, parm0},
+ {93, "sign.pri", sIN_CSEG, parm0},
+ {102, "sleq", sIN_CSEG, parm0},
+ {101, "sless", sIN_CSEG, parm0},
+ {72, "smul", sIN_CSEG, parm0},
+ {88, "smul.c", sIN_CSEG, parm1},
+ {127, "srange", sIN_CSEG, parm2}, /* version 1 */
+ {20, "sref.alt", sIN_CSEG, parm1},
+ {19, "sref.pri", sIN_CSEG, parm1},
+ {22, "sref.s.alt", sIN_CSEG, parm1},
+ {21, "sref.s.pri", sIN_CSEG, parm1},
+ {67, "sshr", sIN_CSEG, parm0},
+ {44, "stack", sIN_CSEG, parm1},
+ {0, "stksize", 0, noop},
+ {16, "stor.alt", sIN_CSEG, parm1},
+ {23, "stor.i", sIN_CSEG, parm0},
+ {15, "stor.pri", sIN_CSEG, parm1},
+ {18, "stor.s.alt", sIN_CSEG, parm1},
+ {17, "stor.s.pri", sIN_CSEG, parm1},
+ {24, "strb.i", sIN_CSEG, parm1},
+ {79, "sub", sIN_CSEG, parm0},
+ {80, "sub.alt", sIN_CSEG, parm0},
+ {132, "swap.alt", sIN_CSEG, parm0}, /* version 4 */
+ {131, "swap.pri", sIN_CSEG, parm0}, /* version 4 */
+ {129, "switch", sIN_CSEG, do_switch}, /* version 1 */
+ {126, "symbol", sIN_CSEG, do_symbol},
+ {136, "symtag", sIN_CSEG, parm1}, /* version 7 */
+ {123, "sysreq.c", sIN_CSEG, parm1},
+ {135, "sysreq.d", sIN_CSEG, parm1}, /* version 7, not generated directly */
+ {122, "sysreq.pri", sIN_CSEG, parm0},
+ {76, "udiv", sIN_CSEG, parm0},
+ {77, "udiv.alt", sIN_CSEG, parm0},
+ {75, "umul", sIN_CSEG, parm0},
+ {35, "xchg", sIN_CSEG, parm0},
+ {83, "xor", sIN_CSEG, parm0},
+ {91, "zero", sIN_CSEG, parm1},
+ {90, "zero.alt", sIN_CSEG, parm0},
+ {89, "zero.pri", sIN_CSEG, parm0},
+ {92, "zero.s", sIN_CSEG, parm1},
+};
+
+#define MAX_INSTR_LEN 30
+static int
+findopcode(char *instr, int maxlen)
+{
+ int low, high, mid, cmp;
+ char str[MAX_INSTR_LEN];
+
+ if (maxlen >= MAX_INSTR_LEN)
+ return 0;
+ strncpy(str, instr, maxlen);
+ str[maxlen] = '\0'; /* make sure the string is zero terminated */
+ /* look up the instruction with a binary search
+ * the assembler is case insensitive to instructions (but case sensitive
+ * to symbols)
+ */
+ low = 1; /* entry 0 is reserved (for "not found") */
+ high = (sizeof opcodelist / sizeof opcodelist[0]) - 1;
+ while (low < high)
+ {
+ mid = (low + high) / 2;
+ assert(opcodelist[mid].name != NULL);
+ cmp = strcasecmp(str, opcodelist[mid].name);
+ if (cmp > 0)
+ low = mid + 1;
+ else
+ high = mid;
+ } /* while */
+
+ assert(low == high);
+ if (strcasecmp(str, opcodelist[low].name) == 0)
+ return low; /* found */
+ return 0; /* not found, return special index */
+}
+
+void
+assemble(FILE * fout, FILE * fin)
+{
+ typedef struct tagFUNCSTUB
+ {
+ unsigned int address, nameofs;
+ } FUNCSTUB;
+ AMX_HEADER hdr;
+ FUNCSTUB func;
+ int numpublics, numnatives, numlibraries, numpubvars,
+ numtags, padding;
+ long nametablesize, nameofs;
+ char line[256], *instr, *params;
+ int i, pass;
+ short count;
+ symbol *sym, **nativelist;
+ constvalue *constptr;
+ cell mainaddr;
+ int nametable, tags, libraries, publics, natives, pubvars;
+ int cod, defsize;
+
+#if !defined NDEBUG
+ /* verify that the opcode list is sorted (skip entry 1; it is reserved
+ * for a non-existent opcode)
+ */
+ assert(opcodelist[1].name != NULL);
+ for (i = 2; i < (int)(sizeof(opcodelist) / sizeof(opcodelist[0])); i++)
+ {
+ assert(opcodelist[i].name != NULL);
+ assert(strcasecmp(opcodelist[i].name, opcodelist[i - 1].name) > 0);
+ } /* for */
+#endif
+
+ writeerror = FALSE;
+ nametablesize = sizeof(short);
+ numpublics = 0;
+ numnatives = 0;
+ numpubvars = 0;
+ mainaddr = -1;
+ /* count number of public and native functions and public variables */
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ char alias[sNAMEMAX + 1] = "";
+ int match = 0;
+
+ if (sym->ident == iFUNCTN)
+ {
+ assert(strlen(sym->name) <= sNAMEMAX);
+ if ((sym->usage & uNATIVE) != 0 && (sym->usage & uREAD) != 0
+ && sym->addr >= 0)
+ {
+ match = ++numnatives;
+ if (!lookup_alias(alias, sym->name))
+ strcpy(alias, sym->name);
+ } /* if */
+ if ((sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+ {
+ match = ++numpublics;
+ strcpy(alias, sym->name);
+ } /* if */
+ if (strcmp(sym->name, uMAINFUNC) == 0)
+ {
+ assert(sym->vclass == sGLOBAL);
+ mainaddr = sym->addr;
+ } /* if */
+ }
+ else if (sym->ident == iVARIABLE)
+ {
+ if ((sym->usage & uPUBLIC) != 0)
+ {
+ match = ++numpubvars;
+ strcpy(alias, sym->name);
+ } /* if */
+ } /* if */
+ if (match)
+ {
+ assert(alias[0] != '\0');
+ nametablesize += strlen(alias) + 1;
+ } /* if */
+ } /* for */
+ assert(numnatives == ntv_funcid);
+
+ /* count number of libraries */
+ numlibraries = 0;
+ for (constptr = libname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if (constptr->value > 0)
+ {
+ assert(constptr->name[0] != '\0');
+ numlibraries++;
+ nametablesize += strlen(constptr->name) + 1;
+ } /* if */
+ } /* for */
+
+ /* count number of public tags */
+ numtags = 0;
+ for (constptr = tagname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if ((constptr->value & PUBLICTAG) != 0)
+ {
+ assert(constptr->name[0] != '\0');
+ numtags++;
+ nametablesize += strlen(constptr->name) + 1;
+ } /* if */
+ } /* for */
+
+ /* pad the header to sc_dataalign
+ * => thereby the code segment is aligned
+ * => since the code segment is padded to a sc_dataalign boundary, the data segment is aligned
+ * => and thereby the stack top is aligned too
+ */
+ assert(sc_dataalign != 0);
+ padding = sc_dataalign - (sizeof hdr + nametablesize) % sc_dataalign;
+ if (padding == sc_dataalign)
+ padding = 0;
+
+ /* write the abstract machine header */
+ memset(&hdr, 0, sizeof hdr);
+ hdr.magic = (unsigned short)0xF1E0;
+ hdr.file_version = CUR_FILE_VERSION;
+ hdr.amx_version = MIN_AMX_VERSION;
+ hdr.flags = (short)(sc_debug & sSYMBOLIC);
+ if (charbits == 16)
+ hdr.flags |= AMX_FLAG_CHAR16;
+ if (sc_compress)
+ hdr.flags |= AMX_FLAG_COMPACT;
+ if (sc_debug == 0)
+ hdr.flags |= AMX_FLAG_NOCHECKS;
+// #ifdef WORDS_BIGENDIAN
+// hdr.flags|=AMX_FLAG_BIGENDIAN;
+// #endif
+ defsize = hdr.defsize = sizeof(FUNCSTUB);
+ assert((hdr.defsize % sizeof(cell)) == 0);
+ publics = hdr.publics = sizeof hdr; /* public table starts right after the header */
+ natives = hdr.natives = hdr.publics + numpublics * sizeof(FUNCSTUB);
+ libraries = hdr.libraries = hdr.natives + numnatives * sizeof(FUNCSTUB);
+ pubvars = hdr.pubvars = hdr.libraries + numlibraries * sizeof(FUNCSTUB);
+ tags = hdr.tags = hdr.pubvars + numpubvars * sizeof(FUNCSTUB);
+ nametable = hdr.nametable = hdr.tags + numtags * sizeof(FUNCSTUB);
+ cod = hdr.cod = hdr.nametable + nametablesize + padding;
+ hdr.dat = hdr.cod + code_idx;
+ hdr.hea = hdr.dat + glb_declared * sizeof(cell);
+ hdr.stp = hdr.hea + sc_stksize * sizeof(cell);
+ hdr.cip = mainaddr;
+ hdr.size = hdr.hea; /* preset, this is incorrect in case of compressed output */
+#ifdef WORDS_BIGENDIAN
+ align32(&hdr.size);
+ align16(&hdr.magic);
+ align16(&hdr.flags);
+ align16(&hdr.defsize);
+ align32(&hdr.cod);
+ align32(&hdr.dat);
+ align32(&hdr.hea);
+ align32(&hdr.stp);
+ align32(&hdr.cip);
+ align32(&hdr.publics);
+ align32(&hdr.natives);
+ align32(&hdr.libraries);
+ align32(&hdr.pubvars);
+ align32(&hdr.tags);
+ align32(&hdr.nametable);
+#endif
+ sc_writebin(fout, &hdr, sizeof hdr);
+
+ /* dump zeros up to the rest of the header, so that we can easily "seek" */
+ for (nameofs = sizeof hdr; nameofs < cod; nameofs++)
+ putc(0, fout);
+ nameofs = nametable + sizeof(short);
+
+ /* write the public functions table */
+ count = 0;
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iFUNCTN
+ && (sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+ {
+ assert(sym->vclass == sGLOBAL);
+ func.address = sym->addr;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, publics + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+ nameofs += strlen(sym->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the natives table */
+ /* The native functions must be written in sorted order. (They are
+ * sorted on their "id", not on their name). A nested loop to find
+ * each successive function would be an O(n^2) operation. But we
+ * do not really need to sort, because the native function id's
+ * are sequential and there are no duplicates. So we first walk
+ * through the complete symbol list and store a pointer to every
+ * native function of interest in a temporary table, where its id
+ * serves as the index in the table. Now we can walk the table and
+ * have all native functions in sorted order.
+ */
+ if (numnatives > 0)
+ {
+ nativelist = (symbol **) malloc(numnatives * sizeof(symbol *));
+ if (!nativelist)
+ error(103); /* insufficient memory */
+#if !defined NDEBUG
+ memset(nativelist, 0, numnatives * sizeof(symbol *)); /* for NULL checking */
+#endif
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iFUNCTN && (sym->usage & uNATIVE) != 0
+ && (sym->usage & uREAD) != 0 && sym->addr >= 0)
+ {
+ assert(sym->addr < numnatives);
+ nativelist[(int)sym->addr] = sym;
+ } /* if */
+ } /* for */
+ count = 0;
+ for (i = 0; i < numnatives; i++)
+ {
+ char alias[sNAMEMAX + 1];
+
+ sym = nativelist[i];
+ assert(sym != NULL);
+ if (!lookup_alias(alias, sym->name))
+ {
+ assert(strlen(sym->name) <= sNAMEMAX);
+ strcpy(alias, sym->name);
+ } /* if */
+ assert(sym->vclass == sGLOBAL);
+ func.address = 0;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, natives + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, alias, strlen(alias) + 1);
+ nameofs += strlen(alias) + 1;
+ count++;
+ } /* for */
+ free(nativelist);
+ } /* if */
+
+ /* write the libraries table */
+ count = 0;
+ for (constptr = libname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if (constptr->value > 0)
+ {
+ assert(constptr->name[0] != '\0');
+ func.address = 0;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, libraries + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+ nameofs += strlen(constptr->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the public variables table */
+ count = 0;
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iVARIABLE && (sym->usage & uPUBLIC) != 0)
+ {
+ assert((sym->usage & uDEFINE) != 0);
+ assert(sym->vclass == sGLOBAL);
+ func.address = sym->addr;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, pubvars + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+ nameofs += strlen(sym->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the public tagnames table */
+ count = 0;
+ for (constptr = tagname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if ((constptr->value & PUBLICTAG) != 0)
+ {
+ assert(constptr->name[0] != '\0');
+ func.address = constptr->value & TAGMASK;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, tags + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+ nameofs += strlen(constptr->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the "maximum name length" field in the name table */
+ assert(nameofs == nametable + nametablesize);
+ fseek(fout, nametable, SEEK_SET);
+ count = sNAMEMAX;
+#ifdef WORDS_BIGENDIAN
+ align16(&count);
+#endif
+ sc_writebin(fout, &count, sizeof count);
+ fseek(fout, cod, SEEK_SET);
+
+ /* First pass: relocate all labels */
+ /* This pass is necessary because the code addresses of labels is only known
+ * after the peephole optimization flag. Labels can occur inside expressions
+ * (e.g. the conditional operator), which are optimized.
+ */
+ lbltab = NULL;
+ if (labnum > 0)
+ {
+ /* only very short programs have zero labels; no first pass is needed
+ * if there are no labels */
+ lbltab = (cell *) malloc(labnum * sizeof(cell));
+ if (!lbltab)
+ error(103); /* insufficient memory */
+ codeindex = 0;
+ sc_resetasm(fin);
+ while (sc_readasm(fin, line, sizeof line))
+ {
+ stripcomment(line);
+ instr = skipwhitespace(line);
+ /* ignore empty lines */
+ if (*instr == '\0')
+ continue;
+ if (tolower(*instr) == 'l' && *(instr + 1) == '.')
+ {
+ int lindex = (int)hex2long(instr + 2, NULL);
+
+ assert(lindex < labnum);
+ lbltab[lindex] = codeindex;
+ }
+ else
+ {
+ /* get to the end of the instruction (make use of the '\n' that fgets()
+ * added at the end of the line; this way we will *always* drop on a
+ * whitespace character) */
+ for (params = instr; *params != '\0' && !sc_isspace(*params);
+ params++)
+ /* nothing */ ;
+ assert(params > instr);
+ i = findopcode(instr, (int)(params - instr));
+ if (!opcodelist[i].name)
+ {
+ *params = '\0';
+ error(104, instr); /* invalid assembler instruction */
+ } /* if */
+ if (opcodelist[i].segment == sIN_CSEG)
+ codeindex +=
+ opcodelist[i].func(NULL, skipwhitespace(params),
+ opcodelist[i].opcode);
+ } /* if */
+ } /* while */
+ } /* if */
+
+ /* Second pass (actually 2 more passes, one for all code and one for all data) */
+ bytes_in = 0;
+ bytes_out = 0;
+ for (pass = sIN_CSEG; pass <= sIN_DSEG; pass++)
+ {
+ sc_resetasm(fin);
+ while (sc_readasm(fin, line, sizeof line))
+ {
+ stripcomment(line);
+ instr = skipwhitespace(line);
+ /* ignore empty lines and labels (labels have a special syntax, so these
+ * must be parsed separately) */
+ if (*instr == '\0' || (tolower(*instr) == 'l'
+ && *(instr + 1) == '.'))
+ continue;
+ /* get to the end of the instruction (make use of the '\n' that fgets()
+ * added at the end of the line; this way we will *always* drop on a
+ * whitespace character) */
+ for (params = instr; *params != '\0' && !sc_isspace(*params);
+ params++)
+ /* nothing */ ;
+ assert(params > instr);
+ i = findopcode(instr, (int)(params - instr));
+ assert(opcodelist[i].name != NULL);
+ if (opcodelist[i].segment == pass)
+ opcodelist[i].func(fout, skipwhitespace(params),
+ opcodelist[i].opcode);
+ } /* while */
+ } /* for */
+ if (bytes_out - bytes_in > 0)
+ error(106); /* compression buffer overflow */
+
+ if (lbltab)
+ {
+ free(lbltab);
+#if !defined NDEBUG
+ lbltab = NULL;
+#endif
+ } /* if */
+
+ if (writeerror)
+ error(101, "disk full");
+
+ /* adjust the header */
+ if (sc_compress)
+ {
+ hdr.size = sc_lengthbin(fout);
+#ifdef WORDS_BIGENDIAN
+ align32(&hdr.size);
+#endif
+ sc_resetbin(fout); /* "size" is the very first field */
+ sc_writebin(fout, &hdr.size, sizeof hdr.size);
+ } /* if */
+}
--- /dev/null
+/* Small compiler - Staging buffer and optimizer
+ *
+ * The staging buffer
+ * ------------------
+ * The staging buffer allows buffered output of generated code, deletion
+ * of redundant code, optimization by a tinkering process and reversing
+ * the ouput of evaluated expressions (which is used for the reversed
+ * evaluation of arguments in functions).
+ * Initially, stgwrite() writes to the file directly, but after a call to
+ * stgset(TRUE), output is redirected to the buffer. After a call to
+ * stgset(FALSE), stgwrite()'s output is directed to the file again. Thus
+ * only one routine is used for writing to the output, which can be
+ * buffered output or direct output.
+ *
+ * staging buffer variables: stgbuf - the buffer
+ * stgidx - current index in the staging buffer
+ * staging - if true, write to the staging buffer;
+ * if false, write to file directly.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h> /* for atoi() */
+#include <string.h>
+#include <ctype.h>
+
+#include "embryo_cc_sc.h"
+
+#if defined _MSC_VER
+#pragma warning(push)
+#pragma warning(disable:4125) /* decimal digit terminates octal escape sequence */
+#endif
+
+#include "embryo_cc_sc7.scp"
+
+#if defined _MSC_VER
+#pragma warning(pop)
+#endif
+
+static void stgstring(char *start, char *end);
+static void stgopt(char *start, char *end);
+
+#define sSTG_GROW 512
+#define sSTG_MAX 20480
+
+static char *stgbuf = NULL;
+static int stgmax = 0; /* current size of the staging buffer */
+
+#define CHECK_STGBUFFER(index) if ((int)(index)>=stgmax) grow_stgbuffer((index)+1)
+
+static void
+grow_stgbuffer(int requiredsize)
+{
+ char *p;
+ int clear = !stgbuf; /* if previously none, empty buffer explicitly */
+
+ assert(stgmax < requiredsize);
+ /* if the staging buffer (holding intermediate code for one line) grows
+ * over a few kBytes, there is probably a run-away expression
+ */
+ if (requiredsize > sSTG_MAX)
+ error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
+ stgmax = requiredsize + sSTG_GROW;
+ if (stgbuf)
+ p = (char *)realloc(stgbuf, stgmax * sizeof(char));
+ else
+ p = (char *)malloc(stgmax * sizeof(char));
+ if (!p)
+ error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
+ stgbuf = p;
+ if (clear)
+ *stgbuf = '\0';
+}
+
+void
+stgbuffer_cleanup(void)
+{
+ if (stgbuf)
+ {
+ free(stgbuf);
+ stgbuf = NULL;
+ stgmax = 0;
+ } /* if */
+}
+
+/* the variables "stgidx" and "staging" are declared in "scvars.c" */
+
+/* stgmark
+ *
+ * Copies a mark into the staging buffer. At this moment there are three
+ * possible marks:
+ * sSTARTREORDER identifies the beginning of a series of expression
+ * strings that must be written to the output file in
+ * reordered order
+ * sENDREORDER identifies the end of 'reverse evaluation'
+ * sEXPRSTART + idx only valid within a block that is evaluated in
+ * reordered order, it identifies the start of an
+ * expression; the "idx" value is the argument position
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (altered)
+ * staging (referred to only)
+ */
+void
+stgmark(char mark)
+{
+ if (staging)
+ {
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = mark;
+ } /* if */
+}
+
+static int
+filewrite(char *str)
+{
+ if (sc_status == statWRITE)
+ return sc_writeasm(outf, str);
+ return TRUE;
+}
+
+/* stgwrite
+ *
+ * Writes the string "st" to the staging buffer or to the output file. In the
+ * case of writing to the staging buffer, the terminating byte of zero is
+ * copied too, but... the optimizer can only work on complete lines (not on
+ * fractions of it. Therefore if the string is staged, if the last character
+ * written to the buffer is a '\0' and the previous-to-last is not a '\n',
+ * the string is concatenated to the last string in the buffer (the '\0' is
+ * overwritten). This also means an '\n' used in the middle of a string isn't
+ * recognized and could give wrong results with the optimizer.
+ * Even when writing to the output file directly, all strings are buffered
+ * until a whole line is complete.
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (altered)
+ * staging (referred to only)
+ */
+void
+stgwrite(char *st)
+{
+ int len;
+
+ CHECK_STGBUFFER(0);
+ if (staging)
+ {
+ if (stgidx >= 2 && stgbuf[stgidx - 1] == '\0'
+ && stgbuf[stgidx - 2] != '\n')
+ stgidx -= 1; /* overwrite last '\0' */
+ while (*st != '\0')
+ { /* copy to staging buffer */
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = *st++;
+ } /* while */
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = '\0';
+ }
+ else
+ {
+ CHECK_STGBUFFER(strlen(stgbuf) + strlen(st) + 1);
+ strcat(stgbuf, st);
+ len = strlen(stgbuf);
+ if (len > 0 && stgbuf[len - 1] == '\n')
+ {
+ filewrite(stgbuf);
+ stgbuf[0] = '\0';
+ } /* if */
+ } /* if */
+}
+
+/* stgout
+ *
+ * Writes the staging buffer to the output file via stgstring() (for
+ * reversing expressions in the buffer) and stgopt() (for optimizing). It
+ * resets "stgidx".
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (referred to only)
+ * staging (referred to only)
+ */
+void
+stgout(int index)
+{
+ if (!staging)
+ return;
+ stgstring(&stgbuf[index], &stgbuf[stgidx]);
+ stgidx = index;
+}
+
+typedef struct
+{
+ char *start, *end;
+} argstack;
+
+/* stgstring
+ *
+ * Analyses whether code strings should be output to the file as they appear
+ * in the staging buffer or whether portions of it should be re-ordered.
+ * Re-ordering takes place in function argument lists; Small passes arguments
+ * to functions from right to left. When arguments are "named" rather than
+ * positional, the order in the source stream is indeterminate.
+ * This function calls itself recursively in case it needs to re-order code
+ * strings, and it uses a private stack (or list) to mark the start and the
+ * end of expressions in their correct (reversed) order.
+ * In any case, stgstring() sends a block as large as possible to the
+ * optimizer stgopt().
+ *
+ * In "reorder" mode, each set of code strings must start with the token
+ * sEXPRSTART, even the first. If the token sSTARTREORDER is represented
+ * by '[', sENDREORDER by ']' and sEXPRSTART by '|' the following applies:
+ * '[]...' valid, but useless; no output
+ * '[|...] valid, but useless; only one string
+ * '[|...|...] valid and useful
+ * '[...|...] invalid, first string doesn't start with '|'
+ * '[|...|] invalid
+ */
+static void
+stgstring(char *start, char *end)
+{
+ char *ptr;
+ int nest, argc, arg;
+ argstack *stack;
+
+ while (start < end)
+ {
+ if (*start == sSTARTREORDER)
+ {
+ start += 1; /* skip token */
+ /* allocate a argstack with sMAXARGS items */
+ stack = (argstack *) malloc(sMAXARGS * sizeof(argstack));
+ if (!stack)
+ error(103); /* insufficient memory */
+ nest = 1; /* nesting counter */
+ argc = 0; /* argument counter */
+ arg = -1; /* argument index; no valid argument yet */
+ do
+ {
+ switch (*start)
+ {
+ case sSTARTREORDER:
+ nest++;
+ start++;
+ break;
+ case sENDREORDER:
+ nest--;
+ start++;
+ break;
+ default:
+ if ((*start & sEXPRSTART) == sEXPRSTART)
+ {
+ if (nest == 1)
+ {
+ if (arg >= 0)
+ stack[arg].end = start - 1; /* finish previous argument */
+ arg = (unsigned char)*start - sEXPRSTART;
+ stack[arg].start = start + 1;
+ if (arg >= argc)
+ argc = arg + 1;
+ } /* if */
+ start++;
+ }
+ else
+ {
+ start += strlen(start) + 1;
+ } /* if */
+ } /* switch */
+ }
+ while (nest); /* enddo */
+ if (arg >= 0)
+ stack[arg].end = start - 1; /* finish previous argument */
+ while (argc > 0)
+ {
+ argc--;
+ stgstring(stack[argc].start, stack[argc].end);
+ } /* while */
+ free(stack);
+ }
+ else
+ {
+ ptr = start;
+ while (ptr < end && *ptr != sSTARTREORDER)
+ ptr += strlen(ptr) + 1;
+ stgopt(start, ptr);
+ start = ptr;
+ } /* if */
+ } /* while */
+}
+
+/* stgdel
+ *
+ * Scraps code from the staging buffer by resetting "stgidx" to "index".
+ *
+ * Global references: stgidx (altered)
+ * staging (referred to only)
+ */
+void
+stgdel(int index, cell code_index)
+{
+ if (staging)
+ {
+ stgidx = index;
+ code_idx = code_index;
+ } /* if */
+}
+
+int
+stgget(int *index, cell * code_index)
+{
+ if (staging)
+ {
+ *index = stgidx;
+ *code_index = code_idx;
+ } /* if */
+ return staging;
+}
+
+/* stgset
+ *
+ * Sets staging on or off. If it's turned off, the staging buffer must be
+ * initialized to an empty string. If it's turned on, the routine makes sure
+ * the index ("stgidx") is set to 0 (it should already be 0).
+ *
+ * Global references: staging (altered)
+ * stgidx (altered)
+ * stgbuf (contents altered)
+ */
+void
+stgset(int onoff)
+{
+ staging = onoff;
+ if (staging)
+ {
+ assert(stgidx == 0);
+ stgidx = 0;
+ CHECK_STGBUFFER(stgidx);
+ /* write any contents that may be put in the buffer by stgwrite()
+ * when "staging" was 0
+ */
+ if (stgbuf[0] != '\0')
+ filewrite(stgbuf);
+ } /* if */
+ stgbuf[0] = '\0';
+}
+
+/* phopt_init
+ * Initialize all sequence strings of the peehole optimizer. The strings
+ * are embedded in the .EXE file in compressed format, here we expand
+ * them (and allocate memory for the sequences).
+ */
+static SEQUENCE *sequences;
+
+int
+phopt_init(void)
+{
+ int number, i, len;
+ char str[160];
+
+ /* count number of sequences */
+ for (number = 0; sequences_cmp[number].find; number++)
+ /* nothing */ ;
+ number++; /* include an item for the NULL terminator */
+
+ if (!(sequences = (SEQUENCE *)malloc(number * sizeof(SEQUENCE))))
+ return FALSE;
+
+ /* pre-initialize all to NULL (in case of failure) */
+ for (i = 0; i < number; i++)
+ {
+ sequences[i].find = NULL;
+ sequences[i].replace = NULL;
+ sequences[i].savesize = 0;
+ } /* for */
+
+ /* expand all strings */
+ for (i = 0; i < number - 1; i++)
+ {
+ len =
+ strexpand(str, (unsigned char *)sequences_cmp[i].find, sizeof str,
+ SCPACK_TABLE);
+ assert(len <= (int)(sizeof(str)));
+ assert(len == (int)(strlen(str) + 1));
+ sequences[i].find = (char *)malloc(len);
+ if (sequences[i].find)
+ strcpy(sequences[i].find, str);
+ len =
+ strexpand(str, (unsigned char *)sequences_cmp[i].replace, sizeof str,
+ SCPACK_TABLE);
+ assert(len <= (int)(sizeof(str)));
+ assert(len == (int)(strlen(str) + 1));
+ sequences[i].replace = (char *)malloc(len);
+ if (sequences[i].replace)
+ strcpy(sequences[i].replace, str);
+ sequences[i].savesize = sequences_cmp[i].savesize;
+ if (!sequences[i].find || !sequences[i].replace)
+ return phopt_cleanup();
+ } /* for */
+
+ return TRUE;
+}
+
+int
+phopt_cleanup(void)
+{
+ int i;
+
+ if (sequences)
+ {
+ i = 0;
+ while (sequences[i].find || sequences[i].replace)
+ {
+ if (sequences[i].find)
+ free(sequences[i].find);
+ if (sequences[i].replace)
+ free(sequences[i].replace);
+ i++;
+ } /* while */
+ free(sequences);
+ sequences = NULL;
+ } /* if */
+ return FALSE;
+}
+
+#define _maxoptvars 4
+#define _aliasmax 10 /* a 32-bit number can be represented in
+ * 9 decimal digits */
+
+static int
+matchsequence(char *start, char *end, char *pattern,
+ char symbols[_maxoptvars][_aliasmax + 1], int *match_length)
+{
+ int var, i;
+ char str[_aliasmax + 1];
+ char *start_org = start;
+
+ *match_length = 0;
+ for (var = 0; var < _maxoptvars; var++)
+ symbols[var][0] = '\0';
+
+ while (*start == '\t' || *start == ' ')
+ start++;
+ while (*pattern)
+ {
+ if (start >= end)
+ return FALSE;
+ switch (*pattern)
+ {
+ case '%': /* new "symbol" */
+ pattern++;
+ assert(sc_isdigit(*pattern));
+ var = atoi(pattern) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(alphanum(*start));
+ for (i = 0; start < end && alphanum(*start); i++, start++)
+ {
+ assert(i <= _aliasmax);
+ str[i] = *start;
+ } /* for */
+ str[i] = '\0';
+ if (symbols[var][0] != '\0')
+ {
+ if (strcmp(symbols[var], str) != 0)
+ return FALSE; /* symbols should be identical */
+ }
+ else
+ {
+ strcpy(symbols[var], str);
+ } /* if */
+ break;
+ case ' ':
+ if (*start != '\t' && *start != ' ')
+ return FALSE;
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++;
+ break;
+ case '!':
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++; /* skip trailing white space */
+ if (*start != '\n')
+ return FALSE;
+ assert(*(start + 1) == '\0');
+ start += 2; /* skip '\n' and '\0' */
+ if (*(pattern + 1) != '\0')
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++; /* skip leading white space of next instruction */
+ break;
+ default:
+ if (tolower(*start) != tolower(*pattern))
+ return FALSE;
+ start++;
+ } /* switch */
+ pattern++;
+ } /* while */
+
+ *match_length = (int)(start - start_org);
+ return TRUE;
+}
+
+static char *
+replacesequence(char *pattern, char symbols[_maxoptvars][_aliasmax + 1],
+ int *repl_length)
+{
+ char *lptr;
+ int var;
+ char *buffer;
+
+ /* calculate the length of the new buffer
+ * this is the length of the pattern plus the length of all symbols (note
+ * that the same symbol may occur multiple times in the pattern) plus
+ * line endings and startings ('\t' to start a line and '\n\0' to end one)
+ */
+ assert(repl_length != NULL);
+ *repl_length = 0;
+ lptr = pattern;
+ while (*lptr)
+ {
+ switch (*lptr)
+ {
+ case '%':
+ lptr++; /* skip '%' */
+ assert(sc_isdigit(*lptr));
+ var = atoi(lptr) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(symbols[var][0] != '\0'); /* variable should be defined */
+ *repl_length += strlen(symbols[var]);
+ break;
+ case '!':
+ *repl_length += 3; /* '\t', '\n' & '\0' */
+ break;
+ default:
+ *repl_length += 1;
+ } /* switch */
+ lptr++;
+ } /* while */
+
+ /* allocate a buffer to replace the sequence in */
+ if (!(buffer = malloc(*repl_length)))
+ {
+ error(103);
+ return NULL;
+ }
+
+ /* replace the pattern into this temporary buffer */
+ lptr = buffer;
+ *lptr++ = '\t'; /* the "replace" patterns do not have tabs */
+ while (*pattern)
+ {
+ assert((int)(lptr - buffer) < *repl_length);
+ switch (*pattern)
+ {
+ case '%':
+ /* write out the symbol */
+ pattern++;
+ assert(sc_isdigit(*pattern));
+ var = atoi(pattern) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(symbols[var][0] != '\0'); /* variable should be defined */
+ strcpy(lptr, symbols[var]);
+ lptr += strlen(symbols[var]);
+ break;
+ case '!':
+ /* finish the line, optionally start the next line with an indent */
+ *lptr++ = '\n';
+ *lptr++ = '\0';
+ if (*(pattern + 1) != '\0')
+ *lptr++ = '\t';
+ break;
+ default:
+ *lptr++ = *pattern;
+ } /* switch */
+ pattern++;
+ } /* while */
+
+ assert((int)(lptr - buffer) == *repl_length);
+ return buffer;
+}
+
+static void
+strreplace(char *dest, char *replace, int sub_length, int repl_length,
+ int dest_length)
+{
+ int offset = sub_length - repl_length;
+
+ if (offset > 0) /* delete a section */
+ memmove(dest, dest + offset, dest_length - offset);
+ else if (offset < 0) /* insert a section */
+ memmove(dest - offset, dest, dest_length);
+ memcpy(dest, replace, repl_length);
+}
+
+/* stgopt
+ *
+ * Optimizes the staging buffer by checking for series of instructions that
+ * can be coded more compact. The routine expects the lines in the staging
+ * buffer to be separated with '\n' and '\0' characters.
+ *
+ * The longest sequences must be checked first.
+ */
+
+static void
+stgopt(char *start, char *end)
+{
+ char symbols[_maxoptvars][_aliasmax + 1];
+ int seq, match_length, repl_length;
+
+ assert(sequences != NULL);
+ while (start < end)
+ {
+ if ((sc_debug & sNOOPTIMIZE) != 0 || sc_status != statWRITE)
+ {
+ /* do not match anything if debug-level is maximum */
+ filewrite(start);
+ }
+ else
+ {
+ seq = 0;
+ while (sequences[seq].find)
+ {
+ assert(seq >= 0);
+ if (matchsequence
+ (start, end, sequences[seq].find, symbols, &match_length))
+ {
+ char *replace =
+ replacesequence(sequences[seq].replace, symbols,
+ &repl_length);
+ /* If the replacement is bigger than the original section, we may need
+ * to "grow" the staging buffer. This is quite complex, due to the
+ * re-ordering of expressions that can also happen in the staging
+ * buffer. In addition, it should not happen: the peephole optimizer
+ * must replace sequences with *shorter* sequences, not longer ones.
+ * So, I simply forbid sequences that are longer than the ones they
+ * are meant to replace.
+ */
+ assert(match_length >= repl_length);
+ if (match_length >= repl_length)
+ {
+ strreplace(start, replace, match_length,
+ repl_length, (int)(end - start));
+ end -= match_length - repl_length;
+ free(replace);
+ code_idx -= sequences[seq].savesize;
+ seq = 0; /* restart search for matches */
+ }
+ else
+ {
+ /* actually, we should never get here (match_length<repl_length) */
+ assert(0);
+ seq++;
+ } /* if */
+ }
+ else
+ {
+ seq++;
+ } /* if */
+ } /* while */
+ assert(sequences[seq].find == NULL);
+ filewrite(start);
+ } /* if */
+ assert(start < end);
+ start += strlen(start) + 1; /* to next string */
+ } /* while (start<end) */
+}
+
+#undef SCPACK_TABLE
--- /dev/null
+/* Small compiler - Peephole optimizer "sequences" strings (plain
+ * and compressed formats)
+ *
+ * Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+int strexpand(char *dest, unsigned char *source, int maxlen,
+ unsigned char pairtable[128][2]);
+
+#define SCPACK_TERMINATOR , /* end each section with a comma */
+
+#define SCPACK_TABLE sequences_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char sequences_table[][2] = {
+ {32, 37}, {114, 105}, {112, 129}, {46, 130}, {49, 33}, {128, 132}, {97, 100},
+ {46, 97}, {135, 108}, {136, 116}, {111, 134}, {108, 138}, {50, 33}, {115,
+ 104},
+ {128, 140}, {137, 33},
+ {46, 115}, {117, 141}, {112, 145}, {131, 133}, {139, 144}, {112, 143}, {131,
+ 142},
+ {115, 116}, {111, 149}, {112, 152}, {131, 33}, {134, 100}, {110, 151},
+ {111, 156}, {99, 157}, {59, 36},
+ {146, 154}, {148, 150}, {112, 33}, {120, 162}, {101, 163}, {159, 164}, {137,
+ 133},
+ {46, 99}, {122, 101}, {110, 100}, {155, 114}, {101, 113}, {168, 114},
+ {147, 160}, {51, 33}, {128, 174},
+ {103, 33}, {133, 165}, {104, 176}, {99, 178}, {120, 179}, {171, 33}, {106,
+ 172},
+ {173, 161}, {155, 33}, {108, 167}, {117, 169}, {115, 175}, {186, 187},
+ {153, 184}, {141, 185}, {111, 188},
+ {98, 191}, {105, 100}, {115, 103}, {115, 108}, {193, 120}, {182, 133}, {114,
+ 33},
+ {166, 161}, {190, 131}, {137, 142}, {169, 33}, {97, 202}, {139, 147},
+ {172, 111}, {158, 147}, {139, 150},
+ {105, 33}, {101, 115}, {209, 115}, {114, 116}, {148, 147}, {171, 133}, {189,
+ 139},
+ {32, 140}, {146, 167}, {196, 170}, {158, 183}, {170, 183}, {199, 192},
+ {108, 196}, {97, 198}, {194, 211},
+ {46, 208}, {195, 210}, {200, 215}, {112, 222}, {159, 227}, {46, 98}, {118,
+ 101},
+ {111, 230}, {109, 231}, {146, 143}, {99, 144}, {158, 150}, {97, 149},
+ {203, 153}, {52, 33}, {225, 33},
+ {158, 166}, {194, 181}, {195, 181}, {201, 180}, {223, 198}, {153, 203}, {214,
+ 224},
+ {100, 101}, {128, 238}, {119, 236}, {249, 237}, {105, 110}, {115, 250},
+ {232, 143}, {205, 154}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+#define seqsize(o,p) (opcodes(o)+opargs(p))
+typedef struct
+{
+ char *find;
+ char *replace;
+ int savesize; /* number of bytes saved (in bytecode) */
+} SEQUENCE;
+static SEQUENCE sequences_cmp[] = {
+ /* A very common sequence in four varieties
+ * load.s.pri n1 load.s.pri n2
+ * push.pri load.s.alt n1
+ * load.s.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.pri n1 load.s.pri n2
+ * push.pri load.alt n1
+ * load.s.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.s.pri n1 load.pri n2
+ * push.pri load.s.alt n1
+ * load.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.pri n1 load.pri n2
+ * push.pri load.alt n1
+ * load.pri n2 -
+ * pop.alt -
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!load.s.alt %1!",
+#else
+ "\224\267\231",
+ "\241\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!load.alt %1!",
+#else
+ "\213\267\231",
+ "\241\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!load.s.alt %1!",
+#else
+ "\224\255\317\231",
+ "\317\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!load.alt %1!",
+#else
+ "\213\255\317\231",
+ "\317\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* (#1#) The above also occurs with "addr.pri" (array
+ * indexing) as the first line; so that adds 2 cases.
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "addr.alt %1!load.s.pri %2!",
+#else
+ "\333\231",
+ "\252\307",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.pri %2!pop.alt!",
+ "addr.alt %1!load.pri %2!",
+#else
+ "\252\255\317\231",
+ "\252\246\317",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* And the same sequence with const.pri as either the first
+ * or the second load instruction: four more cases.
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!const.alt %1!",
+#else
+ "\332\231",
+ "\241\360",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!const.alt %1!",
+#else
+ "\236\255\317\231",
+ "\317\360",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!const.pri %2!pop.alt!",
+ "const.pri %2!load.s.alt %1!",
+#else
+ "\224\255\353\231",
+ "\353\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!const.pri %2!pop.alt!",
+ "const.pri %2!load.alt %1!",
+#else
+ "\213\255\353\231",
+ "\353\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* The same as above, but now with "addr.pri" (array
+ * indexing) on the first line and const.pri on
+ * the second.
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!const.pri %2!pop.alt!",
+ "addr.alt %1!const.pri %2!",
+#else
+ "\252\255\353\231",
+ "\252\246\353",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* ??? add references */
+ /* Chained relational operators can contain sequences like:
+ * move.pri load.s.pri n1
+ * push.pri -
+ * load.s.pri n1 -
+ * pop.alt -
+ * The above also accurs for "load.pri" and for "const.pri",
+ * so add another two cases.
+ */
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!load.s.pri %1!pop.alt!",
+ "load.s.pri %1!",
+#else
+ "\350\232\240\324\231",
+ "\324",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!load.pri %1!pop.alt!",
+ "load.pri %1!",
+#else
+ "\350\232\240\314\231",
+ "\314",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!const.pri %1!pop.alt!",
+ "const.pri %1!",
+#else
+ "\350\232\240\316\231",
+ "\316",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ /* More optimizations for chained relational operators; the
+ * continuation sequences can be simplified if they turn out
+ * to be termination sequences:
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr pop.alt
+ * swap.alt and
+ * and ;$exp
+ * pop.alt -
+ * ;$exp -
+ * --------------------------------------
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr pop.alt
+ * swap.alt and
+ * and jzer n1
+ * pop.alt -
+ * jzer n1 -
+ * --------------------------------------
+ * xchg jsgeq n1 also for sless, sgeq and sleq
+ * sgrtr ;$exp (occurs for non-chained comparisons)
+ * jzer n1 -
+ * ;$exp -
+ * --------------------------------------
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr ;$exp (occurs for non-chained comparisons)
+ * ;$exp -
+ */
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!swap.alt!and!pop.alt!;$exp!",
+ "sless!pop.alt!and!;$exp!",
+#else
+ "\264\364\374\245",
+ "\357\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!swap.alt!and!pop.alt!;$exp!",
+ "sgrtr!pop.alt!and!;$exp!",
+#else
+ "\264\357\374\245",
+ "\364\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!swap.alt!and!pop.alt!;$exp!",
+ "sleq!pop.alt!and!;$exp!",
+#else
+ "\264\361\374\245",
+ "\362\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!swap.alt!and!pop.alt!;$exp!",
+ "sgeq!pop.alt!and!;$exp!",
+#else
+ "\264\362\374\245",
+ "\361\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!swap.alt!and!pop.alt!jzer %1!",
+ "sless!pop.alt!and!jzer %1!",
+#else
+ "\264\364\374\305",
+ "\357\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!swap.alt!and!pop.alt!jzer %1!",
+ "sgrtr!pop.alt!and!jzer %1!",
+#else
+ "\264\357\374\305",
+ "\364\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!swap.alt!and!pop.alt!jzer %1!",
+ "sleq!pop.alt!and!jzer %1!",
+#else
+ "\264\361\374\305",
+ "\362\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!swap.alt!and!pop.alt!jzer %1!",
+ "sgeq!pop.alt!and!jzer %1!",
+#else
+ "\264\362\374\305",
+ "\361\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!jzer %1!;$exp!",
+ "jsgeq %1!;$exp!",
+#else
+ "\264\364\266\261",
+ "j\302\253\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sless!jzer %1!;$exp!",
+ "jsleq %1!;$exp!",
+#else
+ "\264\357\266\261",
+ "j\303\253\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!jzer %1!;$exp!",
+ "jsgrtr %1!;$exp!",
+#else
+ "\264\361\266\261",
+ "j\337r\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!jzer %1!;$exp!",
+ "jsless %1!;$exp!",
+#else
+ "\264\362\266\261",
+ "j\341\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!;$exp!",
+ "sless!;$exp!",
+#else
+ "\264\364\245",
+ "\357\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!;$exp!",
+ "sgrtr!;$exp!",
+#else
+ "\264\357\245",
+ "\364\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!;$exp!",
+ "sleq!;$exp!",
+#else
+ "\264\361\245",
+ "\362\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!;$exp!",
+ "sgeq!;$exp!",
+#else
+ "\264\362\245",
+ "\361\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* The entry to chained operators is also opt to optimization
+ * load.s.pri n1 load.s.pri n2
+ * load.s.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * load.s.pri n1 load.pri n2
+ * load.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * load.s.pri n1 const.pri n2
+ * const.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * and all permutations...
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!load.s.alt %1!",
+#else
+ "\324\224\363",
+ "\241\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!load.alt %2!xchg!",
+ "load.pri %2!load.s.alt %1!",
+#else
+ "\324\213\363",
+ "\317\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!const.alt %2!xchg!",
+ "const.pri %2!load.s.alt %1!",
+#else
+ "\324\236\363",
+ "\353\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!load.alt %1!",
+#else
+ "\314\224\363",
+ "\241\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!xchg!",
+ "load.pri %2!load.alt %1!",
+#else
+ "\314\213\363",
+ "\317\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!xchg!",
+ "const.pri %2!load.alt %1!",
+#else
+ "\314\236\363",
+ "\353\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!const.alt %1!",
+#else
+ "\316\224\363",
+ "\241\360",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!xchg!",
+ "load.pri %2!const.alt %1!",
+#else
+ "\316\213\363",
+ "\317\360",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ /* Array indexing can merit from special instructions.
+ * Simple indexed array lookup can be optimized quite
+ * a bit.
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 lidx.b n4
+ * shl.c.pri n4 -
+ * pop.alt -
+ * add -
+ * load.i -
+ *
+ * And to prepare for storing a value in an array
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 idxaddr.b n4
+ * shl.c.pri n4 -
+ * pop.alt -
+ * add -
+ *
+ * Notes (additional cases):
+ * 1. instruction addr.pri can also be const.pri (for
+ * global arrays)
+ * 2. the bounds instruction can be absent
+ * 3. when "n4" (the shift value) is the 2 (with 32-bit cels), use the
+ * even more optimal instructions LIDX and IDDXADDR
+ *
+ * If the array index is more complex, one can only optimize
+ * the last four instructions:
+ * shl.c.pri n1 pop.alt
+ * pop.alt lidx.b n1
+ * add -
+ * loadi -
+ * --------------------------------------
+ * shl.c.pri n1 pop.alt
+ * pop.alt idxaddr.b n1
+ * add -
+ */
+#if !defined BIT16
+ /* loading from array, "cell" shifted */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+ "\333\300\342\366",
+ "\252\334\335!",
+#endif
+ seqsize(8, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+ "\332\300\342\366",
+ "\236\334\335!",
+#endif
+ seqsize(8, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!lidx!",
+#else
+ "\333\342\366",
+ "\252\307\335!",
+#endif
+ seqsize(7, 3) - seqsize(3, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!lidx!",
+#else
+ "\332\342\366",
+ "\236\307\335!",
+#endif
+ seqsize(7, 3) - seqsize(3, 2)},
+#endif
+ /* loading from array, not "cell" shifted */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+ "\333\300\310\370\366",
+ "\252\334\335\345\370",
+#endif
+ seqsize(8, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+ "\332\300\310\370\366",
+ "\236\334\335\345\370",
+#endif
+ seqsize(8, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+ "\333\310\257\366",
+ "\252\307\335\345\257",
+#endif
+ seqsize(7, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+ "\332\310\257\366",
+ "\236\307\335\345\257",
+#endif
+ seqsize(7, 3) - seqsize(3, 3)},
+#if !defined BIT16
+ /* array index calculation for storing a value, "cell" aligned */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+ "\333\300\342\275",
+ "\252\334\331!",
+#endif
+ seqsize(7, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+ "\332\300\342\275",
+ "\236\334\331!",
+#endif
+ seqsize(7, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!idxaddr!",
+#else
+ "\333\342\275",
+ "\252\307\331!",
+#endif
+ seqsize(6, 3) - seqsize(3, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!idxaddr!",
+#else
+ "\332\342\275",
+ "\236\307\331!",
+#endif
+ seqsize(6, 3) - seqsize(3, 2)},
+#endif
+ /* array index calculation for storing a value, not "cell" packed */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+ "\333\300\310\370\275",
+ "\252\334\331\345\370",
+#endif
+ seqsize(7, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+ "\332\300\310\370\275",
+ "\236\334\331\345\370",
+#endif
+ seqsize(7, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+ "\333\310\257\275",
+ "\252\307\331\345\257",
+#endif
+ seqsize(6, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+ "\332\310\257\275",
+ "\236\307\331\345\257",
+#endif
+ seqsize(6, 3) - seqsize(3, 3)},
+#if !defined BIT16
+ /* the shorter array indexing sequences, see above for comments */
+ {
+#ifdef SCPACK
+ "shl.c.pri 2!pop.alt!add!loadi!",
+ "pop.alt!lidx!",
+#else
+ "\342\326\320",
+ "\231\335!",
+#endif
+ seqsize(4, 1) - seqsize(2, 0)},
+ {
+#ifdef SCPACK
+ "shl.c.pri 2!pop.alt!add!",
+ "pop.alt!idxaddr!",
+#else
+ "\342\275",
+ "\231\331!",
+#endif
+ seqsize(3, 1) - seqsize(2, 0)},
+#endif
+ {
+#ifdef SCPACK
+ "shl.c.pri %1!pop.alt!add!loadi!",
+ "pop.alt!lidx.b %1!",
+#else
+ "\276\223\326\320",
+ "\231\335\345\205",
+#endif
+ seqsize(4, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "shl.c.pri %1!pop.alt!add!",
+ "pop.alt!idxaddr.b %1!",
+#else
+ "\276\223\275",
+ "\231\331\345\205",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ /* For packed arrays, there is another case (packed arrays
+ * do not take advantage of the LIDX or IDXADDR instructions).
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 -
+ * pop.alt -
+ *
+ * Notes (additional cases):
+ * 1. instruction addr.pri can also be const.pri (for
+ * global arrays)
+ * 2. the bounds instruction can be absent, but that
+ * case is already handled (see #1#)
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+ "addr.alt %1!load.s.pri %2!bounds %3!",
+#else
+ "\333\300\231",
+ "\252\334",
+#endif
+ seqsize(5, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+ "const.alt %1!load.s.pri %2!bounds %3!",
+#else
+ "\332\300\231",
+ "\236\334",
+#endif
+ seqsize(5, 3) - seqsize(3, 3)},
+ /* During a calculation, the intermediate result must sometimes
+ * be moved from PRI to ALT, like in:
+ * push.pri move.alt
+ * load.s.pri n1 load.s.pri n1
+ * pop.alt -
+ *
+ * The above also accurs for "load.pri" and for "const.pri",
+ * so add another two cases.
+ */
+ {
+#ifdef SCPACK
+ "push.pri!load.s.pri %1!pop.alt!",
+ "move.alt!load.s.pri %1!",
+#else
+ "\240\324\231",
+ "\375\324",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!load.pri %1!pop.alt!",
+ "move.alt!load.pri %1!",
+#else
+ "\240\314\231",
+ "\375\314",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!const.pri %1!pop.alt!",
+ "move.alt!const.pri %1!",
+#else
+ "\240\316\231",
+ "\375\316",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!zero.pri!pop.alt!",
+ "move.alt!zero.pri!",
+#else
+ "\240\376\231",
+ "\375\376",
+#endif
+ seqsize(3, 0) - seqsize(2, 0)},
+ /* saving PRI and then loading from its address
+ * occurs when indexing a multi-dimensional array
+ */
+ {
+#ifdef SCPACK
+ "push.pri!load.i!pop.alt!",
+ "move.alt!load.i!",
+#else
+ "\240\213\340\231",
+ "\375\213\340",
+#endif
+ seqsize(3, 0) - seqsize(2, 0)},
+ /* An even simpler PUSH/POP optimization (occurs in
+ * switch statements):
+ * push.pri move.alt
+ * pop.alt -
+ */
+ {
+#ifdef SCPACK
+ "push.pri!pop.alt!",
+ "move.alt!",
+#else
+ "\240\231",
+ "\375",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* And what to think of this PUSH/POP sequence, which occurs
+ * due to the support for user-defined assignment operator):
+ * push.alt -
+ * pop.alt -
+ */
+//???
+//{
+// #ifdef SCPACK
+// "push.alt!pop.alt!",
+// ";$", /* SCPACK cannot handle empty strings */
+// #else
+// "\225\237",
+// "\353",
+// #endif
+// seqsize(2,0) - seqsize(0,0)
+//},
+ /* Functions with many parameters with the same default
+ * value have sequences like:
+ * push.c n1 const.pri n1
+ * ;$par push.r.pri n2 ; where n2 is the number of pushes
+ * push.c n1 ;$par
+ * ;$par -
+ * push.c n1 -
+ * ;$par -
+ * etc. etc.
+ * The shortest matched sequence is 3, because a sequence of two can also be
+ * optimized as two "push.c n1" instructions.
+ * => this optimization does not work, because the argument re-ordering in
+ * a function call causes each argument to be optimized individually
+ */
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 5!;$par!",
+// #else
+// "\327\327\254",
+// "\352\221.r\2745!",
+// #endif
+// seqsize(10,5) - seqsize(2,2)
+//},
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 4!;$par!",
+// #else
+// "\327\327",
+// "\352\221.r\274\326",
+// #endif
+// seqsize(8,4) - seqsize(2,2)
+//},
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 3!;$par!",
+// #else
+// "\327\254",
+// "\352\221.r\274\247",
+// #endif
+// seqsize(6,3) - seqsize(2,2)
+//},
+ /* User-defined operators first load the operands into registers and
+ * then have them pushed onto the stack. This can give rise to sequences
+ * like:
+ * const.pri n1 push.c n1
+ * const.alt n2 push.c n2
+ * push.pri -
+ * push.alt -
+ * A similar sequence occurs with the two PUSH.pri/alt instructions inverted.
+ * The first, second, or both CONST.pri/alt instructions can also be
+ * LOAD.pri/alt.
+ * This gives 2 x 4 cases.
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!const.alt %2!push.pri!push.alt!",
+ "push.c %1!push.c %2!",
+#else
+ "\316\236\311\240\351",
+ "\330\205\330\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!const.alt %2!push.alt!push.pri!",
+ "push.c %2!push.c %1!",
+#else
+ "\316\236\311\351\240",
+ "\330\216\330\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!push.pri!push.alt!",
+ "push.c %1!push %2!",
+#else
+ "\316\213\311\240\351",
+ "\330\205\222\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!push.alt!push.pri!",
+ "push %2!push.c %1!",
+#else
+ "\316\213\311\351\240",
+ "\222\216\330\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!push.pri!push.alt!",
+ "push %1!push.c %2!",
+#else
+ "\314\236\311\240\351",
+ "\222\205\330\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!push.alt!push.pri!",
+ "push.c %2!push %1!",
+#else
+ "\314\236\311\351\240",
+ "\330\216\222\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!push.pri!push.alt!",
+ "push %1!push %2!",
+#else
+ "\314\213\311\240\351",
+ "\222\205\222\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!push.alt!push.pri!",
+ "push %2!push %1!",
+#else
+ "\314\213\311\351\240",
+ "\222\216\222\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* Function calls (parameters are passed on the stack)
+ * load.s.pri n1 push.s n1
+ * push.pri -
+ * --------------------------------------
+ * load.pri n1 push n1
+ * push.pri -
+ * --------------------------------------
+ * const.pri n1 push.c n1
+ * push.pri -
+ * --------------------------------------
+ * zero.pri push.c 0
+ * push.pri -
+ * --------------------------------------
+ * addr.pri n1 pushaddr n1
+ * push.pri -
+ *
+ * However, PRI must not be needed after this instruction
+ * if this shortcut is used. Check for the ;$par comment.
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!;$par!",
+ "push.s %1!;$par!",
+#else
+ "\224\255\344",
+ "\222\220\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!;$par!",
+ "push %1!;$par!",
+#else
+ "\213\255\344",
+ "\222\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!;$par!",
+ "push.c %1!;$par!",
+#else
+ "\236\255\344",
+ "\330\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!push.pri!;$par!",
+ "push.c 0!;$par!",
+#else
+ "\376\240\344",
+ "\330 0!\344",
+#endif
+ seqsize(2, 0) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!;$par!",
+ "pushaddr %1!;$par!",
+#else
+ "\252\255\344",
+ "\222\252\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* References with a default value generate new cells on the heap
+ * dynamically. That code often ends with:
+ * move.pri push.alt
+ * push.pri -
+ */
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!",
+ "push.alt!",
+#else
+ "\350\232\240",
+ "\351",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* Simple arithmetic operations on constants. Noteworthy is the
+ * subtraction of a constant, since it is converted to the addition
+ * of the inverse value.
+ * const.alt n1 add.c n1
+ * add -
+ * --------------------------------------
+ * const.alt n1 add.c -n1
+ * sub -
+ * --------------------------------------
+ * const.alt n1 smul.c n1
+ * smul -
+ * --------------------------------------
+ * const.alt n1 eq.c.pri n1
+ * eq -
+ */
+ {
+#ifdef SCPACK
+ "const.alt %1!add!",
+ "add.c %1!",
+#else
+ "\360\270",
+ "\233\247\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!sub!",
+ "add.c -%1!",
+#else
+ "\360sub!",
+ "\233\247 -%\204",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!smul!",
+ "smul.c %1!",
+#else
+ "\360smul!",
+ "smu\271\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!eq!",
+ "eq.c.pri %1!",
+#else
+ "\360\265",
+ "\253\247\223",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Some operations use the alternative subtraction operation --these
+ * can also be optimized.
+ * const.pri n1 load.s.pri n2
+ * load.s.alt n2 add.c -n1
+ * sub.alt -
+ * --------------------------------------
+ * const.pri n1 load.pri n2
+ * load.alt n2 add.c -n1
+ * sub.alt -
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!load.s.alt %2!sub.alt!",
+ "load.s.pri %2!add.c -%1!",
+#else
+ "\316\224\311sub\217",
+ "\241\233\247 -%\204",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!sub.alt!",
+ "load.pri %2!add.c -%1!",
+#else
+ "\316\213\311sub\217",
+ "\317\233\247 -%\204",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ /* Compare and jump
+ * eq jneq n1
+ * jzer n1 -
+ * --------------------------------------
+ * eq jeq n1
+ * jnz n1 -
+ * --------------------------------------
+ * neq jeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * neq jneq n1
+ * jnz n1 -
+ * Compares followed by jzer occur much more
+ * often than compares followed with jnz. So we
+ * take the easy route here.
+ * less jgeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * leq jgrtr n1
+ * jzer n1 -
+ * --------------------------------------
+ * grtr jleq n1
+ * jzer n1 -
+ * --------------------------------------
+ * geq jless n1
+ * jzer n1 -
+ * --------------------------------------
+ * sless jsgeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * sleq jsgrtr n1
+ * jzer n1 -
+ * --------------------------------------
+ * sgrtr jsleq n1
+ * jzer n1 -
+ * --------------------------------------
+ * sgeq jsless n1
+ * jzer n1 -
+ */
+ {
+#ifdef SCPACK
+ "eq!jzer %1!",
+ "jneq %1!",
+#else
+ "\265\305",
+ "jn\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "eq!jnz %1!",
+ "jeq %1!",
+#else
+ "\265jnz\205",
+ "j\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "neq!jzer %1!",
+ "jeq %1!",
+#else
+ "n\265\305",
+ "j\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "neq!jnz %1!",
+ "jneq %1!",
+#else
+ "n\265jnz\205",
+ "jn\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "less!jzer %1!",
+ "jgeq %1!",
+#else
+ "l\322!\305",
+ "jg\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "leq!jzer %1!",
+ "jgrtr %1!",
+#else
+ "l\265\305",
+ "jg\323r\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "grtr!jzer %1!",
+ "jleq %1!",
+#else
+ "g\323\306\305",
+ "jl\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "geq!jzer %1!",
+ "jless %1!",
+#else
+ "g\265\305",
+ "jl\322\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sless!jzer %1!",
+ "jsgeq %1!",
+#else
+ "\357\305",
+ "j\302\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sleq!jzer %1!",
+ "jsgrtr %1!",
+#else
+ "\362\305",
+ "j\337r\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sgrtr!jzer %1!",
+ "jsleq %1!",
+#else
+ "\364\305",
+ "j\303\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sgeq!jzer %1!",
+ "jsless %1!",
+#else
+ "\361\305",
+ "j\341\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Test for zero (common case, especially for strings)
+ * E.g. the test expression of: "for (i=0; str{i}!=0; ++i)"
+ *
+ * zero.alt jzer n1
+ * jeq n1 -
+ * --------------------------------------
+ * zero.alt jnz n1
+ * jneq n1 -
+ */
+ {
+#ifdef SCPACK
+ "zero.alt!jeq %1!",
+ "jzer %1!",
+#else
+ "\315\217j\325",
+ "\305",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.alt!jneq %1!",
+ "jnz %1!",
+#else
+ "\315\217jn\325",
+ "jnz\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Incrementing and decrementing leaves a value in
+ * in PRI which may not be used (for example, as the
+ * third expression in a "for" loop).
+ * inc n1 inc n1 ; ++n
+ * load.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * load.pri n1 inc n1 ; n++, e.g. "for (n=0; n<10; n++)"
+ * inc n1 ;$exp
+ * ;$exp -
+ * Plus the varieties for stack relative increments
+ * and decrements.
+ */
+ {
+#ifdef SCPACK
+ "inc %1!load.pri %1!;$exp!",
+ "inc %1!;$exp!",
+#else
+ "\373c\205\314\245",
+ "\373c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!inc %1!;$exp!",
+ "inc %1!;$exp!",
+#else
+ "\314\373c\261",
+ "\373c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "inc.s %1!load.s.pri %1!;$exp!",
+ "inc.s %1!;$exp!",
+#else
+ "\373\352\205\324\245",
+ "\373\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!inc.s %1!;$exp!",
+ "inc.s %1!;$exp!",
+#else
+ "\324\373\352\261",
+ "\373\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "dec %1!load.pri %1!;$exp!",
+ "dec %1!;$exp!",
+#else
+ "\367c\205\314\245",
+ "\367c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!dec %1!;$exp!",
+ "dec %1!;$exp!",
+#else
+ "\314\367c\261",
+ "\367c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "dec.s %1!load.s.pri %1!;$exp!",
+ "dec.s %1!;$exp!",
+#else
+ "\367\352\205\324\245",
+ "\367\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!dec.s %1!;$exp!",
+ "dec.s %1!;$exp!",
+#else
+ "\324\367\352\261",
+ "\367\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ /* ??? the same (increments and decrements) for references */
+ /* Loading the constant zero has a special opcode.
+ * When storing zero in memory, the value of PRI must not be later on.
+ * const.pri 0 zero n1
+ * stor.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * const.pri 0 zero.s n1
+ * stor.s.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * zero.pri zero n1
+ * stor.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * zero.pri zero.s n1
+ * stor.s.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * const.pri 0 zero.pri
+ * --------------------------------------
+ * const.alt 0 zero.alt
+ * The last two alternatives save more memory than they save
+ * time, but anyway...
+ */
+ {
+#ifdef SCPACK
+ "const.pri 0!stor.pri %1!;$exp!",
+ "zero %1!;$exp!",
+#else
+ "\236\203 0!\227or\223\245",
+ "\315\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri 0!stor.s.pri %1!;$exp!",
+ "zero.s %1!;$exp!",
+#else
+ "\236\203 0!\227or\220\223\245",
+ "\315\220\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!stor.pri %1!;$exp!",
+ "zero %1!;$exp!",
+#else
+ "\376\227or\223\245",
+ "\315\261",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!stor.s.pri %1!;$exp!",
+ "zero.s %1!;$exp!",
+#else
+ "\376\227or\220\223\245",
+ "\315\220\261",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri 0!",
+ "zero.pri!",
+#else
+ "\236\203 0!",
+ "\376",
+#endif
+ seqsize(1, 1) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "const.alt 0!",
+ "zero.alt!",
+#else
+ "\236\211 0!",
+ "\315\217",
+#endif
+ seqsize(1, 1) - seqsize(1, 0)},
+ /* ----- */
+ {NULL, NULL, 0}
+};
--- /dev/null
+/* expand.c -- Byte Pair Encoding decompression */
+/* Copyright 1996 Philip Gage */
+
+/* Byte Pair Compression appeared in the September 1997
+ * issue of C/C++ Users Journal. The original source code
+ * may still be found at the web site of the magazine
+ * (www.cuj.com).
+ *
+ * The decompressor has been modified by me (Thiadmer
+ * Riemersma) to accept a string as input, instead of a
+ * complete file.
+ */
+
+
+#include "embryo_cc_sc.h"
+
+#define STACKSIZE 16
+
+int
+strexpand(char *dest, unsigned char *source, int maxlen, unsigned char pairtable[128][2])
+{
+ unsigned char stack[STACKSIZE];
+ short c, top = 0;
+ int len;
+
+ len = 1; /* already 1 byte for '\0' */
+ for (;;)
+ {
+ /* Pop byte from stack or read byte from the input string */
+ if (top)
+ c = stack[--top];
+ else if ((c = *(unsigned char *)source++) == '\0')
+ break;
+
+ /* Push pair on stack or output byte to the output string */
+ if (c > 127)
+ {
+ stack[top++] = pairtable[c - 128][1];
+ stack[top++] = pairtable[c - 128][0];
+ }
+ else
+ {
+ len++;
+ if (maxlen > 1)
+ {
+ *dest++ = (char)c;
+ maxlen--;
+ }
+ }
+ }
+ *dest = '\0';
+ return len;
+}
--- /dev/null
+/* Small compiler - maintenance of various lists
+ *
+ * Name list (aliases)
+ * Include path list
+ *
+ * Copyright (c) ITB CompuPhase, 2001-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+#include "embryo_cc_sc.h"
+
+static stringpair *
+insert_stringpair(stringpair * root, char *first, char *second, int matchlength)
+{
+ stringpair *cur, *pred;
+
+ assert(root != NULL);
+ assert(first != NULL);
+ assert(second != NULL);
+ /* create a new node, and check whether all is okay */
+ if (!(cur = (stringpair *)malloc(sizeof(stringpair))))
+ return NULL;
+ cur->first = strdup(first);
+ cur->second = strdup(second);
+ cur->matchlength = matchlength;
+ if (!cur->first || !cur->second)
+ {
+ if (cur->first)
+ free(cur->first);
+ if (cur->second)
+ free(cur->second);
+ free(cur);
+ return NULL;
+ } /* if */
+ /* link the node to the tree, find the position */
+ for (pred = root; pred->next && strcmp(pred->next->first, first) < 0;
+ pred = pred->next)
+ /* nothing */ ;
+ cur->next = pred->next;
+ pred->next = cur;
+ return cur;
+}
+
+static void
+delete_stringpairtable(stringpair * root)
+{
+ stringpair *cur, *next;
+
+ assert(root != NULL);
+ cur = root->next;
+ while (cur)
+ {
+ next = cur->next;
+ assert(cur->first != NULL);
+ assert(cur->second != NULL);
+ free(cur->first);
+ free(cur->second);
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(root, 0, sizeof(stringpair));
+}
+
+static stringpair *
+find_stringpair(stringpair * cur, char *first, int matchlength)
+{
+ int result = 0;
+
+ assert(matchlength > 0); /* the function cannot handle zero-length comparison */
+ assert(first != NULL);
+ while (cur && result <= 0)
+ {
+ result = (int)*cur->first - (int)*first;
+ if (result == 0 && matchlength == cur->matchlength)
+ {
+ result = strncmp(cur->first, first, matchlength);
+ if (result == 0)
+ return cur;
+ } /* if */
+ cur = cur->next;
+ } /* while */
+ return NULL;
+}
+
+static int
+delete_stringpair(stringpair * root, stringpair * item)
+{
+ stringpair *cur;
+
+ assert(root != NULL);
+ cur = root;
+ while (cur->next)
+ {
+ if (cur->next == item)
+ {
+ cur->next = item->next; /* unlink from list */
+ assert(item->first != NULL);
+ assert(item->second != NULL);
+ free(item->first);
+ free(item->second);
+ free(item);
+ return TRUE;
+ } /* if */
+ cur = cur->next;
+ } /* while */
+ return FALSE;
+}
+
+/* ----- alias table --------------------------------------------- */
+static stringpair alias_tab = { NULL, NULL, NULL, 0 }; /* alias table */
+
+stringpair *
+insert_alias(char *name, char *alias)
+{
+ stringpair *cur;
+
+ assert(name != NULL);
+ assert(strlen(name) <= sNAMEMAX);
+ assert(alias != NULL);
+ assert(strlen(alias) <= sEXPMAX);
+ if (!(cur = insert_stringpair(&alias_tab, name, alias, strlen(name))))
+ error(103); /* insufficient memory (fatal error) */
+ return cur;
+}
+
+int
+lookup_alias(char *target, char *name)
+{
+ stringpair *cur =
+ find_stringpair(alias_tab.next, name, strlen(name));
+ if (cur)
+ {
+ assert(strlen(cur->second) <= sEXPMAX);
+ strcpy(target, cur->second);
+ } /* if */
+ return !!cur;
+}
+
+void
+delete_aliastable(void)
+{
+ delete_stringpairtable(&alias_tab);
+}
+
+/* ----- include paths list -------------------------------------- */
+static stringlist includepaths = { NULL, NULL }; /* directory list for include files */
+
+stringlist *
+insert_path(char *path)
+{
+ stringlist *cur;
+
+ assert(path != NULL);
+ if (!(cur = (stringlist *)malloc(sizeof(stringlist))))
+ error(103); /* insufficient memory (fatal error) */
+ if (!(cur->line = strdup(path)))
+ error(103); /* insufficient memory (fatal error) */
+ cur->next = includepaths.next;
+ includepaths.next = cur;
+ return cur;
+}
+
+char *
+get_path(int index)
+{
+ stringlist *cur = includepaths.next;
+
+ while (cur && index-- > 0)
+ cur = cur->next;
+ if (cur)
+ {
+ assert(cur->line != NULL);
+ return cur->line;
+ } /* if */
+ return NULL;
+}
+
+void
+delete_pathtable(void)
+{
+ stringlist *cur = includepaths.next, *next;
+
+ while (cur)
+ {
+ next = cur->next;
+ assert(cur->line != NULL);
+ free(cur->line);
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(&includepaths, 0, sizeof(stringlist));
+}
+
+/* ----- text substitution patterns ------------------------------ */
+
+static stringpair substpair = { NULL, NULL, NULL, 0 }; /* list of substitution pairs */
+static stringpair *substindex['z' - 'A' + 1]; /* quick index to first character */
+
+static void
+adjustindex(char c)
+{
+ stringpair *cur;
+
+ assert((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_');
+ assert('A' < '_' && '_' < 'z');
+
+ for (cur = substpair.next; cur && cur->first[0] != c;
+ cur = cur->next)
+ /* nothing */ ;
+ substindex[(int)c - 'A'] = cur;
+}
+
+stringpair *
+insert_subst(char *pattern, char *substitution, int prefixlen)
+{
+ stringpair *cur;
+
+ assert(pattern != NULL);
+ assert(substitution != NULL);
+ if (!(cur = insert_stringpair(&substpair, pattern, substitution, prefixlen)))
+ error(103); /* insufficient memory (fatal error) */
+ adjustindex(*pattern);
+ return cur;
+}
+
+stringpair *
+find_subst(char *name, int length)
+{
+ stringpair *item;
+
+ assert(name != NULL);
+ assert(length > 0);
+ assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+ || *name == '_');
+ item = substindex[(int)*name - 'A'];
+ if (item)
+ item = find_stringpair(item, name, length);
+ return item;
+}
+
+int
+delete_subst(char *name, int length)
+{
+ stringpair *item;
+
+ assert(name != NULL);
+ assert(length > 0);
+ assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+ || *name == '_');
+ item = substindex[(int)*name - 'A'];
+ if (item)
+ item = find_stringpair(item, name, length);
+ if (!item)
+ return FALSE;
+ delete_stringpair(&substpair, item);
+ adjustindex(*name);
+ return TRUE;
+}
+
+void
+delete_substtable(void)
+{
+ int i;
+
+ delete_stringpairtable(&substpair);
+ for (i = 0; i < (int)(sizeof(substindex) / sizeof(substindex[0])); i++)
+ substindex[i] = NULL;
+}
--- /dev/null
+/* Small compiler
+ *
+ * Global (cross-module) variables.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h> /* for PATH_MAX */
+#endif
+
+#include "embryo_cc_sc.h"
+
+/* global variables
+ *
+ * All global variables that are shared amongst the compiler files are
+ * declared here.
+ */
+symbol loctab; /* local symbol table */
+symbol glbtab; /* global symbol table */
+cell *litq; /* the literal queue */
+char pline[sLINEMAX + 1]; /* the line read from the input file */
+char *lptr; /* points to the current position in "pline" */
+constvalue tagname_tab = { NULL, "", 0, 0 }; /* tagname table */
+constvalue libname_tab = { NULL, "", 0, 0 }; /* library table (#pragma library "..." syntax) */
+constvalue *curlibrary = NULL; /* current library */
+symbol *curfunc; /* pointer to current function */
+char *inpfname; /* pointer to name of the file currently read from */
+char outfname[PATH_MAX]; /* output file name */
+char sc_ctrlchar = CTRL_CHAR; /* the control character (or escape character) */
+int litidx = 0; /* index to literal table */
+int litmax = sDEF_LITMAX; /* current size of the literal table */
+int stgidx = 0; /* index to the staging buffer */
+int labnum = 0; /* number of (internal) labels */
+int staging = 0; /* true if staging output */
+cell declared = 0; /* number of local cells declared */
+cell glb_declared = 0; /* number of global cells declared */
+cell code_idx = 0; /* number of bytes with generated code */
+int ntv_funcid = 0; /* incremental number of native function */
+int errnum = 0; /* number of errors */
+int warnnum = 0; /* number of warnings */
+int sc_debug = sCHKBOUNDS; /* by default: bounds checking+assertions */
+int charbits = 8; /* a "char" is 8 bits */
+int sc_packstr = FALSE; /* strings are packed by default? */
+int sc_compress = TRUE; /* compress bytecode? */
+int sc_needsemicolon = TRUE; /* semicolon required to terminate expressions? */
+int sc_dataalign = sizeof(cell); /* data alignment value */
+int sc_alignnext = FALSE; /* must frame of the next function be aligned? */
+int curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
+cell sc_stksize = sDEF_AMXSTACK; /* default stack size */
+int freading = FALSE; /* Is there an input file ready for reading? */
+int fline = 0; /* the line number in the current file */
+int fnumber = 0; /* the file number in the file table (debugging) */
+int fcurrent = 0; /* current file being processed (debugging) */
+int intest = 0; /* true if inside a test */
+int sideeffect = 0; /* true if an expression causes a side-effect */
+int stmtindent = 0; /* current indent of the statement */
+int indent_nowarn = TRUE; /* skip warning "217 loose indentation" */
+int sc_tabsize = 8; /* number of spaces that a TAB represents */
+int sc_allowtags = TRUE; /* allow/detect tagnames in lex() */
+int sc_status; /* read/write status */
+int sc_rationaltag = 0; /* tag for rational numbers */
+int rational_digits = 0; /* number of fractional digits */
+
+FILE *inpf = NULL; /* file read from (source or include) */
+FILE *inpf_org = NULL; /* main source file */
+FILE *outf = NULL; /* file written to */
+
+jmp_buf errbuf;
--- /dev/null
+/**
+@brief Embryo Library
+
+These routines are used for Embryo.
+
+@mainpage Embryo Library Documentation
+
+@image html e_big.png
+
+@version 1.7.0
+@author Carsten Haitzler <raster\@rasterman.com>
+@author Compuphase http://www.compuphase.com
+@date 2004-2012
+
+@section intro What is Embryo?
+
+Embryo is a tiny library designed to interpret limited Small programs
+compiled by the included compiler, @c embryo_cc. It is mostly a cleaned
+up and smaller version of the original Small abstract machine. The
+compiler is mostly untouched.
+
+Small was renamed to Pawn.
+For more information about the Pawn language, see
+@htmlonly <a href=http://www.compuphase.com/pawn/pawn.htm>Pawn</a>
+@endhtmlonly
+@latexonly http://www.compuphase.com/pawn/pawn.htm @endlatexonly
+For the basics about the Small language, see @ref Small_Page.
+
+@section How_to_Use How to Use Embryo?
+
+To use Embryo in your code, you need to do at least the following:
+
+@li Include @ref Embryo.h.
+@li Load the Embryo program using one of the
+ @ref Embryo_Program_Creation_Group.
+@li Set up the native calls with @ref embryo_program_native_call_add.
+@li Create a virtual machine with @ref embryo_program_vm_push.
+@li Then run the program with @ref embryo_program_run.
+
+@todo Clean up compiler code.
+@todo Proper overview of the operation of the interpreter, that is how
+ the heap, stack, virtual machines, etc fit together.
+
+@page Small_Page Brief Introduction to Small
+
+This section describes the basics of Small, as compiled and interpreted
+with Embryo.
+
+This summary assumes that you are familar with C. For a full list of
+differences between C and Small, again, see the full documentation.
+
+@section Small_Variables_Section Variables
+
+@subsection Small_Type_Subsection Types
+
+There is only one type, known as the "cell", which can hold an integer.
+
+@subsection Small_Scope_Subsection Scope
+
+The scope and usage of a variable depends on its declaration.
+
+@li A local variable is normally declared with the @c new keyword. E.g.
+ @code new variable @endcode
+@li A static function variable is defined within a function with the
+ @c static keyword.
+@li A global static variable is one that is only available within the
+ file it was declared in. Again, use the @c static keyword, but outside
+ of any function.
+@li A stock variable is one that may not be compiled into a program if it
+ is not used. It is declared using @c stock.
+@li A public variable is one that can be read by the host program using
+ @ref embryo_program_variable_find. It is declared using @c public
+ keyword.
+
+Remember that the keywords above are to be used on their own. That is,
+for example: @code public testvar @endcode not:
+@code new public testvar @endcode
+
+@subsection Small_Constants_Subsection Constants
+
+You can declare constants in two ways:
+@li Using the preprocessor macro @c \#define.
+@li By inserting @c const between the keyword and variable name of a
+ variable declaration. For example, to declare the variable @c var1
+ constant, you type @code new const var1 = 2 @endcode Now @c var1
+ cannot be changed.
+
+@subsection Small_Arrays_Subsection Arrays
+
+To declare an array, append square brackets to the end of the variable
+name. The following examples show how to declare arrays. Note the
+use of the ellipsis operator, which bases the array based on the last two
+declared values:
+
+@code
+new msg[] = "A message."
+new ints[] = {1, 3, 4}
+new ints2[20] = {1, 3} // All other elements 0.
+new ints3[10] = {1, ... } // All elements = 1
+new ints4[10] = {10, 20, ... } // Elements = 10 -> 100.
+ // The difference can be negative.
+new ints5[3][3] = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
+@endcode
+
+@note Array initialisers need to be constant.
+
+@section Small_Func_Calls_Section Function Calls
+
+A typical function declaration is as follows:
+
+@code
+testfunc(param) {
+ // Do something ...
+ // over a couple of lines.
+}
+@endcode
+
+You can pass by reference. That is, the parameter you pass is changed
+outside of the function. For example:
+
+@code
+testfunc(¶m) {
+ param = 10
+ // The passed variable will be set to 10 outside of the function.
+}
+@endcode
+
+To pass an array:
+
+@code
+testfunc(param[]) {
+ // Do something to the array
+}
+@endcode
+
+@note Arrays are passed by reference.
+
+@section Small_Control_Subsection Control Structures.
+
+Small has the following control structures, which similar to their C
+counterparts:
+@li @code if (expression) statement1 else statement2 @endcode
+@li @code switch (expression) {
+ case 0:
+ statement1 // Can only be one statement. Look Ma, no breaks!
+ case 1..3: // For values between 1 and 3 inclusive.
+ statement2
+ default: // Optional
+ statement3
+}
+@endcode
+@li @code while(expression) statement @endcode
+@li @code do statement while (expression) @endcode
+@li @code for (init_expression; before_iter_test_expression; after_iter_expression) statement @endcode
+
+@section Small_Preprocessor_Section Preprocessor
+
+The following preprocessor directives are available:
+@li @code #assert constant_expression @endcode
+@li @code #define pattern replacement @endcode
+@li @code #define pattern(%1,%2,...) replacement @endcode
+@li @code #include filename @endcode
+@li @code #if constant_expression
+ // Various bits of code
+#else
+ // Other bits of code
+#endif
+@endcode
+@li @code #undef pattern @endcode
+
+
+@page Available_Native_Calls_Page Available Calls
+
+Embryo provides a minimal set of native calls that can be used within
+any Embryo script. Those calls are detailed here.
+
+@note Some of the "core" functions here are also described in the full
+ Small documentation given
+
+@todo Finish this section.
+
+@section Args_ANC_Section Argument Functions
+
+@subsection Numargs_Desc numargs
+
+Returns the number of arguments passed to a function. Useful
+when dealing with variable argument lists.
+
+@subsection Getargs_Desc getarg(arg, index=0)
+
+Retrieves the argument number @c arg. If the argument is an array,
+use @c index to specify the index of the array to return.
+
+@subsection Setargs_Desc setargs(arg, index=0, value)
+
+Sets the argument number @c arg to the given @c arg. @c index specifies
+the index of @c arg to set if @c arg is an array.
+
+@section String_ANC_Section String Functions
+
+Functions that work on strings.
+
+@subsection Atoi_Desc atoi
+
+Translates an number in string form into an integer.
+
+@subsection Fnmatch_Desc fnmatch
+
+Buggered if I know what this does?
+
+@subsection Strcmp_Desc strcmp
+
+String comparing function.
+
+
+@section Float_ANC_Section Float Functions
+
+@subsection Float_Desc float
+
+@subsection Atof_Desc atof
+
+@subsection Float_Mul_Desc float_mul
+
+@subsection Float_Div_Desc float_div
+
+@subsection Float_Add_Desc float_add
+
+@subsection Float_Sub_Desc float_sub
+
+@subsection Fract_Desc fract
+
+@subsection Round_Desc round
+
+@subsection Float_Cmp_Desc float_cmp
+
+@subsection Sqrt_Desc sqrt
+
+@subsection Pow_Desc pow
+
+@subsection Log_Desc log
+
+@subsection Sin_Desc sin
+
+@subsection Cos_Desc cos
+
+@subsection Tan_Desc tan
+
+@subsection Abs_Desc abs
+
+Returns the absolute value of the given float.
+
+@section Time_ANC_Section Time Functions
+
+@subsection Seconds_Desc seconds()
+
+@subsection Date_Desc date
+
+
+@section Rand_ANC_Section Random Functions
+
+@subsection Rand_Desc rand()
+
+Returns a random integer.
+
+@subsection Randf_Desc randf()
+
+Returns a random float.
+
+@file Embryo.h
+@brief Embryo virtual machine library.
+
+This file includes the routines needed for Embryo library interaction.
+This is the @e only file you need to include.
+
+*/
+
+// The following definitions are in Embryo.h, but I did not want to
+// mess up the formatting of the file
+
+/**
+ @def EMBRYO_FUNCTION_NONE
+ An invalid/non-existent function.
+*/
+
+/**
+ @def EMBRYO_FUNCTION_MAIN
+ Start at program entry point. For use with @ref embryo_program_run.
+*/
+
+/**
+ @def EMBRYO_FUNCTION_CONT
+ Continue from last address. For use with @ref embryo_program_run.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_OK
+ Program was run successfully.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_SLEEP
+ The program's execution was interrupted by a Small @c sleep command.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_FAIL
+ An error in the program caused it to fail.
+*/
+
+#ifndef _EMBRYO_H
+#define _EMBRYO_H
+
+#ifdef EAPI
+# undef EAPI
+#endif
+
+#ifdef _WIN32
+# ifdef EFL_EMBRYO_BUILD
+# ifdef DLL_EXPORT
+# define EAPI __declspec(dllexport)
+# else
+# define EAPI
+# endif /* ! DLL_EXPORT */
+# else
+# define EAPI __declspec(dllimport)
+# endif /* ! EFL_EMBRYO_BUILD */
+#else
+# ifdef __GNUC__
+# if __GNUC__ >= 4
+# define EAPI __attribute__ ((visibility("default")))
+# else
+# define EAPI
+# endif
+# else
+# define EAPI
+# endif
+#endif /* ! _WIN32 */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define EMBRYO_VERSION_MAJOR 1
+#define EMBRYO_VERSION_MINOR 8
+
+ typedef struct _Embryo_Version
+ {
+ int major;
+ int minor;
+ int micro;
+ int revision;
+ } Embryo_Version;
+
+ EAPI extern Embryo_Version *embryo_version;
+
+ /* potential error values */
+ typedef enum _Embryo_Error
+ {
+ EMBRYO_ERROR_NONE,
+ /* reserve the first 15 error codes for exit codes of the abstract machine */
+ EMBRYO_ERROR_EXIT, /** Forced exit */
+ EMBRYO_ERROR_ASSERT, /** Assertion failed */
+ EMBRYO_ERROR_STACKERR, /** Stack/heap collision */
+ EMBRYO_ERROR_BOUNDS, /** Index out of bounds */
+ EMBRYO_ERROR_MEMACCESS, /** Invalid memory access */
+ EMBRYO_ERROR_INVINSTR, /** Invalid instruction */
+ EMBRYO_ERROR_STACKLOW, /** Stack underflow */
+ EMBRYO_ERROR_HEAPLOW, /** Heap underflow */
+ EMBRYO_ERROR_CALLBACK, /** No callback, or invalid callback */
+ EMBRYO_ERROR_NATIVE, /** Native function failed */
+ EMBRYO_ERROR_DIVIDE, /** Divide by zero */
+ EMBRYO_ERROR_SLEEP, /** Go into sleepmode - code can be restarted */
+
+ EMBRYO_ERROR_MEMORY = 16, /** Out of memory */
+ EMBRYO_ERROR_FORMAT, /** Invalid file format */
+ EMBRYO_ERROR_VERSION, /** File is for a newer version of the Embryo_Program */
+ EMBRYO_ERROR_NOTFOUND, /** Function not found */
+ EMBRYO_ERROR_INDEX, /** Invalid index parameter (bad entry point) */
+ EMBRYO_ERROR_DEBUG, /** Debugger cannot run */
+ EMBRYO_ERROR_INIT, /** Embryo_Program not initialized (or doubly initialized) */
+ EMBRYO_ERROR_USERDATA, /** Unable to set user data field (table full) */
+ EMBRYO_ERROR_INIT_JIT, /** Cannot initialize the JIT */
+ EMBRYO_ERROR_PARAMS, /** Parameter error */
+ EMBRYO_ERROR_DOMAIN, /** Domain error, expression result does not fit in range */
+ } Embryo_Error;
+
+ /* program run return values */
+ typedef enum _Embryo_Status
+ {
+ EMBRYO_PROGRAM_FAIL = 0,
+ EMBRYO_PROGRAM_OK = 1,
+ EMBRYO_PROGRAM_SLEEP = 2,
+ EMBRYO_PROGRAM_BUSY = 3,
+ EMBRYO_PROGRAM_TOOLONG = 4
+ } Embryo_Status;
+
+ typedef unsigned int Embryo_UCell;
+ typedef int Embryo_Cell;
+ /** An invalid cell reference */
+#define EMBRYO_CELL_NONE 0x7fffffff
+
+ typedef struct _Embryo_Program Embryo_Program;
+ typedef int Embryo_Function;
+ /* possible function type values that are enumerated */
+#define EMBRYO_FUNCTION_NONE 0x7fffffff /* An invalid/non existent function */
+#define EMBRYO_FUNCTION_MAIN -1 /* Start at program entry point */
+#define EMBRYO_FUNCTION_CONT -2 /* Continue from last address */
+
+ typedef union
+ {
+ float f;
+ Embryo_Cell c;
+ } Embryo_Float_Cell;
+
+#if defined _MSC_VER || defined __SUNPRO_C
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) (((Embryo_Float_Cell *)&(f))->c)
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) (((Embryo_Float_Cell *)&(c))->f)
+#else
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) ((Embryo_Float_Cell) f).c
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) ((Embryo_Float_Cell) c).f
+#endif
+
+ /**
+ * @defgroup Embryo_Library_Group Library Maintenance Functions
+ *
+ * Functions that start up and shutdown the Embryo library.
+ */
+
+
+/**
+ * Initialises the Embryo library.
+ * @return The number of times the library has been initialised without being
+ * shut down.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int embryo_init(void);
+
+/**
+ * Shuts down the Embryo library.
+ * @return The number of times the library has been initialised without being
+ * shutdown.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int embryo_shutdown(void);
+
+ /**
+ * @defgroup Embryo_Program_Creation_Group Program Creation and Destruction Functions
+ *
+ * Functions that set up programs, and destroy them.
+ */
+
+/**
+ * Creates a new Embryo program, with bytecode data that can be freed.
+ * @param data Pointer to the bytecode of the program.
+ * @param size Number of bytes of bytecode.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_new(void *data, int size);
+
+/**
+ * Creates a new Embryo program, with bytecode data that cannot be
+ * freed.
+ * @param data Pointer to the bytecode of the program.
+ * @param size Number of bytes of bytecode.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_const_new(void *data, int size);
+
+/**
+ * Creates a new Embryo program based on the bytecode data stored in the
+ * given file.
+ * @param file Filename of the given file.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_load(const char *file);
+
+/**
+ * Frees the given Embryo program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI void embryo_program_free(Embryo_Program *ep);
+
+/**
+ * Adds a native program call to the given Embryo program.
+ * @param ep The given Embryo program.
+ * @param name The name for the call used in the script.
+ * @param func The function to use when the call is made.
+ * @ingroup Embryo_Func_Group
+ */
+
+/**
+ * @defgroup Embryo_Func_Group Function Functions
+ *
+ * Functions that deal with Embryo program functions.
+ */
+EAPI void embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params));
+
+/**
+ * Resets the current virtual machine session of the given program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_VM_Group Virtual Machine Functions
+ *
+ * Functions that deal with creating and destroying virtual machine sessions
+ * for a given program.
+ *
+ * A given embryo program can have multiple virtual machine sessions running.
+ * This is useful when you have a native call that in turn calls a function in
+ * the embryo program. The native call can start a new virtual machine
+ * session to run the function it needs. Once completed, the session can be
+ * popped off the program's stack, and the native call can return its value
+ * to the old session.
+ *
+ * A new virtual machine session is created by pushing a new virtual machine
+ * onto the session stack of a program using @ref embryo_program_vm_push.
+ * The current virtual machine session can be destroyed by calling
+ * @ref embryo_program_vm_pop.
+ */
+EAPI void embryo_program_vm_reset(Embryo_Program *ep);
+
+/**
+ * Starts a new virtual machine session for the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ *
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void embryo_program_vm_push(Embryo_Program *ep);
+
+/**
+ * Frees the current virtual machine session associated with the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ * Note that you will need to retrieve any return data or data on the stack
+ * before you pop.
+ *
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void embryo_program_vm_pop(Embryo_Program *ep);
+
+/**
+ * Ensures that the given unsigned short integer is in the small
+ * endian format.
+ * @param v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+
+/**
+ * @defgroup Embryo_Swap_Group Byte Swapping Functions
+ *
+ * Functions that are used to ensure that integers passed to the
+ * virtual machine are in small endian format. These functions are
+ * used to ensure that the virtual machine operates correctly on big
+ * endian machines.
+ */
+EAPI void embryo_swap_16(unsigned short *v);
+
+/**
+ * Ensures that the given unsigned integer is in the small endian
+ * format.
+ * @param v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+EAPI void embryo_swap_32(unsigned int *v);
+
+/**
+ * Returns the function in the given program with the given name.
+ * @param ep The given program.
+ * @param name The given function name.
+ * @return The function if successful. Otherwise, @c EMBRYO_FUNCTION_NONE.
+ * @ingroup Embryo_Func_Group
+ */
+EAPI Embryo_Function embryo_program_function_find(Embryo_Program *ep, const char *name);
+
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given name.
+ * @param ep The given program.
+ * @param name The given name.
+ * @return The address of the variable if found. @c EMBRYO_CELL_NONE
+ * otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+
+/**
+ * @defgroup Embryo_Public_Variable_Group Public Variable Access Functions
+ *
+ * In an Embryo program, a global variable can be declared public, as
+ * described in @ref Small_Scope_Subsection. The functions here allow
+ * the host program to access these public variables.
+ */
+EAPI Embryo_Cell embryo_program_variable_find(Embryo_Program *ep, const char *name);
+
+/**
+ * Retrieves the number of public variables in the given program.
+ * @param ep The given program.
+ * @return The number of public variables.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI int embryo_program_variable_count_get(Embryo_Program *ep);
+
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given identifier.
+ * @param ep The given program.
+ * @param num The identifier of the public variable.
+ * @return The virtual machine address of the variable if found.
+ * @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI Embryo_Cell embryo_program_variable_get(Embryo_Program *ep, int num);
+
+/**
+ * Sets the error code for the given program to the given code.
+ * @param ep The given program.
+ * @param error The given error code.
+ * @ingroup Embryo_Error_Group
+ */
+
+/**
+ * @defgroup Embryo_Error_Group Error Functions
+ *
+ * Functions that set and retrieve error codes in Embryo programs.
+ */
+EAPI void embryo_program_error_set(Embryo_Program *ep, Embryo_Error error);
+
+/**
+ * Retrieves the current error code for the given program.
+ * @param ep The given program.
+ * @return The current error code.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI Embryo_Error embryo_program_error_get(Embryo_Program *ep);
+
+/**
+ * Sets the data associated to the given program.
+ * @param ep The given program.
+ * @param data New bytecode data.
+ * @ingroup Embryo_Program_Data_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_Data_Group Program Data Functions
+ *
+ * Functions that set and retrieve data associated with the given
+ * program.
+ */
+EAPI void embryo_program_data_set(Embryo_Program *ep, void *data);
+
+/**
+ * Retrieves the data associated to the given program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_Data_Group
+ */
+EAPI void *embryo_program_data_get(Embryo_Program *ep);
+
+/**
+ * Retrieves a string describing the given error code.
+ * @param error The given error code.
+ * @return String describing the given error code. If the given code is not
+ * known, the string "(unknown)" is returned.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI const char *embryo_error_string_get(Embryo_Error error);
+
+/**
+ * Retrieves the length of the string starting at the given cell.
+ * @param ep The program the cell is part of.
+ * @param str_cell Pointer to the first cell of the string.
+ * @return The length of the string. @c 0 is returned if there is an error.
+ * @ingroup Embryo_Data_String_Group
+ */
+
+/**
+ * @defgroup Embryo_Data_String_Group Embryo Data String Functions
+ *
+ * Functions that operate on strings in the memory of a virtual machine.
+ */
+EAPI int embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell);
+
+/**
+ * Copies the string starting at the given cell to the given buffer.
+ * @param ep The program the cell is part of.
+ * @param str_cell Pointer to the first cell of the string.
+ * @param dst The given buffer.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst);
+
+/**
+ * Copies string in the given buffer into the virtual machine memory
+ * starting at the given cell.
+ * @param ep The program the cell is part of.
+ * @param src The given buffer.
+ * @param str_cell Pointer to the first cell to copy the string to.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell);
+
+/**
+ * Retreives a pointer to the address in the virtual machine given by the
+ * given cell.
+ * @param ep The program whose virtual machine address is being queried.
+ * @param addr The given cell.
+ * @return A pointer to the cell at the given address.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI Embryo_Cell *embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr);
+
+/**
+ * Increases the size of the heap of the given virtual machine by the given
+ * number of Embryo_Cells.
+ * @param ep The program with the given virtual machine.
+ * @param cells The given number of Embryo_Cells.
+ * @return The address of the new memory region on success.
+ * @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Heap_Group
+ */
+
+/**
+ * @defgroup Embryo_Heap_Group Heap Functions
+ *
+ * The heap is an area of memory that can be allocated for program
+ * use at runtime. The heap functions here change the amount of heap
+ * memory available.
+ */
+EAPI Embryo_Cell embryo_data_heap_push(Embryo_Program *ep, int cells);
+
+/**
+ * Decreases the size of the heap of the given virtual machine down to the
+ * given size.
+ * @param ep The program with the given virtual machine.
+ * @param down_to The given size.
+ * @ingroup Embryo_Heap_Group
+ */
+EAPI void embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to);
+
+/**
+ * Returns the number of virtual machines are running for the given program.
+ * @param ep The given program.
+ * @return The number of virtual machines running.
+ * @ingroup Embryo_Run_Group
+ */
+
+/**
+ * @defgroup Embryo_Run_Group Program Run Functions
+ *
+ * Functions that are involved in actually running functions in an
+ * Embryo program.
+ */
+EAPI int embryo_program_recursion_get(Embryo_Program *ep);
+
+/**
+ * Runs the given function of the given Embryo program in the current
+ * virtual machine. The parameter @p fn can be found using
+ * @ref embryo_program_function_find.
+ *
+ * @note For Embryo to be able to run a function, it must have been
+ * declared @c public in the Small source code.
+ *
+ * @param ep The given program.
+ * @param func The given function. Normally "main", in which case the
+ * constant @c EMBRYO_FUNCTION_MAIN can be used.
+ * @return @c EMBRYO_PROGRAM_OK on success. @c EMBRYO_PROGRAM_SLEEP if the
+ * program is halted by the Small @c sleep call.
+ * @c EMBRYO_PROGRAM_FAIL if there is an error.
+ * @c EMBRYO_PROGRAM_TOOLONG if the program executes for longer than
+ * it is allowed to in abstract machine instruction count.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Status embryo_program_run(Embryo_Program *ep, Embryo_Function func);
+
+/**
+ * Retreives the return value of the last called function of the given
+ * program.
+ * @param ep The given program.
+ * @return An Embryo_Cell representing the return value of the function
+ * that was last called.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Cell embryo_program_return_value_get(Embryo_Program *ep);
+
+/**
+ * Sets the maximum number of abstract machine cycles any given program run
+ * can execute before being put to sleep and returning.
+ *
+ * @param ep The given program.
+ * @param max The number of machine cycles as a limit.
+ *
+ * This sets the maximum number of abstract machine (virtual machine)
+ * instructions that a single run of an embryo function (even if its main)
+ * can use before embryo embryo_program_run() reutrns with the value
+ * EMBRYO_PROGRAM_TOOLONG. If the function fully executes within this number
+ * of cycles, embryo_program_run() will return as normal with either
+ * EMBRYO_PROGRAM_OK, EMBRYO_PROGRAM_FAIL or EMBRYO_PROGRAM_SLEEP. If the
+ * run exceeds this instruction count, then EMBRYO_PROGRAM_TOOLONG will be
+ * returned indicating the program exceeded its run count. If the app wishes
+ * to continue running this anyway - it is free to process its own events or
+ * whatever it wants and continue the function by calling
+ * embryo_program_run(program, EMBRYO_FUNCTION_CONT); which will start the
+ * run again until the instruction count is reached. This can keep being done
+ * to allow the calling program to still be able to control things outside the
+ * embryo function being called. If the maximum run cycle count is 0 then the
+ * program is allowed to run forever only returning when it is done.
+ *
+ * It is important to note that abstract machine cycles are NOT the same as
+ * the host machine cpu cycles. They are not fixed in runtime per cycle, so
+ * this is more of a helper tool than a way to HARD-FORCE a script to only
+ * run for a specific period of time. If the cycle count is set to something
+ * low like 5000 or 1000, then every 1000 (or 5000) cycles control will be
+ * returned to the calling process where it can check a timer to see if a
+ * physical runtime limit has been elapsed and then abort running further
+ * assuming a "runaway script" or keep continuing the script run. This
+ * limits resolution to only that many cycles which do not take a determined
+ * amount of time to execute, as this varies from cpu to cpu and also depends
+ * on how loaded the system is. Making the max cycle run too low will
+ * impact performance requiring the abstract machine to do setup and teardown
+ * cycles too often comapred to cycles actually executed.
+ *
+ * Also note it does NOT include nested abstract machines. IF this abstract
+ * machine run calls embryo script that calls a native function that in turn
+ * calls more embryo script, then the 2nd (and so on) levels are not included
+ * in this run count. They can set their own max instruction count values
+ * separately.
+ *
+ * The default max cycle run value is 0 in any program until set with this
+ * function.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI void embryo_program_max_cycle_run_set(Embryo_Program *ep, int max);
+
+/**
+ * Retreives the maximum number of abstract machine cycles a program is allowed
+ * to run.
+ * @param ep The given program.
+ * @return The number of cycles a run cycle is allowed to run for this
+ * program.
+ *
+ * This returns the value set by embryo_program_max_cycle_run_set(). See
+ * embryo_program_max_cycle_run_set() for more information.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI int embryo_program_max_cycle_run_get(Embryo_Program *ep);
+
+/**
+ * Pushes an Embryo_Cell onto the function stack to use as a parameter for
+ * the next function that is called in the given program.
+ * @param ep The given program.
+ * @param cell The Embryo_Cell to push onto the stack.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+
+/**
+ * @defgroup Embryo_Parameter_Group Function Parameter Functions
+ *
+ * Functions that set parameters for the next function that is called.
+ */
+EAPI int embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell);
+
+/**
+ * Pushes a string onto the function stack to use as a parameter for the
+ * next function that is called in the given program.
+ * @param ep The given program.
+ * @param str The string to push onto the stack.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int embryo_parameter_string_push(Embryo_Program *ep, const char *str);
+
+/**
+ * Pushes an array of Embryo_Cells onto the function stack to be used as
+ * parameters for the next function that is called in the given program.
+ * @param ep The given program.
+ * @param cells The array of Embryo_Cells.
+ * @param num The number of cells in @p cells.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_builddir) \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir)/src/lib/include \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EVIL_CFLAGS@ \
+@EXOTIC_CFLAGS@ \
+@EMBRYO_CPPFLAGS@ \
+@EFL_EMBRYO_BUILD@
+
+includes_HEADERS = Embryo.h
+includesdir = $(includedir)/embryo-@VMAJ@
+
+lib_LTLIBRARIES = libembryo.la
+
+libembryo_la_SOURCES = \
+embryo_amx.c \
+embryo_args.c \
+embryo_float.c \
+embryo_main.c \
+embryo_rand.c \
+embryo_str.c \
+embryo_time.c
+
+libembryo_la_CFLAGS = @EMBRYO_CFLAGS@
+libembryo_la_LIBADD = @EXOTIC_LIBS@ @EVIL_LIBS@ -lm
+libembryo_la_LDFLAGS = -no-undefined @lt_enable_auto_import@ -version-info @version_info@ @release_info@
+
+EXTRA_DIST = embryo_private.h
--- /dev/null
+/* Abstract Machine for the Small compiler
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ * Portions Copyright (c) Carsten Haitzler, 2004-2010 <raster@rasterman.com>
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+
+#define JUMPABS(base, ip) ((Embryo_Cell *)(code + (*ip)))
+
+#ifdef WORDS_BIGENDIAN
+static void _embryo_byte_swap_16 (unsigned short *v);
+static void _embryo_byte_swap_32 (unsigned int *v);
+#endif
+static int _embryo_native_call (Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params);
+static int _embryo_func_get (Embryo_Program *ep, int idx, char *funcname);
+static int _embryo_var_get (Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr);
+static int _embryo_program_init (Embryo_Program *ep, void *code);
+
+#ifdef WORDS_BIGENDIAN
+static void
+_embryo_byte_swap_16(unsigned short *v)
+{
+ unsigned char *s, t;
+
+ s = (unsigned char *)v;
+ t = s[0]; s[0] = s[1]; s[1] = t;
+}
+
+static void
+_embryo_byte_swap_32(unsigned int *v)
+{
+ unsigned char *s, t;
+
+ s = (unsigned char *)v;
+ t = s[0]; s[0] = s[3]; s[3] = t;
+ t = s[1]; s[1] = s[2]; s[2] = t;
+}
+#endif
+
+static int
+_embryo_native_call(Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func_entry;
+ Embryo_Native f;
+
+ hdr = (Embryo_Header *)ep->base;
+ func_entry = GETENTRY(hdr, natives, idx);
+ if ((func_entry->address <= 0) ||
+ (func_entry->address > ep->native_calls_size))
+ {
+ ep->error = EMBRYO_ERROR_CALLBACK;
+ return ep->error;
+ }
+ f = ep->native_calls[func_entry->address - 1];
+ if (!f)
+ {
+ ep->error = EMBRYO_ERROR_CALLBACK;
+ return ep->error;
+ }
+ ep->error = EMBRYO_ERROR_NONE;
+ *result = f(ep, params);
+ return ep->error;
+}
+
+static int
+_embryo_func_get(Embryo_Program *ep, int idx, char *funcname)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func;
+
+ hdr = (Embryo_Header *)ep->code;
+ if (idx >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+ return EMBRYO_ERROR_INDEX;
+
+ func = GETENTRY(hdr, publics, idx);
+ strcpy(funcname, GETENTRYNAME(hdr, func));
+ return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_var_get(Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr)
+{
+
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *var;
+
+ hdr=(Embryo_Header *)ep->base;
+ if (idx >= (Embryo_Cell)NUMENTRIES(hdr, pubvars, tags))
+ return EMBRYO_ERROR_INDEX;
+
+ var = GETENTRY(hdr, pubvars, idx);
+ strcpy(varname, GETENTRYNAME(hdr, var));
+ *ep_addr = var->address;
+ return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_program_init(Embryo_Program *ep, void *code)
+{
+ Embryo_Header *hdr;
+
+ if ((ep->flags & EMBRYO_FLAG_RELOC)) return 1;
+ ep->code = (unsigned char *)code;
+ hdr = (Embryo_Header *)ep->code;
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32((unsigned int *)&hdr->size);
+ embryo_swap_16((unsigned short *)&hdr->magic);
+ embryo_swap_16((unsigned short *)&hdr->flags);
+ embryo_swap_16((unsigned short *)&hdr->defsize);
+ embryo_swap_32((unsigned int *)&hdr->cod);
+ embryo_swap_32((unsigned int *)&hdr->dat);
+ embryo_swap_32((unsigned int *)&hdr->hea);
+ embryo_swap_32((unsigned int *)&hdr->stp);
+ embryo_swap_32((unsigned int *)&hdr->cip);
+ embryo_swap_32((unsigned int *)&hdr->publics);
+ embryo_swap_32((unsigned int *)&hdr->natives);
+ embryo_swap_32((unsigned int *)&hdr->libraries);
+ embryo_swap_32((unsigned int *)&hdr->pubvars);
+ embryo_swap_32((unsigned int *)&hdr->tags);
+ embryo_swap_32((unsigned int *)&hdr->nametable);
+#endif
+
+ if (hdr->magic != EMBRYO_MAGIC) return 0;
+ if ((hdr->file_version < MIN_FILE_VERSION) ||
+ (hdr->ep_version > CUR_FILE_VERSION)) return 0;
+ if ((hdr->defsize != sizeof(Embryo_Func_Stub)) &&
+ (hdr->defsize != (2 * sizeof(unsigned int)))) return 0;
+ if (hdr->defsize == (2 * sizeof(unsigned int)))
+ {
+ unsigned short *len;
+
+ len = (unsigned short*)((unsigned char*)ep->code + hdr->nametable);
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_16((unsigned short *)len);
+#endif
+ if (*len > sNAMEMAX) return 0;
+ }
+ if (hdr->stp <= 0) return 0;
+ if ((hdr->flags & EMBRYO_FLAG_COMPACT)) return 0;
+
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Func_Stub *fs;
+ int i, num;
+
+ /* also align all addresses in the public function, public variable and */
+ /* public tag tables */
+ fs = GETENTRY(hdr, publics, 0);
+ num = NUMENTRIES(hdr, publics, natives);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+
+ fs = GETENTRY(hdr, pubvars, 0);
+ num = NUMENTRIES(hdr, pubvars, tags);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+
+ fs = GETENTRY(hdr, tags, 0);
+ num = NUMENTRIES(hdr, tags, nametable);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+ }
+#endif
+ ep->flags = EMBRYO_FLAG_RELOC;
+
+ {
+ Embryo_Cell cip, code_size, cip_end;
+ Embryo_Cell *code;
+
+ code_size = hdr->dat - hdr->cod;
+ code = (Embryo_Cell *)((unsigned char *)ep->code + (int)hdr->cod);
+ cip_end = code_size / sizeof(Embryo_Cell);
+ for (cip = 0; cip < cip_end; cip++)
+ {
+/* move this here - later we probably want something that verifies opcodes
+ * are valid and ok...
+ */
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32(&(code[cip]));
+#endif
+
+ }
+ }
+ /* init native api for handling floating point - default in embryo */
+ _embryo_args_init(ep);
+ _embryo_fp_init(ep);
+ _embryo_rand_init(ep);
+ _embryo_str_init(ep);
+ _embryo_time_init(ep);
+ return 1;
+}
+
+/*** EXPORTED CALLS ***/
+
+EAPI Embryo_Program *
+embryo_program_new(void *data, int size)
+{
+ Embryo_Program *ep;
+ void *code_data;
+
+ if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+ ep = calloc(1, sizeof(Embryo_Program));
+ if (!ep) return NULL;
+
+ code_data = malloc(size);
+ if (!code_data)
+ {
+ free(ep);
+ return NULL;
+ }
+ memcpy(code_data, data, size);
+ if (_embryo_program_init(ep, code_data)) return ep;
+ free(code_data);
+ free(ep);
+ return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_const_new(void *data, int size)
+{
+ Embryo_Program *ep;
+
+ if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+ ep = calloc(1, sizeof(Embryo_Program));
+ if (!ep) return NULL;
+
+ if (_embryo_program_init(ep, data))
+ {
+ ep->dont_free_code = 1;
+ return ep;
+ }
+ free(ep);
+ return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_load(const char *file)
+{
+ Embryo_Program *ep;
+ Embryo_Header hdr;
+ FILE *f;
+ void *program = NULL;
+ int program_size = 0;
+
+ f = fopen(file, "rb");
+ if (!f) return NULL;
+ fseek(f, 0, SEEK_END);
+ program_size = ftell(f);
+ fseek(f, 0L, SEEK_SET);
+ if (program_size < (int)sizeof(Embryo_Header))
+ {
+ fclose(f);
+ return NULL;
+ }
+ if (fread(&hdr, sizeof(Embryo_Header), 1, f) != 1)
+ {
+ fclose(f);
+ return NULL;
+ }
+ fseek(f, 0L, SEEK_SET);
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32((unsigned int *)(&hdr.size));
+#endif
+ if ((int)hdr.size < program_size) program_size = hdr.size;
+ program = malloc(program_size);
+ if (!program)
+ {
+ fclose(f);
+ return NULL;
+ }
+ if (fread(program, program_size, 1, f) != 1)
+ {
+ free(program);
+ fclose(f);
+ return NULL;
+ }
+ ep = embryo_program_new(program, program_size);
+ free(program);
+ fclose(f);
+ return ep;
+}
+
+EAPI void
+embryo_program_free(Embryo_Program *ep)
+{
+ int i;
+
+ if (ep->base) free(ep->base);
+ if ((!ep->dont_free_code) && (ep->code)) free(ep->code);
+ if (ep->native_calls) free(ep->native_calls);
+ for (i = 0; i < ep->params_size; i++)
+ {
+ if (ep->params[i].string) free(ep->params[i].string);
+ if (ep->params[i].cell_array) free(ep->params[i].cell_array);
+ }
+ if (ep->params) free(ep->params);
+ free(ep);
+}
+
+
+EAPI void
+embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params))
+{
+ Embryo_Func_Stub *func_entry;
+ Embryo_Header *hdr;
+ int i, num;
+
+ if ((!ep ) || (!name) || (!func)) return;
+ if (strlen(name) > sNAMEMAX) return;
+
+ hdr = (Embryo_Header *)ep->code;
+ if (hdr->defsize < 1) return;
+ num = NUMENTRIES(hdr, natives, libraries);
+ if (num <= 0) return;
+
+ ep->native_calls_size++;
+ if (ep->native_calls_size > ep->native_calls_alloc)
+ {
+ Embryo_Native *calls;
+
+ ep->native_calls_alloc += 32;
+ calls = realloc(ep->native_calls,
+ ep->native_calls_alloc * sizeof(Embryo_Native));
+ if (!calls)
+ {
+ ep->native_calls_size--;
+ ep->native_calls_alloc -= 32;
+ return;
+ }
+ ep->native_calls = calls;
+ }
+ ep->native_calls[ep->native_calls_size - 1] = func;
+
+ func_entry = GETENTRY(hdr, natives, 0);
+ for (i = 0; i < num; i++)
+ {
+ if (func_entry->address == 0)
+ {
+ char *entry_name;
+
+ entry_name = GETENTRYNAME(hdr, func_entry);
+ if ((entry_name) && (!strcmp(entry_name, name)))
+ {
+ func_entry->address = ep->native_calls_size;
+ /* FIXME: embryo_cc is putting in multiple native */
+ /* function call entries - so we need to fill in all */
+ /* of them!!! */
+ /* return; */
+ }
+ }
+ func_entry =
+ (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+ }
+}
+
+
+EAPI void
+embryo_program_vm_reset(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if ((!ep) || (!ep->base)) return;
+ hdr = (Embryo_Header *)ep->code;
+ memcpy(ep->base, hdr, hdr->size);
+ *(Embryo_Cell *)(ep->base + (int)hdr->stp - sizeof(Embryo_Cell)) = 0;
+
+ ep->hlw = hdr->hea - hdr->dat; /* stack and heap relative to data segment */
+ ep->stp = hdr->stp - hdr->dat - sizeof(Embryo_Cell);
+ ep->hea = ep->hlw;
+ ep->stk = ep->stp;
+}
+
+EAPI void
+embryo_program_vm_push(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if (!ep) return;
+ ep->pushes++;
+ if (ep->pushes > 1)
+ {
+ embryo_program_vm_reset(ep);
+ return;
+ }
+ hdr = (Embryo_Header *)ep->code;
+ ep->base = calloc(1, hdr->stp);
+ if (!ep->base)
+ {
+ ep->pushes = 0;
+ return;
+ }
+ embryo_program_vm_reset(ep);
+}
+
+EAPI void
+embryo_program_vm_pop(Embryo_Program *ep)
+{
+ if ((!ep) || (!ep->base)) return;
+ ep->pushes--;
+ if (ep->pushes >= 1) return;
+ free(ep->base);
+ ep->base = NULL;
+}
+
+
+EAPI void
+embryo_swap_16(unsigned short *v
+#ifndef WORDS_BIGENDIAN
+ __UNUSED__
+#endif
+ )
+{
+#ifdef WORDS_BIGENDIAN
+ _embryo_byte_swap_16(v);
+#endif
+}
+
+EAPI void
+embryo_swap_32(unsigned int *v
+#ifndef WORDS_BIGENDIAN
+ __UNUSED__
+#endif
+ )
+{
+#ifdef WORDS_BIGENDIAN
+ _embryo_byte_swap_32(v);
+#endif
+}
+
+EAPI Embryo_Function
+embryo_program_function_find(Embryo_Program *ep, const char *name)
+{
+ int first, last, mid, result;
+ char pname[sNAMEMAX + 1];
+ Embryo_Header *hdr;
+
+ if (!ep) return EMBRYO_FUNCTION_NONE;
+ hdr = (Embryo_Header *)ep->code;
+ last = NUMENTRIES(hdr, publics, natives) - 1;
+ first = 0;
+ /* binary search */
+ while (first <= last)
+ {
+ mid = (first + last) / 2;
+ if (_embryo_func_get(ep, mid, pname) == EMBRYO_ERROR_NONE)
+ result = strcmp(pname, name);
+ else
+ return EMBRYO_FUNCTION_NONE;
+/* result = -1;*/
+ if (result > 0) last = mid - 1;
+ else if (result < 0) first = mid + 1;
+ else return mid;
+ }
+ return EMBRYO_FUNCTION_NONE;
+}
+
+
+EAPI Embryo_Cell
+embryo_program_variable_find(Embryo_Program *ep, const char *name)
+{
+ int first, last, mid, result;
+ char pname[sNAMEMAX + 1];
+ Embryo_Cell paddr;
+ Embryo_Header *hdr;
+
+ if (!ep) return EMBRYO_CELL_NONE;
+ if (!ep->base) return EMBRYO_CELL_NONE;
+ hdr = (Embryo_Header *)ep->base;
+ last = NUMENTRIES(hdr, pubvars, tags) - 1;
+ first = 0;
+ /* binary search */
+ while (first <= last)
+ {
+ mid = (first + last) / 2;
+ if (_embryo_var_get(ep, mid, pname, &paddr) == EMBRYO_ERROR_NONE)
+ result = strcmp(pname, name);
+ else
+ return EMBRYO_CELL_NONE;
+/* result = -1;*/
+ if (result > 0) last = mid - 1;
+ else if (result < 0) first = mid + 1;
+ else return paddr;
+ }
+ return EMBRYO_CELL_NONE;
+}
+
+EAPI int
+embryo_program_variable_count_get(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if (!ep) return 0;
+ if (!ep->base) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ return NUMENTRIES(hdr, pubvars, tags);
+}
+
+EAPI Embryo_Cell
+embryo_program_variable_get(Embryo_Program *ep, int num)
+{
+ Embryo_Cell paddr;
+ char pname[sNAMEMAX + 1];
+
+ if (!ep) return EMBRYO_CELL_NONE;
+ if (!ep->base) return EMBRYO_CELL_NONE;
+ if (_embryo_var_get(ep, num, pname, &paddr) == EMBRYO_ERROR_NONE)
+ return paddr;
+ return EMBRYO_CELL_NONE;
+}
+
+
+EAPI void
+embryo_program_error_set(Embryo_Program *ep, Embryo_Error error)
+{
+ if (!ep) return;
+ ep->error = error;
+}
+
+EAPI Embryo_Error
+embryo_program_error_get(Embryo_Program *ep)
+{
+ if (!ep) return EMBRYO_ERROR_NONE;
+ return ep->error;
+}
+
+
+EAPI void
+embryo_program_data_set(Embryo_Program *ep, void *data)
+{
+ if (!ep) return;
+ ep->data = data;
+}
+
+EAPI void *
+embryo_program_data_get(Embryo_Program *ep)
+{
+ if (!ep) return NULL;
+ return ep->data;
+}
+
+EAPI const char *
+embryo_error_string_get(Embryo_Error error)
+{
+ const char *messages[] =
+ {
+ /* EMBRYO_ERROR_NONE */ "(none)",
+ /* EMBRYO_ERROR_EXIT */ "Forced exit",
+ /* EMBRYO_ERROR_ASSERT */ "Assertion failed",
+ /* EMBRYO_ERROR_STACKERR */ "Stack/heap collision (insufficient stack size)",
+ /* EMBRYO_ERROR_BOUNDS */ "Array index out of bounds",
+ /* EMBRYO_ERROR_MEMACCESS */ "Invalid memory access",
+ /* EMBRYO_ERROR_INVINSTR */ "Invalid instruction",
+ /* EMBRYO_ERROR_STACKLOW */ "Stack underflow",
+ /* EMBRYO_ERROR_HEAPLOW */ "Heap underflow",
+ /* EMBRYO_ERROR_CALLBACK */ "No (valid) native function callback",
+ /* EMBRYO_ERROR_NATIVE */ "Native function failed",
+ /* EMBRYO_ERROR_DIVIDE */ "Divide by zero",
+ /* EMBRYO_ERROR_SLEEP */ "(sleep mode)",
+ /* 13 */ "(reserved)",
+ /* 14 */ "(reserved)",
+ /* 15 */ "(reserved)",
+ /* EMBRYO_ERROR_MEMORY */ "Out of memory",
+ /* EMBRYO_ERROR_FORMAT */ "Invalid/unsupported P-code file format",
+ /* EMBRYO_ERROR_VERSION */ "File is for a newer version of the Embryo_Program",
+ /* EMBRYO_ERROR_NOTFOUND */ "Native/Public function is not found",
+ /* EMBRYO_ERROR_INDEX */ "Invalid index parameter (bad entry point)",
+ /* EMBRYO_ERROR_DEBUG */ "Debugger cannot run",
+ /* EMBRYO_ERROR_INIT */ "Embryo_Program not initialized (or doubly initialized)",
+ /* EMBRYO_ERROR_USERDATA */ "Unable to set user data field (table full)",
+ /* EMBRYO_ERROR_INIT_JIT */ "Cannot initialize the JIT",
+ /* EMBRYO_ERROR_PARAMS */ "Parameter error",
+ };
+ if (((int)error < 0) ||
+ ((int)error >= (int)(sizeof(messages) / sizeof(messages[0]))))
+ return (const char *)"(unknown)";
+ return messages[error];
+}
+
+
+EAPI int
+embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell)
+{
+ int len;
+ Embryo_Header *hdr;
+
+ if ((!ep) || (!ep->base)) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ return 0;
+ for (len = 0; str_cell[len] != 0; len++);
+ return len;
+}
+
+EAPI void
+embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst)
+{
+ int i;
+ Embryo_Header *hdr;
+
+ if (!dst) return;
+ if ((!ep) || (!ep->base))
+ {
+ dst[0] = 0;
+ return;
+ }
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ {
+ dst[0] = 0;
+ return;
+ }
+ for (i = 0; str_cell[i] != 0; i++)
+ {
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Cell tmp;
+
+ tmp = str_cell[i];
+ _embryo_byte_swap_32(&tmp);
+ dst[i] = tmp;
+ }
+#else
+ dst[i] = str_cell[i];
+#endif
+ }
+ dst[i] = 0;
+}
+
+EAPI void
+embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell)
+{
+ int i;
+ Embryo_Header *hdr;
+
+ if (!ep) return;
+ if (!ep->base) return;
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ return;
+ if (!src)
+ {
+ str_cell[0] = 0;
+ return;
+ }
+ for (i = 0; src[i] != 0; i++)
+ {
+ if ((void *)(&(str_cell[i])) >= (void *)(ep->base + hdr->stp)) return;
+ else if ((void *)(&(str_cell[i])) == (void *)(ep->base + hdr->stp - 1))
+ {
+ str_cell[i] = 0;
+ return;
+ }
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Cell tmp;
+
+ tmp = src[i];
+ _embryo_byte_swap_32(&tmp);
+ str_cell[i] = tmp;
+ }
+#else
+ str_cell[i] = src[i];
+#endif
+ }
+ str_cell[i] = 0;
+}
+
+EAPI Embryo_Cell *
+embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+
+ if ((!ep) || (!ep->base)) return NULL;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ if ((addr < 0) || (addr >= hdr->stp)) return NULL;
+ return (Embryo_Cell *)(data + (int)addr);
+}
+
+
+EAPI Embryo_Cell
+embryo_data_heap_push(Embryo_Program *ep, int cells)
+{
+ Embryo_Header *hdr;
+ Embryo_Cell addr;
+
+ if ((!ep) || (!ep->base)) return EMBRYO_CELL_NONE;
+ hdr = (Embryo_Header *)ep->base;
+ if (ep->stk - ep->hea - (cells * sizeof(Embryo_Cell)) < STKMARGIN)
+ return EMBRYO_CELL_NONE;
+ addr = ep->hea;
+ ep->hea += (cells * sizeof(Embryo_Cell));
+ return addr;
+}
+
+EAPI void
+embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to)
+{
+ if (!ep) return;
+ if (down_to < 0) down_to = 0;
+ if (ep->hea > down_to) ep->hea = down_to;
+}
+
+
+EAPI int
+embryo_program_recursion_get(Embryo_Program *ep)
+{
+ return ep->run_count;
+}
+
+#ifdef __GNUC__
+#if 1
+#define EMBRYO_EXEC_JUMPTABLE
+#endif
+#endif
+
+/* jump table optimization - only works for gcc though */
+#ifdef EMBRYO_EXEC_JUMPTABLE
+#define SWITCH(x) while (1) { goto *switchtable[x];
+#define SWITCHEND break; }
+#define CASE(x) SWITCHTABLE_##x:
+#define BREAK break;
+#else
+#define SWITCH(x) switch (x) {
+#define SWITCHEND }
+#define CASE(x) case x:
+#define BREAK break
+#endif
+
+EAPI Embryo_Status
+embryo_program_run(Embryo_Program *ep, Embryo_Function fn)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func;
+ unsigned char *code, *data;
+ Embryo_Cell pri, alt, stk, frm, hea, hea_start;
+ Embryo_Cell reset_stk, reset_hea, *cip;
+ Embryo_UCell codesize;
+ int i;
+ unsigned char op;
+ Embryo_Cell offs;
+ int num;
+ int max_run_cycles;
+ int cycle_count;
+#ifdef EMBRYO_EXEC_JUMPTABLE
+ /* we limit the jumptable to 256 elements. why? above we forced "op" to be
+ * a unsigned char - that means 256 max values. we limit opcode overflow
+ * here, so eliminating crashes on table lookups with bad/corrupt bytecode.
+ * no need to atuall do compares, branches etc. the datatype does the work
+ * for us. so that means EXCESS elements are all declared as OP_NONE to
+ * keep them innocuous.
+ */
+ static const void *switchtable[256] =
+ {
+ &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_I,
+ &&SWITCHTABLE_EMBRYO_OP_LODB_I,
+ &&SWITCHTABLE_EMBRYO_OP_CONST_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_CONST_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ADDR_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ADDR_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_I,
+ &&SWITCHTABLE_EMBRYO_OP_STRB_I,
+ &&SWITCHTABLE_EMBRYO_OP_LIDX,
+ &&SWITCHTABLE_EMBRYO_OP_LIDX_B,
+ &&SWITCHTABLE_EMBRYO_OP_IDXADDR,
+ &&SWITCHTABLE_EMBRYO_OP_IDXADDR_B,
+ &&SWITCHTABLE_EMBRYO_OP_ALIGN_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ALIGN_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LCTRL,
+ &&SWITCHTABLE_EMBRYO_OP_SCTRL,
+ &&SWITCHTABLE_EMBRYO_OP_MOVE_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_MOVE_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_XCHG,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_R,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_C,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_S,
+ &&SWITCHTABLE_EMBRYO_OP_POP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_POP_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STACK,
+ &&SWITCHTABLE_EMBRYO_OP_HEAP,
+ &&SWITCHTABLE_EMBRYO_OP_PROC,
+ &&SWITCHTABLE_EMBRYO_OP_RET,
+ &&SWITCHTABLE_EMBRYO_OP_RETN,
+ &&SWITCHTABLE_EMBRYO_OP_CALL,
+ &&SWITCHTABLE_EMBRYO_OP_CALL_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_JUMP,
+ &&SWITCHTABLE_EMBRYO_OP_JREL,
+ &&SWITCHTABLE_EMBRYO_OP_JZER,
+ &&SWITCHTABLE_EMBRYO_OP_JNZ,
+ &&SWITCHTABLE_EMBRYO_OP_JEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JNEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JLESS,
+ &&SWITCHTABLE_EMBRYO_OP_JLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_JGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JSLESS,
+ &&SWITCHTABLE_EMBRYO_OP_JSLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JSGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_JSGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SHL,
+ &&SWITCHTABLE_EMBRYO_OP_SHR,
+ &&SWITCHTABLE_EMBRYO_OP_SSHR,
+ &&SWITCHTABLE_EMBRYO_OP_SHL_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SHL_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SHR_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SHR_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SMUL,
+ &&SWITCHTABLE_EMBRYO_OP_SDIV,
+ &&SWITCHTABLE_EMBRYO_OP_SDIV_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_UMUL,
+ &&SWITCHTABLE_EMBRYO_OP_UDIV,
+ &&SWITCHTABLE_EMBRYO_OP_UDIV_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ADD,
+ &&SWITCHTABLE_EMBRYO_OP_SUB,
+ &&SWITCHTABLE_EMBRYO_OP_SUB_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_AND,
+ &&SWITCHTABLE_EMBRYO_OP_OR,
+ &&SWITCHTABLE_EMBRYO_OP_XOR,
+ &&SWITCHTABLE_EMBRYO_OP_NOT,
+ &&SWITCHTABLE_EMBRYO_OP_NEG,
+ &&SWITCHTABLE_EMBRYO_OP_INVERT,
+ &&SWITCHTABLE_EMBRYO_OP_ADD_C,
+ &&SWITCHTABLE_EMBRYO_OP_SMUL_C,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_S,
+ &&SWITCHTABLE_EMBRYO_OP_SIGN_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SIGN_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_EQ,
+ &&SWITCHTABLE_EMBRYO_OP_NEQ,
+ &&SWITCHTABLE_EMBRYO_OP_LESS,
+ &&SWITCHTABLE_EMBRYO_OP_LEQ,
+ &&SWITCHTABLE_EMBRYO_OP_GRTR,
+ &&SWITCHTABLE_EMBRYO_OP_GEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SLESS,
+ &&SWITCHTABLE_EMBRYO_OP_SLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_SGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_EQ_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_EQ_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_INC_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_INC_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_INC,
+ &&SWITCHTABLE_EMBRYO_OP_INC_S,
+ &&SWITCHTABLE_EMBRYO_OP_INC_I,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_DEC,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_S,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_I,
+ &&SWITCHTABLE_EMBRYO_OP_MOVS,
+ &&SWITCHTABLE_EMBRYO_OP_CMPS,
+ &&SWITCHTABLE_EMBRYO_OP_FILL,
+ &&SWITCHTABLE_EMBRYO_OP_HALT,
+ &&SWITCHTABLE_EMBRYO_OP_BOUNDS,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_C,
+ &&SWITCHTABLE_EMBRYO_OP_FILE,
+ &&SWITCHTABLE_EMBRYO_OP_LINE,
+ &&SWITCHTABLE_EMBRYO_OP_SYMBOL,
+ &&SWITCHTABLE_EMBRYO_OP_SRANGE,
+ &&SWITCHTABLE_EMBRYO_OP_JUMP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SWITCH,
+ &&SWITCHTABLE_EMBRYO_OP_CASETBL,
+ &&SWITCHTABLE_EMBRYO_OP_SWAP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SWAP_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_PUSHADDR,
+ &&SWITCHTABLE_EMBRYO_OP_NOP,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_D,
+ &&SWITCHTABLE_EMBRYO_OP_SYMTAG,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE
+ };
+#endif
+ if (!ep) return EMBRYO_PROGRAM_FAIL;
+ if (!(ep->flags & EMBRYO_FLAG_RELOC))
+ {
+ ep->error = EMBRYO_ERROR_INIT;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ if (!ep->base)
+ {
+ ep->error = EMBRYO_ERROR_INIT;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ if (ep->run_count > 0)
+ {
+ /* return EMBRYO_PROGRAM_BUSY; */
+ /* FIXME: test C->vm->C->vm recursion more fully */
+ /* it seems to work... just fine!!! - strange! */
+ }
+
+ /* set up the registers */
+ hdr = (Embryo_Header *)ep->base;
+ codesize = (Embryo_UCell)(hdr->dat - hdr->cod);
+ code = ep->base + (int)hdr->cod;
+ data = ep->base + (int)hdr->dat;
+ hea_start = hea = ep->hea;
+ stk = ep->stk;
+ reset_stk = stk;
+ reset_hea = hea;
+ frm = alt = pri = 0;
+
+ /* get the start address */
+ if (fn == EMBRYO_FUNCTION_MAIN)
+ {
+ if (hdr->cip < 0)
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ cip = (Embryo_Cell *)(code + (int)hdr->cip);
+ }
+ else if (fn == EMBRYO_FUNCTION_CONT)
+ {
+ /* all registers: pri, alt, frm, cip, hea, stk, reset_stk, reset_hea */
+ frm = ep->frm;
+ stk = ep->stk;
+ hea = ep->hea;
+ pri = ep->pri;
+ alt = ep->alt;
+ reset_stk = ep->reset_stk;
+ reset_hea = ep->reset_hea;
+ cip = (Embryo_Cell *)(code + (int)ep->cip);
+ }
+ else if (fn < 0)
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ else
+ {
+ if (fn >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ func = GETENTRY(hdr, publics, fn);
+ cip = (Embryo_Cell *)(code + (int)func->address);
+ }
+ /* check values just copied */
+ CHKSTACK();
+ CHKHEAP();
+
+ if (fn != EMBRYO_FUNCTION_CONT)
+ {
+ int i;
+
+ for (i = ep->params_size - 1; i >= 0; i--)
+ {
+ Embryo_Param *pr;
+
+ pr = &(ep->params[i]);
+ if (pr->string)
+ {
+ int len;
+ Embryo_Cell ep_addr, *addr;
+
+ len = strlen(pr->string);
+ ep_addr = embryo_data_heap_push(ep, len + 1);
+ if (ep_addr == EMBRYO_CELL_NONE)
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ addr = embryo_data_address_get(ep, ep_addr);
+ if (addr)
+ embryo_data_string_set(ep, pr->string, addr);
+ else
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ PUSH(ep_addr);
+ free(pr->string);
+ }
+ else if (pr->cell_array)
+ {
+ int len;
+ Embryo_Cell ep_addr, *addr;
+
+ len = pr->cell_array_size;
+ ep_addr = embryo_data_heap_push(ep, len + 1);
+ if (ep_addr == EMBRYO_CELL_NONE)
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ addr = embryo_data_address_get(ep, ep_addr);
+ if (addr)
+ memcpy(addr, pr->cell_array,
+ pr->cell_array_size * sizeof(Embryo_Cell));
+ else
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ PUSH(ep_addr);
+ free(pr->cell_array);
+ }
+ else
+ {
+ PUSH(pr->cell);
+ }
+ }
+ PUSH(ep->params_size * sizeof(Embryo_Cell));
+ PUSH(0);
+ if (ep->params)
+ {
+ free(ep->params);
+ ep->params = NULL;
+ }
+ ep->params_size = ep->params_alloc = 0;
+ }
+ /* check stack/heap before starting to run */
+ CHKMARGIN();
+
+ /* track recursion depth */
+ ep->run_count++;
+
+ max_run_cycles = ep->max_run_cycles;
+ /* start running */
+ for (cycle_count = 0;;)
+ {
+ if (max_run_cycles > 0)
+ {
+ if (cycle_count >= max_run_cycles)
+ {
+ TOOLONG(ep);
+ }
+ cycle_count++;
+ }
+ op = (Embryo_Opcode)*cip++;
+ SWITCH(op);
+ CASE(EMBRYO_OP_LOAD_PRI);
+ GETPARAM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_ALT);
+ GETPARAM(offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_S_PRI);
+ GETPARAM(offs);
+ pri = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_S_ALT);
+ GETPARAM(offs);
+ alt = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_S_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_S_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_I);
+ CHKMEM(pri);
+ pri = *(Embryo_Cell *)(data + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_LODB_I);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ switch (offs)
+ {
+ case 1:
+ pri = *(data + (int)pri);
+ break;
+ case 2:
+ pri = *(unsigned short *)(data + (int)pri);
+ break;
+ case 4:
+ pri = *(unsigned int *)(data + (int)pri);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_CONST_PRI);
+ GETPARAM(pri);
+ BREAK;
+ CASE(EMBRYO_OP_CONST_ALT);
+ GETPARAM(alt);
+ BREAK;
+ CASE(EMBRYO_OP_ADDR_PRI);
+ GETPARAM(pri);
+ pri += frm;
+ BREAK;
+ CASE(EMBRYO_OP_ADDR_ALT);
+ GETPARAM(alt);
+ alt += frm;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_PRI);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_ALT);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_S_PRI);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_S_ALT);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_S_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_S_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_I);
+ CHKMEM(alt);
+ *(Embryo_Cell *)(data + (int)alt) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STRB_I);
+ GETPARAM(offs);
+ CHKMEM(alt);
+ switch (offs)
+ {
+ case 1:
+ *(data + (int)alt) = (unsigned char)pri;
+ break;
+ case 2:
+ *(unsigned short *)(data + (int)alt) = (unsigned short)pri;
+ break;
+ case 4:
+ *(unsigned int *)(data + (int)alt) = (unsigned int)pri;
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_LIDX);
+ offs = (pri * sizeof(Embryo_Cell)) + alt;
+ CHKMEM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LIDX_B);
+ GETPARAM(offs);
+ offs = (pri << (int)offs) + alt;
+ CHKMEM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_IDXADDR);
+ pri = (pri * sizeof(Embryo_Cell)) + alt;
+ BREAK;
+ CASE(EMBRYO_OP_IDXADDR_B);
+ GETPARAM(offs);
+ pri = (pri << (int)offs) + alt;
+ BREAK;
+ CASE(EMBRYO_OP_ALIGN_PRI);
+ GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+ if ((size_t)offs < sizeof(Embryo_Cell))
+ pri ^= sizeof(Embryo_Cell) - offs;
+#endif
+ BREAK;
+ CASE(EMBRYO_OP_ALIGN_ALT);
+ GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+ if ((size_t)offs < sizeof(Embryo_Cell))
+ alt ^= sizeof(Embryo_Cell) - offs;
+#endif
+ BREAK;
+ CASE(EMBRYO_OP_LCTRL);
+ GETPARAM(offs);
+ switch (offs)
+ {
+ case 0:
+ pri = hdr->cod;
+ break;
+ case 1:
+ pri = hdr->dat;
+ break;
+ case 2:
+ pri = hea;
+ break;
+ case 3:
+ pri = ep->stp;
+ break;
+ case 4:
+ pri = stk;
+ break;
+ case 5:
+ pri = frm;
+ break;
+ case 6:
+ pri = (Embryo_Cell)((unsigned char *)cip - code);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SCTRL);
+ GETPARAM(offs);
+ switch (offs)
+ {
+ case 0:
+ case 1:
+ case 2:
+ hea = pri;
+ break;
+ case 3:
+ /* cannot change these parameters */
+ break;
+ case 4:
+ stk = pri;
+ break;
+ case 5:
+ frm = pri;
+ break;
+ case 6:
+ cip = (Embryo_Cell *)(code + (int)pri);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_MOVE_PRI);
+ pri = alt;
+ BREAK;
+ CASE(EMBRYO_OP_MOVE_ALT);
+ alt = pri;
+ BREAK;
+ CASE(EMBRYO_OP_XCHG);
+ offs = pri; /* offs is a temporary variable */
+ pri = alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_PRI);
+ PUSH(pri);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_ALT);
+ PUSH(alt);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_C);
+ GETPARAM(offs);
+ PUSH(offs);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_R);
+ GETPARAM(offs);
+ while (offs--) PUSH(pri);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH);
+ GETPARAM(offs);
+ PUSH(*(Embryo_Cell *)(data + (int)offs));
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_S);
+ GETPARAM(offs);
+ PUSH(*(Embryo_Cell *)(data + (int)frm + (int)offs));
+ BREAK;
+ CASE(EMBRYO_OP_POP_PRI);
+ POP(pri);
+ BREAK;
+ CASE(EMBRYO_OP_POP_ALT);
+ POP(alt);
+ BREAK;
+ CASE(EMBRYO_OP_STACK);
+ GETPARAM(offs);
+ alt = stk;
+ stk += offs;
+ CHKMARGIN();
+ CHKSTACK();
+ BREAK;
+ CASE(EMBRYO_OP_HEAP);
+ GETPARAM(offs);
+ alt = hea;
+ hea += offs;
+ CHKMARGIN();
+ CHKHEAP();
+ BREAK;
+ CASE(EMBRYO_OP_PROC);
+ PUSH(frm);
+ frm = stk;
+ CHKMARGIN();
+ BREAK;
+ CASE(EMBRYO_OP_RET);
+ POP(frm);
+ POP(offs);
+ if ((Embryo_UCell)offs >= codesize)
+ ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+ cip = (Embryo_Cell *)(code + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_RETN);
+ POP(frm);
+ POP(offs);
+ if ((Embryo_UCell)offs >= codesize)
+ ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+ cip = (Embryo_Cell *)(code + (int)offs);
+ stk += *(Embryo_Cell *)(data + (int)stk) + sizeof(Embryo_Cell); /* remove parameters from the stack */
+ ep->stk = stk;
+ BREAK;
+ CASE(EMBRYO_OP_CALL);
+ PUSH(((unsigned char *)cip - code) + sizeof(Embryo_Cell));/* skip address */
+ cip = JUMPABS(code, cip); /* jump to the address */
+ BREAK;
+ CASE(EMBRYO_OP_CALL_PRI);
+ PUSH((unsigned char *)cip - code);
+ cip = (Embryo_Cell *)(code + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_JUMP);
+ /* since the GETPARAM() macro modifies cip, you cannot
+ * do GETPARAM(cip) directly */
+ cip = JUMPABS(code, cip);
+ BREAK;
+ CASE(EMBRYO_OP_JREL);
+ offs = *cip;
+ cip = (Embryo_Cell *)((unsigned char *)cip + (int)offs + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JZER);
+ if (pri == 0)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JNZ);
+ if (pri != 0)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JEQ);
+ if (pri==alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JNEQ);
+ if (pri != alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JLESS);
+ if ((Embryo_UCell)pri < (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JLEQ);
+ if ((Embryo_UCell)pri <= (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JGRTR);
+ if ((Embryo_UCell)pri > (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JGEQ);
+ if ((Embryo_UCell)pri >= (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSLESS);
+ if (pri < alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSLEQ);
+ if (pri <= alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSGRTR);
+ if (pri > alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSGEQ);
+ if (pri >= alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_SHL);
+ pri <<= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SHR);
+ pri = (Embryo_UCell)pri >> (int)alt;
+ BREAK;
+ CASE(EMBRYO_OP_SSHR);
+ pri >>= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SHL_C_PRI);
+ GETPARAM(offs);
+ pri <<= offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHL_C_ALT);
+ GETPARAM(offs);
+ alt <<= offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHR_C_PRI);
+ GETPARAM(offs);
+ pri = (Embryo_UCell)pri >> (int)offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHR_C_ALT);
+ GETPARAM(offs);
+ alt = (Embryo_UCell)alt >> (int)offs;
+ BREAK;
+ CASE(EMBRYO_OP_SMUL);
+ pri *= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SDIV);
+ if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ /* divide must always round down; this is a bit
+ * involved to do in a machine-independent way.
+ */
+ offs = ((pri % alt) + alt) % alt; /* true modulus */
+ pri = (pri - offs) / alt; /* division result */
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_SDIV_ALT);
+ if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ /* divide must always round down; this is a bit
+ * involved to do in a machine-independent way.
+ */
+ offs = ((alt % pri) + pri) % pri; /* true modulus */
+ pri = (alt - offs) / pri; /* division result */
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_UMUL);
+ pri = (Embryo_UCell)pri * (Embryo_UCell)alt;
+ BREAK;
+ CASE(EMBRYO_OP_UDIV);
+ if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ offs = (Embryo_UCell)pri % (Embryo_UCell)alt; /* temporary storage */
+ pri = (Embryo_UCell)pri / (Embryo_UCell)alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_UDIV_ALT);
+ if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ offs = (Embryo_UCell)alt % (Embryo_UCell)pri; /* temporary storage */
+ pri = (Embryo_UCell)alt / (Embryo_UCell)pri;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_ADD);
+ pri += alt;
+ BREAK;
+ CASE(EMBRYO_OP_SUB);
+ pri -= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SUB_ALT);
+ pri = alt - pri;
+ BREAK;
+ CASE(EMBRYO_OP_AND);
+ pri &= alt;
+ BREAK;
+ CASE(EMBRYO_OP_OR);
+ pri |= alt;
+ BREAK;
+ CASE(EMBRYO_OP_XOR);
+ pri ^= alt;
+ BREAK;
+ CASE(EMBRYO_OP_NOT);
+ pri = !pri;
+ BREAK;
+ CASE(EMBRYO_OP_NEG);
+ pri = -pri;
+ BREAK;
+ CASE(EMBRYO_OP_INVERT);
+ pri = ~pri;
+ BREAK;
+ CASE(EMBRYO_OP_ADD_C);
+ GETPARAM(offs);
+ pri += offs;
+ BREAK;
+ CASE(EMBRYO_OP_SMUL_C);
+ GETPARAM(offs);
+ pri *= offs;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_PRI);
+ pri = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_ALT);
+ alt = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = 0;
+ BREAK;
+ CASE(EMBRYO_OP_SIGN_PRI);
+ if ((pri & 0xff) >= 0x80) pri |= ~(Embryo_UCell)0xff;
+ BREAK;
+ CASE(EMBRYO_OP_SIGN_ALT);
+ if ((alt & 0xff) >= 0x80) alt |= ~(Embryo_UCell)0xff;
+ BREAK;
+ CASE(EMBRYO_OP_EQ);
+ pri = (pri == alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_NEQ);
+ pri = (pri != alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_LESS);
+ pri = ((Embryo_UCell)pri < (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_LEQ);
+ pri = ((Embryo_UCell)pri <= (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_GRTR);
+ pri = ((Embryo_UCell)pri > (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_GEQ);
+ pri = ((Embryo_UCell)pri >= (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SLESS);
+ pri = (pri < alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SLEQ);
+ pri = (pri <= alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SGRTR);
+ pri = (pri > alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SGEQ);
+ pri = (pri >= alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_EQ_C_PRI);
+ GETPARAM(offs);
+ pri = (pri == offs) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_EQ_C_ALT);
+ GETPARAM(offs);
+ pri = (alt == offs) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_INC_PRI);
+ pri++;
+ BREAK;
+ CASE(EMBRYO_OP_INC_ALT);
+ alt++;
+ BREAK;
+ CASE(EMBRYO_OP_INC);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_INC_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_INC_I);
+ *(Embryo_Cell *)(data + (int)pri) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_PRI);
+ pri--;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_ALT);
+ alt--;
+ BREAK;
+ CASE(EMBRYO_OP_DEC);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_I);
+ *(Embryo_Cell *)(data + (int)pri) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_MOVS);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ CHKMEM(pri + offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ memcpy(data+(int)alt, data+(int)pri, (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_CMPS);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ CHKMEM(pri + offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ pri = memcmp(data + (int)alt, data + (int)pri, (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_FILL);
+ GETPARAM(offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ for (i = (int)alt;
+ (size_t)offs >= sizeof(Embryo_Cell);
+ i += sizeof(Embryo_Cell), offs -= sizeof(Embryo_Cell))
+ *(Embryo_Cell *)(data + i) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_HALT);
+ GETPARAM(offs);
+ ep->retval = pri;
+ /* store complete status */
+ ep->frm = frm;
+ ep->stk = stk;
+ ep->hea = hea;
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->cip = (Embryo_Cell)((unsigned char*)cip - code);
+ if (offs == EMBRYO_ERROR_SLEEP)
+ {
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ OK(ep, (int)offs);
+ CASE(EMBRYO_OP_BOUNDS);
+ GETPARAM(offs);
+ if ((Embryo_UCell)pri > (Embryo_UCell)offs)
+ ABORT(ep, EMBRYO_ERROR_BOUNDS);
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_PRI);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, pri, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ ABORT(ep, num);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_C);
+ GETPARAM(offs);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ {
+ Embryo_Header *hdr;
+ int i, num;
+ Embryo_Func_Stub *func_entry;
+
+ hdr = (Embryo_Header *)ep->code;
+ num = NUMENTRIES(hdr, natives, libraries);
+ func_entry = GETENTRY(hdr, natives, 0);
+ for (i = 0; i < num; i++)
+ {
+ char *entry_name;
+
+ entry_name = GETENTRYNAME(hdr, func_entry);
+ if (i == offs)
+ printf("EMBRYO: CALL [%i] %s() non-existent!\n", i, entry_name);
+ func_entry =
+ (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+ }
+ }
+ ABORT(ep, num);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_D);
+ GETPARAM(offs);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ ABORT(ep, ep->error);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_JUMP_PRI);
+ cip = (Embryo_Cell *)(code + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_SWITCH);
+ {
+ Embryo_Cell *cptr;
+
+ /* +1, to skip the "casetbl" opcode */
+ cptr = (Embryo_Cell *)(code + (*cip)) + 1;
+ /* number of records in the case table */
+ num = (int)(*cptr);
+ /* preset to "none-matched" case */
+ cip = (Embryo_Cell *)(code + *(cptr + 1));
+ for (cptr += 2;
+ (num > 0) && (*cptr != pri);
+ num--, cptr += 2);
+ /* case found */
+ if (num > 0)
+ cip = (Embryo_Cell *)(code + *(cptr + 1));
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SWAP_PRI);
+ offs = *(Embryo_Cell *)(data + (int)stk);
+ *(Embryo_Cell *)(data + (int)stk) = pri;
+ pri = offs;
+ BREAK;
+ CASE(EMBRYO_OP_SWAP_ALT);
+ offs = *(Embryo_Cell *)(data + (int)stk);
+ *(Embryo_Cell *)(data + (int)stk) = alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_PUSHADDR);
+ GETPARAM(offs);
+ PUSH(frm + offs);
+ BREAK;
+ CASE(EMBRYO_OP_NOP);
+ BREAK;
+ CASE(EMBRYO_OP_NONE);
+ CASE(EMBRYO_OP_FILE);
+ CASE(EMBRYO_OP_LINE);
+ CASE(EMBRYO_OP_SYMBOL);
+ CASE(EMBRYO_OP_SRANGE);
+ CASE(EMBRYO_OP_CASETBL);
+ CASE(EMBRYO_OP_SYMTAG);
+ BREAK;
+#ifndef EMBRYO_EXEC_JUMPTABLE
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+#endif
+ SWITCHEND;
+ }
+ ep->max_run_cycles = max_run_cycles;
+ ep->run_count--;
+ ep->hea = hea_start;
+ return EMBRYO_PROGRAM_OK;
+}
+
+EAPI Embryo_Cell
+embryo_program_return_value_get(Embryo_Program *ep)
+{
+ if (!ep) return 0;
+ return ep->retval;
+}
+
+EAPI void
+embryo_program_max_cycle_run_set(Embryo_Program *ep, int max)
+{
+ if (!ep) return;
+ if (max < 0) max = 0;
+ ep->max_run_cycles = max;
+}
+
+EAPI int
+embryo_program_max_cycle_run_get(Embryo_Program *ep)
+{
+ if (!ep) return 0;
+ return ep->max_run_cycles;
+}
+
+
+EAPI int
+embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell)
+{
+ Embryo_Param *pr;
+
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr) return 0;
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->cell = cell;
+ return 1;
+}
+
+EAPI int
+embryo_parameter_string_push(Embryo_Program *ep, const char *str)
+{
+ Embryo_Param *pr;
+ char *str_dup;
+
+ if (!str)
+ return embryo_parameter_string_push(ep, "");
+ str_dup = strdup(str);
+ if (!str_dup) return 0;
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr)
+ {
+ free(str_dup);
+ return 0;
+ }
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->string = str_dup;
+ return 1;
+}
+
+EAPI int
+embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num)
+{
+ Embryo_Param *pr;
+ Embryo_Cell *cell_array;
+
+ if ((!cells) || (num <= 0))
+ return embryo_parameter_cell_push(ep, 0);
+ cell_array = malloc(num * sizeof(Embryo_Cell));
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr)
+ {
+ free(cell_array);
+ return 0;
+ }
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->cell_array = cell_array;
+ pr->cell_array_size = num;
+ memcpy(pr->cell_array, cells, num * sizeof(Embryo_Cell));
+ return 1;
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif defined __GNUC__
+# define alloca __builtin_alloca
+#elif defined _AIX
+# define alloca __alloca
+#elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+#else
+# include <stddef.h>
+# ifdef __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRSET(ep, par, str) { \
+ Embryo_Cell *___cptr; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ embryo_data_string_set(ep, str, ___cptr); \
+ } }
+
+/* exported args api */
+
+static Embryo_Cell
+_embryo_args_numargs(Embryo_Program *ep, Embryo_Cell *params __UNUSED__)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell bytes;
+
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ bytes = *(Embryo_Cell *)(data + (int)ep->frm +
+ (2 * sizeof(Embryo_Cell)));
+ return bytes / sizeof(Embryo_Cell);
+}
+
+static Embryo_Cell
+_embryo_args_getarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell val;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ val = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+ val += params[2] * sizeof(Embryo_Cell);
+ val = *(Embryo_Cell *)(data + (int)val);
+ return val;
+}
+
+static Embryo_Cell
+_embryo_args_setarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell val;
+
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ val = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+ val += params[2] * sizeof(Embryo_Cell);
+ if ((val < 0) || ((val >= ep->hea) && (val < ep->stk))) return 0;
+ *(Embryo_Cell *)(data + (int)val) = params[3];
+ return 1;
+}
+
+static Embryo_Cell
+_embryo_args_getsarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell base_cell;
+ char *s;
+ int i = 0;
+
+ /* params[1] = arg_no */
+ /* params[2] = buf */
+ /* params[3] = buflen */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] <= 0) return 0; /* buflen must be > 0 */
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ base_cell = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+
+ s = alloca(params[3]);
+
+ while (i < params[3])
+ {
+ int offset = base_cell + (i * sizeof(Embryo_Cell));
+
+ s[i] = *(Embryo_Cell *)(data + offset);
+ if (!s[i++]) break;
+ }
+
+ s[i - 1] = 0;
+ STRSET(ep, params[2], s);
+
+ return i - 1; /* characters written minus terminator */
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_args_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "numargs", _embryo_args_numargs);
+ embryo_program_native_call_add(ep, "getarg", _embryo_args_getarg);
+ embryo_program_native_call_add(ep, "setarg", _embryo_args_setarg);
+ embryo_program_native_call_add(ep, "getfarg", _embryo_args_getarg);
+ embryo_program_native_call_add(ep, "setfarg", _embryo_args_setarg);
+ embryo_program_native_call_add(ep, "getsarg", _embryo_args_getsarg);
+}
--- /dev/null
+/* Float arithmetic for the Small AMX engine
+ *
+ * Copyright (c) Artran, Inc. 1999
+ * Written by Greg Garner (gmg@artran.com)
+ * Portions Copyright (c) Carsten Haitzler, 2004 <raster@rasterman.com>
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+/* CHANGES -
+ * 2002-08-27: Basic conversion of source from C++ to C by Adam D. Moss
+ * <adam@gimp.org> <aspirin@icculus.org>
+ * 2003-08-29: Removal of the dynamic memory allocation and replacing two
+ * type conversion functions by macros, by Thiadmer Riemersma
+ * 2003-09-22: Moved the type conversion macros to AMX.H, and simplifications
+ * of some routines, by Thiadmer Riemersma
+ * 2003-11-24: A few more native functions (geometry), plus minor modifications,
+ * mostly to be compatible with dynamically loadable extension
+ * modules, by Thiadmer Riemersma
+ * 2004-03-20: Cleaned up and reduced size for Embryo, Modified to conform to
+ * E coding style. Added extra parameter checks.
+ * Carsten Haitzler, <raster@rasterman.com>
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <math.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define PI 3.1415926535897932384626433832795f
+#ifndef MAXFLOAT
+#define MAXFLOAT 3.40282347e+38f
+#endif
+
+/* internally useful calls */
+
+static float
+_embryo_fp_degrees_to_radians(float angle, int radix)
+{
+ switch (radix)
+ {
+ case 1: /* degrees, sexagesimal system (technically: degrees/minutes/seconds) */
+ return (angle * PI / 180.0f);
+ case 2: /* grades, centesimal system */
+ return (angle * PI / 200.0f);
+ default: /* assume already radian */
+ break;
+ }
+ return angle;
+}
+
+/* exported float api */
+
+static Embryo_Cell
+_embryo_fp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = long value to convert to a float */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = (float)params[1];
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_str(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = virtual string address to convert to a float */
+ char buf[64];
+ Embryo_Cell *str;
+ float f;
+ int len;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ str = embryo_data_address_get(ep, params[1]);
+ len = embryo_data_string_length_get(ep, str);
+ if ((len == 0) || (len >= (int)sizeof(buf))) return 0;
+ embryo_data_string_get(ep, str, buf);
+ f = (float)atof(buf);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_mul(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) * EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_div(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float dividend (top) */
+ /* params[2] = float divisor (bottom) */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if (ff == 0.0)
+ {
+ if (f == 0.0)
+ return EMBRYO_FLOAT_TO_CELL(0.0f);
+ else if (f < 0.0)
+ return EMBRYO_FLOAT_TO_CELL(-MAXFLOAT);
+ else
+ return EMBRYO_FLOAT_TO_CELL(MAXFLOAT);
+ }
+ f = f / ff;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_add(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) + EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sub(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) - EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return fractional part of float */
+static Embryo_Cell
+_embryo_fp_fract(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f -= (floorf(f));
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return integer part of float, rounded */
+static Embryo_Cell
+_embryo_fp_round(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ /* params[2] = Type of rounding (cell) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ switch (params[2])
+ {
+ case 1: /* round downwards (truncate) */
+ f = (floorf(f));
+ break;
+ case 2: /* round upwards */
+ f = (ceilf(f));
+ break;
+ case 3: /* round towards zero */
+ if (f >= 0.0) f = (floorf(f));
+ else f = (ceilf(f));
+ break;
+ default: /* standard, round to nearest */
+ f = (floorf(f + 0.5));
+ break;
+ }
+ return (Embryo_Cell)f;
+}
+
+static Embryo_Cell
+_embryo_fp_cmp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if (f == ff) return 0;
+ else if (f > ff) return 1;
+ return -1;
+}
+
+static Embryo_Cell
+_embryo_fp_sqroot(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = sqrtf(f);
+ if (f < 0)
+ {
+ embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+ return 0;
+ }
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_power(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = powf(f, ff);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (value) */
+ /* params[2] = float operand 2 (base) */
+ float f, ff, tf;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if ((f <= 0.0) || (ff <= 0.0))
+ {
+ embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+ return 0;
+ }
+ if (ff == 10.0) f = log10f(f);
+ else if (ff == 2.0) f = log2f(f);
+ else
+ {
+ tf = logf(ff);
+ if (tf == 0.0) f = 0.0;
+ else f = (logf(f) / tf);
+ }
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = sinf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = cosf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_tan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = tanf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_abs(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = (f >= 0) ? f : -f;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_asin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = sinf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_acos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = cosf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = tanf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (y) */
+ /* params[2] = float operand 2 (x) */
+ /* params[3] = float operand 3 (radix) */
+ float f, ff;
+
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = atan2f(f, ff);
+ f = _embryo_fp_degrees_to_radians(f, params[3]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log1p(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = log1pf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cbrt(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = cbrtf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = expf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = exp2f(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_hypot(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = hypotf(f, ff);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_fp_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "float", _embryo_fp);
+ embryo_program_native_call_add(ep, "atof", _embryo_fp_str);
+ embryo_program_native_call_add(ep, "float_mul", _embryo_fp_mul);
+ embryo_program_native_call_add(ep, "float_div", _embryo_fp_div);
+ embryo_program_native_call_add(ep, "float_add", _embryo_fp_add);
+ embryo_program_native_call_add(ep, "float_sub", _embryo_fp_sub);
+ embryo_program_native_call_add(ep, "fract", _embryo_fp_fract);
+ embryo_program_native_call_add(ep, "round", _embryo_fp_round);
+ embryo_program_native_call_add(ep, "float_cmp", _embryo_fp_cmp);
+ embryo_program_native_call_add(ep, "sqrt", _embryo_fp_sqroot);
+ embryo_program_native_call_add(ep, "pow", _embryo_fp_power);
+ embryo_program_native_call_add(ep, "log", _embryo_fp_log);
+ embryo_program_native_call_add(ep, "sin", _embryo_fp_sin);
+ embryo_program_native_call_add(ep, "cos", _embryo_fp_cos);
+ embryo_program_native_call_add(ep, "tan", _embryo_fp_tan);
+ embryo_program_native_call_add(ep, "abs", _embryo_fp_abs);
+ /* Added in embryo 1.2 */
+ embryo_program_native_call_add(ep, "asin", _embryo_fp_asin);
+ embryo_program_native_call_add(ep, "acos", _embryo_fp_acos);
+ embryo_program_native_call_add(ep, "atan", _embryo_fp_atan);
+ embryo_program_native_call_add(ep, "atan2", _embryo_fp_atan2);
+ embryo_program_native_call_add(ep, "log1p", _embryo_fp_log1p);
+ embryo_program_native_call_add(ep, "cbrt", _embryo_fp_cbrt);
+ embryo_program_native_call_add(ep, "exp", _embryo_fp_exp);
+ embryo_program_native_call_add(ep, "exp2", _embryo_fp_exp2);
+ embryo_program_native_call_add(ep, "hypot", _embryo_fp_hypot);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+static Embryo_Version _version = { VMAJ, VMIN, VMIC, VREV };
+EAPI Embryo_Version *embryo_version = &_version;
+
+static int _embryo_init_count = 0;
+
+/*** EXPORTED CALLS ***/
+
+EAPI int
+embryo_init(void)
+{
+ if (++_embryo_init_count != 1)
+ return _embryo_init_count;
+
+ srand(time(NULL));
+
+ return _embryo_init_count;
+}
+
+EAPI int
+embryo_shutdown(void)
+{
+ if (_embryo_init_count <= 0)
+ {
+ printf("%s:%i Init count not greater than 0 in shutdown.", __FUNCTION__, __LINE__);
+ return 0;
+ }
+ if (--_embryo_init_count != 0)
+ return _embryo_init_count;
+
+ return _embryo_init_count;
+}
--- /dev/null
+#ifndef _EMBRYO_PRIVATE_H
+#define _EMBRYO_PRIVATE_H
+
+
+#ifdef __GNUC__
+# if __GNUC__ >= 4
+// BROKEN in gcc 4 on amd64
+//# pragma GCC visibility push(hidden)
+# endif
+#endif
+
+typedef enum _Embryo_Opcode Embryo_Opcode;
+
+enum _Embryo_Opcode
+{
+ EMBRYO_OP_NONE,
+ EMBRYO_OP_LOAD_PRI,
+ EMBRYO_OP_LOAD_ALT,
+ EMBRYO_OP_LOAD_S_PRI,
+ EMBRYO_OP_LOAD_S_ALT,
+ EMBRYO_OP_LREF_PRI,
+ EMBRYO_OP_LREF_ALT,
+ EMBRYO_OP_LREF_S_PRI,
+ EMBRYO_OP_LREF_S_ALT,
+ EMBRYO_OP_LOAD_I,
+ EMBRYO_OP_LODB_I,
+ EMBRYO_OP_CONST_PRI,
+ EMBRYO_OP_CONST_ALT,
+ EMBRYO_OP_ADDR_PRI,
+ EMBRYO_OP_ADDR_ALT,
+ EMBRYO_OP_STOR_PRI,
+ EMBRYO_OP_STOR_ALT,
+ EMBRYO_OP_STOR_S_PRI,
+ EMBRYO_OP_STOR_S_ALT,
+ EMBRYO_OP_SREF_PRI,
+ EMBRYO_OP_SREF_ALT,
+ EMBRYO_OP_SREF_S_PRI,
+ EMBRYO_OP_SREF_S_ALT,
+ EMBRYO_OP_STOR_I,
+ EMBRYO_OP_STRB_I,
+ EMBRYO_OP_LIDX,
+ EMBRYO_OP_LIDX_B,
+ EMBRYO_OP_IDXADDR,
+ EMBRYO_OP_IDXADDR_B,
+ EMBRYO_OP_ALIGN_PRI,
+ EMBRYO_OP_ALIGN_ALT,
+ EMBRYO_OP_LCTRL,
+ EMBRYO_OP_SCTRL,
+ EMBRYO_OP_MOVE_PRI,
+ EMBRYO_OP_MOVE_ALT,
+ EMBRYO_OP_XCHG,
+ EMBRYO_OP_PUSH_PRI,
+ EMBRYO_OP_PUSH_ALT,
+ EMBRYO_OP_PUSH_R,
+ EMBRYO_OP_PUSH_C,
+ EMBRYO_OP_PUSH,
+ EMBRYO_OP_PUSH_S,
+ EMBRYO_OP_POP_PRI,
+ EMBRYO_OP_POP_ALT,
+ EMBRYO_OP_STACK,
+ EMBRYO_OP_HEAP,
+ EMBRYO_OP_PROC,
+ EMBRYO_OP_RET,
+ EMBRYO_OP_RETN,
+ EMBRYO_OP_CALL,
+ EMBRYO_OP_CALL_PRI,
+ EMBRYO_OP_JUMP,
+ EMBRYO_OP_JREL,
+ EMBRYO_OP_JZER,
+ EMBRYO_OP_JNZ,
+ EMBRYO_OP_JEQ,
+ EMBRYO_OP_JNEQ,
+ EMBRYO_OP_JLESS,
+ EMBRYO_OP_JLEQ,
+ EMBRYO_OP_JGRTR,
+ EMBRYO_OP_JGEQ,
+ EMBRYO_OP_JSLESS,
+ EMBRYO_OP_JSLEQ,
+ EMBRYO_OP_JSGRTR,
+ EMBRYO_OP_JSGEQ,
+ EMBRYO_OP_SHL,
+ EMBRYO_OP_SHR,
+ EMBRYO_OP_SSHR,
+ EMBRYO_OP_SHL_C_PRI,
+ EMBRYO_OP_SHL_C_ALT,
+ EMBRYO_OP_SHR_C_PRI,
+ EMBRYO_OP_SHR_C_ALT,
+ EMBRYO_OP_SMUL,
+ EMBRYO_OP_SDIV,
+ EMBRYO_OP_SDIV_ALT,
+ EMBRYO_OP_UMUL,
+ EMBRYO_OP_UDIV,
+ EMBRYO_OP_UDIV_ALT,
+ EMBRYO_OP_ADD,
+ EMBRYO_OP_SUB,
+ EMBRYO_OP_SUB_ALT,
+ EMBRYO_OP_AND,
+ EMBRYO_OP_OR,
+ EMBRYO_OP_XOR,
+ EMBRYO_OP_NOT,
+ EMBRYO_OP_NEG,
+ EMBRYO_OP_INVERT,
+ EMBRYO_OP_ADD_C,
+ EMBRYO_OP_SMUL_C,
+ EMBRYO_OP_ZERO_PRI,
+ EMBRYO_OP_ZERO_ALT,
+ EMBRYO_OP_ZERO,
+ EMBRYO_OP_ZERO_S,
+ EMBRYO_OP_SIGN_PRI,
+ EMBRYO_OP_SIGN_ALT,
+ EMBRYO_OP_EQ,
+ EMBRYO_OP_NEQ,
+ EMBRYO_OP_LESS,
+ EMBRYO_OP_LEQ,
+ EMBRYO_OP_GRTR,
+ EMBRYO_OP_GEQ,
+ EMBRYO_OP_SLESS,
+ EMBRYO_OP_SLEQ,
+ EMBRYO_OP_SGRTR,
+ EMBRYO_OP_SGEQ,
+ EMBRYO_OP_EQ_C_PRI,
+ EMBRYO_OP_EQ_C_ALT,
+ EMBRYO_OP_INC_PRI,
+ EMBRYO_OP_INC_ALT,
+ EMBRYO_OP_INC,
+ EMBRYO_OP_INC_S,
+ EMBRYO_OP_INC_I,
+ EMBRYO_OP_DEC_PRI,
+ EMBRYO_OP_DEC_ALT,
+ EMBRYO_OP_DEC,
+ EMBRYO_OP_DEC_S,
+ EMBRYO_OP_DEC_I,
+ EMBRYO_OP_MOVS,
+ EMBRYO_OP_CMPS,
+ EMBRYO_OP_FILL,
+ EMBRYO_OP_HALT,
+ EMBRYO_OP_BOUNDS,
+ EMBRYO_OP_SYSREQ_PRI,
+ EMBRYO_OP_SYSREQ_C,
+ EMBRYO_OP_FILE,
+ EMBRYO_OP_LINE,
+ EMBRYO_OP_SYMBOL,
+ EMBRYO_OP_SRANGE,
+ EMBRYO_OP_JUMP_PRI,
+ EMBRYO_OP_SWITCH,
+ EMBRYO_OP_CASETBL,
+ EMBRYO_OP_SWAP_PRI,
+ EMBRYO_OP_SWAP_ALT,
+ EMBRYO_OP_PUSHADDR,
+ EMBRYO_OP_NOP,
+ EMBRYO_OP_SYSREQ_D,
+ EMBRYO_OP_SYMTAG,
+ /* ----- */
+ EMBRYO_OP_NUM_OPCODES
+};
+
+#define NUMENTRIES(hdr, field, nextfield) \
+(int)(((hdr)->nextfield - (hdr)->field) / (hdr)->defsize)
+#define GETENTRY(hdr, table, index) \
+(Embryo_Func_Stub *)((unsigned char*)(hdr) + \
+(int)(hdr)->table + index * (hdr)->defsize)
+#ifdef WORDS_BIGENDIAN
+static int __inline __entryswap32(int v)
+{int vv; vv = v; embryo_swap_32((unsigned int *)&vv); return vv;}
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + \
+__entryswap32(*((unsigned int *)(entry) + 1))) \
+: (entry)->name)
+#else
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + *((unsigned int *)(entry) + 1)) \
+: (entry)->name)
+#endif
+
+#define CUR_FILE_VERSION 7 /* current file version; also the current Embryo_Program version */
+#define MIN_FILE_VERSION 7 /* lowest supported file format version for the current Embryo_Program version */
+#define MIN_AMX_VERSION 7 /* minimum Embryo_Program version needed to support the current file format */
+#define sEXPMAX 19 /* maximum name length for file version <= 6 */
+#define sNAMEMAX 31 /* maximum name length of symbol name */
+#define EMBRYO_MAGIC 0xf1e0 /* magic byte pattern */
+#define EMBRYO_FLAG_COMPACT 0x04 /* compact encoding */
+#define EMBRYO_FLAG_RELOC 0x8000 /* jump/call addresses relocated */
+#define GETPARAM(v) (v = *(Embryo_Cell *)cip++)
+#define PUSH(v) (stk -= sizeof(Embryo_Cell), *(Embryo_Cell *)(data + (int)stk) = v)
+#define POP(v) (v = *(Embryo_Cell *)(data + (int)stk), stk += sizeof(Embryo_Cell))
+#define ABORT(ep,v) {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_FAIL;}
+#define OK(ep,v) {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_OK;}
+#define TOOLONG(ep) {(ep)->pri = pri; (ep)->cip = (Embryo_Cell)((unsigned char *)cip - code); (ep)->alt = alt; (ep)->frm = frm; (ep)->stk = stk; (ep)->hea = hea; (ep)->reset_stk = reset_stk; (ep)->reset_hea = reset_hea; (ep)->run_count--; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_TOOLONG;}
+#define STKMARGIN ((Embryo_Cell)(16 * sizeof(Embryo_Cell)))
+#define CHKMARGIN() if ((hea + STKMARGIN) > stk) {ep->error = EMBRYO_ERROR_STACKERR; return 0;}
+#define CHKSTACK() if (stk > ep->stp) {ep->run_count--; ep->error = EMBRYO_ERROR_STACKLOW; return 0;}
+#define CHKHEAP() if (hea < ep->hlw) {ep->run_count--; ep->error = EMBRYO_ERROR_HEAPLOW; return 0;}
+#define CHKMEM(x) if ((((x) >= hea) && ((x) < stk)) || ((Embryo_UCell)(x) >= (Embryo_UCell)ep->stp)) ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+
+typedef struct _Embryo_Param Embryo_Param;
+typedef struct _Embryo_Header Embryo_Header;
+typedef struct _Embryo_Func_Stub Embryo_Func_Stub;
+
+typedef Embryo_Cell (*Embryo_Native)(Embryo_Program *ep, Embryo_Cell *params);
+
+struct _Embryo_Param
+{
+ char *string;
+ Embryo_Cell *cell_array;
+ int cell_array_size;
+ Embryo_Cell cell;
+};
+
+struct _Embryo_Program
+{
+ unsigned char *base; /* points to the Embryo_Program header ("ephdr") plus the code, optionally also the data */
+ int pushes; /* number of pushes - pops */
+ /* for external functions a few registers must be accessible from the outside */
+ Embryo_Cell cip; /* instruction pointer: relative to base + ephdr->cod */
+ Embryo_Cell frm; /* stack frame base: relative to base + ephdr->dat */
+ Embryo_Cell hea; /* top of the heap: relative to base + ephdr->dat */
+ Embryo_Cell hlw; /* bottom of the heap: relative to base + ephdr->dat */
+ Embryo_Cell stk; /* stack pointer: relative to base + ephdr->dat */
+ Embryo_Cell stp; /* top of the stack: relative to base + ephdr->dat */
+ int flags; /* current status */
+ /* native functions can raise an error */
+ int error;
+ /* the sleep opcode needs to store the full Embryo_Program status */
+ Embryo_Cell pri;
+ Embryo_Cell alt;
+ Embryo_Cell reset_stk;
+ Embryo_Cell reset_hea;
+ Embryo_Cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
+
+ /* extended stuff */
+ Embryo_Native *native_calls;
+ int native_calls_size;
+ int native_calls_alloc;
+
+ unsigned char *code;
+ unsigned char dont_free_code : 1;
+ Embryo_Cell retval;
+
+ Embryo_Param *params;
+ int params_size;
+ int params_alloc;
+
+ int run_count;
+
+ int max_run_cycles;
+
+ void *data;
+};
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+struct _Embryo_Func_Stub
+{
+ int address;
+ char name[sEXPMAX+1];
+} EMBRYO_STRUCT_PACKED;
+
+struct _Embryo_Header
+{
+ unsigned int size; /* size of the "file" */
+ unsigned short magic; /* signature */
+ char file_version; /* file format version */
+ char ep_version; /* required version of the Embryo_Program */
+ short flags;
+ short defsize; /* size of a definition record */
+ int cod; /* initial value of COD - code block */
+ int dat; /* initial value of DAT - data block */
+ int hea; /* initial value of HEA - start of the heap */
+ int stp; /* initial value of STP - stack top */
+ int cip; /* initial value of CIP - the instruction pointer */
+ int publics; /* offset to the "public functions" table */
+ int natives; /* offset to the "native functions" table */
+ int libraries; /* offset to the table of libraries */
+ int pubvars; /* the "public variables" table */
+ int tags; /* the "public tagnames" table */
+ int nametable; /* name table, file version 7 only */
+} EMBRYO_STRUCT_PACKED;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+void _embryo_args_init(Embryo_Program *ep);
+void _embryo_fp_init(Embryo_Program *ep);
+void _embryo_rand_init(Embryo_Program *ep);
+void _embryo_str_init(Embryo_Program *ep);
+void _embryo_time_init(Embryo_Program *ep);
+
+#endif
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported random number api */
+
+static Embryo_Cell
+_embryo_rand_rand(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ return (Embryo_Cell)(rand() & 0xffff);
+}
+
+static Embryo_Cell
+_embryo_rand_randf(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ double r;
+ float f;
+
+ r = (double)(rand() & 0xffff) / 65535.0;
+ f = (float)r;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_rand_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "rand", _embryo_rand_rand);
+ embryo_program_native_call_add(ep, "randf", _embryo_rand_randf);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif !defined alloca
+# ifdef __GNUC__
+# define alloca __builtin_alloca
+# elif defined _AIX
+# define alloca __alloca
+# elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+# elif !defined HAVE_ALLOCA
+# ifdef __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+# endif
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <fnmatch.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRGET(ep, str, par) { \
+ Embryo_Cell *___cptr; \
+ str = NULL; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ int ___l; \
+ ___l = embryo_data_string_length_get(ep, ___cptr); \
+ (str) = alloca(___l + 1); \
+ if (str) embryo_data_string_get(ep, ___cptr, str); \
+ } }
+#define STRSET(ep, par, str) { \
+ Embryo_Cell *___cptr; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ embryo_data_string_set(ep, str, ___cptr); \
+ } }
+
+/* exported string api */
+
+static Embryo_Cell
+_embryo_str_atoi(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = str */
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ if (!s1) return 0;
+ return (Embryo_Cell)atoi(s1);
+}
+
+static Embryo_Cell
+_embryo_str_fnmatch(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = glob */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)fnmatch(s1, s2, 0);
+}
+
+static Embryo_Cell
+_embryo_str_strcmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = str1 */
+ /* params[2] = str2 */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return -1;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)strcmp(s1, s2);
+}
+
+static Embryo_Cell
+_embryo_str_strncmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = str1 */
+ /* params[2] = str2 */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)strncmp(s1, s2, (size_t)params[3]);
+}
+
+static Embryo_Cell
+_embryo_str_strcpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ STRSET(ep, params[1], s1);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+ int l;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ l = strlen(s1);
+ if (l > params[3]) s1[params[3]] = 0;
+ STRSET(ep, params[1], s1);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strlen(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = str */
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ if (!s1) return 0;
+ return (Embryo_Cell)strlen(s1);
+}
+
+static Embryo_Cell
+_embryo_str_strcat(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+
+ /* params[1] = dsr */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ s3 = alloca(strlen(s1) + strlen(s2) + 1);
+ if (!s3) return 0;
+ strcpy(s3, s1);
+ strcat(s3, s2);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncat(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+ int l1, l2;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ l1 = strlen(s1);
+ l2 = strlen(s2);
+ s3 = alloca(l1 + l2 + 1);
+ if (!s3) return 0;
+ strcpy(s3, s1);
+ strncat(s3, s2, params[3]);
+ if (l2 >= params[3]) s3[l1 + params[3]] = 0;
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ s3 = alloca(strlen(s1) + strlen(s2) + 1);
+ if (!s3) return 0;
+ strcpy(s3, s2);
+ strcat(s3, s1);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strnprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+ int l1, l2;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ l1 = strlen(s1);
+ l2 = strlen(s2);
+ s3 = alloca(l1 + l2 + 1);
+ if (!s3) return 0;
+ strncpy(s3, s2, params[3]);
+ if (params[3] <= l2) s3[params[3]] = 0;
+ strcat(s3, s1);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strcut(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+ int l1;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ /* params[4] = n2 */
+ if (params[0] != (4 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ if (params[4] < params[3]) params[4] = params[3];
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ l1 = strlen(s1);
+ if (params[3] >= l1) params[3] = l1;
+ if (params[4] >= l1) params[4] = l1;
+ if (params[4] == params[3])
+ {
+ STRSET(ep, params[1], "");
+ return 0;
+ }
+ s2 = alloca(params[4] - params[3] + 1);
+ strncpy(s2, s1 + params[3], params[4] - params[3]);
+ s2[params[4] - params[3]] = 0;
+ STRSET(ep, params[1], s2);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_snprintf(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+ int i, o;
+ int inesc = 0;
+ int insub = 0;
+ int p, pnum;
+
+ /* params[1] = buf */
+ /* params[2] = bufsize */
+ /* params[3] = format_string */
+ /* params[4] = first arg ... */
+ if (params[0] < (Embryo_Cell)(3 * sizeof(Embryo_Cell))) return 0;
+ if (params[2] <= 0) return 0;
+ STRGET(ep, s1, params[3]);
+ if (!s1) return -1;
+ s2 = alloca(params[2] + 1);
+ if (!s2) return -1;
+ s2[0] = 0;
+ pnum = (params[0] / sizeof(Embryo_Cell)) - 3;
+ for (p = 0, o = 0, i = 0; (s1[i]) && (o < (params[2] - 1)) && (p < (pnum + 1)); i++)
+ {
+ if ((!inesc) && (!insub))
+ {
+ if (s1[i] == '\\') inesc = 1;
+ else if (s1[i] == '%') insub = 1;
+ if ((!inesc) && (!insub))
+ {
+ s2[o] = s1[i];
+ o++;
+ }
+ }
+ else
+ {
+ Embryo_Cell *cptr;
+
+ if (inesc)
+ {
+ switch (s1[i])
+ {
+ case 't':
+ s2[o] = '\t';
+ o++;
+ break;
+ case 'n':
+ s2[o] = '\n';
+ o++;
+ break;
+ default:
+ s2[o] = s1[i];
+ o++;
+ break;
+ }
+ inesc = 0;
+ }
+ if ((insub) && (s1[i] == '%')) pnum++;
+ if ((insub) && (p < pnum))
+ {
+ switch (s1[i])
+ {
+ case '%':
+ s2[o] = '%';
+ o++;
+ break;
+ case 'c':
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) s2[o] = (char)(*cptr);
+ p++;
+ o++;
+ break;
+ case 'i':
+ case 'd':
+ case 'x':
+ case 'X':
+ {
+ char fmt[10] = "";
+ char tmp[256] = "";
+ int l;
+
+ if (s1[i] == 'i') strcpy(fmt, "%i");
+ else if (s1[i] == 'd') strcpy(fmt, "%d");
+ else if (s1[i] == 'x') strcpy(fmt, "%x");
+ else if (s1[i] == 'X') strcpy(fmt, "%08x");
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) snprintf(tmp, sizeof(tmp), fmt, (int)(*cptr));
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ case 'f':
+ {
+ char tmp[256] = "";
+ int l;
+
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) snprintf(tmp, sizeof(tmp), "%f", (double)EMBRYO_CELL_TO_FLOAT(*cptr));
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ case 's':
+ {
+ char *tmp;
+ int l;
+
+ STRGET(ep, tmp, params[4 + p]);
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ default:
+ break;
+ }
+ insub = 0;
+ }
+ else if (insub)
+ insub = 0;
+ }
+ }
+ s2[o] = 0;
+
+ STRSET(ep, params[1], s2);
+ return o;
+}
+
+static Embryo_Cell
+_embryo_str_strstr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ndl */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strstr(s1, s2);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ch */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strchr(s1, s2[0]);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strrchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ch */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strrchr(s1, s2[0]);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_str_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "atoi", _embryo_str_atoi);
+ embryo_program_native_call_add(ep, "fnmatch", _embryo_str_fnmatch);
+ embryo_program_native_call_add(ep, "strcmp", _embryo_str_strcmp);
+ embryo_program_native_call_add(ep, "strncmp", _embryo_str_strncmp);
+ embryo_program_native_call_add(ep, "strcpy", _embryo_str_strcpy);
+ embryo_program_native_call_add(ep, "strncpy", _embryo_str_strncpy);
+ embryo_program_native_call_add(ep, "strlen", _embryo_str_strlen);
+ embryo_program_native_call_add(ep, "strcat", _embryo_str_strcat);
+ embryo_program_native_call_add(ep, "strncat", _embryo_str_strncat);
+ embryo_program_native_call_add(ep, "strprep", _embryo_str_strprep);
+ embryo_program_native_call_add(ep, "strnprep", _embryo_str_strnprep);
+ embryo_program_native_call_add(ep, "strcut", _embryo_str_strcut);
+ embryo_program_native_call_add(ep, "snprintf", _embryo_str_snprintf);
+ embryo_program_native_call_add(ep, "strstr", _embryo_str_strstr);
+ embryo_program_native_call_add(ep, "strchr", _embryo_str_strchr);
+ embryo_program_native_call_add(ep, "strrchr", _embryo_str_strrchr);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifndef EFL_HAVE_GETTIMEOFDAY
+# error "Your platform isn't supported yet"
+#endif
+
+#include <sys/time.h>
+#include <time.h>
+
+#ifdef _MSC_VER
+# include <winsock2.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported time api */
+
+static Embryo_Cell
+_embryo_time_seconds(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ struct timeval timev;
+ double t;
+ float f;
+
+ gettimeofday(&timev, NULL);
+ t = (double)(timev.tv_sec - ((timev.tv_sec / (60 * 60 * 24)) * (60 * 60 * 24)))
+ + (((double)timev.tv_usec) / 1000000);
+ f = (float)t;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_time_date(Embryo_Program *ep, Embryo_Cell *params)
+{
+ static time_t last_tzset = 0;
+ struct timeval timev;
+ struct tm *tm;
+ time_t tt;
+
+ if (params[0] != (8 * sizeof(Embryo_Cell))) return 0;
+ gettimeofday(&timev, NULL);
+ tt = (time_t)(timev.tv_sec);
+ if ((tt > (last_tzset + 1)) ||
+ (tt < (last_tzset - 1)))
+ {
+ last_tzset = tt;
+ tzset();
+ }
+ tm = localtime(&tt);
+ if (tm)
+ {
+ Embryo_Cell *cptr;
+ double t;
+ float f;
+
+ cptr = embryo_data_address_get(ep, params[1]);
+ if (cptr) *cptr = tm->tm_year + 1900;
+ cptr = embryo_data_address_get(ep, params[2]);
+ if (cptr) *cptr = tm->tm_mon + 1;
+ cptr = embryo_data_address_get(ep, params[3]);
+ if (cptr) *cptr = tm->tm_mday;
+ cptr = embryo_data_address_get(ep, params[4]);
+ if (cptr) *cptr = tm->tm_yday;
+ cptr = embryo_data_address_get(ep, params[5]);
+ if (cptr) *cptr = (tm->tm_wday + 6) % 7;
+ cptr = embryo_data_address_get(ep, params[6]);
+ if (cptr) *cptr = tm->tm_hour;
+ cptr = embryo_data_address_get(ep, params[7]);
+ if (cptr) *cptr = tm->tm_min;
+ cptr = embryo_data_address_get(ep, params[8]);
+ t = (double)tm->tm_sec + (((double)timev.tv_usec) / 1000000);
+ f = (float)t;
+ if (cptr) *cptr = EMBRYO_FLOAT_TO_CELL(f);
+
+ }
+ return 0;
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_time_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "seconds", _embryo_time_seconds);
+ embryo_program_native_call_add(ep, "date", _embryo_time_date);
+}
--- /dev/null
+#sbs-git:slp/pkgs/e/embryo embryo 1.1.0+svn.68928slp2+build01 ff312ab0f1dd243c5f94e56b2e55f3c43b0cf40f
+Name: embryo
+Summary: A small virtual machine engine (in a library) and bytecode compiler
+Version: 1.6.0+svn.76491slp2+build04
+Release: 1
+Group: System/Libraries
+License: BSD
+URL: http://www.enlightenment.org/
+Source0: %{name}-%{version}.tar.gz
+Requires(post): /sbin/ldconfig
+Requires(postun): /sbin/ldconfig
+BuildRequires: pkgconfig(eina)
+Provides: embryo-bin
+
+
+%description
+Development files for libembryo0 Embryo is primarily a shared library that gives you an API to load
+ and control interpreted programs compiled into an abstract machine
+ bytecode that it understands. This abstract (or virtual) machine is
+ similar to a real machine with a CPU, but it is emulated in
+ software.
+ .
+ This packages contains headers and static libraries for Embryo.
+
+
+
+%package devel
+Summary: A small virtual machine engine and bytecode compile (devel)
+Group: Development/Libraries
+Requires: %{name} = %{version}-%{release}
+
+%description devel
+A small virtual machine engine (in a library) and bytecode compile (devel)
+
+%prep
+%setup -q
+
+
+%build
+export CFLAGS+=" -fvisibility=hidden -fPIC"
+export LDFLAGS+=" -fvisibility=hidden -Wl,--hash-style=both -Wl,--as-needed"
+
+
+cd %{_repository} && %autogen --disable-static
+make %{?jobs:-j%jobs}
+
+%install
+cd %{_repository} && %make_install
+mkdir -p %{buildroot}/usr/share/license
+cp %{_builddir}/%{buildsubdir}/COPYING %{buildroot}/usr/share/license/%{name}
+
+%post -p /sbin/ldconfig
+
+%postun -p /sbin/ldconfig
+
+%files
+%defattr(-,root,root,-)
+%{_libdir}/libembryo.so.*
+%{_bindir}/embryo_cc
+%{_datadir}/embryo/include/default.inc
+%manifest %{name}.manifest
+/usr/share/license/%{name}
+
+
+%files devel
+%defattr(-,root,root,-)
+%{_includedir}/embryo-1/Embryo.h
+%{_libdir}/libembryo.so
+%{_libdir}/pkgconfig/*.pc
--- /dev/null
+The Rasterman (Carsten Haitzler) <raster@rasterman.com>
+Jérôme Pinot <ngc891@gmail.com>
--- /dev/null
+2011-01-29 Carsten Haitzler (The Rasterman)
+
+ 1.0.0 release
+
+2011-05-12 Carsten Haitzler (The Rasterman)
+
+ * Make embryo_cc use eina and eina_prefix to determine include location
+
+2011-07-16 Vincent Torri
+
+ * delete temporary files on Windows
+
+2011-10-05 Vincent Torri
+
+ * use fseek() instead of rewind() as the latter does not exist on
+ Windows CE and fix compilation with Evil.
+
+2011-12-02 Carsten Haitzler (The Rasterman)
+
+ 1.1.0 release
+
+2012-02-24 Cedric Bail
+
+ * Add exotic support
+
+2012-03-07 Vincent Torri
+
+ * Fix windows compilation issues
+
+2012-04-16 Carsten Haitzler (The Rasterman)
+
+ * Add asin(), acos(), atan(), atan2(), log1p(), cbrt(), exp(),
+ exp2(), hypot(), EMBRYO_12 define
+
+2012-04-26 Carsten Haitzler (The Rasterman)
+
+ 1.2.0 release
+
+2012-06-14 Carsten Haitzler (The Rasterman)
+
+ * Fix divide by 0 possibilities in the fp support so no FPE is
+ produced (bad).
+
+2012-08-30 Carsten Haitzler (The Rasterman)
+
+ 1.7.0 release
+
+2012-09-12 Carsten Haitzler (The Rasterman)
+
+ * Fix windows utf/whitespace parsing issue in windows
+
--- /dev/null
+ACLOCAL_AMFLAGS = -I m4
+
+SUBDIRS = src include doc
+
+MAINTAINERCLEANFILES = \
+Makefile.in \
+aclocal.m4 \
+compile \
+config.guess \
+config.h.in \
+config.h.in~ \
+config.sub \
+configure \
+depcomp \
+install-sh \
+ltmain.sh \
+missing \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION).tar.gz \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION).tar.bz2 \
+$(PACKAGE_TARNAME)-$(PACKAGE_VERSION)-doc.tar.bz2 \
+m4/libtool.m4 \
+m4/lt~obsolete.m4 \
+m4/ltoptions.m4 \
+m4/ltsugar.m4 \
+m4/ltversion.m4
+
+EXTRA_DIST = \
+AUTHORS \
+COPYING \
+autogen.sh \
+embryo.pc.in \
+embryo.spec.in \
+embryo.spec
+
+pkgconfigdir = $(libdir)/pkgconfig
+pkgconfig_DATA = embryo.pc
+
+.PHONY: doc
+
+# Documentation
+
+doc:
+ @echo "entering doc/"
+ make -C doc doc
--- /dev/null
+Embryo 1.8.0
+
+Changes since Embryo 1.7.0:
+---------------------------
+
+Fixes:
+
+ * Fix windows utf8 shitepsace parse issue.
+
+Changes since Embryo 1.2.0:
+---------------------------
+
+Fixes:
+
+ * Fix divide by 0 n FP support to avoid FPE.
+
+Changes since Embryo 1.1.0:
+---------------------------
+
+Additions:
+
+ * exotic support
+ * asin()
+ * acos()
+ * atan()
+ * atan2()
+ * log1p()
+ * cbrt()
+ * exp(),
+ * exp2()
+ * hypot()
+ * EMBRYO_12
+
+Fixes:
+
+ * windows compilation support
+
+Improvements:
+
+ * exotic support
+
+Changes since Embryo 1.0.0:
+---------------------------
+
+Fixes:
+
+ * on windows use fseek instead of rewind as rewind doesn't exist on wince
+ * delete tmp files on windows
+
+Improvements:
+
+ * make embryo_cc use eina_prefix to determine installation location
+
--- /dev/null
+Embryo 1.7.99
+
+******************************************************************************
+
+ FOR ANY ISSUES PLEASE EMAIL:
+ enlightenment-devel@lists.sourceforge.net
+
+******************************************************************************
+
+Requirements:
+-------------
+
+Must:
+ eina
+ libc
+
+WARNING: gcc compatibility!!!
+There seems to be some bug (or disagreement) between embryo and gcc 3.2.x
+where IEEE floating point format encoding does not "agree" with embryo's own
+hand-made tests. embryo_cc may not work if you compile using gcc 3.2.x. gcc
+3.3.x is known to work fine. we are not 100% sure whose fault this is yet, so
+we won't be jumping up and down, but be warned - gcc 3.2.x does not agree
+with embryo.
+
+To view the API docs, run ./gendoc and view doc/html/index.html.
+
+OK a lot of people ask this. What is Embryo?
+
+Embryo is primarily a shared library that gives you an API to load and control
+interpreted programs compiled into an abstract machine bytecode that it
+understands. This abstract (or virtual) machine is similar to a real machine
+with a CPU, but it is emulated in software. The architecture is simple and is
+the same as the abstract machine (AMX) in the
+<a href=http://www.compuphase.com/pawn>PAWN</a> language (formerly called
+SMALL) as it is based on exactly the same code. Embryo has modified the code
+for the AMX extensively and has made it smaller and more portable. It is VERY
+small. The total size of the virtual machine code AND header files is less
+than 2500 lines of code. It includes the floating point library support by
+default as well. This makes it one of the smallest interpreters around, and
+thus makes is very efficient to use in code.
+
+Embryo also uses the PAWN compiler from the same code base. This code has
+barely been touched and so suffers from lots of portability issues. It has
+been partially fixed and now works on both big and little endian but the code
+still need to be gone over and really cleaned up . It does work, but it's only
+just working. It has been called embryo_cc and compiled a subset of PAWN
+binary outputs. It does not support packed strings, variable alignment, or
+debugging output. It does not support many features of the full PAWN
+compiler because the Embryo AMX does not support these either. You will find
+the Embryo codebase to work much better on Linux (and BSD and MacOS X) and
+other UNIX operating systems as it has been developed and tested on them. IT
+is known to work on:
+ gcc Linux (x86-32)
+ gcc Linux (PPC)
+ gcc MacOS X (PPC)
+
+And will likely work on more combinations. IT currently has problems on 64bit
+SPARC CPUs. Other 64bit systems are untested. It is the aim to fix the code
+so it works on all commonly used architectures (32, 64bit, big and little
+endian, alignment forgiving/unforgiving). So far 64bit support is the major
+issue.
+
+For more documentation please see the Language guide here:
+
+<a href=http://www.compuphase.com/pawn>Pawn Language Booklet</a>
+
+This documents the PAWN language and is 100% relevant for Embryo and the
+syntax of files it can compile (.sma files).
+
+Any help is appreciated in helping clean and port this code, so feel free to
+send patches to the Enlightenment development lists.
+
+The main aim of Embryo is to provide an easy to use library for running
+compiled PAWN programs and giving them access to the calling program and
+any API it exports to the PAWN script. PAWN programs/scripts are completely
+sand-boxed. They cannot access any system or function calls other than the
+ones provided by the calling application to the Embryo API. This means a
+PAWN script cannot open or write to, delete or load files. It is fairly
+harmless and this also keeps Embryo small.
+
+This is a work in progress, so please be patient if things don't work for you
+- and patches and help in fixing it is very much appreciated.
+
+------------------------------------------------------------------------------
+COMPILING AND INSTALLING:
+
+ ./configure
+ make
+(as root unless you are installing in your users directories):
+ make install
--- /dev/null
+#!/bin/sh
+
+rm -rf autom4te.cache
+rm -f aclocal.m4 ltmain.sh
+
+touch ABOUT-NLS
+
+echo "Running aclocal..." ; aclocal $ACLOCAL_FLAGS -I m4 || exit 1
+echo "Running autoheader..." ; autoheader || exit 1
+echo "Running autoconf..." ; autoconf || exit 1
+echo "Running libtoolize..." ; (libtoolize --copy --automake || glibtoolize --automake) || exit 1
+echo "Running automake..." ; automake --add-missing --copy --gnu || exit 1
+
+W=0
+
+rm -f config.cache-env.tmp
+echo "OLD_PARM=\"$@\"" >> config.cache-env.tmp
+echo "OLD_CFLAGS=\"$CFLAGS\"" >> config.cache-env.tmp
+echo "OLD_PATH=\"$PATH\"" >> config.cache-env.tmp
+echo "OLD_PKG_CONFIG_PATH=\"$PKG_CONFIG_PATH\"" >> config.cache-env.tmp
+echo "OLD_LDFLAGS=\"$LDFLAGS\"" >> config.cache-env.tmp
+
+cmp config.cache-env.tmp config.cache-env >> /dev/null
+if [ $? -ne 0 ]; then
+ W=1;
+fi
+
+if [ $W -ne 0 ]; then
+ echo "Cleaning configure cache...";
+ rm -f config.cache config.cache-env
+ mv config.cache-env.tmp config.cache-env
+else
+ rm -f config.cache-env.tmp
+fi
+
+if [ -z "$NOCONFIGURE" ]; then
+ ./configure -C "$@"
+fi
--- /dev/null
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_define([v_maj], [1])
+m4_define([v_min], [7])
+m4_define([v_mic], [99])
+m4_define([v_rev], m4_esyscmd([(svnversion "${SVN_REPO_PATH:-.}" | grep -v '\(export\|Unversioned directory\)' || echo 0) | awk -F : '{printf("%s\n", $1);}' | tr -d ' :MSP\n']))
+m4_if(v_rev, [0], [m4_define([v_rev], m4_esyscmd([git log 2> /dev/null | (grep -m1 git-svn-id || echo 0) | sed -e 's/.*@\([0-9]*\).*/\1/' | tr -d '\n']))])
+##-- When released, remove the dnl on the below line
+dnl m4_undefine([v_rev])
+##-- When doing snapshots - change soname. remove dnl on below line
+dnl m4_define([relname], [ver-pre-svn-07])
+dnl m4_define([v_rel], [-release ver-pre-svn-07])
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_ifdef([v_rev], [m4_define([v_ver], [v_maj.v_min.v_mic.v_rev])], [m4_define([v_ver], [v_maj.v_min.v_mic])])
+m4_define([lt_cur], m4_eval(v_maj + v_min))
+m4_define([lt_rev], v_mic)
+m4_define([lt_age], v_min)
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+
+AC_INIT([embryo], [v_ver], [enlightenment-devel@lists.sourceforge.net])
+AC_PREREQ([2.52])
+AC_CONFIG_SRCDIR([configure.ac])
+AC_CONFIG_MACRO_DIR([m4])
+
+AC_CONFIG_HEADERS([config.h])
+AH_TOP([
+#ifndef EFL_CONFIG_H__
+#define EFL_CONFIG_H__
+])
+AH_BOTTOM([
+#endif /* EFL_CONFIG_H__ */
+])
+
+AM_INIT_AUTOMAKE([1.6 dist-bzip2])
+m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])])
+
+AC_LIBTOOL_WIN32_DLL
+define([AC_LIBTOOL_LANG_CXX_CONFIG], [:])dnl
+define([AC_LIBTOOL_LANG_F77_CONFIG], [:])dnl
+AC_PROG_LIBTOOL
+
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+m4_ifdef([v_rev], , [m4_define([v_rev], [0])])
+m4_ifdef([v_rel], , [m4_define([v_rel], [])])
+AC_DEFINE_UNQUOTED(VMAJ, [v_maj], [Major version])
+AC_DEFINE_UNQUOTED(VMIN, [v_min], [Minor version])
+AC_DEFINE_UNQUOTED(VMIC, [v_mic], [Micro version])
+AC_DEFINE_UNQUOTED(VREV, [v_rev], [Revison])
+version_info="lt_cur:lt_rev:lt_age"
+release_info="v_rel"
+AC_SUBST(version_info)
+AC_SUBST(release_info)
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##
+VMAJ=v_maj
+AC_SUBST(VMAJ)
+
+### Default options with respect to host
+
+AC_CANONICAL_BUILD
+AC_CANONICAL_HOST
+
+requirement_embryo=""
+embryoincludedir="${datadir}/include"
+
+
+### Additional options to configure
+
+EFL_ENABLE_BIN([embryo-cc])
+
+
+### Checks for programs
+AC_PROG_CC
+
+# doxygen program for documentation building
+
+EFL_CHECK_DOXYGEN([build_doc="yes"], [build_doc="no"])
+
+# pkg-config
+
+PKG_PROG_PKG_CONFIG
+
+# Check whether pkg-config supports Requires.private
+if $PKG_CONFIG --atleast-pkgconfig-version 0.22; then
+ pkgconfig_requires_private="Requires.private"
+else
+ pkgconfig_requires_private="Requires"
+fi
+AC_SUBST(pkgconfig_requires_private)
+
+
+### Checks for libraries
+
+# Evil library for compilation on Windows
+
+EFL_EMBRYO_BUILD=""
+case "$host_os" in
+ mingw*)
+ PKG_CHECK_MODULES([EVIL], [evil >= 1.6.99])
+ AC_DEFINE(HAVE_EVIL, 1, [Set to 1 if Evil library is installed])
+ requirement_embryo="evil ${requirement_embryo}"
+ EFL_EMBRYO_BUILD="-DEFL_EMBRYO_BUILD"
+ ;;
+esac
+AC_SUBST(EFL_EMBRYO_BUILD)
+
+# For embryo_cc_prefix.c
+PKG_CHECK_MODULES([EINA], [eina >= 1.6.99])
+
+### Checks for portability layer
+
+PKG_CHECK_MODULES([EXOTIC],
+ [exotic],
+ [enable_exotic="yes"],
+ [enable_exotic="no"])
+
+if test "x${enable_exotic}" = "xyes"; then
+ requirement_embryo="exotic ${requirement_embryo}"
+
+ AC_DEFINE([HAVE_EXOTIC], [1], [Define to 1 if you have Exotic.])
+fi
+
+### Checks for header files
+
+AC_CHECK_HEADERS([unistd.h])
+EFL_CHECK_PATH_MAX
+
+
+### Checks for types
+
+
+### Checks for structures
+
+
+### Checks for compiler characteristics
+AC_C_BIGENDIAN
+AM_PROG_CC_C_O
+AC_C_CONST
+AC_C_INLINE
+AC_PROG_CC_STDC
+AC_HEADER_STDC
+AC_C___ATTRIBUTE__
+
+EMBRYO_CPPFLAGS=""
+EMBRYO_CFLAGS=""
+case "$host_os" in
+ mingw32ce*)
+ EMBRYO_CPPFLAGS="-D_WIN32_WCE=0x0420"
+ ;;
+esac
+AC_SUBST(EMBRYO_CPPFLAGS)
+AC_SUBST(EMBRYO_CFLAGS)
+
+
+### Checks for linker characteristics
+
+lt_enable_auto_import=""
+case "$host_os" in
+ mingw*)
+ lt_enable_auto_import="-Wl,--enable-auto-import"
+ ;;
+esac
+AC_SUBST(lt_enable_auto_import)
+
+
+### Checks for library functions
+
+AC_ISC_POSIX
+
+# alloca
+AC_FUNC_ALLOCA
+
+# fnmatch
+EFL_CHECK_FNMATCH([], [AC_MSG_ERROR([Cannot find fnmatch()])])
+
+# gettimeofday
+EFL_CHECK_GETTIMEOFDAY([], [AC_MSG_ERROR([Cannot find gettimeofday()])])
+
+
+AC_SUBST(requirement_embryo)
+AC_SUBST(embryoincludedir)
+
+AC_OUTPUT([
+Makefile
+doc/Makefile
+doc/Doxyfile
+doc/embryo.dox
+embryo.pc
+include/Makefile
+src/Makefile
+src/lib/Makefile
+src/bin/Makefile
+embryo.spec
+])
+
+
+#####################################################################
+## Info
+
+echo
+echo
+echo
+echo "------------------------------------------------------------------------"
+echo "$PACKAGE $VERSION"
+echo "------------------------------------------------------------------------"
+echo
+echo "Configuration Options Summary:"
+echo
+echo " Build embryo_cc......: $have_embryo_cc"
+echo
+echo " Documentation........: ${build_doc}"
+echo
+echo "Compilation............: make (or gmake)"
+echo " CPPFLAGS.............: $CPPFLAGS"
+echo " CFLAGS...............: $CFLAGS"
+echo " LDFLAGS..............: $LDFLAGS"
+echo
+echo "Installation...........: make install (as root if needed, with 'su' or 'sudo')"
+echo " prefix...............: $prefix"
+echo
--- /dev/null
+PROJECT_NAME = Embryo
+PROJECT_NUMBER =
+OUTPUT_DIRECTORY = .
+INPUT = @srcdir@/embryo.dox @top_srcdir@/src/lib/
+IMAGE_PATH = img
+OUTPUT_LANGUAGE = English
+GENERATE_HTML = YES
+HTML_OUTPUT = html
+HTML_FILE_EXTENSION = .html
+HTML_HEADER = @srcdir@/head.html
+HTML_FOOTER = @srcdir@/foot.html
+HTML_STYLESHEET = @srcdir@/e.css
+HTML_ALIGN_MEMBERS = YES
+ENUM_VALUES_PER_LINE = 1
+GENERATE_HTMLHELP = NO
+CHM_FILE =
+HHC_LOCATION =
+GENERATE_CHI = NO
+BINARY_TOC = NO
+TOC_EXPAND = NO
+DISABLE_INDEX = YES
+EXTRACT_ALL = NO
+EXTRACT_PRIVATE = NO
+EXTRACT_STATIC = NO
+EXTRACT_LOCAL_CLASSES = NO
+HIDE_UNDOC_MEMBERS = YES
+HIDE_UNDOC_CLASSES = YES
+HIDE_FRIEND_COMPOUNDS = YES
+BRIEF_MEMBER_DESC = YES
+REPEAT_BRIEF = YES
+ALWAYS_DETAILED_SEC = NO
+INLINE_INHERITED_MEMB = NO
+FULL_PATH_NAMES = NO
+STRIP_FROM_PATH =
+INTERNAL_DOCS = NO
+STRIP_CODE_COMMENTS = YES
+CASE_SENSE_NAMES = YES
+SHORT_NAMES = NO
+HIDE_SCOPE_NAMES = NO
+VERBATIM_HEADERS = NO
+SHOW_INCLUDE_FILES = NO
+JAVADOC_AUTOBRIEF = YES
+MULTILINE_CPP_IS_BRIEF = NO
+INHERIT_DOCS = YES
+INLINE_INFO = YES
+SORT_MEMBER_DOCS = YES
+DISTRIBUTE_GROUP_DOC = NO
+TAB_SIZE = 2
+GENERATE_TODOLIST = YES
+GENERATE_TESTLIST = YES
+GENERATE_BUGLIST = YES
+GENERATE_DEPRECATEDLIST= YES
+ALIASES =
+ENABLED_SECTIONS =
+MAX_INITIALIZER_LINES = 30
+OPTIMIZE_OUTPUT_FOR_C = YES
+OPTIMIZE_OUTPUT_JAVA = NO
+SHOW_USED_FILES = NO
+QUIET = YES
+WARNINGS = YES
+WARN_IF_UNDOCUMENTED = YES
+WARN_FORMAT = "$file:$line: $text"
+WARN_LOGFILE =
+FILE_PATTERNS =
+RECURSIVE = NO
+EXCLUDE =
+EXCLUDE_SYMLINKS = NO
+EXCLUDE_PATTERNS =
+EXAMPLE_PATH =
+EXAMPLE_PATTERNS =
+EXAMPLE_RECURSIVE = NO
+INPUT_FILTER =
+FILTER_SOURCE_FILES = NO
+SOURCE_BROWSER = NO
+INLINE_SOURCES = NO
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION = YES
+ALPHABETICAL_INDEX = YES
+COLS_IN_ALPHA_INDEX = 2
+IGNORE_PREFIX =
+GENERATE_TREEVIEW = NO
+TREEVIEW_WIDTH = 250
+GENERATE_LATEX = YES
+LATEX_OUTPUT = latex
+LATEX_CMD_NAME = latex
+MAKEINDEX_CMD_NAME = makeindex
+COMPACT_LATEX = NO
+PAPER_TYPE = a4wide
+EXTRA_PACKAGES =
+LATEX_HEADER =
+PDF_HYPERLINKS = YES
+USE_PDFLATEX = NO
+LATEX_BATCHMODE = NO
+GENERATE_RTF = NO
+RTF_OUTPUT = rtf
+COMPACT_RTF = NO
+RTF_HYPERLINKS = NO
+RTF_STYLESHEET_FILE =
+RTF_EXTENSIONS_FILE =
+GENERATE_MAN = YES
+MAN_OUTPUT = man
+MAN_EXTENSION = .3
+MAN_LINKS = YES
+GENERATE_XML = NO
+XML_SCHEMA =
+XML_DTD =
+GENERATE_AUTOGEN_DEF = NO
+ENABLE_PREPROCESSING = YES
+MACRO_EXPANSION = NO
+EXPAND_ONLY_PREDEF = NO
+SEARCH_INCLUDES = NO
+INCLUDE_PATH =
+INCLUDE_FILE_PATTERNS =
+PREDEFINED =
+EXPAND_AS_DEFINED =
+SKIP_FUNCTION_MACROS = YES
+TAGFILES =
+GENERATE_TAGFILE =
+ALLEXTERNALS = NO
+EXTERNAL_GROUPS = YES
+PERL_PATH = /usr/bin/perl
+CLASS_DIAGRAMS = NO
+HIDE_UNDOC_RELATIONS = YES
+HAVE_DOT = NO
+CLASS_GRAPH = NO
+COLLABORATION_GRAPH = NO
+TEMPLATE_RELATIONS = NO
+INCLUDE_GRAPH = NO
+INCLUDED_BY_GRAPH = NO
+GRAPHICAL_HIERARCHY = NO
+DOT_IMAGE_FORMAT = png
+DOT_PATH =
+DOTFILE_DIRS =
+DOT_GRAPH_MAX_NODES = 50
+GENERATE_LEGEND = YES
+DOT_CLEANUP = YES
+SEARCHENGINE = NO
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in embryo.dox
+
+.PHONY: doc
+
+PACKAGE_DOCNAME = $(PACKAGE_TARNAME)-$(PACKAGE_VERSION)-doc
+
+if EFL_BUILD_DOC
+
+doc-clean:
+ rm -rf html/ latex/ man/ xml/ $(top_builddir)/$(PACKAGE_DOCNAME).tar*
+
+doc: all doc-clean
+ $(efl_doxygen)
+ cp $(srcdir)/img/* html/
+ rm -rf $(PACKAGE_DOCNAME).tar*
+ mkdir -p $(PACKAGE_DOCNAME)/doc
+ cp -R html/ latex/ man/ $(PACKAGE_DOCNAME)/doc
+ tar cf $(PACKAGE_DOCNAME).tar $(PACKAGE_DOCNAME)/
+ bzip2 -9 $(PACKAGE_DOCNAME).tar
+ rm -rf $(PACKAGE_DOCNAME)/
+ mv $(PACKAGE_DOCNAME).tar.bz2 $(top_builddir)
+
+clean-local: doc-clean
+
+else
+
+doc:
+ @echo "Documentation not built. Run ./configure --help"
+
+endif
+
+EXTRA_DIST = Doxyfile e.css foot.html head.html $(wildcard img/*.*) embryo.dox.in
--- /dev/null
+/*
+ Author:
+ Andres Blanc <andresblanc@gmail.com>
+ DaveMDS Andreoli <dave@gurumeditation.it>
+
+ Supported Browsers:
+ ie7, opera9, konqueror4 and firefox3
+
+ Please use a different file for ie6, ie5, etc. hacks.
+*/
+
+
+/* Necessary to place the footer at the bottom of the page */
+html, body {
+ height: 100%;
+ margin: 0px;
+ padding: 0px;
+}
+
+#container {
+ min-height: 100%;
+ height: auto !important;
+ height: 100%;
+ margin: 0 auto -53px;
+}
+
+#footer, #push {
+ height: 53px;
+}
+
+
+* html #container {
+ height: 100%;
+}
+
+/* Prevent floating elements overflowing containers */
+.clear {
+ clear: both;
+ width: 0px;
+ height: 0px;
+}
+
+/* Flexible & centered layout from 750 to 960 pixels */
+.layout {
+ max-width: 960px;
+ min-width: 760px;
+ margin-left: auto;
+ margin-right: auto;
+}
+
+body {
+ /*font-family: Lucida Grande, Helvetica, sans-serif;*/
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif
+}
+
+/* Prevent design overflowing the viewport in small resolutions */
+#container {
+ padding-right: 17px;
+ padding-left: 17px;
+ background-image: url(head_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header {
+ width: 100%;
+ height: 102px;
+}
+
+#header h1 {
+ width: 63px;
+ height: 63px;
+ background-image: url(e.png);
+ background-repeat: no-repeat;
+ position: absolute;
+ margin: 0px;
+}
+
+#header h1 span {
+ display: none;
+}
+
+#header h2 {
+ display: none;
+}
+
+/* .menu-container is used to set properties common to .menu and .submenu */
+#header .menu-container {
+}
+
+#header .menu-container ul {
+ list-style-type: none;
+ list-style-position: inside;
+ margin: 0;
+}
+
+#header .menu-container li {
+ display: block;
+ float: right;
+}
+
+#header .menu {
+ height: 63px;
+ display: block;
+ background-image: url(menu_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header .menu ul {
+ height: 100%;
+ display: block;
+ background-image: url(menu_bg_last.png);
+ background-repeat: no-repeat;
+ background-position: top right;
+ padding-right: 17px;
+}
+
+#header .menu li {
+ height: 100%;
+ text-align: center;
+ background-image: url(menu_bg_unsel.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu a {
+ height: 100%;
+ display: block;
+ color: #cdcdcd;
+ text-decoration: none;
+ font-size: 10pt;
+ line-height: 59px;
+ text-align: center;
+ padding: 0px 15px 0px 15px;
+}
+
+#header .menu li:hover {
+ background-image: url(menu_bg_hover.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li:hover a {
+ color: #FFFFFF;
+}
+
+#header .menu li.current {
+ background-image: url(menu_bg_current.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li.current a {
+ color: #646464;
+}
+
+
+/* Hide all the submenus but the current */
+#header .submenu ul {
+ display: none;
+}
+
+#header .submenu .current {
+ display: block;
+}
+
+#header .submenu {
+ font: bold 10px verdana,'Bitstream Vera Sans',helvetica,arial,sans-serif;
+ margin-top: 10px;
+}
+
+#header .submenu a {
+ color: #888888;
+ text-decoration: none;
+ font-size: 0.9em;
+ line-height: 15px;
+ padding:0px 5px 0px 5px;
+}
+
+#header .submenu a:hover {
+ color: #444444;
+}
+
+#header .submenu li {
+ border-left: 1px solid #DDDDDD;
+}
+
+#header .submenu li:last-child {
+ border-left: 0;
+}
+
+#header .doxytitle {
+ position: absolute;
+ font-size: 1.8em;
+ font-weight: bold;
+ color: #444444;
+ line-height: 35px;
+}
+
+#header small {
+ font-size: 0.4em;
+}
+
+#footer {
+ background-image: url(foot_bg.png);
+ width: 100%;
+}
+
+#footer table {
+ width: 100%;
+ text-align: center;
+ white-space: nowrap;
+ padding: 5px 30px 5px 30px;
+ font-size: 0.8em;
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif;
+ color: #888888;
+}
+
+#footer td.copyright {
+ width: 100%;
+}
+
+/*
+ Author:
+ Andres Blanc <andresblanc@gmail.com>
+ DaveMDS Andreoli <dave@gurumeditation.it>
+
+ Supported Browsers:
+ ie7, opera9, konqueror4 and firefox3
+
+ Please use a different file for ie6, ie5, etc. hacks.
+*/
+
+
+/* Necessary to place the footer at the bottom of the page */
+html, body {
+ height: 100%;
+ margin: 0px;
+ padding: 0px;
+}
+
+#container {
+ min-height: 100%;
+ height: auto !important;
+ height: 100%;
+ margin: 0 auto -53px;
+}
+
+#footer, #push {
+ height: 53px;
+}
+
+
+* html #container {
+ height: 100%;
+}
+
+/* Prevent floating elements overflowing containers */
+.clear {
+ clear: both;
+ width: 0px;
+ height: 0px;
+}
+
+/* Flexible & centered layout from 750 to 960 pixels */
+.layout {
+ max-width: 960px;
+ min-width: 760px;
+ margin-left: auto;
+ margin-right: auto;
+}
+
+body {
+ /*font-family: Lucida Grande, Helvetica, sans-serif;*/
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif
+}
+
+/* Prevent design overflowing the viewport in small resolutions */
+#container {
+ padding-right: 17px;
+ padding-left: 17px;
+ background-image: url(head_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header {
+ width: 100%;
+ height: 102px;
+}
+
+#header h1 {
+ width: 63px;
+ height: 63px;
+ background-image: url(e.png);
+ background-repeat: no-repeat;
+ position: absolute;
+ margin: 0px;
+}
+
+#header h1 span {
+ display: none;
+}
+
+#header h2 {
+ display: none;
+}
+
+/* .menu-container is used to set properties common to .menu and .submenu */
+#header .menu-container {
+}
+
+#header .menu-container ul {
+ list-style-type: none;
+ list-style-position: inside;
+ margin: 0;
+}
+
+#header .menu-container li {
+ display: block;
+ float: right;
+}
+
+#header .menu {
+ height: 63px;
+ display: block;
+ background-image: url(menu_bg.png);
+ background-repeat: repeat-x;
+}
+
+#header .menu ul {
+ height: 100%;
+ display: block;
+ background-image: url(menu_bg_last.png);
+ background-repeat: no-repeat;
+ background-position: top right;
+ padding-right: 17px;
+}
+
+#header .menu li {
+ height: 100%;
+ text-align: center;
+ background-image: url(menu_bg_unsel.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu a {
+ height: 100%;
+ display: block;
+ color: #cdcdcd;
+ text-decoration: none;
+ font-size: 10pt;
+ line-height: 59px;
+ text-align: center;
+ padding: 0px 15px 0px 15px;
+}
+
+#header .menu li:hover {
+ background-image: url(menu_bg_hover.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li:hover a {
+ color: #FFFFFF;
+}
+
+#header .menu li.current {
+ background-image: url(menu_bg_current.png);
+ background-repeat: no-repeat;
+}
+
+#header .menu li.current a {
+ color: #646464;
+}
+
+
+/* Hide all the submenus but the current */
+#header .submenu ul {
+ display: none;
+}
+
+#header .submenu .current {
+ display: block;
+}
+
+#header .submenu {
+ font: bold 10px verdana,'Bitstream Vera Sans',helvetica,arial,sans-serif;
+ margin-top: 10px;
+}
+
+#header .submenu a {
+ color: #888888;
+ text-decoration: none;
+ font-size: 0.9em;
+ line-height: 15px;
+ padding:0px 5px 0px 5px;
+}
+
+#header .submenu a:hover {
+ color: #444444;
+}
+
+#header .submenu li {
+ border-left: 1px solid #DDDDDD;
+}
+
+#header .submenu li:last-child {
+ border-left: 0;
+}
+
+#header .doxytitle {
+ position: absolute;
+ font-size: 1.8em;
+ font-weight: bold;
+ color: #444444;
+ line-height: 35px;
+}
+
+#header small {
+ font-size: 0.4em;
+}
+
+#footer {
+ background-image: url(foot_bg.png);
+ width: 100%;
+}
+
+#footer table {
+ width: 100%;
+ text-align: center;
+ white-space: nowrap;
+ padding: 5px 30px 5px 30px;
+ font-size: 0.8em;
+ font-family: "Bitstream Vera","Vera","Trebuchet MS",Trebuchet,Tahoma,sans-serif;
+ color: #888888;
+}
+
+#footer td.copyright {
+ width: 100%;
+}
+
--- /dev/null
+td.md {
+ background-color: #ffffff;
+ font-family: monospace;
+ text-align: left;
+ vertical-align: center;
+ font-size: 10;
+ padding-right : 1px;
+ padding-top : 1px;
+ padding-left : 1px;
+ padding-bottom : 1px;
+ margin-left : 1px;
+ margin-right : 1px;
+ margin-top : 1px;
+ margin-bottom : 1px
+}
+td.mdname {
+ font-family: monospace;
+ text-align: left;
+ vertical-align: center;
+ font-size: 10;
+ padding-right : 1px;
+ padding-top : 1px;
+ padding-left : 1px;
+ padding-bottom : 1px;
+ margin-left : 1px;
+ margin-right : 1px;
+ margin-top : 1px;
+ margin-bottom : 1px
+}
+h1
+{
+ text-align: center;
+ color: #333333
+}
+h2
+{
+ text-align: left;
+ color: #333333
+}
+h3
+{
+ text-align: left;
+ color: #333333
+}
+a:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: bold;
+}
+a:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: bold;
+}
+a:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: bold;
+}
+a.nav:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: normal;
+}
+a.nav:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: normal;
+}
+a.nav:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: normal;
+}
+a.qindex:link
+{
+ text-decoration: none;
+ color: #444444;
+ font-weight: normal;
+}
+a.qindex:visited
+{
+ text-decoration: none;
+ color: #666666;
+ font-weight: normal;
+}
+a.qindex:hover
+{
+ text-decoration: none;
+ color: #000000;
+ font-weight: normal;
+}
+p
+{
+ color: #000000;
+ font-family: sans-serif;
+ font-size: 10;
+}
+body {
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ background-color: #dddddd;
+ color: #000000;
+ font-family: sans-serif;
+ padding: 8px;
+ margin: 0;
+}
+div.fragment
+{
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ border: thin solid #888888;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: left;
+ vertical-align: center;
+ font-size: 12;
+}
+hr
+{
+ border: 0;
+ background-color: #000000;
+ width: 80%;
+ height: 1;
+}
+dl
+{
+ background-image: url("hilite.png");
+ background-repeat: no-repeat;
+ background-position: left top;
+ border: thin solid #aaaaaa;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: left;
+ vertical-align: center;
+ font-size: 12;
+}
+em
+{
+ color: #334466;
+ font-family: courier;
+ font-size: 10;
+ font-style: normal;
+}
+
+div.nav
+{
+ border: thin solid #000000;
+ background-color: #ffffff;
+ padding: 1px;
+ text-align: center;
+ vertical-align: center;
+ font-size: 12;
+}
+div.body
+{
+ border: thin solid #000000;
+ background-color: #ffffff;
+ padding: 4px;
+ text-align: left;
+ font-size: 10;
+}
+div.diag
+{
+ border: thin solid #888888;
+ background-color: #eeeeee;
+ padding: 4px;
+ text-align: center;
+ font-size: 8;
+}
--- /dev/null
+
+ <div id="push"></div>
+ </div> <!-- #content -->
+ </div> <!-- .layout -->
+
+ </div> <!-- #container -->
+
+
+ <div id="footer">
+ <table><tr>
+ <td class="poweredby"><img src="doxygen.png"></td>
+ <td class="copyright">Copyright ©$year Enlightenment</td>
+ <td class="generated">Docs generated $datetime</td>
+ </tr></table>
+ </div>
+
+
+</body>
+</html>
--- /dev/null
+<html>
+<head>
+ <title>$title</title>
+ <meta http-equiv="content-type" content="text/html;charset=UTF-8">
+ <meta name="author" content="Andres Blanc" >
+
+ <link rel="icon" href="img/favicon.png" type="image/x-icon">
+ <link rel="shortcut icon" href="img/favicon.png" type="image/x-icon">
+ <link rel="icon" href="img/favicon.png" type="image/ico">
+ <link rel="shortcut icon" href="img/favicon.png" type="image/ico">
+
+ <link rel="stylesheet" type="text/css" media="screen" href="e.css">
+ <link rel="stylesheet" type="text/css" media="screen" href="edoxy.css">
+</head>
+
+<body>
+
+<div id="container">
+
+<div id="header">
+<div class="layout">
+
+ <h1><span>Enlightenment</span></h1>
+ <h2><span>Beauty at your fingertips</span></h2>
+
+ <div class="menu-container">
+ <div class="menu">
+ <ul>
+ <li class="current"><a href="http://web.enlightenment.org/p.php?p=docs">Docs</a></li>
+ <li><a href="http://trac.enlightenment.org/e">Tracker</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=contact">Contact</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=contribute">Contribute</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=support">Support</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=download">Download</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=about">About</a></li>
+ <li><a href="http://www.enlightenment.org/p.php?p=news">News</a></li>
+ <li><a href="http://www.enlightenment.org/">Home</a></li>
+ </ul>
+ </div>
+ </div>
+
+ <div class="doxytitle">
+ $projectname Documentation <small>at $date</small>
+ </div>
+
+ <div class="menu-container">
+ <div class="submenu">
+ <ul class="current">
+ <li><a href="todo.html">Todo</a></li>
+ <li><a href="files.html">Files</a></li>
+ <li><a href="annotated.html">Data Structures</a></li>
+ <li><a href="globals.html">Globals</a></li>
+ <li><a href="modules.html">Modules</a></li>
+ <li><a href="pages.html">Related Pages</a></li>
+ <li class="current"><a href="index.html">Main Page</a></li>
+ </ul>
+ </div>
+ </div>
+
+
+ <div class="clear"></div>
+</div>
+</div>
+
+<div id="content">
+<div class="layout">
--- /dev/null
+/*
+ * This file contain a custom doxygen style to match e.org graphics
+ */
+
+
+
+/* BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}*/
+BODY, TD {
+ font-size: 12px;
+}
+H1 {
+ text-align: center;
+ font-size: 160%;
+}
+H2 {
+ font-size: 120%;
+}
+H3 {
+ font-size: 100%;
+}
+CAPTION {
+ font-weight: bold
+}
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navpath {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff
+}
+A.el {
+ text-decoration: none;
+ font-weight: bold
+}
+A.elRef {
+ font-weight: bold
+}
+A.code:link {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.code:visited {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:link {
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:visited {
+ font-weight: normal;
+ color: #0000FF
+}
+A:hover, A:visited:hover {
+ text-decoration: none;
+ /* background-color: #f2f2ff; */
+ color: #000055;
+}
+A.anchor {
+ color: #000;
+}
+DL.el {
+ margin-left: -1cm
+}
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah {
+ background-color: black;
+ font-weight: bold;
+ color: #ffffff;
+ margin-bottom: 3px;
+ margin-top: 3px
+}
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText {
+ margin-left: 16px;
+ font-style: italic;
+ font-size: 90%
+}
+/*BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}*/
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp {
+ text-align: center;
+}
+IMG.formulaDsp {
+}
+IMG.formulaInl {
+ vertical-align: middle;
+}
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+SPAN.vhdldigit { color: #ff00ff }
+SPAN.vhdlchar { color: #000000 }
+SPAN.vhdlkeyword { color: #700070 }
+SPAN.vhdllogic { color: #ff0000 }
+
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search {
+ color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search {
+ font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny {
+ font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab {
+ padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab {
+ background: #e8eef2;
+ font-weight: bold;
+}
+HR {
+ height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+ margin-left: 3px;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+ white-space: nowrap;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+/* these are for tree view when used as main index */
+.directory {
+ font-size: 9pt;
+ font-weight: bold;
+}
+.directory h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+
+/* The following two styles can be used to replace the root node title */
+/* with an image of your choice. Simply uncomment the next two styles, */
+/* specify the name of your image and be sure to set 'height' to the */
+/* proper pixel height of your image. */
+
+/* .directory h3.swap { */
+/* height: 61px; */
+/* background-repeat: no-repeat; */
+/* background-image: url("yourimage.gif"); */
+/* } */
+/* .directory h3.swap span { */
+/* display: none; */
+/* } */
+
+.directory > h3 {
+ margin-top: 0;
+}
+.directory p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory div {
+ display: none;
+ margin: 0px;
+}
+.directory img {
+ vertical-align: -30%;
+}
+/* these are for tree view when not used as main index */
+.directory-alt {
+ font-size: 100%;
+ font-weight: bold;
+}
+.directory-alt h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+.directory-alt > h3 {
+ margin-top: 0;
+}
+.directory-alt p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory-alt div {
+ display: none;
+ margin: 0px;
+}
+.directory-alt img {
+ vertical-align: -30%;
+}
+
+/*
+ * This file contain a custom doxygen style to match e.org graphics
+ */
+
+
+
+/* BODY,H1,H2,H3,H4,H5,H6,P,CENTER,TD,TH,UL,DL,DIV {
+ font-family: Geneva, Arial, Helvetica, sans-serif;
+}*/
+BODY, TD {
+ font-size: 12px;
+}
+H1 {
+ text-align: center;
+ font-size: 160%;
+}
+H2 {
+ font-size: 120%;
+}
+H3 {
+ font-size: 100%;
+}
+CAPTION {
+ font-weight: bold
+}
+DIV.qindex {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navpath {
+ width: 100%;
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ padding: 2px;
+ line-height: 140%;
+}
+DIV.navtab {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+TD.navtab {
+ font-size: 70%;
+}
+A.qindex {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D;
+}
+A.qindex:visited {
+ text-decoration: none;
+ font-weight: bold;
+ color: #1A419D
+}
+A.qindex:hover {
+ text-decoration: none;
+ background-color: #ddddff;
+}
+A.qindexHL {
+ text-decoration: none;
+ font-weight: bold;
+ background-color: #6666cc;
+ color: #ffffff;
+ border: 1px double #9295C2;
+}
+A.qindexHL:hover {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff;
+}
+A.qindexHL:visited {
+ text-decoration: none;
+ background-color: #6666cc;
+ color: #ffffff
+}
+A.el {
+ text-decoration: none;
+ font-weight: bold
+}
+A.elRef {
+ font-weight: bold
+}
+A.code:link {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.code:visited {
+ text-decoration: none;
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:link {
+ font-weight: normal;
+ color: #0000FF
+}
+A.codeRef:visited {
+ font-weight: normal;
+ color: #0000FF
+}
+A:hover, A:visited:hover {
+ text-decoration: none;
+ /* background-color: #f2f2ff; */
+ color: #000055;
+}
+A.anchor {
+ color: #000;
+}
+DL.el {
+ margin-left: -1cm
+}
+.fragment {
+ font-family: monospace, fixed;
+ font-size: 95%;
+}
+PRE.fragment {
+ border: 1px solid #CCCCCC;
+ background-color: #f5f5f5;
+ margin-top: 4px;
+ margin-bottom: 4px;
+ margin-left: 2px;
+ margin-right: 8px;
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+}
+DIV.ah {
+ background-color: black;
+ font-weight: bold;
+ color: #ffffff;
+ margin-bottom: 3px;
+ margin-top: 3px
+}
+
+DIV.groupHeader {
+ margin-left: 16px;
+ margin-top: 12px;
+ margin-bottom: 6px;
+ font-weight: bold;
+}
+DIV.groupText {
+ margin-left: 16px;
+ font-style: italic;
+ font-size: 90%
+}
+/*BODY {
+ background: white;
+ color: black;
+ margin-right: 20px;
+ margin-left: 20px;
+}*/
+TD.indexkey {
+ background-color: #e8eef2;
+ font-weight: bold;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TD.indexvalue {
+ background-color: #e8eef2;
+ font-style: italic;
+ padding-right : 10px;
+ padding-top : 2px;
+ padding-left : 10px;
+ padding-bottom : 2px;
+ margin-left : 0px;
+ margin-right : 0px;
+ margin-top : 2px;
+ margin-bottom : 2px;
+ border: 1px solid #CCCCCC;
+}
+TR.memlist {
+ background-color: #f0f0f0;
+}
+P.formulaDsp {
+ text-align: center;
+}
+IMG.formulaDsp {
+}
+IMG.formulaInl {
+ vertical-align: middle;
+}
+SPAN.keyword { color: #008000 }
+SPAN.keywordtype { color: #604020 }
+SPAN.keywordflow { color: #e08000 }
+SPAN.comment { color: #800000 }
+SPAN.preprocessor { color: #806020 }
+SPAN.stringliteral { color: #002080 }
+SPAN.charliteral { color: #008080 }
+SPAN.vhdldigit { color: #ff00ff }
+SPAN.vhdlchar { color: #000000 }
+SPAN.vhdlkeyword { color: #700070 }
+SPAN.vhdllogic { color: #ff0000 }
+
+.mdescLeft {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.mdescRight {
+ padding: 0px 8px 4px 8px;
+ font-size: 80%;
+ font-style: italic;
+ background-color: #FAFAFA;
+ border-top: 1px none #E0E0E0;
+ border-right: 1px none #E0E0E0;
+ border-bottom: 1px none #E0E0E0;
+ border-left: 1px none #E0E0E0;
+ margin: 0px;
+}
+.memItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemLeft {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplItemRight {
+ padding: 1px 8px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: none;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.memTemplParams {
+ padding: 1px 0px 0px 8px;
+ margin: 4px;
+ border-top-width: 1px;
+ border-right-width: 1px;
+ border-bottom-width: 1px;
+ border-left-width: 1px;
+ border-top-color: #E0E0E0;
+ border-right-color: #E0E0E0;
+ border-bottom-color: #E0E0E0;
+ border-left-color: #E0E0E0;
+ border-top-style: solid;
+ border-right-style: none;
+ border-bottom-style: none;
+ border-left-style: none;
+ color: #606060;
+ background-color: #FAFAFA;
+ font-size: 80%;
+}
+.search {
+ color: #003399;
+ font-weight: bold;
+}
+FORM.search {
+ margin-bottom: 0px;
+ margin-top: 0px;
+}
+INPUT.search {
+ font-size: 75%;
+ color: #000080;
+ font-weight: normal;
+ background-color: #e8eef2;
+}
+TD.tiny {
+ font-size: 75%;
+}
+a {
+ color: #1A41A8;
+}
+a:visited {
+ color: #2A3798;
+}
+.dirtab {
+ padding: 4px;
+ border-collapse: collapse;
+ border: 1px solid #84b0c7;
+}
+TH.dirtab {
+ background: #e8eef2;
+ font-weight: bold;
+}
+HR {
+ height: 1px;
+ border: none;
+ border-top: 1px solid black;
+}
+
+/* Style for detailed member documentation */
+.memtemplate {
+ font-size: 80%;
+ color: #606060;
+ font-weight: normal;
+ margin-left: 3px;
+}
+.memnav {
+ background-color: #e8eef2;
+ border: 1px solid #84b0c7;
+ text-align: center;
+ margin: 2px;
+ margin-right: 15px;
+ padding: 2px;
+}
+.memitem {
+ padding: 4px;
+ background-color: #eef3f5;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #dedeee;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.memname {
+ white-space: nowrap;
+ font-weight: bold;
+}
+.memdoc{
+ padding-left: 10px;
+}
+.memproto {
+ background-color: #d5e1e8;
+ width: 100%;
+ border-width: 1px;
+ border-style: solid;
+ border-color: #84b0c7;
+ font-weight: bold;
+ -moz-border-radius: 8px 8px 8px 8px;
+}
+.paramkey {
+ text-align: right;
+}
+.paramtype {
+ white-space: nowrap;
+}
+.paramname {
+ color: #602020;
+ font-style: italic;
+ white-space: nowrap;
+}
+/* End Styling for detailed member documentation */
+
+/* for the tree view */
+.ftvtree {
+ font-family: sans-serif;
+ margin:0.5em;
+}
+/* these are for tree view when used as main index */
+.directory {
+ font-size: 9pt;
+ font-weight: bold;
+}
+.directory h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+
+/* The following two styles can be used to replace the root node title */
+/* with an image of your choice. Simply uncomment the next two styles, */
+/* specify the name of your image and be sure to set 'height' to the */
+/* proper pixel height of your image. */
+
+/* .directory h3.swap { */
+/* height: 61px; */
+/* background-repeat: no-repeat; */
+/* background-image: url("yourimage.gif"); */
+/* } */
+/* .directory h3.swap span { */
+/* display: none; */
+/* } */
+
+.directory > h3 {
+ margin-top: 0;
+}
+.directory p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory div {
+ display: none;
+ margin: 0px;
+}
+.directory img {
+ vertical-align: -30%;
+}
+/* these are for tree view when not used as main index */
+.directory-alt {
+ font-size: 100%;
+ font-weight: bold;
+}
+.directory-alt h3 {
+ margin: 0px;
+ margin-top: 1em;
+ font-size: 11pt;
+}
+.directory-alt > h3 {
+ margin-top: 0;
+}
+.directory-alt p {
+ margin: 0px;
+ white-space: nowrap;
+}
+.directory-alt div {
+ display: none;
+ margin: 0px;
+}
+.directory-alt img {
+ vertical-align: -30%;
+}
+
--- /dev/null
+prefix=/usr
+exec_prefix=/usr
+libdir=/usr/lib
+includedir=/usr/include
+datarootdir=${prefix}/share
+datadir=/usr/share/embryo
+embryoincludedir=/usr/share/include
+
+Name: embryo
+Description: A small virtual machine engine and bytecode compiler
+Requires.private:
+Version: 1.7.99.0
+Libs: -L${libdir} -lembryo
+Libs.private: -lm
+Cflags: -I${includedir}/embryo-1
--- /dev/null
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+datarootdir=@datarootdir@
+datadir=@datadir@/@PACKAGE@
+embryoincludedir=@embryoincludedir@
+
+Name: embryo
+Description: A small virtual machine engine and bytecode compiler
+@pkgconfig_requires_private@: @requirement_embryo@
+Version: @VERSION@
+Libs: -L${libdir} -lembryo
+Libs.private: @EFL_FNMATCH_LIBS@ -lm
+Cflags: -I${includedir}/embryo-@VMAJ@
--- /dev/null
+%define _missing_doc_files_terminate_build 0
+
+%{!?_rel:%{expand:%%global _rel 0.enl%{?dist}}}
+
+Summary: A small virtual machine engine (in a library) and bytecode compiler
+Name: @PACKAGE@
+Version: @VERSION@
+Release: %{_rel}
+License: BSD
+Group: System Environment/Libraries
+Source: %{name}-%{version}.tar.gz
+Packager: %{?_packager:%{_packager}}%{!?_packager:Michael Jennings <mej@eterm.org>}
+Vendor: %{?_vendorinfo:%{_vendorinfo}}%{!?_vendorinfo:The Enlightenment Project (http://www.enlightenment.org/)}
+Distribution: %{?_distribution:%{_distribution}}%{!?_distribution:%{_vendor}}
+URL: http://www.enlightenment.org/
+BuildRoot: %{_tmppath}/%{name}-%{version}-root
+
+%description
+Embryo is a tiny library designed as a virtual machine to interpret a
+limited set of small compiled programs.
+
+%package devel
+Summary: Embryo headers, static libraries, documentation and test programs
+Group: System Environment/Libraries
+Requires: %{name} = %{version}
+
+%description devel
+Headers, static libraries, test programs and documentation for Embryo
+
+%package bin
+Summary: Embryo bytecode compiler and needed data files
+Group: System Environment/Libraries
+Requires: %{name} = %{version}
+
+%description bin
+The embryo bytecode compiler and its files
+
+%prep
+%setup -q
+
+%build
+%{configure} --prefix=%{_prefix}
+### use this if you have build problems
+#./configure --prefix=%{_prefix}
+%{__make} %{?_smp_mflags} %{?mflags}
+
+%install
+%{__make} %{?mflags_install} DESTDIR=$RPM_BUILD_ROOT install
+
+%clean
+test "x$RPM_BUILD_ROOT" != "x/" && rm -rf $RPM_BUILD_ROOT
+
+%post
+/sbin/ldconfig
+
+%postun
+/sbin/ldconfig
+
+%files
+%defattr(-, root, root)
+%doc AUTHORS COPYING* README
+%{_libdir}/*.so.*
+
+%files bin
+%defattr(-, root, root)
+%attr(755,root,root) %{_bindir}/embryo_cc
+%{_datadir}/embryo/include
+
+%files devel
+%defattr(-, root, root)
+%{_libdir}/*.so
+%{_libdir}/*.la
+%{_libdir}/*.a
+%{_libdir}/pkgconfig/*
+%{_includedir}/embryo-1/*.h
+
+%changelog
--- /dev/null
+MAINTAINERCLEANFILES = Makefile.in
+
+filesdir = $(datadir)/embryo/include
+files_DATA = \
+default.inc
+
+EXTRA_DIST = $(files_DATA)
--- /dev/null
+/* Float arithmetic
+ *
+ * (c) Copyright 1999, Artran, Inc.
+ * Written by Greg Garner (gmg@artran.com)
+ * Modified in March 2001 to include user defined
+ * operators for the floating point functions.
+ * (c) Copyright 2004, Carsten Haitzler
+ * Modified March 2004 by Carsten Haitzler <raster@rasterman.com> to conform
+ * to E coding style
+ * Became default include for embryo...
+ * Added string functions
+ * Added rand functions
+ * Added time functions
+ *
+ * This file is provided as is (no warranties).
+ */
+#if defined DEFAULT_INC
+#endinput
+#endif
+#define DEFAULT_INC
+
+#pragma rational Float
+
+#define PI 3.1415926535897932384626433832795
+
+/* Different methods of rounding */
+enum Float_Round_Method
+{
+ ROUND, FLOOR, CEIL, TOZERO
+};
+/* different angle addressing modes (default is radians) */
+enum Float_Angle_Mode
+{
+ RADIAN, DEGREES, GRADES
+};
+
+/* varags - get numebr of args to a function */
+native numargs();
+/* varags - get arg no "arg" */
+native getarg(arg, index=0);
+native getsarg(arg, buf[], buflen);
+native Float:getfarg(arg, index=0);
+/* varags - set arg no "arg" */
+native setarg(arg, index=0, value);
+native setfarg(arg, index=0, Float:value);
+
+/* Convert a string into a floating point value */
+native Float:atof(const string[]);
+/* Return the fractional part of a float */
+native Float:fract(Float:value);
+/* Round a float into a integer value */
+native round(Float:value, Float_Round_Method:method=ROUND);
+/* Return the square root of value, same as float_power(value, 0.5) */
+native Float:sqrt(Float:value);
+/* Return the value raised to the power of the exponent */
+native Float:pow(Float:value, Float:exponent);
+/* Return the logarithm */
+native Float:log(Float:value, Float:base=10.0);
+/* Return the sine, cosine or tangent. The input angle may be in radian*/
+/* degrees or grades. */
+native Float:sin(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:cos(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:tan(Float:value, Float_Angle_Mode:mode=RADIAN);
+/* Return the absolute value */
+native Float:abs(Float:value);
+/* return integer from string */
+native atoi(str[]);
+/* return 0 if string matches glob, non-zero otherwise */
+native fnmatch(glob[], str[]);
+/* same as strcmp() */
+native strcmp(str1[], str2[]);
+/* same as strncmp */
+native strncmp(str1[], str2[], n);
+/* same as strcpy */
+native strcpy(dst[], src[]);
+/* same as strncpy except it nul terminates */
+native strncpy(dst[], src[], n);
+/* same as strlen */
+native strlen(str[]);
+/* same as strcat */
+native strcat(dst[], src[]);
+/* same as strncat except it nul terminates */
+native strncat(dst[], src[], n);
+/* prepends src string onto start of dst string */
+native strprep(dst[], src[]);
+/* prepends at most n chars from src string onto dst string */
+native strnprep(dst[], src[], n);
+/* cuts chars from char n to (not including) n2, and puts them in str */
+native strcut(dst[], str[], n, n2);
+/* same as snprintf, except only supports %%, %c, %i, %d, %f, %x, %X, %s, \n and \t */
+native snprintf(dst[], dstn, fmt[], ...);
+/* same as strstr */
+native strstr(str[], ndl[]);
+/* same as strchr, except ch must be a 1 charater long string, and returns string index */
+native strchr(str[], ch[]);
+/* same as strrchr, except ch must be a 1 charater long string and returns string index */
+native strrchr(str[], ch[]);
+/* return random number 0 - 65535 */
+native rand();
+/* return random number 0.0 - 1.0 */
+native Float:randf();
+/* return seconds since midnight as a float */
+native Float:seconds();
+/* return the current date, year, time etc. in the variables provided */
+native date(&year, &month, &day, &yearday, &weekday, &hr, &min, &Float:sec);
+
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+/*****************************************************************************/
+
+/**************************************************/
+/* Hidden calls - all are overloaded on operators */
+/**************************************************/
+
+/* Convert an integer into a floating point value */
+native Float:float(value);
+/* Multiple two floats together */
+native Float:float_mul(Float:oper1, Float:oper2);
+/* Divide the dividend float by the divisor float */
+native Float:float_div(Float:dividend, Float:divisor);
+/* Add two floats together */
+native Float:float_add(Float:oper1, Float:oper2);
+/* Subtract oper2 float from oper1 float */
+native Float:float_sub(Float:oper1, Float:oper2);
+/* Compare two integers. If the two elements are equal, return 0. */
+/* If the first argument is greater than the second argument, return 1, */
+/* If the first argument is less than the second argument, return -1. */
+native float_cmp(Float:oper1, Float:oper2);
+/* user defined operators */
+native Float:operator*(Float:oper1, Float:oper2) = float_mul;
+native Float:operator/(Float:oper1, Float:oper2) = float_div;
+native Float:operator+(Float:oper1, Float:oper2) = float_add;
+native Float:operator-(Float:oper1, Float:oper2) = float_sub;
+native Float:operator=(oper) = float;
+stock Float:operator++(Float:oper)
+ return oper+1.0;
+stock Float:operator--(Float:oper)
+ return oper-1.0;
+stock Float:operator-(Float:oper)
+ return oper^Float:0x80000000; /* IEEE values are sign/magnitude */
+stock Float:operator*(Float:oper1, oper2)
+ return float_mul(oper1, float(oper2)); /* "*" is commutative */
+stock Float:operator/(Float:oper1, oper2)
+ return float_div(oper1, float(oper2));
+stock Float:operator/(oper1, Float:oper2)
+ return float_div(float(oper1), oper2);
+stock Float:operator+(Float:oper1, oper2)
+ return float_add(oper1, float(oper2)); /* "+" is commutative */
+stock Float:operator-(Float:oper1, oper2)
+ return float_sub(oper1, float(oper2));
+stock Float:operator-(oper1, Float:oper2)
+ return float_sub(float(oper1), oper2);
+stock bool:operator==(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) == 0;
+stock bool:operator==(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) == 0; /* "==" is commutative */
+stock bool:operator!=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) != 0;
+stock bool:operator!=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) != 0; /* "!=" is commutative */
+stock bool:operator>(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) > 0;
+stock bool:operator>(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) > 0;
+stock bool:operator>(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) > 0;
+stock bool:operator>=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) >= 0;
+stock bool:operator>=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) >= 0;
+stock bool:operator>=(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) >= 0;
+stock bool:operator<(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) < 0;
+stock bool:operator<(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) < 0;
+stock bool:operator<(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) < 0;
+stock bool:operator<=(Float:oper1, Float:oper2)
+ return float_cmp(oper1, oper2) <= 0;
+stock bool:operator<=(Float:oper1, oper2)
+ return float_cmp(oper1, float(oper2)) <= 0;
+stock bool:operator<=(oper1, Float:oper2)
+ return float_cmp(float(oper1), oper2) <= 0;
+stock bool:operator!(Float:oper)
+ return (_:oper & 0x7fffffff) == 0;
+/* forbidden operations */
+forward operator%(Float:oper1, Float:oper2);
+forward operator%(Float:oper1, oper2);
+forward operator%(oper1, Float:oper2);
+
+/**************************************************************************/
+/* ADDED in embryo 1.2 */
+/**************************************************************************/
+/* use this to determine embryo age */
+#define EMBRYO_12 12
+/* Return the inverse sine, cosine or tangent. The output may be radians, */
+/* degrees or grades. */
+native Float:asin(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:acos(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:atan(Float:value, Float_Angle_Mode:mode=RADIAN);
+native Float:atan2(Float:valuey, Float:valuex, Float_Angle_Mode:mode=RADIAN);
+/* same as libc functions */
+native Float:log1p(Float:value);
+native Float:cbrt(Float:value);
+native Float:exp(Float:value);
+native Float:exp2(Float:value);
+native Float:hypot(Float:valuex, Float:valuey);
--- /dev/null
+dnl Copyright (C) 2004-2008 Kim Woelders
+dnl Copyright (C) 2008 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+dnl Originally snatched from somewhere...
+
+dnl Macro for checking if the compiler supports __attribute__
+
+dnl Usage: AC_C___ATTRIBUTE__
+dnl call AC_DEFINE for HAVE___ATTRIBUTE__ and __UNUSED__
+dnl if the compiler supports __attribute__, HAVE___ATTRIBUTE__ is
+dnl defined to 1 and __UNUSED__ is defined to __attribute__((unused))
+dnl otherwise, HAVE___ATTRIBUTE__ is not defined and __UNUSED__ is
+dnl defined to nothing.
+
+AC_DEFUN([AC_C___ATTRIBUTE__],
+[
+
+AC_MSG_CHECKING([for __attribute__])
+
+AC_CACHE_VAL([ac_cv___attribute__],
+ [AC_TRY_COMPILE(
+ [
+#include <stdlib.h>
+
+int func(int x);
+int foo(int x __attribute__ ((unused)))
+{
+ exit(1);
+}
+ ],
+ [],
+ [ac_cv___attribute__="yes"],
+ [ac_cv___attribute__="no"]
+ )])
+
+AC_MSG_RESULT($ac_cv___attribute__)
+
+if test "x${ac_cv___attribute__}" = "xyes" ; then
+ AC_DEFINE([HAVE___ATTRIBUTE__], [1], [Define to 1 if your compiler has __attribute__])
+ AC_DEFINE([__UNUSED__], [__attribute__((unused))], [Macro declaring a function argument to be unused])
+ else
+ AC_DEFINE([__UNUSED__], [], [Macro declaring a function argument to be unused])
+fi
+
+])
+
+dnl End of ac_attribute.m4
--- /dev/null
+dnl Copyright (C) 2010 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if a binary is built or not
+
+dnl Usage: EFL_ENABLE_BIN(binary)
+dnl Call AC_SUBST(BINARY_PRG) (BINARY is the uppercase of binary, - being transformed into _)
+dnl Define have_binary (- is transformed into _)
+dnl Define conditional BUILD_BINARY (BINARY is the uppercase of binary, - being transformed into _)
+
+AC_DEFUN([EFL_ENABLE_BIN],
+[
+
+m4_pushdef([UP], m4_translit([[$1]], [-a-z], [_A-Z]))dnl
+m4_pushdef([DOWN], m4_translit([[$1]], [-A-Z], [_a-z]))dnl
+
+have_[]m4_defn([DOWN])="yes"
+
+dnl configure option
+
+AC_ARG_ENABLE([$1],
+ [AC_HELP_STRING([--disable-$1], [disable building of ]DOWN)],
+ [
+ if test "x${enableval}" = "xyes" ; then
+ have_[]m4_defn([DOWN])="yes"
+ else
+ have_[]m4_defn([DOWN])="no"
+ fi
+ ])
+
+AC_MSG_CHECKING([whether to build ]DOWN[ binary])
+AC_MSG_RESULT([$have_[]m4_defn([DOWN])])
+
+if test "x$have_[]m4_defn([DOWN])" = "xyes"; then
+ UP[]_PRG=DOWN[${EXEEXT}]
+fi
+
+AC_SUBST(UP[]_PRG)
+
+AM_CONDITIONAL(BUILD_[]UP, test "x$have_[]m4_defn([DOWN])" = "xyes")
+
+AS_IF([test "x$have_[]m4_defn([DOWN])" = "xyes"], [$2], [$3])
+
+])
--- /dev/null
+dnl Copyright (C) 2008 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if doxygen is available or not.
+
+dnl EFL_CHECK_DOXYGEN([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl Test for the doxygen program
+dnl Defines efl_doxygen
+dnl Defines the automake conditionnal EFL_BUILD_DOC
+dnl
+AC_DEFUN([EFL_CHECK_DOXYGEN],
+[
+
+dnl
+dnl Disable the build of the documentation
+dnl
+AC_ARG_ENABLE([doc],
+ [AC_HELP_STRING(
+ [--disable-doc],
+ [Disable documentation build @<:@default=enabled@:>@])],
+ [
+ if test "x${enableval}" = "xyes" ; then
+ efl_enable_doc="yes"
+ else
+ efl_enable_doc="no"
+ fi
+ ],
+ [efl_enable_doc="yes"])
+
+AC_MSG_CHECKING([whether to build documentation])
+AC_MSG_RESULT([${efl_enable_doc}])
+
+if test "x${efl_enable_doc}" = "xyes" ; then
+
+dnl Specify the file name, without path
+
+ efl_doxygen="doxygen"
+
+ AC_ARG_WITH([doxygen],
+ [AC_HELP_STRING(
+ [--with-doxygen=FILE],
+ [doxygen program to use @<:@default=doxygen@:>@])],
+
+dnl Check the given doxygen program.
+
+ [efl_doxygen=${withval}
+ AC_CHECK_PROG([efl_have_doxygen],
+ [${efl_doxygen}],
+ [yes],
+ [no])
+ if test "x${efl_have_doxygen}" = "xno" ; then
+ echo "WARNING:"
+ echo "The doxygen program you specified:"
+ echo "${efl_doxygen}"
+ echo "was not found. Please check the path and make sure "
+ echo "the program exists and is executable."
+ AC_MSG_WARN([no doxygen detected. Documentation will not be built])
+ fi
+ ],
+ [AC_CHECK_PROG([efl_have_doxygen],
+ [${efl_doxygen}],
+ [yes],
+ [no])
+ if test "x${efl_have_doxygen}" = "xno" ; then
+ echo "WARNING:"
+ echo "The doxygen program was not found in your execute path."
+ echo "You may have doxygen installed somewhere not covered by your path."
+ echo ""
+ echo "If this is the case make sure you have the packages installed, AND"
+ echo "that the doxygen program is in your execute path (see your"
+ echo "shell manual page on setting the \$PATH environment variable), OR"
+ echo "alternatively, specify the program to use with --with-doxygen."
+ AC_MSG_WARN([no doxygen detected. Documentation will not be built])
+ fi
+ ])
+fi
+
+dnl
+dnl Substitution
+dnl
+AC_SUBST([efl_doxygen])
+
+if ! test "x${efl_have_doxygen}" = "xyes" ; then
+ efl_enable_doc="no"
+fi
+
+AM_CONDITIONAL(EFL_BUILD_DOC, test "x${efl_enable_doc}" = "xyes")
+
+if test "x${efl_enable_doc}" = "xyes" ; then
+ m4_default([$1], [:])
+else
+ m4_default([$2], [:])
+fi
+
+])
+
+dnl End of efl_doxygen.m4
--- /dev/null
+dnl Copyright (C) 2010 Vincent Torri <vtorri at univ-evry dot fr>
+dnl That code is public domain and can be freely used or copied.
+
+dnl Macro that check if fnmatch functions are available or not.
+
+dnl Usage: EFL_CHECK_FNMATCH([, ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
+dnl Call AC_SUBST(EFL_FNMATCH_LIBS)
+
+AC_DEFUN([EFL_CHECK_FNMATCH],
+[
+
+AC_CHECK_HEADER([fnmatch.h], [_efl_have_fnmatch="yes"], [_efl_have_fnmatch="no"])
+
+if test "x${_efl_have_fnmatch}" = "xyes" ; then
+ AC_SEARCH_LIBS([fnmatch],
+ [fnmatch evil exotic iberty],
+ [_efl_have_fnmatch="yes"],
+ [_efl_have_fnmatch="no"])
+fi
+
+EFL_FNMATCH_LIBS=""
+
+if (! test "x${ac_cv_search_fnmatch}" = "xnone required") && (! test "x${ac_cv_search_fnmatch}" = "xno") && (! test "x${ac_cv_search_fnmatch}" = "x-levil") ; then
+ EFL_FNMATCH_LIBS=${ac_cv_search_fnmatch}
+fi
+
+AC_SUBST(EFL_FNMATCH_LIBS)
+
+AS_IF([test "x$_efl_have_fnmatch" = "xyes"], [$1], [$2])
+
+])
--- /dev/null
+dnl Copyright (C) 2011 Cedric Bail <cedric.bail@free.fr>
+dnl This code is public domain and can be freely used or copied.
+
+dnl Macro that check for gettimeofday definition
+
+dnl Usage: EFL_CHECK_GETTIMEOFDAY(ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND])
+dnl Define EFL_HAVE_GETTIMEOFDAY
+
+AC_DEFUN([EFL_CHECK_GETTIMEOFDAY],
+[
+
+_efl_have_gettimeofday="no"
+
+AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[
+#include <stdlib.h>
+#include <sys/time.h>
+ ]],
+ [[
+int res;
+res = gettimeofday(NULL, NULL);
+ ]])],
+ [_efl_have_gettimeofday="yes"],
+ [_efl_have_gettimeofday="no"])
+
+if test "x${_efl_have_gettimeofday}" = "xno" -a "x${enable_exotic}" = "xyes"; then
+ SAVE_LIBS="${LIBS}"
+ SAVE_CFLAGS="${CFLAGS}"
+ LIBS="${LIBS} ${EXOTIC_LIBS}"
+ CFLAGS="${CFLAGS} ${EXOTIC_CFLAGS}"
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM([[
+#include <Exotic.h>
+ ]],
+ [[
+int res;
+res = gettimeofday(NULL, NULL);
+ ]])],
+ [_efl_have_gettimeofday="yes"],
+ [_efl_have_gettimeofday="no"])
+fi
+
+if test "x${_efl_have_gettimeofday}" = "xyes"; then
+ AC_DEFINE([EFL_HAVE_GETTIMEOFDAY], [1], [Defined if gettimeofday is available.])
+fi
+
+AS_IF([test "x${_efl_have_gettimeofday}" = "xyes"], [$1], [$2])
+])
--- /dev/null
+dnl Check for PATH_MAX in limits.h, and define a default value if not found
+dnl This is a workaround for systems not providing PATH_MAX, like GNU/Hurd
+
+dnl EFL_CHECK_PATH_MAX([DEFAULT_VALUE_IF_NOT_FOUND])
+dnl
+dnl If PATH_MAX is not defined in <limits.h>, defines it
+dnl to DEFAULT_VALUE_IF_NOT_FOUND if it exists, or fallback
+dnl to using 4096
+
+AC_DEFUN([EFL_CHECK_PATH_MAX],
+[
+
+default_max=m4_default([$1], "4096")
+AC_LANG_PUSH([C])
+
+AC_MSG_CHECKING([for PATH_MAX in limits.h])
+AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+#include <limits.h>
+ ]],
+ [[
+int i = PATH_MAX;
+ ]])],
+ [AC_MSG_RESULT([yes])],
+ [
+ AC_DEFINE_UNQUOTED([PATH_MAX],
+ [${default_max}],
+ [default value since PATH_MAX is not defined])
+ AC_MSG_RESULT([no: using ${default_max}])
+ ])
+
+AC_LANG_POP([C])
+
+])
+dnl end of efl_path_max.m4
--- /dev/null
+MAINTAINERCLEANFILES = Makefile.in
+
+SUBDIRS = lib bin
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir) \
+-I$(top_builddir) \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EINA_CFLAGS@ \
+@EVIL_CFLAGS@
+
+bin_PROGRAMS = @EMBRYO_CC_PRG@
+EXTRA_PROGRAMS = embryo_cc
+
+embryo_cc_SOURCES = \
+embryo_cc_amx.h \
+embryo_cc_sc.h \
+embryo_cc_sc1.c \
+embryo_cc_sc2.c \
+embryo_cc_sc3.c \
+embryo_cc_sc4.c \
+embryo_cc_sc5.c \
+embryo_cc_sc6.c \
+embryo_cc_sc7.c \
+embryo_cc_scexpand.c \
+embryo_cc_sclist.c \
+embryo_cc_scvars.c \
+embryo_cc_prefix.c \
+embryo_cc_prefix.h
+
+embryo_cc_CFLAGS = @EMBRYO_CFLAGS@
+embryo_cc_LDADD = $(top_builddir)/src/lib/libembryo.la @EVIL_LIBS@ @EINA_LIBS@ -lm
+embryo_cc_LDFLAGS = @lt_enable_auto_import@
+
+EXTRA_DIST = \
+embryo_cc_sc5.scp \
+embryo_cc_sc7.scp
--- /dev/null
+/* Abstract Machine for the Small compiler
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+#ifndef EMBRYO_CC_AMX_H
+#define EMBRYO_CC_AMX_H
+
+#include <sys/types.h>
+
+/* calling convention for all interface functions and callback functions */
+
+/* File format version Required AMX version
+ * 0 (original version) 0
+ * 1 (opcodes JUMP.pri, SWITCH and CASETBL) 1
+ * 2 (compressed files) 2
+ * 3 (public variables) 2
+ * 4 (opcodes SWAP.pri/alt and PUSHADDR) 4
+ * 5 (tagnames table) 4
+ * 6 (reformatted header) 6
+ * 7 (name table, opcodes SYMTAG & SYSREQ.D) 7
+ */
+#define CUR_FILE_VERSION 7 /* current file version; also the current AMX version */
+#define MIN_FILE_VERSION 6 /* lowest supported file format version for the current AMX version */
+#define MIN_AMX_VERSION 7 /* minimum AMX version needed to support the current file format */
+
+#if !defined CELL_TYPE
+#define CELL_TYPE
+ typedef unsigned int ucell;
+ typedef int cell;
+#endif
+
+ struct tagAMX;
+ typedef cell(*AMX_NATIVE) (struct tagAMX * amx,
+ cell * params);
+ typedef int (* AMX_CALLBACK) (struct tagAMX * amx, cell index,
+ cell * result, cell * params);
+ typedef int (* AMX_DEBUG) (struct tagAMX * amx);
+
+ typedef struct
+ {
+ char *name;
+ AMX_NATIVE func ;
+ } AMX_NATIVE_INFO ;
+
+#define AMX_USERNUM 4
+#define sEXPMAX 19 /* maximum name length for file version <= 6 */
+#define sNAMEMAX 31 /* maximum name length of symbol name */
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+ typedef struct tagAMX_FUNCSTUB
+ {
+ unsigned int address;
+ char name[sEXPMAX + 1];
+ } EMBRYO_STRUCT_PACKED AMX_FUNCSTUB;
+
+/* The AMX structure is the internal structure for many functions. Not all
+ * fields are valid at all times; many fields are cached in local variables.
+ */
+ typedef struct tagAMX
+ {
+ unsigned char *base; /* points to the AMX header ("amxhdr") plus the code, optionally also the data */
+ unsigned char *data; /* points to separate data+stack+heap, may be NULL */
+ AMX_CALLBACK callback;
+ AMX_DEBUG debug ; /* debug callback */
+ /* for external functions a few registers must be accessible from the outside */
+ cell cip ; /* instruction pointer: relative to base + amxhdr->cod */
+ cell frm ; /* stack frame base: relative to base + amxhdr->dat */
+ cell hea ; /* top of the heap: relative to base + amxhdr->dat */
+ cell hlw ; /* bottom of the heap: relative to base + amxhdr->dat */
+ cell stk ; /* stack pointer: relative to base + amxhdr->dat */
+ cell stp ; /* top of the stack: relative to base + amxhdr->dat */
+ int flags ; /* current status, see amx_Flags() */
+ /* for assertions and debug hook */
+ cell curline ;
+ cell curfile ;
+ int dbgcode ;
+ cell dbgaddr ;
+ cell dbgparam ;
+ char *dbgname;
+ /* user data */
+ long usertags[AMX_USERNUM];
+ void *userdata[AMX_USERNUM];
+ /* native functions can raise an error */
+ int error ;
+ /* the sleep opcode needs to store the full AMX status */
+ cell pri ;
+ cell alt ;
+ cell reset_stk ;
+ cell reset_hea ;
+ cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
+ } EMBRYO_STRUCT_PACKED AMX;
+
+/* The AMX_HEADER structure is both the memory format as the file format. The
+ * structure is used internaly.
+ */
+ typedef struct tagAMX_HEADER
+ {
+ int size ; /* size of the "file" */
+ unsigned short magic ; /* signature */
+ char file_version ; /* file format version */
+ char amx_version ; /* required version of the AMX */
+ unsigned short flags ;
+ unsigned short defsize ; /* size of a definition record */
+ int cod ; /* initial value of COD - code block */
+ int dat ; /* initial value of DAT - data block */
+ int hea ; /* initial value of HEA - start of the heap */
+ int stp ; /* initial value of STP - stack top */
+ int cip ; /* initial value of CIP - the instruction pointer */
+ int publics ; /* offset to the "public functions" table */
+ int natives ; /* offset to the "native functions" table */
+ int libraries ; /* offset to the table of libraries */
+ int pubvars ; /* the "public variables" table */
+ int tags ; /* the "public tagnames" table */
+ int nametable ; /* name table, file version 7 only */
+ } EMBRYO_STRUCT_PACKED AMX_HEADER;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+#define AMX_MAGIC 0xf1e0
+
+ enum
+ {
+ AMX_ERR_NONE,
+ /* reserve the first 15 error codes for exit codes of the abstract machine */
+ AMX_ERR_EXIT, /* forced exit */
+ AMX_ERR_ASSERT, /* assertion failed */
+ AMX_ERR_STACKERR, /* stack/heap collision */
+ AMX_ERR_BOUNDS, /* index out of bounds */
+ AMX_ERR_MEMACCESS, /* invalid memory access */
+ AMX_ERR_INVINSTR, /* invalid instruction */
+ AMX_ERR_STACKLOW, /* stack underflow */
+ AMX_ERR_HEAPLOW, /* heap underflow */
+ AMX_ERR_CALLBACK, /* no callback, or invalid callback */
+ AMX_ERR_NATIVE, /* native function failed */
+ AMX_ERR_DIVIDE, /* divide by zero */
+ AMX_ERR_SLEEP, /* go into sleepmode - code can be restarted */
+
+ AMX_ERR_MEMORY = 16, /* out of memory */
+ AMX_ERR_FORMAT, /* invalid file format */
+ AMX_ERR_VERSION, /* file is for a newer version of the AMX */
+ AMX_ERR_NOTFOUND, /* function not found */
+ AMX_ERR_INDEX, /* invalid index parameter (bad entry point) */
+ AMX_ERR_DEBUG, /* debugger cannot run */
+ AMX_ERR_INIT, /* AMX not initialized (or doubly initialized) */
+ AMX_ERR_USERDATA, /* unable to set user data field (table full) */
+ AMX_ERR_INIT_JIT, /* cannot initialize the JIT */
+ AMX_ERR_PARAMS, /* parameter error */
+ AMX_ERR_DOMAIN, /* domain error, expression result does not fit in range */
+ };
+
+ enum
+ {
+ DBG_INIT, /* query/initialize */
+ DBG_FILE, /* file number in curfile, filename in name */
+ DBG_LINE, /* line number in curline, file number in curfile */
+ DBG_SYMBOL, /* address in dbgaddr, class/type in dbgparam */
+ DBG_CLRSYM, /* stack address below which locals should be removed. stack address in stk */
+ DBG_CALL, /* function call, address jumped to in dbgaddr */
+ DBG_RETURN, /* function returns */
+ DBG_TERMINATE, /* program ends, code address in dbgaddr, reason in dbgparam */
+ DBG_SRANGE, /* symbol size and dimensions (arrays); level in dbgaddr (!); length in dbgparam */
+ DBG_SYMTAG, /* tag of the most recent symbol (if non-zero), tag in dbgparam */
+ };
+
+#define AMX_FLAG_CHAR16 0x01 /* characters are 16-bit */
+#define AMX_FLAG_DEBUG 0x02 /* symbolic info. available */
+#define AMX_FLAG_COMPACT 0x04 /* compact encoding */
+#define AMX_FLAG_BIGENDIAN 0x08 /* big endian encoding */
+#define AMX_FLAG_NOCHECKS 0x10 /* no array bounds checking */
+#define AMX_FLAG_BROWSE 0x4000 /* browsing/relocating or executing */
+#define AMX_FLAG_RELOC 0x8000 /* jump/call addresses relocated */
+
+#define AMX_EXEC_MAIN -1 /* start at program entry point */
+#define AMX_EXEC_CONT -2 /* continue from last address */
+
+#define AMX_USERTAG(a,b,c,d) ((a) | ((b)<<8) | ((long)(c)<<16) | ((long)(d)<<24))
+
+#define AMX_EXPANDMARGIN 64
+
+/* for native functions that use floating point parameters, the following
+ * two macros are convenient for casting a "cell" into a "float" type _without_
+ * changing the bit pattern
+ */
+#define amx_ftoc(f) ( * ((cell*)&f) ) /* float to cell */
+#define amx_ctof(c) ( * ((float*)&c) ) /* cell to float */
+
+#define amx_StrParam(amx,param,result) { \
+ cell *amx_cstr_; int amx_length_; \
+ amx_GetAddr((amx), (param), &amx_cstr_); \
+ amx_StrLen(amx_cstr_, &amx_length_); \
+ if (amx_length_ > 0 && \
+ ((result) = (char *)alloca(amx_length_ + 1))) \
+ amx_GetString((result), amx_cstr_); \
+ else (result) = NULL; \
+}
+
+#endif /* __AMX_H */
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <Eina.h>
+
+#include "embryo_cc_prefix.h"
+
+/* local subsystem functions */
+
+/* local subsystem globals */
+
+static Eina_Prefix *pfx = NULL;
+
+/* externally accessible functions */
+int
+e_prefix_determine(char *argv0)
+{
+ if (pfx) return 1;
+ eina_init();
+ pfx = eina_prefix_new(argv0, e_prefix_determine,
+ "EMBRYO", "embryo", "include/default.inc",
+ PACKAGE_BIN_DIR,
+ PACKAGE_LIB_DIR,
+ PACKAGE_DATA_DIR,
+ PACKAGE_DATA_DIR);
+ if (!pfx) return 0;
+ return 1;
+}
+
+void
+e_prefix_shutdown(void)
+{
+ eina_prefix_free(pfx);
+ pfx = NULL;
+ eina_shutdown();
+}
+
+const char *
+e_prefix_get(void)
+{
+ return eina_prefix_get(pfx);
+}
+
+const char *
+e_prefix_bin_get(void)
+{
+ return eina_prefix_bin_get(pfx);
+}
+
+const char *
+e_prefix_data_get(void)
+{
+ return eina_prefix_data_get(pfx);
+}
+
+const char *
+e_prefix_lib_get(void)
+{
+ return eina_prefix_lib_get(pfx);
+}
--- /dev/null
+int e_prefix_determine(char *argv0);
+void e_prefix_shutdown(void);
+const char *e_prefix_get(void);
+const char *e_prefix_bin_get(void);
+const char *e_prefix_data_get(void);
+const char *e_prefix_lib_get(void);
--- /dev/null
+/* Small compiler
+ *
+ * Drafted after the Small-C compiler Version 2.01, originally created
+ * by Ron Cain, july 1980, and enhanced by James E. Hendrix.
+ *
+ * This version comes close to a complete rewrite.
+ *
+ * Copyright R. Cain, 1980
+ * Copyright J.E. Hendrix, 1982, 1983
+ * Copyright T. Riemersma, 1997-2003
+ *
+ * Version: $Id$
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+#ifndef EMBRYO_CC_SC_H
+#define EMBRYO_CC_SC_H
+
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <setjmp.h>
+
+#ifndef _MSC_VER
+# include <stdint.h>
+#else
+# include <stddef.h>
+# include <Evil.h>
+#endif
+
+#include "embryo_cc_amx.h"
+
+/* Note: the "cell" and "ucell" types are defined in AMX.H */
+
+#define PUBLIC_CHAR '@' /* character that defines a function "public" */
+#define CTRL_CHAR '\\' /* default control character */
+
+#define DIRSEP_CHAR '/' /* directory separator character */
+
+#define sDIMEN_MAX 2 /* maximum number of array dimensions */
+#define sDEF_LITMAX 500 /* initial size of the literal pool, in "cells" */
+#define sLINEMAX (640 * 1024) /* input line length (in characters) */
+#define sDEF_AMXSTACK 4096 /* default stack size for AMX files */
+#define sSTKMAX 80 /* stack for nested #includes and other uses */
+#define PREPROC_TERM '\x7f' /* termination character for preprocessor expressions (the "DEL" code) */
+#define sDEF_PREFIX "default.inc" /* default prefix filename */
+
+typedef intptr_t stkitem; /* type of items stored on the stack */
+
+typedef struct __s_arginfo
+{ /* function argument info */
+ char name[sNAMEMAX + 1];
+ char ident; /* iVARIABLE, iREFERENCE, iREFARRAY or iVARARGS */
+ char usage; /* uCONST */
+ int *tags; /* argument tag id. list */
+ int numtags; /* number of tags in the tag list */
+ int dim[sDIMEN_MAX];
+ int numdim; /* number of dimensions */
+ unsigned char hasdefault; /* bit0: is there a default value? bit6: "tagof"; bit7: "sizeof" */
+ union
+ {
+ cell val; /* default value */
+ struct
+ {
+ char *symname; /* name of another symbol */
+ short level; /* indirection level for that symbol */
+ } size; /* used for "sizeof" default value */
+ struct
+ {
+ cell *data; /* values of default array */
+ int size; /* complete length of default array */
+ int arraysize; /* size to reserve on the heap */
+ cell addr; /* address of the default array in the data segment */
+ } array;
+ } defvalue; /* default value, or pointer to default array */
+ int defvalue_tag; /* tag of the default value */
+} arginfo;
+
+/* Equate table, tagname table, library table */
+typedef struct __s_constvalue
+{
+ struct __s_constvalue *next;
+ char name[sNAMEMAX + 1];
+ cell value;
+ short index;
+} constvalue;
+
+/* Symbol table format
+ *
+ * The symbol name read from the input file is stored in "name", the
+ * value of "addr" is written to the output file. The address in "addr"
+ * depends on the class of the symbol:
+ * global offset into the data segment
+ * local offset relative to the stack frame
+ * label generated hexadecimal number
+ * function offset into code segment
+ */
+typedef struct __s_symbol
+{
+ struct __s_symbol *next;
+ struct __s_symbol *parent; /* hierarchical types (multi-dimensional arrays) */
+ char name[sNAMEMAX + 1];
+ unsigned int hash; /* value derived from name, for quicker searching */
+ cell addr; /* address or offset (or value for constant, index for native function) */
+ char vclass; /* sLOCAL if "addr" refers to a local symbol */
+ char ident; /* see below for possible values */
+ char usage; /* see below for possible values */
+ int compound; /* compound level (braces nesting level) */
+ int tag; /* tagname id */
+ union
+ {
+ int declared; /* label: how many local variables are declared */
+ int idxtag; /* array: tag of array indices */
+ constvalue *lib; /* native function: library it is part of *///??? use "stringlist"
+ } x; /* 'x' for 'extra' */
+ union
+ {
+ arginfo *arglist; /* types of all parameters for functions */
+ struct
+ {
+ cell length; /* arrays: length (size) */
+ short level; /* number of dimensions below this level */
+ } array;
+ } dim; /* for 'dimension', both functions and arrays */
+ int fnumber; /* static global variables: file number in which the declaration is visible */
+ struct __s_symbol **refer; /* referrer list, functions that "use" this symbol */
+ int numrefers; /* number of entries in the referrer list */
+} symbol;
+
+/* Possible entries for "ident". These are used in the "symbol", "value"
+ * and arginfo structures. Not every constant is valid for every use.
+ * In an argument list, the list is terminated with a "zero" ident; labels
+ * cannot be passed as function arguments, so the value 0 is overloaded.
+ */
+#define iLABEL 0
+#define iVARIABLE 1 /* cell that has an address and that can be fetched directly (lvalue) */
+#define iREFERENCE 2 /* iVARIABLE, but must be dereferenced */
+#define iARRAY 3
+#define iREFARRAY 4 /* an array passed by reference (i.e. a pointer) */
+#define iARRAYCELL 5 /* array element, cell that must be fetched indirectly */
+#define iARRAYCHAR 6 /* array element, character from cell from array */
+#define iEXPRESSION 7 /* expression result, has no address (rvalue) */
+#define iCONSTEXPR 8 /* constant expression (or constant symbol) */
+#define iFUNCTN 9
+#define iREFFUNC 10 /* function passed as a parameter */
+#define iVARARGS 11 /* function specified ... as argument(s) */
+
+/* Possible entries for "usage"
+ *
+ * This byte is used as a serie of bits, the syntax is different for
+ * functions and other symbols:
+ *
+ * VARIABLE
+ * bits: 0 (uDEFINE) the variable is defined in the source file
+ * 1 (uREAD) the variable is "read" (accessed) in the source file
+ * 2 (uWRITTEN) the variable is altered (assigned a value)
+ * 3 (uCONST) the variable is constant (may not be assigned to)
+ * 4 (uPUBLIC) the variable is public
+ * 6 (uSTOCK) the variable is discardable (without warning)
+ *
+ * FUNCTION
+ * bits: 0 (uDEFINE) the function is defined ("implemented") in the source file
+ * 1 (uREAD) the function is invoked in the source file
+ * 2 (uRETVALUE) the function returns a value (or should return a value)
+ * 3 (uPROTOTYPED) the function was prototyped
+ * 4 (uPUBLIC) the function is public
+ * 5 (uNATIVE) the function is native
+ * 6 (uSTOCK) the function is discardable (without warning)
+ * 7 (uMISSING) the function is not implemented in this source file
+ *
+ * CONSTANT
+ * bits: 0 (uDEFINE) the symbol is defined in the source file
+ * 1 (uREAD) the constant is "read" (accessed) in the source file
+ * 3 (uPREDEF) the constant is pre-defined and should be kept between passes
+ */
+#define uDEFINE 0x01
+#define uREAD 0x02
+#define uWRITTEN 0x04
+#define uRETVALUE 0x04 /* function returns (or should return) a value */
+#define uCONST 0x08
+#define uPROTOTYPED 0x08
+#define uPREDEF 0x08 /* constant is pre-defined */
+#define uPUBLIC 0x10
+#define uNATIVE 0x20
+#define uSTOCK 0x40
+#define uMISSING 0x80
+/* uRETNONE is not stored in the "usage" field of a symbol. It is
+ * used during parsing a function, to detect a mix of "return;" and
+ * "return value;" in a few special cases.
+ */
+#define uRETNONE 0x10
+
+#define uTAGOF 0x40 /* set in the "hasdefault" field of the arginfo struct */
+#define uSIZEOF 0x80 /* set in the "hasdefault" field of the arginfo struct */
+
+#define uMAINFUNC "main"
+
+#define sGLOBAL 0 /* global/local variable/constant class */
+#define sLOCAL 1
+#define sSTATIC 2 /* global life, local scope */
+
+typedef struct
+{
+ symbol *sym; /* symbol in symbol table, NULL for (constant) expression */
+ cell constval; /* value of the constant expression (if ident==iCONSTEXPR)
+ * also used for the size of a literal array */
+ int tag; /* tagname id (of the expression) */
+ char ident; /* iCONSTEXPR, iVARIABLE, iARRAY, iARRAYCELL,
+ * iEXPRESSION or iREFERENCE */
+ char boolresult; /* boolean result for relational operators */
+ cell *arrayidx; /* last used array indices, for checking self assignment */
+} value;
+
+/* "while" statement queue (also used for "for" and "do - while" loops) */
+enum
+{
+ wqBRK, /* used to restore stack for "break" */
+ wqCONT, /* used to restore stack for "continue" */
+ wqLOOP, /* loop start label number */
+ wqEXIT, /* loop exit label number (jump if false) */
+ /* --- */
+ wqSIZE /* "while queue" size */
+};
+
+#define wqTABSZ (24*wqSIZE) /* 24 nested loop statements */
+
+enum
+{
+ statIDLE, /* not compiling yet */
+ statFIRST, /* first pass */
+ statWRITE, /* writing output */
+ statSKIP, /* skipping output */
+};
+
+typedef struct __s_stringlist
+{
+ struct __s_stringlist *next;
+ char *line;
+} stringlist;
+
+typedef struct __s_stringpair
+{
+ struct __s_stringpair *next;
+ char *first;
+ char *second;
+ int matchlength;
+} stringpair;
+
+/* macros for code generation */
+#define opcodes(n) ((n)*sizeof(cell)) /* opcode size */
+#define opargs(n) ((n)*sizeof(cell)) /* size of typical argument */
+
+/* Tokens recognized by lex()
+ * Some of these constants are assigned as well to the variable "lastst"
+ */
+#define tFIRST 256 /* value of first multi-character operator */
+#define tMIDDLE 279 /* value of last multi-character operator */
+#define tLAST 320 /* value of last multi-character match-able token */
+/* multi-character operators */
+#define taMULT 256 /* *= */
+#define taDIV 257 /* /= */
+#define taMOD 258 /* %= */
+#define taADD 259 /* += */
+#define taSUB 260 /* -= */
+#define taSHL 261 /* <<= */
+#define taSHRU 262 /* >>>= */
+#define taSHR 263 /* >>= */
+#define taAND 264 /* &= */
+#define taXOR 265 /* ^= */
+#define taOR 266 /* |= */
+#define tlOR 267 /* || */
+#define tlAND 268 /* && */
+#define tlEQ 269 /* == */
+#define tlNE 270 /* != */
+#define tlLE 271 /* <= */
+#define tlGE 272 /* >= */
+#define tSHL 273 /* << */
+#define tSHRU 274 /* >>> */
+#define tSHR 275 /* >> */
+#define tINC 276 /* ++ */
+#define tDEC 277 /* -- */
+#define tELLIPS 278 /* ... */
+#define tDBLDOT 279 /* .. */
+/* reserved words (statements) */
+#define tASSERT 280
+#define tBREAK 281
+#define tCASE 282
+#define tCHAR 283
+#define tCONST 284
+#define tCONTINUE 285
+#define tDEFAULT 286
+#define tDEFINED 287
+#define tDO 288
+#define tELSE 289
+#define tENUM 290
+#define tEXIT 291
+#define tFOR 292
+#define tFORWARD 293
+#define tGOTO 294
+#define tIF 295
+#define tNATIVE 296
+#define tNEW 297
+#define tOPERATOR 298
+#define tPUBLIC 299
+#define tRETURN 300
+#define tSIZEOF 301
+#define tSLEEP 302
+#define tSTATIC 303
+#define tSTOCK 304
+#define tSWITCH 305
+#define tTAGOF 306
+#define tWHILE 307
+/* compiler directives */
+#define tpASSERT 308 /* #assert */
+#define tpDEFINE 309
+#define tpELSE 310 /* #else */
+#define tpEMIT 311
+#define tpENDIF 312
+#define tpENDINPUT 313
+#define tpENDSCRPT 314
+#define tpFILE 315
+#define tpIF 316 /* #if */
+#define tINCLUDE 317
+#define tpLINE 318
+#define tpPRAGMA 319
+#define tpUNDEF 320
+/* semicolon is a special case, because it can be optional */
+#define tTERM 321 /* semicolon or newline */
+#define tENDEXPR 322 /* forced end of expression */
+/* other recognized tokens */
+#define tNUMBER 323 /* integer number */
+#define tRATIONAL 324 /* rational number */
+#define tSYMBOL 325
+#define tLABEL 326
+#define tSTRING 327
+#define tEXPR 328 /* for assigment to "lastst" only */
+
+/* (reversed) evaluation of staging buffer */
+#define sSTARTREORDER 1
+#define sENDREORDER 2
+#define sEXPRSTART 0xc0 /* top 2 bits set, rest is free */
+#define sMAXARGS 64 /* relates to the bit pattern of sEXPRSTART */
+
+/* codes for ffabort() */
+#define xEXIT 1 /* exit code in PRI */
+#define xASSERTION 2 /* abort caused by failing assertion */
+#define xSTACKERROR 3 /* stack/heap overflow */
+#define xBOUNDSERROR 4 /* array index out of bounds */
+#define xMEMACCESS 5 /* data access error */
+#define xINVINSTR 6 /* invalid instruction */
+#define xSTACKUNDERFLOW 7 /* stack underflow */
+#define xHEAPUNDERFLOW 8 /* heap underflow */
+#define xCALLBACKERR 9 /* no, or invalid, callback */
+#define xSLEEP 12 /* sleep, exit code in PRI, tag in ALT */
+
+/* Miscellaneous */
+#if !defined TRUE
+#define FALSE 0
+#define TRUE 1
+#endif
+#define sIN_CSEG 1 /* if parsing CODE */
+#define sIN_DSEG 2 /* if parsing DATA */
+#define sCHKBOUNDS 1 /* bit position in "debug" variable: check bounds */
+#define sSYMBOLIC 2 /* bit position in "debug" variable: symbolic info */
+#define sNOOPTIMIZE 4 /* bit position in "debug" variable: no optimization */
+#define sRESET 0 /* reset error flag */
+#define sFORCESET 1 /* force error flag on */
+#define sEXPRMARK 2 /* mark start of expression */
+#define sEXPRRELEASE 3 /* mark end of expression */
+
+#if INT_MAX<0x8000u
+#define PUBLICTAG 0x8000u
+#define FIXEDTAG 0x4000u
+#else
+#define PUBLICTAG 0x80000000Lu
+#define FIXEDTAG 0x40000000Lu
+#endif
+#define TAGMASK (~PUBLICTAG)
+
+
+/*
+ * Functions you call from the "driver" program
+ */
+ int sc_compile(int argc, char **argv);
+ int sc_addconstant(char *name, cell value, int tag);
+ int sc_addtag(char *name);
+
+/*
+ * Functions called from the compiler (to be implemented by you)
+ */
+
+/* general console output */
+ int sc_printf(const char *message, ...);
+
+/* error report function */
+ int sc_error(int number, char *message, char *filename,
+ int firstline, int lastline, va_list argptr);
+
+/* input from source file */
+ void *sc_opensrc(char *filename); /* reading only */
+ void sc_closesrc(void *handle); /* never delete */
+ void sc_resetsrc(void *handle, void *position); /* reset to a position marked earlier */
+ char *sc_readsrc(void *handle, char *target, int maxchars);
+ void *sc_getpossrc(void *handle); /* mark the current position */
+ int sc_eofsrc(void *handle);
+
+/* output to intermediate (.ASM) file */
+ void *sc_openasm(int fd); /* read/write */
+ void sc_closeasm(void *handle);
+ void sc_resetasm(void *handle);
+ int sc_writeasm(void *handle, char *str);
+ char *sc_readasm(void *handle, char *target, int maxchars);
+
+/* output to binary (.AMX) file */
+ void *sc_openbin(char *filename);
+ void sc_closebin(void *handle, int deletefile);
+ void sc_resetbin(void *handle);
+ int sc_writebin(void *handle, void *buffer, int size);
+ long sc_lengthbin(void *handle); /* return the length of the file */
+
+/* function prototypes in SC1.C */
+symbol *fetchfunc(char *name, int tag);
+char *operator_symname(char *symname, char *opername, int tag1,
+ int tag2, int numtags, int resulttag);
+char *funcdisplayname(char *dest, char *funcname);
+int constexpr(cell * val, int *tag);
+constvalue *append_constval(constvalue * table, char *name, cell val,
+ short index);
+constvalue *find_constval(constvalue * table, char *name, short index);
+void delete_consttable(constvalue * table);
+void add_constant(char *name, cell val, int vclass, int tag);
+void exporttag(int tag);
+
+/* function prototypes in SC2.C */
+void pushstk(stkitem val);
+stkitem popstk(void);
+int plungequalifiedfile(char *name); /* explicit path included */
+int plungefile(char *name, int try_currentpath, int try_includepaths); /* search through "include" paths */
+void preprocess(void);
+void lexinit(void);
+int lex(cell * lexvalue, char **lexsym);
+void lexpush(void);
+void lexclr(int clreol);
+int matchtoken(int token);
+int tokeninfo(cell * val, char **str);
+int needtoken(int token);
+void stowlit(cell value);
+int alphanum(char c);
+void delete_symbol(symbol * root, symbol * sym);
+void delete_symbols(symbol * root, int level, int del_labels,
+ int delete_functions);
+int refer_symbol(symbol * entry, symbol * bywhom);
+void markusage(symbol * sym, int usage);
+unsigned int namehash(char *name);
+symbol *findglb(char *name);
+symbol *findloc(char *name);
+symbol *findconst(char *name);
+symbol *finddepend(symbol * parent);
+symbol *addsym(char *name, cell addr, int ident, int vclass,
+ int tag, int usage);
+symbol *addvariable(char *name, cell addr, int ident, int vclass,
+ int tag, int dim[], int numdim, int idxtag[]);
+int getlabel(void);
+char *itoh(ucell val);
+
+/* function prototypes in SC3.C */
+int check_userop(void (*oper) (void), int tag1, int tag2,
+ int numparam, value * lval, int *resulttag);
+int matchtag(int formaltag, int actualtag, int allowcoerce);
+int expression(int *constant, cell * val, int *tag,
+ int chkfuncresult);
+int hier14(value * lval1); /* the highest expression level */
+
+/* function prototypes in SC4.C */
+void writeleader(void);
+void writetrailer(void);
+void begcseg(void);
+void begdseg(void);
+void setactivefile(int fnumber);
+cell nameincells(char *name);
+void setfile(char *name, int fileno);
+void setline(int line, int fileno);
+void setlabel(int index);
+void endexpr(int fullexpr);
+void startfunc(char *fname);
+void endfunc(void);
+void alignframe(int numbytes);
+void defsymbol(char *name, int ident, int vclass, cell offset,
+ int tag);
+void symbolrange(int level, cell size);
+void rvalue(value * lval);
+void address(symbol * ptr);
+void store(value * lval);
+void memcopy(cell size);
+void copyarray(symbol * sym, cell size);
+void fillarray(symbol * sym, cell size, cell value);
+void const1(cell val);
+void const2(cell val);
+void moveto1(void);
+void push1(void);
+void push2(void);
+void pushval(cell val);
+void pop1(void);
+void pop2(void);
+void swap1(void);
+void ffswitch(int label);
+void ffcase(cell value, char *labelname, int newtable);
+void ffcall(symbol * sym, int numargs);
+void ffret(void);
+void ffabort(int reason);
+void ffbounds(cell size);
+void jumplabel(int number);
+void defstorage(void);
+void modstk(int delta);
+void setstk(cell value);
+void modheap(int delta);
+void setheap_pri(void);
+void setheap(cell value);
+void cell2addr(void);
+void cell2addr_alt(void);
+void addr2cell(void);
+void char2addr(void);
+void charalign(void);
+void addconst(cell value);
+
+/* Code generation functions for arithmetic operators.
+ *
+ * Syntax: o[u|s|b]_name
+ * | | | +--- name of operator
+ * | | +----- underscore
+ * | +--------- "u"nsigned operator, "s"igned operator or "b"oth
+ * +------------- "o"perator
+ */
+void os_mult(void); /* multiplication (signed) */
+void os_div(void); /* division (signed) */
+void os_mod(void); /* modulus (signed) */
+void ob_add(void); /* addition */
+void ob_sub(void); /* subtraction */
+void ob_sal(void); /* shift left (arithmetic) */
+void os_sar(void); /* shift right (arithmetic, signed) */
+void ou_sar(void); /* shift right (logical, unsigned) */
+void ob_or(void); /* bitwise or */
+void ob_xor(void); /* bitwise xor */
+void ob_and(void); /* bitwise and */
+void ob_eq(void); /* equality */
+void ob_ne(void); /* inequality */
+void relop_prefix(void);
+void relop_suffix(void);
+void os_le(void); /* less or equal (signed) */
+void os_ge(void); /* greater or equal (signed) */
+void os_lt(void); /* less (signed) */
+void os_gt(void); /* greater (signed) */
+
+void lneg(void);
+void neg(void);
+void invert(void);
+void nooperation(void);
+void inc(value * lval);
+void dec(value * lval);
+void jmp_ne0(int number);
+void jmp_eq0(int number);
+void outval(cell val, int newline);
+
+/* function prototypes in SC5.C */
+int error(int number, ...);
+void errorset(int code);
+
+/* function prototypes in SC6.C */
+void assemble(FILE * fout, FILE * fin);
+
+/* function prototypes in SC7.C */
+void stgbuffer_cleanup(void);
+void stgmark(char mark);
+void stgwrite(char *st);
+void stgout(int index);
+void stgdel(int index, cell code_index);
+int stgget(int *index, cell * code_index);
+void stgset(int onoff);
+int phopt_init(void);
+int phopt_cleanup(void);
+
+/* function prototypes in SCLIST.C */
+stringpair *insert_alias(char *name, char *alias);
+stringpair *find_alias(char *name);
+int lookup_alias(char *target, char *name);
+void delete_aliastable(void);
+stringlist *insert_path(char *path);
+char *get_path(int index);
+void delete_pathtable(void);
+stringpair *insert_subst(char *pattern, char *substitution,
+ int prefixlen);
+int get_subst(int index, char **pattern, char **substitution);
+stringpair *find_subst(char *name, int length);
+int delete_subst(char *name, int length);
+void delete_substtable(void);
+
+/* external variables (defined in scvars.c) */
+extern symbol loctab; /* local symbol table */
+extern symbol glbtab; /* global symbol table */
+extern cell *litq; /* the literal queue */
+extern char pline[]; /* the line read from the input file */
+extern char *lptr; /* points to the current position in "pline" */
+extern constvalue tagname_tab; /* tagname table */
+extern constvalue libname_tab; /* library table (#pragma library "..." syntax) *///??? use "stringlist" type
+extern constvalue *curlibrary; /* current library */
+extern symbol *curfunc; /* pointer to current function */
+extern char *inpfname; /* name of the file currently read from */
+extern char outfname[]; /* output file name */
+extern char sc_ctrlchar; /* the control character (or escape character) */
+extern int litidx; /* index to literal table */
+extern int litmax; /* current size of the literal table */
+extern int stgidx; /* index to the staging buffer */
+extern int labnum; /* number of (internal) labels */
+extern int staging; /* true if staging output */
+extern cell declared; /* number of local cells declared */
+extern cell glb_declared; /* number of global cells declared */
+extern cell code_idx; /* number of bytes with generated code */
+extern int ntv_funcid; /* incremental number of native function */
+extern int errnum; /* number of errors */
+extern int warnnum; /* number of warnings */
+extern int sc_debug; /* debug/optimization options (bit field) */
+extern int charbits; /* number of bits for a character */
+extern int sc_packstr; /* strings are packed by default? */
+extern int sc_asmfile; /* create .ASM file? */
+extern int sc_listing; /* create .LST file? */
+extern int sc_compress; /* compress bytecode? */
+extern int sc_needsemicolon; /* semicolon required to terminate expressions? */
+extern int sc_dataalign; /* data alignment value */
+extern int sc_alignnext; /* must frame of the next function be aligned? */
+extern int curseg; /* 1 if currently parsing CODE, 2 if parsing DATA */
+extern cell sc_stksize; /* stack size */
+extern int freading; /* is there an input file ready for reading? */
+extern int fline; /* the line number in the current file */
+extern int fnumber; /* number of files in the file table (debugging) */
+extern int fcurrent; /* current file being processed (debugging) */
+extern int intest; /* true if inside a test */
+extern int sideeffect; /* true if an expression causes a side-effect */
+extern int stmtindent; /* current indent of the statement */
+extern int indent_nowarn; /* skip warning "217 loose indentation" */
+extern int sc_tabsize; /* number of spaces that a TAB represents */
+extern int sc_allowtags; /* allow/detect tagnames in lex() */
+extern int sc_status; /* read/write status */
+extern int sc_rationaltag; /* tag for rational numbers */
+extern int rational_digits; /* number of fractional digits */
+
+extern FILE *inpf; /* file read from (source or include) */
+extern FILE *inpf_org; /* main source file */
+extern FILE *outf; /* file written to */
+
+extern jmp_buf errbuf; /* target of longjmp() on a fatal error */
+
+#define sc_isspace(x) isspace ((int)((unsigned char)x))
+#define sc_isalpha(x) isalpha ((int)((unsigned char)x))
+#define sc_isdigit(x) isdigit ((int)((unsigned char)x))
+#define sc_isupper(x) isupper ((int)((unsigned char)x))
+#define sc_isxdigit(x) isxdigit((int)((unsigned char)x))
+
+#endif
--- /dev/null
+/* Small compiler
+ * Function and variable definition and declaration, statement parser.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied
+ * warranty. In no event will the authors be held liable for any
+ * damages arising from the use of this software. Permission is granted
+ * to anyone to use this software for any purpose, including commercial
+ * applications, and to alter it and redistribute it freely, subject to
+ * the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented;
+ * you must not claim that you wrote the original software.
+ * If you use this software in a product, an acknowledgment in the
+ * product documentation would be appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and
+ * must not be misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source
+ * distribution.
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif /* HAVE_EVIL */
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_prefix.h"
+
+#define VERSION_STR "2.4"
+#define VERSION_INT 240
+
+static void resetglobals(void);
+static void initglobals(void);
+static void setopt(int argc, char **argv,
+ char *iname, char *oname,
+ char *pname, char *rname);
+static void setconfig(char *root);
+static void about(void);
+static void setconstants(void);
+static void parse(void);
+static void dumplits(void);
+static void dumpzero(int count);
+static void declfuncvar(int tok, char *symname,
+ int tag, int fpublic,
+ int fstatic, int fstock, int fconst);
+static void declglb(char *firstname, int firsttag,
+ int fpublic, int fstatic, int stock, int fconst);
+static int declloc(int fstatic);
+static void decl_const(int table);
+static void decl_enum(int table);
+static cell needsub(int *tag);
+static void initials(int ident, int tag,
+ cell * size, int dim[], int numdim);
+static cell initvector(int ident, int tag, cell size, int fillzero);
+static cell init(int ident, int *tag);
+static void funcstub(int native);
+static int newfunc(char *firstname, int firsttag,
+ int fpublic, int fstatic, int stock);
+static int declargs(symbol * sym);
+static void doarg(char *name, int ident, int offset,
+ int tags[], int numtags,
+ int fpublic, int fconst, arginfo * arg);
+static void reduce_referrers(symbol * root);
+static int testsymbols(symbol * root, int level,
+ int testlabs, int testconst);
+static void destructsymbols(symbol * root, int level);
+static constvalue *find_constval_byval(constvalue * table, cell val);
+static void statement(int *lastindent, int allow_decl);
+static void compound(void);
+static void doexpr(int comma, int chkeffect,
+ int allowarray, int mark_endexpr,
+ int *tag, int chkfuncresult);
+static void doassert(void);
+static void doexit(void);
+static void test(int label, int parens, int invert);
+static void doif(void);
+static void dowhile(void);
+static void dodo(void);
+static void dofor(void);
+static void doswitch(void);
+static void dogoto(void);
+static void dolabel(void);
+static symbol *fetchlab(char *name);
+static void doreturn(void);
+static void dobreak(void);
+static void docont(void);
+static void dosleep(void);
+static void addwhile(int *ptr);
+static void delwhile(void);
+static int *readwhile(void);
+
+static int lastst = 0; /* last executed statement type */
+static int nestlevel = 0; /* number of active (open) compound statements */
+static int rettype = 0; /* the type that a "return" expression should have */
+static int skipinput = 0; /* number of lines to skip from the first input file */
+static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
+static int *wqptr; /* pointer to next entry */
+static char binfname[PATH_MAX]; /* binary file name */
+
+int
+main(int argc, char *argv[], char *env[] __UNUSED__)
+{
+ e_prefix_determine(argv[0]);
+ return sc_compile(argc, argv);
+}
+
+int
+sc_error(int number, char *message, char *filename, int firstline,
+ int lastline, va_list argptr)
+{
+ static char *prefix[3] = { "error", "fatal error", "warning" };
+
+ if (number != 0)
+ {
+ char *pre;
+
+ pre = prefix[number / 100];
+ if (firstline >= 0)
+ fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
+ lastline, pre, number);
+ else
+ fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
+ number);
+ } /* if */
+ vfprintf(stderr, message, argptr);
+ fflush(stderr);
+ return 0;
+}
+
+void *
+sc_opensrc(char *filename)
+{
+ return fopen(filename, "rb");
+}
+
+void
+sc_closesrc(void *handle)
+{
+ assert(handle != NULL);
+ fclose((FILE *) handle);
+}
+
+void
+sc_resetsrc(void *handle, void *position)
+{
+ assert(handle != NULL);
+ fsetpos((FILE *) handle, (fpos_t *) position);
+}
+
+char *
+sc_readsrc(void *handle, char *target, int maxchars)
+{
+ return fgets(target, maxchars, (FILE *) handle);
+}
+
+void *
+sc_getpossrc(void *handle)
+{
+ static fpos_t lastpos; /* may need to have a LIFO stack of
+ * such positions */
+
+ fgetpos((FILE *) handle, &lastpos);
+ return &lastpos;
+}
+
+int
+sc_eofsrc(void *handle)
+{
+ return feof((FILE *) handle);
+}
+
+void *
+sc_openasm(int fd)
+{
+ return fdopen(fd, "w+");
+}
+
+void
+sc_closeasm(void *handle)
+{
+ if (handle)
+ fclose((FILE *) handle);
+}
+
+void
+sc_resetasm(void *handle)
+{
+ fflush((FILE *) handle);
+ fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writeasm(void *handle, char *st)
+{
+ return fputs(st, (FILE *) handle) >= 0;
+}
+
+char *
+sc_readasm(void *handle, char *target, int maxchars)
+{
+ return fgets(target, maxchars, (FILE *) handle);
+}
+
+void *
+sc_openbin(char *filename)
+{
+ return fopen(filename, "wb");
+}
+
+void
+sc_closebin(void *handle, int deletefile)
+{
+ fclose((FILE *) handle);
+ if (deletefile)
+ unlink(binfname);
+}
+
+void
+sc_resetbin(void *handle)
+{
+ fflush((FILE *) handle);
+ fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writebin(void *handle, void *buffer, int size)
+{
+ return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
+}
+
+long
+sc_lengthbin(void *handle)
+{
+ return ftell((FILE *) handle);
+}
+
+/* "main" of the compiler
+ */
+int
+sc_compile(int argc, char *argv[])
+{
+ int entry, i, jmpcode, fd_out;
+ int retcode;
+ char incfname[PATH_MAX];
+ char reportname[PATH_MAX];
+ FILE *binf;
+ void *inpfmark;
+ char lcl_ctrlchar;
+ int lcl_packstr, lcl_needsemicolon, lcl_tabsize;
+ char *tmpdir;
+
+ /* set global variables to their initial value */
+ binf = NULL;
+ initglobals();
+ errorset(sRESET);
+ errorset(sEXPRRELEASE);
+ lexinit();
+
+ /* make sure that we clean up on a fatal error; do this before the
+ * first call to error(). */
+ if ((jmpcode = setjmp(errbuf)) != 0)
+ goto cleanup;
+
+ /* allocate memory for fixed tables */
+ inpfname = (char *)malloc(PATH_MAX);
+ litq = (cell *) malloc(litmax * sizeof(cell));
+ if (!litq)
+ error(103); /* insufficient memory */
+ if (!phopt_init())
+ error(103); /* insufficient memory */
+
+ setopt(argc, argv, inpfname, binfname, incfname, reportname);
+
+ /* open the output file */
+
+#ifndef HAVE_EVIL
+ tmpdir = getenv("TMPDIR");
+ if (!tmpdir) tmpdir = "/tmp";
+#else
+ tmpdir = (char *)evil_tmpdir_get();
+#endif /* ! HAVE_EVIL */
+
+ snprintf(outfname, PATH_MAX, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
+ fd_out = mkstemp(outfname);
+ if (fd_out < 0)
+ error(101, outfname);
+
+ setconfig(argv[0]); /* the path to the include files */
+ lcl_ctrlchar = sc_ctrlchar;
+ lcl_packstr = sc_packstr;
+ lcl_needsemicolon = sc_needsemicolon;
+ lcl_tabsize = sc_tabsize;
+ inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
+ if (!inpf)
+ error(100, inpfname);
+ freading = TRUE;
+ outf = (FILE *) sc_openasm(fd_out); /* first write to assembler
+ * file (may be temporary) */
+ if (!outf)
+ error(101, outfname);
+ /* immediately open the binary file, for other programs to check */
+ binf = (FILE *) sc_openbin(binfname);
+ if (!binf)
+ error(101, binfname);
+ setconstants(); /* set predefined constants and tagnames */
+ for (i = 0; i < skipinput; i++) /* skip lines in the input file */
+ if (sc_readsrc(inpf, pline, sLINEMAX))
+ fline++; /* keep line number up to date */
+ skipinput = fline;
+ sc_status = statFIRST;
+ /* do the first pass through the file */
+ inpfmark = sc_getpossrc(inpf);
+ if (incfname[0] != '\0')
+ {
+ if (strcmp(incfname, sDEF_PREFIX) == 0)
+ {
+ plungefile(incfname, FALSE, TRUE); /* parse "default.inc" */
+ }
+ else
+ {
+ if (!plungequalifiedfile(incfname)) /* parse "prefix" include
+ * file */
+ error(100, incfname); /* cannot read from ... (fatal error) */
+ } /* if */
+ } /* if */
+ preprocess(); /* fetch first line */
+ parse(); /* process all input */
+
+ /* second pass */
+ sc_status = statWRITE; /* set, to enable warnings */
+
+ /* ??? for re-parsing the listing file instead of the original source
+ * file (and doing preprocessing twice):
+ * - close input file, close listing file
+ * - re-open listing file for reading (inpf)
+ * - open assembler file (outf)
+ */
+
+ /* reset "defined" flag of all functions and global variables */
+ reduce_referrers(&glbtab);
+ delete_symbols(&glbtab, 0, TRUE, FALSE);
+#if !defined NO_DEFINE
+ delete_substtable();
+#endif
+ resetglobals();
+ sc_ctrlchar = lcl_ctrlchar;
+ sc_packstr = lcl_packstr;
+ sc_needsemicolon = lcl_needsemicolon;
+ sc_tabsize = lcl_tabsize;
+ errorset(sRESET);
+ /* reset the source file */
+ inpf = inpf_org;
+ freading = TRUE;
+ sc_resetsrc(inpf, inpfmark); /* reset file position */
+ fline = skipinput; /* reset line number */
+ lexinit(); /* clear internal flags of lex() */
+ sc_status = statWRITE; /* allow to write --this variable was reset
+ * by resetglobals() */
+ writeleader();
+ setfile(inpfname, fnumber);
+ if (incfname[0] != '\0')
+ {
+ if (strcmp(incfname, sDEF_PREFIX) == 0)
+ plungefile(incfname, FALSE, TRUE); /* parse "default.inc" (again) */
+ else
+ plungequalifiedfile(incfname); /* parse implicit include
+ * file (again) */
+ } /* if */
+ preprocess(); /* fetch first line */
+ parse(); /* process all input */
+ /* inpf is already closed when readline() attempts to pop of a file */
+ writetrailer(); /* write remaining stuff */
+
+ entry = testsymbols(&glbtab, 0, TRUE, FALSE); /* test for unused
+ * or undefined functions and variables */
+ if (!entry)
+ error(13); /* no entry point (no public functions) */
+
+ cleanup:
+ if (inpf) /* main source file is not closed, do it now */
+ sc_closesrc(inpf);
+ /* write the binary file (the file is already open) */
+ if (errnum == 0 && jmpcode == 0)
+ {
+ assert(binf != NULL);
+ sc_resetasm(outf); /* flush and loop back, for reading */
+ assemble(binf, outf); /* assembler file is now input */
+ } /* if */
+ if (outf)
+ sc_closeasm(outf);
+ unlink (outfname);
+ if (binf)
+ sc_closebin(binf, errnum != 0);
+
+ if (inpfname)
+ free(inpfname);
+ if (litq)
+ free(litq);
+ phopt_cleanup();
+ stgbuffer_cleanup();
+ assert(jmpcode != 0 || loctab.next == NULL); /* on normal flow,
+ * local symbols
+ * should already have been deleted */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* delete local variables
+ * if not yet done (i.e.
+ * on a fatal error) */
+ delete_symbols(&glbtab, 0, TRUE, TRUE);
+ delete_consttable(&tagname_tab);
+ delete_consttable(&libname_tab);
+ delete_aliastable();
+ delete_pathtable();
+#if !defined NO_DEFINE
+ delete_substtable();
+#endif
+ if (errnum != 0)
+ {
+ printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
+ retcode = 2;
+ }
+ else if (warnnum != 0)
+ {
+ printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
+ retcode = 1;
+ }
+ else
+ {
+ retcode = jmpcode;
+ } /* if */
+ return retcode;
+}
+
+int
+sc_addconstant(char *name, cell value, int tag)
+{
+ errorset(sFORCESET); /* make sure error engine is silenced */
+ sc_status = statIDLE;
+ add_constant(name, value, sGLOBAL, tag);
+ return 1;
+}
+
+int
+sc_addtag(char *name)
+{
+ cell val;
+ constvalue *ptr;
+ int last, tag;
+
+ if (!name)
+ {
+ /* no tagname was given, check for one */
+ if (lex(&val, &name) != tLABEL)
+ {
+ lexpush();
+ return 0; /* untagged */
+ } /* if */
+ } /* if */
+
+ last = 0;
+ ptr = tagname_tab.next;
+ while (ptr)
+ {
+ tag = (int)(ptr->value & TAGMASK);
+ if (strcmp(name, ptr->name) == 0)
+ return tag; /* tagname is known, return its sequence number */
+ tag &= (int)~FIXEDTAG;
+ if (tag > last)
+ last = tag;
+ ptr = ptr->next;
+ } /* while */
+
+ /* tagname currently unknown, add it */
+ tag = last + 1; /* guaranteed not to exist already */
+ if (sc_isupper(*name))
+ tag |= (int)FIXEDTAG;
+ append_constval(&tagname_tab, name, (cell) tag, 0);
+ return tag;
+}
+
+static void
+resetglobals(void)
+{
+ /* reset the subset of global variables that is modified by the
+ * first pass */
+ curfunc = NULL; /* pointer to current function */
+ lastst = 0; /* last executed statement type */
+ nestlevel = 0; /* number of active (open) compound statements */
+ rettype = 0; /* the type that a "return" expression should have */
+ litidx = 0; /* index to literal table */
+ stgidx = 0; /* index to the staging buffer */
+ labnum = 0; /* number of (internal) labels */
+ staging = 0; /* true if staging output */
+ declared = 0; /* number of local cells declared */
+ glb_declared = 0; /* number of global cells declared */
+ code_idx = 0; /* number of bytes with generated code */
+ ntv_funcid = 0; /* incremental number of native function */
+ curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
+ freading = FALSE; /* no input file ready yet */
+ fline = 0; /* the line number in the current file */
+ fnumber = 0; /* the file number in the file table (debugging) */
+ fcurrent = 0; /* current file being processed (debugging) */
+ intest = 0; /* true if inside a test */
+ sideeffect = 0; /* true if an expression causes a side-effect */
+ stmtindent = 0; /* current indent of the statement */
+ indent_nowarn = TRUE; /* do not skip warning "217 loose indentation" */
+ sc_allowtags = TRUE; /* allow/detect tagnames */
+ sc_status = statIDLE;
+}
+
+static void
+initglobals(void)
+{
+ resetglobals();
+
+ skipinput = 0; /* number of lines to skip from the first
+ * input file */
+ sc_ctrlchar = CTRL_CHAR; /* the escape character */
+ litmax = sDEF_LITMAX; /* current size of the literal table */
+ errnum = 0; /* number of errors */
+ warnnum = 0; /* number of warnings */
+/* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
+ sc_debug = 0; /* by default: no debug */
+ charbits = 8; /* a "char" is 8 bits */
+ sc_packstr = FALSE; /* strings are unpacked by default */
+/* sc_compress=TRUE; compress output bytecodes */
+ sc_compress = FALSE; /* compress output bytecodes */
+ sc_needsemicolon = FALSE; /* semicolon required to terminate
+ * expressions? */
+ sc_dataalign = 4;
+ sc_stksize = sDEF_AMXSTACK; /* default stack size */
+ sc_tabsize = 8; /* assume a TAB is 8 spaces */
+ sc_rationaltag = 0; /* assume no support for rational numbers */
+ rational_digits = 0; /* number of fractional digits */
+
+ outfname[0] = '\0'; /* output file name */
+ inpf = NULL; /* file read from */
+ inpfname = NULL; /* pointer to name of the file currently
+ * read from */
+ outf = NULL; /* file written to */
+ litq = NULL; /* the literal queue */
+ glbtab.next = NULL; /* clear global variables/constants table */
+ loctab.next = NULL; /* " local " / " " */
+ tagname_tab.next = NULL; /* tagname table */
+ libname_tab.next = NULL; /* library table (#pragma library "..."
+ * syntax) */
+
+ pline[0] = '\0'; /* the line read from the input file */
+ lptr = NULL; /* points to the current position in "pline" */
+ curlibrary = NULL; /* current library */
+ inpf_org = NULL; /* main source file */
+
+ wqptr = wq; /* initialize while queue pointer */
+
+}
+
+static void
+parseoptions(int argc, char **argv, char *iname, char *oname,
+ char *pname __UNUSED__, char *rname __UNUSED__)
+{
+ char str[PATH_MAX];
+ int i, stack_size;
+ size_t len;
+
+ /* use embryo include dir always */
+ snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
+ insert_path(str);
+ insert_path("./");
+
+ for (i = 1; i < argc; i++)
+ {
+ if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* include directory */
+ i++;
+ strncpy(str, argv[i], sizeof(str));
+
+ len = strlen(str);
+ if (str[len - 1] != DIRSEP_CHAR)
+ {
+ str[len] = DIRSEP_CHAR;
+ str[len + 1] = '\0';
+ }
+
+ insert_path(str);
+ }
+ else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* output file */
+ i++;
+ strcpy(oname, argv[i]); /* FIXME */
+ }
+ else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
+ {
+ /* stack size */
+ i++;
+ stack_size = atoi(argv[i]);
+
+ if (stack_size > 64)
+ sc_stksize = (cell) stack_size;
+ else
+ about();
+ }
+ else if (!*iname)
+ {
+ /* input file */
+ strcpy(iname, argv[i]); /* FIXME */
+ }
+ else
+ {
+ /* only allow one input filename */
+ about();
+ }
+ }
+}
+
+static void
+setopt(int argc, char **argv, char *iname, char *oname,
+ char *pname, char *rname)
+{
+ *iname = '\0';
+ *oname = '\0';
+ *pname = '\0';
+ *rname = '\0';
+ strcpy(pname, sDEF_PREFIX);
+
+ parseoptions(argc, argv, iname, oname, pname, rname);
+ if (iname[0] == '\0')
+ about();
+}
+
+static void
+setconfig(char *root)
+{
+ char path[PATH_MAX];
+ char *ptr;
+ int len;
+
+ path[sizeof(path) - 1] = 0;
+
+ /* add the default "include" directory */
+ if (root)
+ {
+ /* path + filename (hopefully) */
+ strncpy(path, root, sizeof(path) - 1);
+ path[sizeof(path) - 1] = 0;
+ }
+/* terminate just behind last \ or : */
+ if ((ptr = strrchr(path, DIRSEP_CHAR))
+ || (ptr = strchr(path, ':')))
+ {
+ /* If there was no terminating "\" or ":",
+ * the filename probably does not
+ * contain the path; so we just don't add it
+ * to the list in that case
+ */
+ *(ptr + 1) = '\0';
+ if (strlen(path) < (sizeof(path) - 1 - 7))
+ {
+ strcat(path, "include");
+ }
+ len = strlen(path);
+ path[len] = DIRSEP_CHAR;
+ path[len + 1] = '\0';
+ insert_path(path);
+ } /* if */
+}
+
+static void
+about(void)
+{
+ printf("Usage: embryo_cc <filename> [options]\n\n");
+ printf("Options:\n");
+#if 0
+ printf
+ (" -A<num> alignment in bytes of the data segment and the\
+ stack\n");
+
+ printf
+ (" -a output assembler code (skip code generation\
+ pass)\n");
+
+ printf
+ (" -C[+/-] compact encoding for output file (default=%c)\n",
+ sc_compress ? '+' : '-');
+ printf(" -c8 [default] a character is 8-bits\
+ (ASCII/ISO Latin-1)\n");
+
+ printf(" -c16 a character is 16-bits (Unicode)\n");
+#if defined dos_setdrive
+ printf(" -Dpath active directory path\n");
+#endif
+ printf
+ (" -d0 no symbolic information, no run-time checks\n");
+ printf(" -d1 [default] run-time checks, no symbolic\
+ information\n");
+ printf
+ (" -d2 full debug information and dynamic checking\n");
+ printf(" -d3 full debug information, dynamic checking,\
+ no optimization\n");
+#endif
+ printf(" -i <name> path for include files\n");
+#if 0
+ printf(" -l create list file (preprocess only)\n");
+#endif
+ printf(" -o <name> set base name of output file\n");
+#if 0
+ printf
+ (" -P[+/-] strings are \"packed\" by default (default=%c)\n",
+ sc_packstr ? '+' : '-');
+ printf(" -p<name> set name of \"prefix\" file\n");
+ if (!waitkey())
+ longjmp(errbuf, 3);
+#endif
+ printf
+ (" -S <num> stack/heap size in cells (default=%d, min=65)\n",
+ (int)sc_stksize);
+#if 0
+ printf(" -s<num> skip lines from the input file\n");
+ printf
+ (" -t<num> TAB indent size (in character positions)\n");
+ printf(" -\\ use '\\' for escape characters\n");
+ printf(" -^ use '^' for escape characters\n");
+ printf(" -;[+/-] require a semicolon to end each statement\
+ (default=%c)\n", sc_needsemicolon ? '+' : '-');
+
+ printf
+ (" sym=val define constant \"sym\" with value \"val\"\n");
+ printf(" sym= define constant \"sym\" with value 0\n");
+#endif
+ longjmp(errbuf, 3); /* user abort */
+}
+
+static void
+setconstants(void)
+{
+ int debug;
+
+ assert(sc_status == statIDLE);
+ append_constval(&tagname_tab, "_", 0, 0); /* "untagged" */
+ append_constval(&tagname_tab, "bool", 1, 0);
+
+ add_constant("true", 1, sGLOBAL, 1); /* boolean flags */
+ add_constant("false", 0, sGLOBAL, 1);
+ add_constant("EOS", 0, sGLOBAL, 0); /* End Of String, or '\0' */
+ add_constant("cellbits", 32, sGLOBAL, 0);
+ add_constant("cellmax", INT_MAX, sGLOBAL, 0);
+ add_constant("cellmin", INT_MIN, sGLOBAL, 0);
+ add_constant("charbits", charbits, sGLOBAL, 0);
+ add_constant("charmin", 0, sGLOBAL, 0);
+ add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
+
+ add_constant("__Small", VERSION_INT, sGLOBAL, 0);
+
+ debug = 0;
+ if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
+ debug = 2;
+ else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
+ debug = 1;
+ add_constant("debug", debug, sGLOBAL, 0);
+}
+
+/* parse - process all input text
+ *
+ * At this level, only static declarations and function definitions
+ * are legal.
+ */
+static void
+parse(void)
+{
+ int tok, tag, fconst, fstock, fstatic;
+ cell val;
+ char *str;
+
+ while (freading)
+ {
+ /* first try whether a declaration possibly is native or public */
+ tok = lex(&val, &str); /* read in (new) token */
+ switch (tok)
+ {
+ case 0:
+ /* ignore zero's */
+ break;
+ case tNEW:
+ fconst = matchtoken(tCONST);
+ declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
+ break;
+ case tSTATIC:
+ /* This can be a static function or a static global variable;
+ * we know which of the two as soon as we have parsed up to the
+ * point where an opening parenthesis of a function would be
+ * expected. To back out after deciding it was a declaration of
+ * a static variable after all, we have to store the symbol name
+ * and tag.
+ */
+ fstock = matchtoken(tSTOCK);
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tPUBLIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
+ break;
+ case tCONST:
+ decl_const(sGLOBAL);
+ break;
+ case tENUM:
+ decl_enum(sGLOBAL);
+ break;
+ case tPUBLIC:
+ /* This can be a public function or a public variable;
+ * see the comment above (for static functions/variables)
+ * for details.
+ */
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
+ break;
+ case tSTOCK:
+ /* This can be a stock function or a stock *global) variable;
+ * see the comment above (for static functions/variables) for
+ * details.
+ */
+ fstatic = matchtoken(tSTATIC);
+ fconst = matchtoken(tCONST);
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (tok == tNATIVE || tok == tPUBLIC)
+ {
+ error(42); /* invalid combination of class specifiers */
+ break;
+ } /* if */
+ declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
+ break;
+ case tLABEL:
+ case tSYMBOL:
+ case tOPERATOR:
+ lexpush();
+ if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
+ {
+ error(10); /* illegal function or declaration */
+ lexclr(TRUE); /* drop the rest of the line */
+ } /* if */
+ break;
+ case tNATIVE:
+ funcstub(TRUE); /* create a dummy function */
+ break;
+ case tFORWARD:
+ funcstub(FALSE);
+ break;
+ case '}':
+ error(54); /* unmatched closing brace */
+ break;
+ case '{':
+ error(55); /* start of function body without function header */
+ break;
+ default:
+ if (freading)
+ {
+ error(10); /* illegal function or declaration */
+ lexclr(TRUE); /* drop the rest of the line */
+ } /* if */
+ } /* switch */
+ } /* while */
+}
+
+/* dumplits
+ *
+ * Dump the literal pool (strings etc.)
+ *
+ * Global references: litidx (referred to only)
+ */
+static void
+dumplits(void)
+{
+ int j, k;
+
+ k = 0;
+ while (k < litidx)
+ {
+ /* should be in the data segment */
+ assert(curseg == 2);
+ defstorage();
+ j = 16; /* 16 values per line */
+ while (j && k < litidx)
+ {
+ outval(litq[k], FALSE);
+ stgwrite(" ");
+ k++;
+ j--;
+ if (j == 0 || k >= litidx)
+ stgwrite("\n"); /* force a newline after 10 dumps */
+ /* Note: stgwrite() buffers a line until it is complete. It recognizes
+ * the end of line as a sequence of "\n\0", so something like "\n\t"
+ * so should not be passed to stgwrite().
+ */
+ } /* while */
+ } /* while */
+}
+
+/* dumpzero
+ *
+ * Dump zero's for default initial values
+ */
+static void
+dumpzero(int count)
+{
+ int i;
+
+ if (count <= 0)
+ return;
+ assert(curseg == 2);
+ defstorage();
+ i = 0;
+ while (count-- > 0)
+ {
+ outval(0, FALSE);
+ i = (i + 1) % 16;
+ stgwrite((i == 0 || count == 0) ? "\n" : " ");
+ if (i == 0 && count > 0)
+ defstorage();
+ } /* while */
+}
+
+static void
+aligndata(int numbytes)
+{
+ if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+ {
+ while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+ stowlit(0);
+ } /* if */
+
+}
+
+static void
+declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
+ int fstock, int fconst)
+{
+ char name[sNAMEMAX + 1];
+
+ if (tok != tSYMBOL && tok != tOPERATOR)
+ {
+ if (freading)
+ error(20, symname); /* invalid symbol name */
+ return;
+ } /* if */
+ if (tok == tOPERATOR)
+ {
+ lexpush();
+ if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
+ error(10); /* illegal function or declaration */
+ }
+ else
+ {
+ assert(strlen(symname) <= sNAMEMAX);
+ strcpy(name, symname);
+ if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
+ declglb(name, tag, fpublic, fstatic, fstock, fconst);
+ /* if not a static function, try a static variable */
+ } /* if */
+}
+
+/* declglb - declare global symbols
+ *
+ * Declare a static (global) variable. Global variables are stored in
+ * the DATA segment.
+ *
+ * global references: glb_declared (altered)
+ */
+static void
+declglb(char *firstname, int firsttag, int fpublic, int fstatic,
+ int stock, int fconst)
+{
+ int ident, tag, ispublic;
+ int idxtag[sDIMEN_MAX];
+ char name[sNAMEMAX + 1];
+ cell val, size, cidx;
+ char *str;
+ int dim[sDIMEN_MAX];
+ int numdim, level;
+ int filenum;
+ symbol *sym;
+
+#if !defined NDEBUG
+ cell glbdecl = 0;
+#endif
+
+ filenum = fcurrent; /* save file number at the start of the
+ * declaration */
+ do
+ {
+ size = 1; /* single size (no array) */
+ numdim = 0; /* no dimensions */
+ ident = iVARIABLE;
+ if (firstname)
+ {
+ assert(strlen(firstname) <= sNAMEMAX);
+ strcpy(name, firstname); /* save symbol name */
+ tag = firsttag;
+ firstname = NULL;
+ }
+ else
+ {
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(name, str); /* save symbol name */
+ } /* if */
+ sym = findglb(name);
+ if (!sym)
+ sym = findconst(name);
+ if (sym && (sym->usage & uDEFINE) != 0)
+ error(21, name); /* symbol already defined */
+ ispublic = fpublic;
+ if (name[0] == PUBLIC_CHAR)
+ {
+ ispublic = TRUE; /* implicitly public variable */
+ if (stock || fstatic)
+ error(42); /* invalid combination of class specifiers */
+ } /* if */
+ while (matchtoken('['))
+ {
+ ident = iARRAY;
+ if (numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return;
+ } /* if */
+ if (numdim > 0 && dim[numdim - 1] == 0)
+ error(52); /* only last dimension may be variable length */
+ size = needsub(&idxtag[numdim]); /* get size; size==0 for
+ * "var[]" */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ if (ispublic)
+ error(56, name); /* arrays cannot be public */
+ dim[numdim++] = (int)size;
+ } /* while */
+ /* if this variable is never used (which can be detected only in
+ * the second stage), shut off code generation; make an exception
+ * for public variables
+ */
+ cidx = 0; /* only to avoid a compiler warning */
+ if (sc_status == statWRITE && sym
+ && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
+ {
+ sc_status = statSKIP;
+ cidx = code_idx;
+#if !defined NDEBUG
+ glbdecl = glb_declared;
+#endif
+ } /* if */
+ defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
+ begdseg(); /* real (initialized) data in data segment */
+ assert(litidx == 0); /* literal queue should be empty */
+ if (sc_alignnext)
+ {
+ litidx = 0;
+ aligndata(sc_dataalign);
+ dumplits(); /* dump the literal queue */
+ sc_alignnext = FALSE;
+ litidx = 0; /* global initial data is dumped, so restart at zero */
+ } /* if */
+ initials(ident, tag, &size, dim, numdim); /* stores values in
+ * the literal queue */
+ if (numdim == 1)
+ dim[0] = (int)size;
+ dumplits(); /* dump the literal queue */
+ dumpzero((int)size - litidx);
+ litidx = 0;
+ if (!sym)
+ { /* define only if not yet defined */
+ sym =
+ addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
+ tag, dim, numdim, idxtag);
+ }
+ else
+ { /* if declared but not yet defined, adjust the
+ * variable's address */
+ sym->addr = sizeof(cell) * glb_declared;
+ sym->usage |= uDEFINE;
+ } /* if */
+ if (ispublic)
+ sym->usage |= uPUBLIC;
+ if (fconst)
+ sym->usage |= uCONST;
+ if (stock)
+ sym->usage |= uSTOCK;
+ if (fstatic)
+ sym->fnumber = filenum;
+ if (ident == iARRAY)
+ for (level = 0; level < numdim; level++)
+ symbolrange(level, dim[level]);
+ if (sc_status == statSKIP)
+ {
+ sc_status = statWRITE;
+ code_idx = cidx;
+ assert(glb_declared == glbdecl);
+ }
+ else
+ {
+ glb_declared += (int)size; /* add total number of cells */
+ } /* if */
+ }
+ while (matchtoken(',')); /* enddo *//* more? */
+ needtoken(tTERM); /* if not comma, must be semicolumn */
+}
+
+/* declloc - declare local symbols
+ *
+ * Declare local (automatic) variables. Since these variables are
+ * relative to the STACK, there is no switch to the DATA segment.
+ * These variables cannot be initialized either.
+ *
+ * global references: declared (altered)
+ * funcstatus (referred to only)
+ */
+static int
+declloc(int fstatic)
+{
+ int ident, tag;
+ int idxtag[sDIMEN_MAX];
+ char name[sNAMEMAX + 1];
+ symbol *sym;
+ cell val, size;
+ char *str;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ int cur_lit = 0;
+ int dim[sDIMEN_MAX];
+ int numdim, level;
+ int fconst;
+
+ fconst = matchtoken(tCONST);
+ do
+ {
+ ident = iVARIABLE;
+ size = 1;
+ numdim = 0; /* no dimensions */
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(name, str); /* save symbol name */
+ if (name[0] == PUBLIC_CHAR)
+ error(56, name); /* local variables cannot be public */
+ /* Note: block locals may be named identical to locals at higher
+ * compound blocks (as with standard C); so we must check (and add)
+ * the "nesting level" of local variables to verify the
+ * multi-definition of symbols.
+ */
+ if ((sym = findloc(name)) && sym->compound == nestlevel)
+ error(21, name); /* symbol already defined */
+ /* Although valid, a local variable whose name is equal to that
+ * of a global variable or to that of a local variable at a lower
+ * level might indicate a bug.
+ */
+ if (((sym = findloc(name)) && sym->compound != nestlevel)
+ || findglb(name))
+ error(219, name); /* variable shadows another symbol */
+ while (matchtoken('['))
+ {
+ ident = iARRAY;
+ if (numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return ident;
+ } /* if */
+ if (numdim > 0 && dim[numdim - 1] == 0)
+ error(52); /* only last dimension may be variable length */
+ size = needsub(&idxtag[numdim]); /* get size; size==0 for "var[]" */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ dim[numdim++] = (int)size;
+ } /* while */
+ if (ident == iARRAY || fstatic)
+ {
+ if (sc_alignnext)
+ {
+ aligndata(sc_dataalign);
+ sc_alignnext = FALSE;
+ } /* if */
+ cur_lit = litidx; /* save current index in the literal table */
+ initials(ident, tag, &size, dim, numdim);
+ if (size == 0)
+ return ident; /* error message already given */
+ if (numdim == 1)
+ dim[0] = (int)size;
+ } /* if */
+ /* reserve memory (on the stack) for the variable */
+ if (fstatic)
+ {
+ /* write zeros for uninitialized fields */
+ while (litidx < cur_lit + size)
+ stowlit(0);
+ sym =
+ addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
+ ident, sSTATIC, tag, dim, numdim, idxtag);
+ defsymbol(name, ident, sSTATIC,
+ (cur_lit + glb_declared) * sizeof(cell), tag);
+ }
+ else
+ {
+ declared += (int)size; /* variables are put on stack,
+ * adjust "declared" */
+ sym =
+ addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
+ dim, numdim, idxtag);
+ defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
+ modstk(-(int)size * sizeof(cell));
+ } /* if */
+ /* now that we have reserved memory for the variable, we can
+ * proceed to initialize it */
+ sym->compound = nestlevel; /* for multiple declaration/shadowing */
+ if (fconst)
+ sym->usage |= uCONST;
+ if (ident == iARRAY)
+ for (level = 0; level < numdim; level++)
+ symbolrange(level, dim[level]);
+ if (!fstatic)
+ { /* static variables already initialized */
+ if (ident == iVARIABLE)
+ {
+ /* simple variable, also supports initialization */
+ int ctag = tag; /* set to "tag" by default */
+ int explicit_init = FALSE; /* is the variable explicitly
+ * initialized? */
+ if (matchtoken('='))
+ {
+ doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
+ explicit_init = TRUE;
+ }
+ else
+ {
+ const1(0); /* uninitialized variable, set to zero */
+ } /* if */
+ /* now try to save the value (still in PRI) in the variable */
+ lval.sym = sym;
+ lval.ident = iVARIABLE;
+ lval.constval = 0;
+ lval.tag = tag;
+ check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
+ store(&lval);
+ endexpr(TRUE); /* full expression ends after the store */
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ /* if the variable was not explicitly initialized, reset the
+ * "uWRITTEN" flag that store() set */
+ if (!explicit_init)
+ sym->usage &= ~uWRITTEN;
+ }
+ else
+ {
+ /* an array */
+ if (litidx - cur_lit < size)
+ fillarray(sym, size * sizeof(cell), 0);
+ if (cur_lit < litidx)
+ {
+ /* check whether the complete array is set to a single value;
+ * if it is, more compact code can be generated */
+ cell first = litq[cur_lit];
+ int i;
+
+ for (i = cur_lit; i < litidx && litq[i] == first; i++)
+ /* nothing */ ;
+ if (i == litidx)
+ {
+ /* all values are the same */
+ fillarray(sym, (litidx - cur_lit) * sizeof(cell),
+ first);
+ litidx = cur_lit; /* reset literal table */
+ }
+ else
+ {
+ /* copy the literals to the array */
+ const1((cur_lit + glb_declared) * sizeof(cell));
+ copyarray(sym, (litidx - cur_lit) * sizeof(cell));
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* if */
+ }
+ while (matchtoken(',')); /* enddo *//* more? */
+ needtoken(tTERM); /* if not comma, must be semicolumn */
+ return ident;
+}
+
+static cell
+calc_arraysize(int dim[], int numdim, int cur)
+{
+ if (cur == numdim)
+ return 0;
+ return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
+}
+
+/* initials
+ *
+ * Initialize global objects and local arrays.
+ * size==array cells (count), if 0 on input, the routine counts
+ * the number of elements
+ * tag==required tagname id (not the returned tag)
+ *
+ * Global references: litidx (altered)
+ */
+static void
+initials(int ident, int tag, cell * size, int dim[], int numdim)
+{
+ int ctag;
+ int curlit = litidx;
+ int d;
+
+ if (!matchtoken('='))
+ {
+ if (ident == iARRAY && dim[numdim - 1] == 0)
+ {
+ /* declared as "myvar[];" which is senseless (note: this *does* make
+ * sense in the case of a iREFARRAY, which is a function parameter)
+ */
+ error(9); /* array has zero length -> invalid size */
+ } /* if */
+ if (numdim > 1)
+ {
+ /* initialize the indirection tables */
+#if sDIMEN_MAX>2
+#error Array algorithms for more than 2 dimensions are not implemented
+#endif
+ assert(numdim == 2);
+ *size = calc_arraysize(dim, numdim, 0);
+ for (d = 0; d < dim[0]; d++)
+ stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
+ } /* if */
+ return;
+ } /* if */
+
+ if (ident == iVARIABLE)
+ {
+ assert(*size == 1);
+ init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ }
+ else
+ {
+ assert(numdim > 0);
+ if (numdim == 1)
+ {
+ *size = initvector(ident, tag, dim[0], FALSE);
+ }
+ else
+ {
+ cell offs, dsize;
+
+ /* The simple algorithm below only works for arrays with one or
+ * two dimensions. This should be some recursive algorithm.
+ */
+ if (dim[numdim - 1] != 0)
+ /* set size to (known) full size */
+ *size = calc_arraysize(dim, numdim, 0);
+ /* dump indirection tables */
+ for (d = 0; d < dim[0]; d++)
+ stowlit(0);
+ /* now dump individual vectors */
+ needtoken('{');
+ offs = dim[0];
+ for (d = 0; d < dim[0]; d++)
+ {
+ litq[curlit + d] = offs * sizeof(cell);
+ dsize = initvector(ident, tag, dim[1], TRUE);
+ offs += dsize - 1;
+ if (d + 1 < dim[0])
+ needtoken(',');
+ if (matchtoken('{') || matchtoken(tSTRING))
+ /* expect a '{' or a string */
+ lexpush();
+ else
+ break;
+ } /* for */
+ matchtoken(',');
+ needtoken('}');
+ } /* if */
+ } /* if */
+
+ if (*size == 0)
+ *size = litidx - curlit; /* number of elements defined */
+}
+
+/* initvector
+ * Initialize a single dimensional array
+ */
+static cell
+initvector(int ident, int tag, cell size, int fillzero)
+{
+ cell prev1 = 0, prev2 = 0;
+ int ctag;
+ int ellips = FALSE;
+ int curlit = litidx;
+
+ assert(ident == iARRAY || ident == iREFARRAY);
+ if (matchtoken('{'))
+ {
+ do
+ {
+ if (matchtoken('}'))
+ { /* to allow for trailing ',' after the initialization */
+ lexpush();
+ break;
+ } /* if */
+ if ((ellips = matchtoken(tELLIPS)) != 0)
+ break;
+ prev2 = prev1;
+ prev1 = init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tag mismatch */
+ }
+ while (matchtoken(',')); /* do */
+ needtoken('}');
+ }
+ else
+ {
+ init(ident, &ctag);
+ if (!matchtag(tag, ctag, TRUE))
+ error(213); /* tagname mismatch */
+ } /* if */
+ /* fill up the literal queue with a series */
+ if (ellips)
+ {
+ cell step =
+ ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
+ if (size == 0 || (litidx - curlit) == 0)
+ error(41); /* invalid ellipsis, array size unknown */
+ else if ((litidx - curlit) == (int)size)
+ error(18); /* initialisation data exceeds declared size */
+ while ((litidx - curlit) < (int)size)
+ {
+ prev1 += step;
+ stowlit(prev1);
+ } /* while */
+ } /* if */
+ if (fillzero && size > 0)
+ {
+ while ((litidx - curlit) < (int)size)
+ stowlit(0);
+ } /* if */
+ if (size == 0)
+ {
+ size = litidx - curlit; /* number of elements defined */
+ }
+ else if (litidx - curlit > (int)size)
+ { /* e.g. "myvar[3]={1,2,3,4};" */
+ error(18); /* initialisation data exceeds declared size */
+ litidx = (int)size + curlit; /* avoid overflow in memory moves */
+ } /* if */
+ return size;
+}
+
+/* init
+ *
+ * Evaluate one initializer.
+ */
+static cell
+init(int ident, int *tag)
+{
+ cell i = 0;
+
+ if (matchtoken(tSTRING))
+ {
+ /* lex() automatically stores strings in the literal table (and
+ * increases "litidx") */
+ if (ident == iVARIABLE)
+ {
+ error(6); /* must be assigned to an array */
+ litidx = 1; /* reset literal queue */
+ } /* if */
+ *tag = 0;
+ }
+ else if (constexpr(&i, tag))
+ {
+ stowlit(i); /* store expression result in literal table */
+ } /* if */
+ return i;
+}
+
+/* needsub
+ *
+ * Get required array size
+ */
+static cell
+needsub(int *tag)
+{
+ cell val;
+
+ *tag = 0;
+ if (matchtoken(']')) /* we've already seen "[" */
+ return 0; /* null size (like "char msg[]") */
+ constexpr(&val, tag); /* get value (must be constant expression) */
+ if (val < 0)
+ {
+ error(9); /* negative array size is invalid; assumed zero */
+ val = 0;
+ } /* if */
+ needtoken(']');
+ return val; /* return array size */
+}
+
+/* decl_const - declare a single constant
+ *
+ */
+static void
+decl_const(int vclass)
+{
+ char constname[sNAMEMAX + 1];
+ cell val;
+ char *str;
+ int tag, exprtag;
+ int symbolline;
+
+ tag = sc_addtag(NULL);
+ if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
+ error(20, str); /* invalid symbol name */
+ symbolline = fline; /* save line where symbol was found */
+ strcpy(constname, str); /* save symbol name */
+ needtoken('=');
+ constexpr(&val, &exprtag); /* get value */
+ needtoken(tTERM);
+ /* add_constant() checks for duplicate definitions */
+ if (!matchtag(tag, exprtag, FALSE))
+ {
+ /* temporarily reset the line number to where the symbol was
+ * defined */
+ int orgfline = fline;
+
+ fline = symbolline;
+ error(213); /* tagname mismatch */
+ fline = orgfline;
+ } /* if */
+ add_constant(constname, val, vclass, tag);
+}
+
+/* decl_enum - declare enumerated constants
+ *
+ */
+static void
+decl_enum(int vclass)
+{
+ char enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
+ cell val, value, size;
+ char *str;
+ int tok, tag, explicittag;
+ cell increment, multiplier;
+
+ /* get an explicit tag, if any (we need to remember whether an
+ * explicit tag was passed, even if that explicit tag was "_:", so we
+ * cannot call sc_addtag() here
+ */
+ if (lex(&val, &str) == tLABEL)
+ {
+ tag = sc_addtag(str);
+ explicittag = TRUE;
+ }
+ else
+ {
+ lexpush();
+ tag = 0;
+ explicittag = FALSE;
+ } /* if */
+
+ /* get optional enum name (also serves as a tag if no explicit
+ * tag was set) */
+ if (lex(&val, &str) == tSYMBOL)
+ { /* read in (new) token */
+ strcpy(enumname, str); /* save enum name (last constant) */
+ if (!explicittag)
+ tag = sc_addtag(enumname);
+ }
+ else
+ {
+ lexpush(); /* analyze again */
+ enumname[0] = '\0';
+ } /* if */
+
+ /* get increment and multiplier */
+ increment = 1;
+ multiplier = 1;
+ if (matchtoken('('))
+ {
+ if (matchtoken(taADD))
+ {
+ constexpr(&increment, NULL);
+ }
+ else if (matchtoken(taMULT))
+ {
+ constexpr(&multiplier, NULL);
+ }
+ else if (matchtoken(taSHL))
+ {
+ constexpr(&val, NULL);
+ while (val-- > 0)
+ multiplier *= 2;
+ } /* if */
+ needtoken(')');
+ } /* if */
+
+ needtoken('{');
+ /* go through all constants */
+ value = 0; /* default starting value */
+ do
+ {
+ if (matchtoken('}'))
+ { /* quick exit if '}' follows ',' */
+ lexpush();
+ break;
+ } /* if */
+ tok = lex(&val, &str); /* read in (new) token */
+ if (tok != tSYMBOL && tok != tLABEL)
+ error(20, str); /* invalid symbol name */
+ strcpy(constname, str); /* save symbol name */
+ size = increment; /* default increment of 'val' */
+ if (tok == tLABEL || matchtoken(':'))
+ constexpr(&size, NULL); /* get size */
+ if (matchtoken('='))
+ constexpr(&value, NULL); /* get value */
+ /* add_constant() checks whether a variable (global or local) or
+ * a constant with the same name already exists */
+ add_constant(constname, value, vclass, tag);
+ if (multiplier == 1)
+ value += size;
+ else
+ value *= size * multiplier;
+ }
+ while (matchtoken(','));
+ needtoken('}'); /* terminates the constant list */
+ matchtoken(';'); /* eat an optional ; */
+
+ /* set the enum name to the last value plus one */
+ if (enumname[0] != '\0')
+ add_constant(enumname, value, vclass, tag);
+}
+
+/*
+ * Finds a function in the global symbol table or creates a new entry.
+ * It does some basic processing and error checking.
+ */
+symbol *
+fetchfunc(char *name, int tag)
+{
+ symbol *sym;
+ cell offset;
+
+ offset = code_idx;
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ offset += opcodes(1) + opargs(3) + nameincells(name);
+ /* ^^^ The address for the symbol is the code address. But the
+ * "symbol" instruction itself generates code. Therefore the
+ * offset is pre-adjusted to the value it will have after the
+ * symbol instruction.
+ */
+ } /* if */
+ if ((sym = findglb(name)))
+ { /* already in symbol table? */
+ if (sym->ident != iFUNCTN)
+ {
+ error(21, name); /* yes, but not as a function */
+ return NULL; /* make sure the old symbol is not damaged */
+ }
+ else if ((sym->usage & uDEFINE) != 0)
+ {
+ error(21, name); /* yes, and it's already defined */
+ }
+ else if ((sym->usage & uNATIVE) != 0)
+ {
+ error(21, name); /* yes, and it is an native */
+ } /* if */
+ assert(sym->vclass == sGLOBAL);
+ if ((sym->usage & uDEFINE) == 0)
+ {
+ /* as long as the function stays undefined, update the address
+ * and the tag */
+ sym->addr = offset;
+ sym->tag = tag;
+ } /* if */
+ }
+ else
+ {
+ /* don't set the "uDEFINE" flag; it may be a prototype */
+ sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
+ /* assume no arguments */
+ sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
+ sym->dim.arglist[0].ident = 0;
+ /* set library ID to NULL (only for native functions) */
+ sym->x.lib = NULL;
+ } /* if */
+ return sym;
+}
+
+/* This routine adds symbolic information for each argument.
+ */
+static void
+define_args(void)
+{
+ symbol *sym;
+
+ /* At this point, no local variables have been declared. All
+ * local symbols are function arguments.
+ */
+ sym = loctab.next;
+ while (sym)
+ {
+ assert(sym->ident != iLABEL);
+ assert(sym->vclass == sLOCAL);
+ defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
+ if (sym->ident == iREFARRAY)
+ {
+ symbol *sub = sym;
+
+ while (sub)
+ {
+ symbolrange(sub->dim.array.level, sub->dim.array.length);
+ sub = finddepend(sub);
+ } /* while */
+ } /* if */
+ sym = sym->next;
+ } /* while */
+}
+
+static int
+operatorname(char *name)
+{
+ int opertok;
+ char *str;
+ cell val;
+
+ assert(name != NULL);
+
+ /* check the operator */
+ opertok = lex(&val, &str);
+ switch (opertok)
+ {
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case '%':
+ case '>':
+ case '<':
+ case '!':
+ case '~':
+ case '=':
+ name[0] = (char)opertok;
+ name[1] = '\0';
+ break;
+ case tINC:
+ strcpy(name, "++");
+ break;
+ case tDEC:
+ strcpy(name, "--");
+ break;
+ case tlEQ:
+ strcpy(name, "==");
+ break;
+ case tlNE:
+ strcpy(name, "!=");
+ break;
+ case tlLE:
+ strcpy(name, "<=");
+ break;
+ case tlGE:
+ strcpy(name, ">=");
+ break;
+ default:
+ name[0] = '\0';
+ error(61); /* operator cannot be redefined
+ * (or bad operator name) */
+ return 0;
+ } /* switch */
+
+ return opertok;
+}
+
+static int
+operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
+{
+ int tags[2] = { 0, 0 };
+ int count = 0;
+ arginfo *arg;
+ char tmpname[sNAMEMAX + 1];
+ symbol *oldsym;
+
+ if (opertok == 0)
+ return TRUE;
+
+ /* count arguments and save (first two) tags */
+ while (arg = &sym->dim.arglist[count], arg->ident != 0)
+ {
+ if (count < 2)
+ {
+ if (arg->numtags > 1)
+ error(65, count + 1); /* function argument may only have
+ * a single tag */
+ else if (arg->numtags == 1)
+ tags[count] = arg->tags[0];
+ } /* if */
+ if (opertok == '~' && count == 0)
+ {
+ if (arg->ident != iREFARRAY)
+ error(73, arg->name); /* must be an array argument */
+ }
+ else
+ {
+ if (arg->ident != iVARIABLE)
+ error(66, arg->name); /* must be non-reference argument */
+ } /* if */
+ if (arg->hasdefault)
+ error(59, arg->name); /* arguments of an operator may not
+ * have a default value */
+ count++;
+ } /* while */
+
+ /* for '!', '++' and '--', count must be 1
+ * for '-', count may be 1 or 2
+ * for '=', count must be 1, and the resulttag is also important
+ * for all other (binary) operators and the special '~'
+ * operator, count must be 2
+ */
+ switch (opertok)
+ {
+ case '!':
+ case '=':
+ case tINC:
+ case tDEC:
+ if (count != 1)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ break;
+ case '-':
+ if (count != 1 && count != 2)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ break;
+ default:
+ if (count != 2)
+ error(62); /* number or placement of the operands does
+ * not fit the operator */
+ } /* switch */
+
+ if (tags[0] == 0
+ && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
+ error(64); /* cannot change predefined operators */
+
+ /* change the operator name */
+ assert(opername[0] != '\0');
+ operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
+ if ((oldsym = findglb(tmpname)))
+ {
+ int i;
+
+ if ((oldsym->usage & uDEFINE) != 0)
+ {
+ char errname[2 * sNAMEMAX + 16];
+
+ funcdisplayname(errname, tmpname);
+ error(21, errname); /* symbol already defined */
+ } /* if */
+ sym->usage |= oldsym->usage; /* copy flags from the previous
+ * definition */
+ for (i = 0; i < oldsym->numrefers; i++)
+ if (oldsym->refer[i])
+ refer_symbol(sym, oldsym->refer[i]);
+ delete_symbol(&glbtab, oldsym);
+ } /* if */
+ if ((sc_debug & sSYMBOLIC) != 0)
+ sym->addr += nameincells(tmpname) - nameincells(sym->name);
+ strcpy(sym->name, tmpname);
+ sym->hash = namehash(sym->name); /* calculate new hash */
+
+ /* operators should return a value, except the '~' operator */
+ if (opertok != '~')
+ sym->usage |= uRETVALUE;
+
+ return TRUE;
+}
+
+static int
+check_operatortag(int opertok, int resulttag, char *opername)
+{
+ assert(opername != NULL && opername[0] != '\0');
+ switch (opertok)
+ {
+ case '!':
+ case '<':
+ case '>':
+ case tlEQ:
+ case tlNE:
+ case tlLE:
+ case tlGE:
+ if (resulttag != sc_addtag("bool"))
+ {
+ error(63, opername, "bool:"); /* operator X requires
+ * a "bool:" result tag */
+ return FALSE;
+ } /* if */
+ break;
+ case '~':
+ if (resulttag != 0)
+ {
+ error(63, opername, "_:"); /* operator "~" requires
+ * a "_:" result tag */
+ return FALSE;
+ } /* if */
+ break;
+ } /* switch */
+ return TRUE;
+}
+
+static char *
+tag2str(char *dest, int tag)
+{
+ tag &= TAGMASK;
+ assert(tag >= 0);
+ sprintf(dest, "0%x", tag);
+ return sc_isdigit(dest[1]) ? &dest[1] : dest;
+}
+
+char *
+operator_symname(char *symname, char *opername, int tag1, int tag2,
+ int numtags, int resulttag)
+{
+ char tagstr1[10], tagstr2[10];
+ int opertok;
+
+ assert(numtags >= 1 && numtags <= 2);
+ opertok = (opername[1] == '\0') ? opername[0] : 0;
+ if (opertok == '=')
+ sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
+ tag2str(tagstr2, tag1));
+ else if (numtags == 1 || opertok == '~')
+ sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
+ else
+ sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
+ tag2str(tagstr2, tag2));
+ return symname;
+}
+
+static int
+parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
+{
+ char *ptr, *name;
+ int unary;
+
+ /* tags are only positive, so if the function name starts with a '-',
+ * the operator is an unary '-' or '--' operator.
+ */
+ if (*fname == '-')
+ {
+ *tag1 = 0;
+ unary = TRUE;
+ ptr = fname;
+ }
+ else
+ {
+ *tag1 = (int)strtol(fname, &ptr, 16);
+ unary = ptr == fname; /* unary operator if it doesn't start
+ * with a tag name */
+ } /* if */
+ assert(!unary || *tag1 == 0);
+ assert(*ptr != '\0');
+ for (name = opname; !sc_isdigit(*ptr);)
+ *name++ = *ptr++;
+ *name = '\0';
+ *tag2 = (int)strtol(ptr, NULL, 16);
+ return unary;
+}
+
+char *
+funcdisplayname(char *dest, char *funcname)
+{
+ int tags[2];
+ char opname[10];
+ constvalue *tagsym[2];
+ int unary;
+
+ if (sc_isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
+ || *funcname == '\0')
+ {
+ if (dest != funcname)
+ strcpy(dest, funcname);
+ return dest;
+ } /* if */
+
+ unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
+ tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
+ assert(tagsym[1] != NULL);
+ if (unary)
+ {
+ sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
+ }
+ else
+ {
+ tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
+ /* special case: the assignment operator has the return value
+ * as the 2nd tag */
+ if (opname[0] == '=' && opname[1] == '\0')
+ sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
+ tagsym[1]->name);
+ else
+ sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
+ tagsym[1]->name);
+ } /* if */
+ return dest;
+}
+
+static void
+funcstub(int native)
+{
+ int tok, tag;
+ char *str;
+ cell val;
+ char symbolname[sNAMEMAX + 1];
+ symbol *sym;
+ int opertok;
+
+ opertok = 0;
+ lastst = 0;
+ litidx = 0; /* clear the literal pool */
+
+ tag = sc_addtag(NULL);
+ tok = lex(&val, &str);
+ if (native)
+ {
+ if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
+ (tok == tSYMBOL && *str == PUBLIC_CHAR))
+ error(42); /* invalid combination of class specifiers */
+ }
+ else
+ {
+ if (tok == tPUBLIC || tok == tSTATIC)
+ tok = lex(&val, &str);
+ } /* if */
+ if (tok == tOPERATOR)
+ {
+ opertok = operatorname(symbolname);
+ if (opertok == 0)
+ return; /* error message already given */
+ check_operatortag(opertok, tag, symbolname);
+ }
+ else
+ {
+ if (tok != tSYMBOL && freading)
+ {
+ error(10); /* illegal function or declaration */
+ return;
+ } /* if */
+ strcpy(symbolname, str);
+ } /* if */
+ needtoken('('); /* only functions may be native/forward */
+
+ sym = fetchfunc(symbolname, tag); /* get a pointer to the
+ * function entry */
+ if (!sym)
+ return;
+ if (native)
+ {
+ sym->usage = uNATIVE | uRETVALUE | uDEFINE;
+ sym->x.lib = curlibrary;
+ } /* if */
+
+ declargs(sym);
+ /* "declargs()" found the ")" */
+ if (!operatoradjust(opertok, sym, symbolname, tag))
+ sym->usage &= ~uDEFINE;
+ /* for a native operator, also need to specify an "exported"
+ * function name; for a native function, this is optional
+ */
+ if (native)
+ {
+ if (opertok != 0)
+ {
+ needtoken('=');
+ lexpush(); /* push back, for matchtoken() to retrieve again */
+ } /* if */
+ if (matchtoken('='))
+ {
+ /* allow number or symbol */
+ if (matchtoken(tSYMBOL))
+ {
+ tokeninfo(&val, &str);
+ if (strlen(str) > sEXPMAX)
+ {
+ error(220, str, sEXPMAX);
+ str[sEXPMAX] = '\0';
+ } /* if */
+ insert_alias(sym->name, str);
+ }
+ else
+ {
+ constexpr(&val, NULL);
+ sym->addr = val;
+ /*
+ * ?? Must mark this address, so that it won't be generated again
+ * and it won't be written to the output file. At the moment,
+ * I have assumed that this syntax is only valid if val < 0.
+ * To properly mix "normal" native functions and indexed native
+ * functions, one should use negative indices anyway.
+ * Special code for a negative index in sym->addr exists in
+ * SC4.C (ffcall()) and in SC6.C (the loops for counting the
+ * number of native variables and for writing them).
+ */
+ } /* if */
+ } /* if */
+ } /* if */
+ needtoken(tTERM);
+
+ litidx = 0; /* clear the literal pool */
+ /* clear local variables queue */
+ delete_symbols(&loctab, 0, TRUE, TRUE);
+}
+
+/* newfunc - begin a function
+ *
+ * This routine is called from "parse" and tries to make a function
+ * out of the following text
+ *
+ * Global references: funcstatus,lastst,litidx
+ * rettype (altered)
+ * curfunc (altered)
+ * declared (altered)
+ * glb_declared (altered)
+ * sc_alignnext (altered)
+ */
+static int
+newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
+{
+ symbol *sym;
+ int argcnt, tok, tag, funcline;
+ int opertok, opererror;
+ char symbolname[sNAMEMAX + 1];
+ char *str;
+ cell val, cidx, glbdecl;
+ int filenum;
+
+ litidx = 0; /* clear the literal pool ??? */
+ opertok = 0;
+ lastst = 0; /* no statement yet */
+ cidx = 0; /* just to avoid compiler warnings */
+ glbdecl = 0;
+ filenum = fcurrent; /* save file number at start of declaration */
+
+ if (firstname)
+ {
+ assert(strlen(firstname) <= sNAMEMAX);
+ strcpy(symbolname, firstname); /* save symbol name */
+ tag = firsttag;
+ }
+ else
+ {
+ tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
+ tok = lex(&val, &str);
+ assert(!fpublic);
+ if (tok == tNATIVE || (tok == tPUBLIC && stock))
+ error(42); /* invalid combination of class specifiers */
+ if (tok == tOPERATOR)
+ {
+ opertok = operatorname(symbolname);
+ if (opertok == 0)
+ return TRUE; /* error message already given */
+ check_operatortag(opertok, tag, symbolname);
+ }
+ else
+ {
+ if (tok != tSYMBOL && freading)
+ {
+ error(20, str); /* invalid symbol name */
+ return FALSE;
+ } /* if */
+ assert(strlen(str) <= sNAMEMAX);
+ strcpy(symbolname, str);
+ } /* if */
+ } /* if */
+ /* check whether this is a function or a variable declaration */
+ if (!matchtoken('('))
+ return FALSE;
+ /* so it is a function, proceed */
+ funcline = fline; /* save line at which the function is defined */
+ if (symbolname[0] == PUBLIC_CHAR)
+ {
+ fpublic = TRUE; /* implicitly public function */
+ if (stock)
+ error(42); /* invalid combination of class specifiers */
+ } /* if */
+ sym = fetchfunc(symbolname, tag); /* get a pointer to the
+ * function entry */
+ if (!sym)
+ return TRUE;
+ if (fpublic)
+ sym->usage |= uPUBLIC;
+ if (fstatic)
+ sym->fnumber = filenum;
+ /* declare all arguments */
+ argcnt = declargs(sym);
+ opererror = !operatoradjust(opertok, sym, symbolname, tag);
+ if (strcmp(symbolname, uMAINFUNC) == 0)
+ {
+ if (argcnt > 0)
+ error(5); /* "main()" function may not have any arguments */
+ sym->usage |= uREAD; /* "main()" is the program's entry point:
+ * always used */
+ } /* if */
+ /* "declargs()" found the ")"; if a ";" appears after this, it was a
+ * prototype */
+ if (matchtoken(';'))
+ {
+ if (!sc_needsemicolon)
+ error(218); /* old style prototypes used with optional
+ * semicolumns */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* prototype is done;
+ * forget everything */
+ return TRUE;
+ } /* if */
+ /* so it is not a prototype, proceed */
+ /* if this is a function that is not referred to (this can only be
+ * detected in the second stage), shut code generation off */
+ if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
+ {
+ sc_status = statSKIP;
+ cidx = code_idx;
+ glbdecl = glb_declared;
+ } /* if */
+ begcseg();
+ sym->usage |= uDEFINE; /* set the definition flag */
+ if (fpublic)
+ sym->usage |= uREAD; /* public functions are always "used" */
+ if (stock)
+ sym->usage |= uSTOCK;
+ if (opertok != 0 && opererror)
+ sym->usage &= ~uDEFINE;
+ defsymbol(sym->name, iFUNCTN, sGLOBAL,
+ code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
+ /* ^^^ The address for the symbol is the code address. But the
+ * "symbol" instruction itself generates code. Therefore the
+ * offset is pre-adjusted to the value it will have after the
+ * symbol instruction.
+ */
+ startfunc(sym->name); /* creates stack frame */
+ if ((sc_debug & sSYMBOLIC) != 0)
+ setline(funcline, fcurrent);
+ if (sc_alignnext)
+ {
+ alignframe(sc_dataalign);
+ sc_alignnext = FALSE;
+ } /* if */
+ declared = 0; /* number of local cells */
+ rettype = (sym->usage & uRETVALUE); /* set "return type" variable */
+ curfunc = sym;
+ define_args(); /* add the symbolic info for the function arguments */
+ statement(NULL, FALSE);
+ if ((rettype & uRETVALUE) != 0)
+ sym->usage |= uRETVALUE;
+ if (declared != 0)
+ {
+ /* This happens only in a very special (and useless) case, where a
+ * function has only a single statement in its body (no compound
+ * block) and that statement declares a new variable
+ */
+ modstk((int)declared * sizeof(cell)); /* remove all local
+ * variables */
+ declared = 0;
+ } /* if */
+ if ((lastst != tRETURN) && (lastst != tGOTO))
+ {
+ const1(0);
+ ffret();
+ if ((sym->usage & uRETVALUE) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user
+ * defined operators */
+ funcdisplayname(symname, sym->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ } /* if */
+ endfunc();
+ if (litidx)
+ { /* if there are literals defined */
+ glb_declared += litidx;
+ begdseg(); /* flip to DATA segment */
+ dumplits(); /* dump literal strings */
+ litidx = 0;
+ } /* if */
+ testsymbols(&loctab, 0, TRUE, TRUE); /* test for unused arguments
+ * and labels */
+ delete_symbols(&loctab, 0, TRUE, TRUE); /* clear local variables
+ * queue */
+ assert(loctab.next == NULL);
+ curfunc = NULL;
+ if (sc_status == statSKIP)
+ {
+ sc_status = statWRITE;
+ code_idx = cidx;
+ glb_declared = glbdecl;
+ } /* if */
+ return TRUE;
+}
+
+static int
+argcompare(arginfo * a1, arginfo * a2)
+{
+ int result, level;
+
+ result = strcmp(a1->name, a2->name) == 0;
+ if (result)
+ result = a1->ident == a2->ident;
+ if (result)
+ result = a1->usage == a2->usage;
+ if (result)
+ result = a1->numtags == a2->numtags;
+ if (result)
+ {
+ int i;
+
+ for (i = 0; i < a1->numtags && result; i++)
+ result = a1->tags[i] == a2->tags[i];
+ } /* if */
+ if (result)
+ result = a1->hasdefault == a2->hasdefault;
+ if (a1->hasdefault)
+ {
+ if (a1->ident == iREFARRAY)
+ {
+ if (result)
+ result = a1->defvalue.array.size == a2->defvalue.array.size;
+ if (result)
+ result =
+ a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
+ /* also check the dimensions of both arrays */
+ if (result)
+ result = a1->numdim == a2->numdim;
+ for (level = 0; result && level < a1->numdim; level++)
+ result = a1->dim[level] == a2->dim[level];
+ /* ??? should also check contents of the default array
+ * (these troubles go away in a 2-pass compiler that forbids
+ * double declarations, but Small currently does not forbid them)
+ */
+ }
+ else
+ {
+ if (result)
+ {
+ if ((a1->hasdefault & uSIZEOF) != 0
+ || (a1->hasdefault & uTAGOF) != 0)
+ result = a1->hasdefault == a2->hasdefault
+ && strcmp(a1->defvalue.size.symname,
+ a2->defvalue.size.symname) == 0
+ && a1->defvalue.size.level == a2->defvalue.size.level;
+ else
+ result = a1->defvalue.val == a2->defvalue.val;
+ } /* if */
+ } /* if */
+ if (result)
+ result = a1->defvalue_tag == a2->defvalue_tag;
+ } /* if */
+ return result;
+}
+
+/* declargs()
+ *
+ * This routine adds an entry in the local symbol table for each
+ * argument found in the argument list.
+ * It returns the number of arguments.
+ */
+static int
+declargs(symbol * sym)
+{
+#define MAXTAGS 16
+ char *ptr;
+ int argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
+ cell val;
+ arginfo arg, *arglist;
+ char name[sNAMEMAX + 1];
+ int ident, fpublic, fconst;
+ int idx;
+
+ /* if the function is already defined earlier, get the number of
+ * arguments of the existing definition
+ */
+ oldargcnt = 0;
+ if ((sym->usage & uPROTOTYPED) != 0)
+ while (sym->dim.arglist[oldargcnt].ident != 0)
+ oldargcnt++;
+ argcnt = 0; /* zero aruments up to now */
+ ident = iVARIABLE;
+ numtags = 0;
+ fconst = FALSE;
+ fpublic = (sym->usage & uPUBLIC) != 0;
+ /* the '(' parantheses has already been parsed */
+ if (!matchtoken(')'))
+ {
+ do
+ { /* there are arguments; process them */
+ /* any legal name increases argument count (and stack offset) */
+ tok = lex(&val, &ptr);
+ switch (tok)
+ {
+ case 0:
+ /* nothing */
+ break;
+ case '&':
+ if (ident != iVARIABLE || numtags > 0)
+ error(1, "-identifier-", "&");
+ ident = iREFERENCE;
+ break;
+ case tCONST:
+ if (ident != iVARIABLE || numtags > 0)
+ error(1, "-identifier-", "const");
+ fconst = TRUE;
+ break;
+ case tLABEL:
+ if (numtags > 0)
+ error(1, "-identifier-", "-tagname-");
+ tags[0] = sc_addtag(ptr);
+ numtags = 1;
+ break;
+ case '{':
+ if (numtags > 0)
+ error(1, "-identifier-", "-tagname-");
+ numtags = 0;
+ while (numtags < MAXTAGS)
+ {
+ if (!matchtoken('_') && !needtoken(tSYMBOL))
+ break;
+ tokeninfo(&val, &ptr);
+ tags[numtags++] = sc_addtag(ptr);
+ if (matchtoken('}'))
+ break;
+ needtoken(',');
+ } /* for */
+ needtoken(':');
+ tok = tLABEL; /* for outer loop:
+ * flag that we have seen a tagname */
+ break;
+ case tSYMBOL:
+ if (argcnt >= sMAXARGS)
+ error(45); /* too many function arguments */
+ strcpy(name, ptr); /* save symbol name */
+ if (name[0] == PUBLIC_CHAR)
+ error(56, name); /* function arguments cannot be public */
+ if (numtags == 0)
+ tags[numtags++] = 0; /* default tag */
+ /* Stack layout:
+ * base + 0*sizeof(cell) == previous "base"
+ * base + 1*sizeof(cell) == function return address
+ * base + 2*sizeof(cell) == number of arguments
+ * base + 3*sizeof(cell) == first argument of the function
+ * So the offset of each argument is:
+ * "(argcnt+3) * sizeof(cell)".
+ */
+ doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
+ fpublic, fconst, &arg);
+ if (fpublic && arg.hasdefault)
+ error(59, name); /* arguments of a public function may not
+ * have a default value */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ {
+ /* redimension the argument list, add the entry */
+ sym->dim.arglist =
+ (arginfo *) realloc(sym->dim.arglist,
+ (argcnt + 2) * sizeof(arginfo));
+ if (!sym->dim.arglist)
+ error(103); /* insufficient memory */
+ sym->dim.arglist[argcnt] = arg;
+ sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
+ * terminated */
+ }
+ else
+ {
+ /* check the argument with the earlier definition */
+ if (argcnt > oldargcnt
+ || !argcompare(&sym->dim.arglist[argcnt], &arg))
+ error(25); /* function definition does not match prototype */
+ /* may need to free default array argument and the tag list */
+ if (arg.ident == iREFARRAY && arg.hasdefault)
+ free(arg.defvalue.array.data);
+ else if (arg.ident == iVARIABLE
+ && ((arg.hasdefault & uSIZEOF) != 0
+ || (arg.hasdefault & uTAGOF) != 0))
+ free(arg.defvalue.size.symname);
+ free(arg.tags);
+ } /* if */
+ argcnt++;
+ ident = iVARIABLE;
+ numtags = 0;
+ fconst = FALSE;
+ break;
+ case tELLIPS:
+ if (ident != iVARIABLE)
+ error(10); /* illegal function or declaration */
+ if (numtags == 0)
+ tags[numtags++] = 0; /* default tag */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ {
+ /* redimension the argument list, add the entry iVARARGS */
+ sym->dim.arglist =
+ (arginfo *) realloc(sym->dim.arglist,
+ (argcnt + 2) * sizeof(arginfo));
+ if (!sym->dim.arglist)
+ error(103); /* insufficient memory */
+ sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
+ * terminated */
+ sym->dim.arglist[argcnt].ident = iVARARGS;
+ sym->dim.arglist[argcnt].hasdefault = FALSE;
+ sym->dim.arglist[argcnt].defvalue.val = 0;
+ sym->dim.arglist[argcnt].defvalue_tag = 0;
+ sym->dim.arglist[argcnt].numtags = numtags;
+ sym->dim.arglist[argcnt].tags =
+ (int *)malloc(numtags * sizeof tags[0]);
+ if (!sym->dim.arglist[argcnt].tags)
+ error(103); /* insufficient memory */
+ memcpy(sym->dim.arglist[argcnt].tags, tags,
+ numtags * sizeof tags[0]);
+ }
+ else
+ {
+ if (argcnt > oldargcnt
+ || sym->dim.arglist[argcnt].ident != iVARARGS)
+ error(25); /* function definition does not match prototype */
+ } /* if */
+ argcnt++;
+ break;
+ default:
+ error(10); /* illegal function or declaration */
+ } /* switch */
+ }
+ while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(','))); /* more? */
+ /* if the next token is not ",", it should be ")" */
+ needtoken(')');
+ } /* if */
+ /* resolve any "sizeof" arguments (now that all arguments are known) */
+ assert(sym->dim.arglist != NULL);
+ arglist = sym->dim.arglist;
+ for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
+ {
+ if ((arglist[idx].hasdefault & uSIZEOF) != 0
+ || (arglist[idx].hasdefault & uTAGOF) != 0)
+ {
+ int altidx;
+
+ /* Find the argument with the name mentioned after the "sizeof".
+ * Note that we cannot use findloc here because we need the
+ * arginfo struct, not the symbol.
+ */
+ ptr = arglist[idx].defvalue.size.symname;
+ for (altidx = 0;
+ altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
+ altidx++)
+ /* nothing */ ;
+ if (altidx >= argcnt)
+ {
+ error(17, ptr); /* undefined symbol */
+ }
+ else
+ {
+ /* check the level against the number of dimensions */
+ /* the level must be zero for "tagof" values */
+ assert(arglist[idx].defvalue.size.level == 0
+ || (arglist[idx].hasdefault & uSIZEOF) != 0);
+ if (arglist[idx].defvalue.size.level > 0
+ && arglist[idx].defvalue.size.level >=
+ arglist[altidx].numdim)
+ error(28); /* invalid subscript */
+ if (arglist[altidx].ident != iREFARRAY)
+ {
+ assert(arglist[altidx].ident == iVARIABLE
+ || arglist[altidx].ident == iREFERENCE);
+ error(223, ptr); /* redundant sizeof */
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* for */
+
+ sym->usage |= uPROTOTYPED;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ return argcnt;
+}
+
+/* doarg - declare one argument type
+ *
+ * this routine is called from "declargs()" and adds an entry in the
+ * local symbol table for one argument. "fpublic" indicates whether
+ * the function for this argument list is public.
+ * The arguments themselves are never public.
+ */
+static void
+doarg(char *name, int ident, int offset, int tags[], int numtags,
+ int fpublic, int fconst, arginfo * arg)
+{
+ symbol *argsym;
+ cell size;
+ int idxtag[sDIMEN_MAX];
+
+ strcpy(arg->name, name);
+ arg->hasdefault = FALSE; /* preset (most common case) */
+ arg->defvalue.val = 0; /* clear */
+ arg->defvalue_tag = 0;
+ arg->numdim = 0;
+ if (matchtoken('['))
+ {
+ if (ident == iREFERENCE)
+ error(67, name); /*illegal declaration ("&name[]" is unsupported) */
+ do
+ {
+ if (arg->numdim == sDIMEN_MAX)
+ {
+ error(53); /* exceeding maximum number of dimensions */
+ return;
+ } /* if */
+ /* there is no check for non-zero major dimensions here, only if
+ * the array parameter has a default value, we enforce that all
+ * array dimensions, except the last, are non-zero
+ */
+ size = needsub(&idxtag[arg->numdim]); /* may be zero here,
+ *it is a pointer anyway */
+#if INT_MAX < LONG_MAX
+ if (size > INT_MAX)
+ error(105); /* overflow, exceeding capacity */
+#endif
+ arg->dim[arg->numdim] = (int)size;
+ arg->numdim += 1;
+ }
+ while (matchtoken('['));
+ ident = iREFARRAY; /* "reference to array" (is a pointer) */
+ if (matchtoken('='))
+ {
+ int level;
+
+ lexpush(); /* initials() needs the "=" token again */
+ assert(numtags > 0);
+ /* for the moment, when a default value is given for the array,
+ * all dimension sizes, except the last, must be non-zero
+ * (function initials() requires to know the major dimensions)
+ */
+ for (level = 0; level < arg->numdim - 1; level++)
+ if (arg->dim[level] == 0)
+ error(52); /* only last dimension may be variable length */
+ initials(ident, tags[0], &size, arg->dim, arg->numdim);
+ assert(size >= litidx);
+ /* allocate memory to hold the initial values */
+ arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
+ if (arg->defvalue.array.data)
+ {
+ int i;
+
+ memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
+ arg->hasdefault = TRUE; /* argument has default value */
+ arg->defvalue.array.size = litidx;
+ arg->defvalue.array.addr = -1;
+ /* calculate size to reserve on the heap */
+ arg->defvalue.array.arraysize = 1;
+ for (i = 0; i < arg->numdim; i++)
+ arg->defvalue.array.arraysize *= arg->dim[i];
+ if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
+ arg->defvalue.array.arraysize = arg->defvalue.array.size;
+ } /* if */
+ litidx = 0; /* reset */
+ } /* if */
+ }
+ else
+ {
+ if (matchtoken('='))
+ {
+ unsigned char size_tag_token;
+
+ assert(ident == iVARIABLE || ident == iREFERENCE);
+ arg->hasdefault = TRUE; /* argument has a default value */
+ size_tag_token =
+ (unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
+ if (size_tag_token == 0)
+ size_tag_token =
+ (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
+ if (size_tag_token != 0)
+ {
+ int paranthese;
+
+ if (ident == iREFERENCE)
+ error(66, name); /* argument may not be a reference */
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ if (needtoken(tSYMBOL))
+ {
+ /* save the name of the argument whose size id to take */
+ char *name;
+ cell val;
+
+ tokeninfo(&val, &name);
+ if (!(arg->defvalue.size.symname = strdup(name)))
+ error(103); /* insufficient memory */
+ arg->defvalue.size.level = 0;
+ if (size_tag_token == uSIZEOF)
+ {
+ while (matchtoken('['))
+ {
+ arg->defvalue.size.level += (short)1;
+ needtoken(']');
+ } /* while */
+ } /* if */
+ if (ident == iVARIABLE) /* make sure we set this only if
+ * not a reference */
+ arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
+ } /* if */
+ while (paranthese--)
+ needtoken(')');
+ }
+ else
+ {
+ constexpr(&arg->defvalue.val, &arg->defvalue_tag);
+ assert(numtags > 0);
+ if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
+ error(213); /* tagname mismatch */
+ } /* if */
+ } /* if */
+ } /* if */
+ arg->ident = (char)ident;
+ arg->usage = (char)(fconst ? uCONST : 0);
+ arg->numtags = numtags;
+ arg->tags = (int *)malloc(numtags * sizeof tags[0]);
+ if (!arg->tags)
+ error(103); /* insufficient memory */
+ memcpy(arg->tags, tags, numtags * sizeof tags[0]);
+ argsym = findloc(name);
+ if (argsym)
+ {
+ error(21, name); /* symbol already defined */
+ }
+ else
+ {
+ if ((argsym = findglb(name)) && argsym->ident != iFUNCTN)
+ error(219, name); /* variable shadows another symbol */
+ /* add details of type and address */
+ assert(numtags > 0);
+ argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
+ arg->dim, arg->numdim, idxtag);
+ argsym->compound = 0;
+ if (ident == iREFERENCE)
+ argsym->usage |= uREAD; /* because references are passed back */
+ if (fpublic)
+ argsym->usage |= uREAD; /* arguments of public functions
+ * are always "used" */
+ if (fconst)
+ argsym->usage |= uCONST;
+ } /* if */
+}
+
+static int
+count_referrers(symbol * entry)
+{
+ int i, count;
+
+ count = 0;
+ for (i = 0; i < entry->numrefers; i++)
+ if (entry->refer[i])
+ count++;
+ return count;
+}
+
+/* Every symbol has a referrer list, that contains the functions that
+ * use the symbol. Now, if function "apple" is accessed by functions
+ * "banana" and "citron", but neither function "banana" nor "citron" are
+ * used by anyone else, then, by inference, function "apple" is not used
+ * either. */
+static void
+reduce_referrers(symbol * root)
+{
+ int i, restart;
+ symbol *sym, *ref;
+
+ do
+ {
+ restart = 0;
+ for (sym = root->next; sym; sym = sym->next)
+ {
+ if (sym->parent)
+ continue; /* hierarchical data type */
+ if (sym->ident == iFUNCTN
+ && (sym->usage & uNATIVE) == 0
+ && (sym->usage & uPUBLIC) == 0
+ && strcmp(sym->name, uMAINFUNC) != 0
+ && count_referrers(sym) == 0)
+ {
+ sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
+ * there is no referrer */
+ /* find all symbols that are referred by this symbol */
+ for (ref = root->next; ref; ref = ref->next)
+ {
+ if (ref->parent)
+ continue; /* hierarchical data type */
+ assert(ref->refer != NULL);
+ for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
+ i++)
+ /* nothing */ ;
+ if (i < ref->numrefers)
+ {
+ assert(ref->refer[i] == sym);
+ ref->refer[i] = NULL;
+ restart++;
+ } /* if */
+ } /* for */
+ }
+ else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
+ && (sym->usage & uPUBLIC) == 0
+ && !sym->parent && count_referrers(sym) == 0)
+ {
+ sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
+ * there is no referrer */
+ } /* if */
+ } /* for */
+ /* after removing a symbol, check whether more can be removed */
+ }
+ while (restart > 0);
+}
+
+/* testsymbols - test for unused local or global variables
+ *
+ * "Public" functions are excluded from the check, since these
+ * may be exported to other object modules.
+ * Labels are excluded from the check if the argument 'testlabs'
+ * is 0. Thus, labels are not tested until the end of the function.
+ * Constants may also be excluded (convenient for global constants).
+ *
+ * When the nesting level drops below "level", the check stops.
+ *
+ * The function returns whether there is an "entry" point for the file.
+ * This flag will only be 1 when browsing the global symbol table.
+ */
+static int
+testsymbols(symbol * root, int level, int testlabs, int testconst)
+{
+ char symname[2 * sNAMEMAX + 16];
+ int entry = FALSE;
+
+ symbol *sym = root->next;
+
+ while (sym && sym->compound >= level)
+ {
+ switch (sym->ident)
+ {
+ case iLABEL:
+ if (testlabs)
+ {
+ if ((sym->usage & uDEFINE) == 0)
+ error(19, sym->name); /* not a label: ... */
+ else if ((sym->usage & uREAD) == 0)
+ error(203, sym->name); /* symbol isn't used: ... */
+ } /* if */
+ break;
+ case iFUNCTN:
+ if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
+ {
+ funcdisplayname(symname, sym->name);
+ if (symname[0] != '\0')
+ error(203, symname); /* symbol isn't used ...
+ * (and not native/stock) */
+ } /* if */
+ if ((sym->usage & uPUBLIC) != 0
+ || strcmp(sym->name, uMAINFUNC) == 0)
+ entry = TRUE; /* there is an entry point */
+ break;
+ case iCONSTEXPR:
+ if (testconst && (sym->usage & uREAD) == 0)
+ error(203, sym->name); /* symbol isn't used: ... */
+ break;
+ default:
+ /* a variable */
+ if (sym->parent)
+ break; /* hierarchical data type */
+ if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
+ error(203, sym->name); /* symbol isn't used (and not stock
+ * or public) */
+ else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
+ error(204, sym->name); /* value assigned to symbol is
+ * never used */
+#if 0 /*// ??? not sure whether it is a good idea to
+ * force people use "const" */
+ else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
+ && sym->ident == iREFARRAY)
+ error(214, sym->name); /* make array argument "const" */
+#endif
+ } /* if */
+ sym = sym->next;
+ } /* while */
+
+ return entry;
+}
+
+static cell
+calc_array_datasize(symbol * sym, cell * offset)
+{
+ cell length;
+
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ length = sym->dim.array.length;
+ if (sym->dim.array.level > 0)
+ {
+ cell sublength =
+ calc_array_datasize(finddepend(sym), offset);
+ if (offset)
+ *offset = length * (*offset + sizeof(cell));
+ if (sublength > 0)
+ length *= length * sublength;
+ else
+ length = 0;
+ }
+ else
+ {
+ if (offset)
+ *offset = 0;
+ } /* if */
+ return length;
+}
+
+static void
+destructsymbols(symbol * root, int level)
+{
+ cell offset = 0;
+ int savepri = FALSE;
+ symbol *sym = root->next;
+
+ while (sym && sym->compound >= level)
+ {
+ if (sym->ident == iVARIABLE || sym->ident == iARRAY)
+ {
+ char symbolname[16];
+ symbol *opsym;
+ cell elements;
+
+ /* check that the '~' operator is defined for this tag */
+ operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
+ if ((opsym = findglb(symbolname)))
+ {
+ /* save PRI, in case of a return statement */
+ if (!savepri)
+ {
+ push1(); /* right-hand operand is in PRI */
+ savepri = TRUE;
+ } /* if */
+ /* if the variable is an array, get the number of elements */
+ if (sym->ident == iARRAY)
+ {
+ elements = calc_array_datasize(sym, &offset);
+ /* "elements" can be zero when the variable is declared like
+ * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
+ * one should declare all dimensions!
+ */
+ if (elements == 0)
+ error(46, sym->name); /* array size is unknown */
+ }
+ else
+ {
+ elements = 1;
+ offset = 0;
+ } /* if */
+ pushval(elements);
+ /* call the '~' operator */
+ address(sym);
+ addconst(offset); /*add offset to array data to the address */
+ push1();
+ pushval(2 * sizeof(cell)); /* 2 parameters */
+ ffcall(opsym, 1);
+ if (sc_status != statSKIP)
+ markusage(opsym, uREAD); /* do not mark as "used" when this
+ * call itself is skipped */
+ if (opsym->x.lib)
+ opsym->x.lib->value += 1; /* increment "usage count"
+ * of the library */
+ } /* if */
+ } /* if */
+ sym = sym->next;
+ } /* while */
+ /* restore PRI, if it was saved */
+ if (savepri)
+ pop1();
+}
+
+static constvalue *
+insert_constval(constvalue * prev, constvalue * next, char *name,
+ cell val, short idx)
+{
+ constvalue *cur;
+
+ if (!(cur = (constvalue *)malloc(sizeof(constvalue))))
+ error(103); /* insufficient memory (fatal error) */
+ memset(cur, 0, sizeof(constvalue));
+ strcpy(cur->name, name);
+ cur->value = val;
+ cur->index = idx;
+ cur->next = next;
+ prev->next = cur;
+ return cur;
+}
+
+constvalue *
+append_constval(constvalue * table, char *name, cell val, short idx)
+{
+ constvalue *cur, *prev;
+
+ /* find the end of the constant table */
+ for (prev = table, cur = table->next; cur;
+ prev = cur, cur = cur->next)
+ /* nothing */ ;
+ return insert_constval(prev, NULL, name, val, idx);
+}
+
+constvalue *
+find_constval(constvalue * table, char *name, short idx)
+{
+ constvalue *ptr = table->next;
+
+ while (ptr)
+ {
+ if (strcmp(name, ptr->name) == 0 && ptr->index == idx)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+static constvalue *
+find_constval_byval(constvalue * table, cell val)
+{
+ constvalue *ptr = table->next;
+
+ while (ptr)
+ {
+ if (ptr->value == val)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+#if 0 /* never used */
+static int
+delete_constval(constvalue * table, char *name)
+{
+ constvalue *prev = table;
+ constvalue *cur = prev->next;
+
+ while (cur != NULL)
+ {
+ if (strcmp(name, cur->name) == 0)
+ {
+ prev->next = cur->next;
+ free(cur);
+ return TRUE;
+ } /* if */
+ prev = cur;
+ cur = cur->next;
+ } /* while */
+ return FALSE;
+}
+#endif
+
+void
+delete_consttable(constvalue * table)
+{
+ constvalue *cur = table->next, *next;
+
+ while (cur)
+ {
+ next = cur->next;
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(table, 0, sizeof(constvalue));
+}
+
+/* add_constant
+ *
+ * Adds a symbol to the #define symbol table.
+ */
+void
+add_constant(char *name, cell val, int vclass, int tag)
+{
+ symbol *sym;
+
+ /* Test whether a global or local symbol with the same name exists. Since
+ * constants are stored in the symbols table, this also finds previously
+ * defind constants. */
+ sym = findglb(name);
+ if (!sym)
+ sym = findloc(name);
+ if (sym)
+ {
+ /* silently ignore redefinitions of constants with the same value */
+ if (sym->ident == iCONSTEXPR)
+ {
+ if (sym->addr != val)
+ error(201, name); /* redefinition of constant (different value) */
+ }
+ else
+ {
+ error(21, name); /* symbol already defined */
+ } /* if */
+ return;
+ } /* if */
+
+ /* constant doesn't exist yet, an entry must be created */
+ sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
+ if (sc_status == statIDLE)
+ sym->usage |= uPREDEF;
+}
+
+/* statement - The Statement Parser
+ *
+ * This routine is called whenever the parser needs to know what
+ * statement it encounters (i.e. whenever program syntax requires a
+ * statement).
+ */
+static void
+statement(int *lastindent, int allow_decl)
+{
+ int tok;
+ cell val;
+ char *st;
+
+ if (!freading)
+ {
+ error(36); /* empty statement */
+ return;
+ } /* if */
+ errorset(sRESET);
+
+ tok = lex(&val, &st);
+ if (tok != '{')
+ setline(fline, fcurrent);
+ /* lex() has set stmtindent */
+ if (lastindent && tok != tLABEL)
+ {
+#if 0
+ if (*lastindent >= 0 && *lastindent != stmtindent &&
+ !indent_nowarn && sc_tabsize > 0)
+ error(217); /* loose indentation */
+#endif
+ *lastindent = stmtindent;
+ indent_nowarn = TRUE; /* if warning was blocked, re-enable it */
+ } /* if */
+ switch (tok)
+ {
+ case 0:
+ /* nothing */
+ break;
+ case tNEW:
+ if (allow_decl)
+ {
+ declloc(FALSE);
+ lastst = tNEW;
+ }
+ else
+ {
+ error(3); /* declaration only valid in a block */
+ } /* if */
+ break;
+ case tSTATIC:
+ if (allow_decl)
+ {
+ declloc(TRUE);
+ lastst = tNEW;
+ }
+ else
+ {
+ error(3); /* declaration only valid in a block */
+ } /* if */
+ break;
+ case '{':
+ if (!matchtoken('}')) /* {} is the empty statement */
+ compound();
+ /* lastst (for "last statement") does not change */
+ break;
+ case ';':
+ error(36); /* empty statement */
+ break;
+ case tIF:
+ doif();
+ lastst = tIF;
+ break;
+ case tWHILE:
+ dowhile();
+ lastst = tWHILE;
+ break;
+ case tDO:
+ dodo();
+ lastst = tDO;
+ break;
+ case tFOR:
+ dofor();
+ lastst = tFOR;
+ break;
+ case tSWITCH:
+ doswitch();
+ lastst = tSWITCH;
+ break;
+ case tCASE:
+ case tDEFAULT:
+ error(14); /* not in switch */
+ break;
+ case tGOTO:
+ dogoto();
+ lastst = tGOTO;
+ break;
+ case tLABEL:
+ dolabel();
+ lastst = tLABEL;
+ break;
+ case tRETURN:
+ doreturn();
+ lastst = tRETURN;
+ break;
+ case tBREAK:
+ dobreak();
+ lastst = tBREAK;
+ break;
+ case tCONTINUE:
+ docont();
+ lastst = tCONTINUE;
+ break;
+ case tEXIT:
+ doexit();
+ lastst = tEXIT;
+ break;
+ case tASSERT:
+ doassert();
+ lastst = tASSERT;
+ break;
+ case tSLEEP:
+ dosleep();
+ lastst = tSLEEP;
+ break;
+ case tCONST:
+ decl_const(sLOCAL);
+ break;
+ case tENUM:
+ decl_enum(sLOCAL);
+ break;
+ default: /* non-empty expression */
+ lexpush(); /* analyze token later */
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
+ needtoken(tTERM);
+ lastst = tEXPR;
+ } /* switch */
+}
+
+static void
+compound(void)
+{
+ int indent = -1;
+ cell save_decl = declared;
+ int count_stmt = 0;
+
+ nestlevel += 1; /* increase compound statement level */
+ while (matchtoken('}') == 0)
+ { /* repeat until compound statement is closed */
+ if (!freading)
+ {
+ needtoken('}'); /* gives error: "expected token }" */
+ break;
+ }
+ else
+ {
+ if (count_stmt > 0
+ && (lastst == tRETURN || lastst == tBREAK
+ || lastst == tCONTINUE))
+ error(225); /* unreachable code */
+ statement(&indent, TRUE); /* do a statement */
+ count_stmt++;
+ } /* if */
+ } /* while */
+ if (lastst != tRETURN)
+ destructsymbols(&loctab, nestlevel);
+ if (lastst != tRETURN && lastst != tGOTO)
+ /* delete local variable space */
+ modstk((int)(declared - save_decl) * sizeof(cell));
+
+ testsymbols(&loctab, nestlevel, FALSE, TRUE); /* look for unused
+ * block locals */
+ declared = save_decl;
+ delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+ /* erase local symbols, but
+ * retain block local labels
+ * (within the function) */
+
+ nestlevel -= 1; /* decrease compound statement level */
+}
+
+/* doexpr
+ *
+ * Global references: stgidx (referred to only)
+ */
+static void
+doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
+ int *tag, int chkfuncresult)
+{
+ int constant, idx, ident;
+ int localstaging = FALSE;
+ cell val;
+
+ if (!staging)
+ {
+ stgset(TRUE); /* start stage-buffering */
+ localstaging = TRUE;
+ assert(stgidx == 0);
+ } /* if */
+ idx = stgidx;
+ errorset(sEXPRMARK);
+ do
+ {
+ /* on second round through, mark the end of the previous expression */
+ if (idx != stgidx)
+ endexpr(TRUE);
+ sideeffect = FALSE;
+ ident = expression(&constant, &val, tag, chkfuncresult);
+ if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
+ error(33, "-unknown-"); /* array must be indexed */
+ if (chkeffect && !sideeffect)
+ error(215); /* expression has no effect */
+ }
+ while (comma && matchtoken(',')); /* more? */
+ if (mark_endexpr)
+ endexpr(TRUE); /* optionally, mark the end of the expression */
+ errorset(sEXPRRELEASE);
+ if (localstaging)
+ {
+ stgout(idx);
+ stgset(FALSE); /* stop staging */
+ } /* if */
+}
+
+/* constexpr
+ */
+int
+constexpr(cell * val, int *tag)
+{
+ int constant, idx;
+ cell cidx;
+
+ stgset(TRUE); /* start stage-buffering */
+ stgget(&idx, &cidx); /* mark position in code generator */
+ errorset(sEXPRMARK);
+ expression(&constant, val, tag, FALSE);
+ stgdel(idx, cidx); /* scratch generated code */
+ stgset(FALSE); /* stop stage-buffering */
+ if (constant == 0)
+ error(8); /* must be constant expression */
+ errorset(sEXPRRELEASE);
+ return constant;
+}
+
+/* test
+ *
+ * In the case a "simple assignment" operator ("=") is used within a
+ * test, * the warning "possibly unintended assignment" is displayed.
+ * This routine sets the global variable "intest" to true, it is
+ * restored upon termination. In the case the assignment was intended,
+ * use parantheses around the expression to avoid the warning;
+ * primary() sets "intest" to 0.
+ *
+ * Global references: intest (altered, but restored upon termination)
+ */
+static void
+test(int label, int parens, int invert)
+{
+ int idx, tok;
+ cell cidx;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ int localstaging = FALSE;
+
+ if (!staging)
+ {
+ stgset(TRUE); /* start staging */
+ localstaging = TRUE;
+#if !defined NDEBUG
+ stgget(&idx, &cidx); /* should start at zero if started
+ * locally */
+ assert(idx == 0);
+#endif
+ } /* if */
+
+ pushstk((stkitem) intest);
+ intest = 1;
+ if (parens)
+ needtoken('(');
+ do
+ {
+ stgget(&idx, &cidx); /* mark position (of last expression) in
+ * code generator */
+ if (hier14(&lval))
+ rvalue(&lval);
+ tok = matchtoken(',');
+ if (tok)
+ endexpr(TRUE);
+ }
+ while (tok); /* do */
+ if (parens)
+ needtoken(')');
+ if (lval.ident == iARRAY || lval.ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval.sym->name) ? lval.sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ if (lval.ident == iCONSTEXPR)
+ { /* constant expression */
+ intest = (int)(long)popstk(); /* restore stack */
+ stgdel(idx, cidx);
+ if (lval.constval)
+ { /* code always executed */
+ error(206); /* redundant test: always non-zero */
+ }
+ else
+ {
+ error(205); /* redundant code: never executed */
+ jumplabel(label);
+ } /* if */
+ if (localstaging)
+ {
+ stgout(0); /* write "jumplabel" code */
+ stgset(FALSE); /* stop staging */
+ } /* if */
+ return;
+ } /* if */
+ if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
+ if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
+ invert = !invert; /* user-defined ! operator inverted result */
+ if (invert)
+ jmp_ne0(label); /* jump to label if true (different from 0) */
+ else
+ jmp_eq0(label); /* jump to label if false (equal to 0) */
+ endexpr(TRUE); /* end expression (give optimizer a chance) */
+ intest = (int)(long)popstk(); /* double typecast to avoid warning
+ * with Microsoft C */
+ if (localstaging)
+ {
+ stgout(0); /* output queue from the very beginning (see
+ * assert() when localstaging is set to TRUE) */
+ stgset(FALSE); /* stop staging */
+ } /* if */
+}
+
+static void
+doif(void)
+{
+ int flab1, flab2;
+ int ifindent;
+
+ ifindent = stmtindent; /* save the indent of the "if" instruction */
+ flab1 = getlabel(); /* get label number for false branch */
+ test(flab1, TRUE, FALSE); /*get expression, branch to flab1 if false */
+ statement(NULL, FALSE); /* if true, do a statement */
+ if (matchtoken(tELSE) == 0)
+ { /* if...else ? */
+ setlabel(flab1); /* no, simple if..., print false label */
+ }
+ else
+ {
+ /* to avoid the "dangling else" error, we want a warning if the "else"
+ * has a lower indent than the matching "if" */
+#if 0
+ if (stmtindent < ifindent && sc_tabsize > 0)
+ error(217); /* loose indentation */
+#endif
+ flab2 = getlabel();
+ if ((lastst != tRETURN) && (lastst != tGOTO))
+ jumplabel(flab2);
+ setlabel(flab1); /* print false label */
+ statement(NULL, FALSE); /* do "else" clause */
+ setlabel(flab2); /* print true label */
+ } /* endif */
+}
+
+static void
+dowhile(void)
+{
+ int wq[wqSIZE]; /* allocate local queue */
+
+ addwhile(wq); /* add entry to queue for "break" */
+ setlabel(wq[wqLOOP]); /* loop label */
+ /* The debugger uses the "line" opcode to be able to "break" out of
+ * a loop. To make sure that each loop has a line opcode, even for the
+ * tiniest loop, set it below the top of the loop */
+ setline(fline, fcurrent);
+ test(wq[wqEXIT], TRUE, FALSE); /* branch to wq[wqEXIT] if false */
+ statement(NULL, FALSE); /* if so, do a statement */
+ jumplabel(wq[wqLOOP]); /* and loop to "while" start */
+ setlabel(wq[wqEXIT]); /* exit label */
+ delwhile(); /* delete queue entry */
+}
+
+/*
+ * Note that "continue" will in this case not jump to the top of the
+ * loop, but to the end: just before the TRUE-or-FALSE testing code.
+ */
+static void
+dodo(void)
+{
+ int wq[wqSIZE], top;
+
+ addwhile(wq); /* see "dowhile" for more info */
+ top = getlabel(); /* make a label first */
+ setlabel(top); /* loop label */
+ statement(NULL, FALSE);
+ needtoken(tWHILE);
+ setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
+ setline(fline, fcurrent);
+ test(wq[wqEXIT], TRUE, FALSE);
+ jumplabel(top);
+ setlabel(wq[wqEXIT]);
+ delwhile();
+ needtoken(tTERM);
+}
+
+static void
+dofor(void)
+{
+ int wq[wqSIZE], skiplab;
+ cell save_decl;
+ int save_nestlevel, idx;
+ int *ptr;
+
+ save_decl = declared;
+ save_nestlevel = nestlevel;
+
+ addwhile(wq);
+ skiplab = getlabel();
+ needtoken('(');
+ if (matchtoken(';') == 0)
+ {
+ /* new variable declarations are allowed here */
+ if (matchtoken(tNEW))
+ {
+ /* The variable in expr1 of the for loop is at a
+ * 'compound statement' level of it own.
+ */
+ nestlevel++;
+ declloc(FALSE); /* declare local variable */
+ }
+ else
+ {
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 1 */
+ needtoken(';');
+ } /* if */
+ } /* if */
+ /* Adjust the "declared" field in the "while queue", in case that
+ * local variables were declared in the first expression of the
+ * "for" loop. These are deleted in separately, so a "break" or a
+ * "continue" must ignore these fields.
+ */
+ ptr = readwhile();
+ assert(ptr != NULL);
+ ptr[wqBRK] = (int)declared;
+ ptr[wqCONT] = (int)declared;
+ jumplabel(skiplab); /* skip expression 3 1st time */
+ setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
+ setline(fline, fcurrent);
+ /* Expressions 2 and 3 are reversed in the generated code:
+ * expression 3 precedes expression 2.
+ * When parsing, the code is buffered and marks for
+ * the start of each expression are insterted in the buffer.
+ */
+ assert(!staging);
+ stgset(TRUE); /* start staging */
+ assert(stgidx == 0);
+ idx = stgidx;
+ stgmark(sSTARTREORDER);
+ stgmark((char)(sEXPRSTART + 0)); /* mark start of 2nd expression
+ * in stage */
+ setlabel(skiplab); /*jump to this point after 1st expression */
+ if (matchtoken(';') == 0)
+ {
+ test(wq[wqEXIT], FALSE, FALSE); /* expression 2
+ *(jump to wq[wqEXIT] if false) */
+ needtoken(';');
+ } /* if */
+ stgmark((char)(sEXPRSTART + 1)); /* mark start of 3th expression
+ * in stage */
+ if (matchtoken(')') == 0)
+ {
+ doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 3 */
+ needtoken(')');
+ } /* if */
+ stgmark(sENDREORDER); /* mark end of reversed evaluation */
+ stgout(idx);
+ stgset(FALSE); /* stop staging */
+ statement(NULL, FALSE);
+ jumplabel(wq[wqLOOP]);
+ setlabel(wq[wqEXIT]);
+ delwhile();
+
+ assert(nestlevel >= save_nestlevel);
+ if (nestlevel > save_nestlevel)
+ {
+ /* Clean up the space and the symbol table for the local
+ * variable in "expr1".
+ */
+ destructsymbols(&loctab, nestlevel);
+ modstk((int)(declared - save_decl) * sizeof(cell));
+ declared = save_decl;
+ delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+ nestlevel = save_nestlevel; /* reset 'compound statement'
+ * nesting level */
+ } /* if */
+}
+
+/* The switch statement is incompatible with its C sibling:
+ * 1. the cases are not drop through
+ * 2. only one instruction may appear below each case, use a compound
+ * instruction to execute multiple instructions
+ * 3. the "case" keyword accepts a comma separated list of values to
+ * match, it also accepts a range using the syntax "1 .. 4"
+ *
+ * SWITCH param
+ * PRI = expression result
+ * param = table offset (code segment)
+ *
+ */
+static void
+doswitch(void)
+{
+ int lbl_table, lbl_exit, lbl_case;
+ int tok, swdefault, casecount;
+ cell val;
+ char *str;
+ constvalue caselist = { NULL, "", 0, 0 }; /*case list starts empty */
+ constvalue *cse, *csp;
+ char labelname[sNAMEMAX + 1];
+
+ needtoken('(');
+ doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE); /* evaluate
+ * switch expression */
+ needtoken(')');
+ /* generate the code for the switch statement, the label is the
+ * address of the case table (to be generated later).
+ */
+ lbl_table = getlabel();
+ lbl_case = 0; /* just to avoid a compiler warning */
+ ffswitch(lbl_table);
+
+ needtoken('{');
+ lbl_exit = getlabel(); /*get label number for jumping out of switch */
+ swdefault = FALSE;
+ casecount = 0;
+ do
+ {
+ tok = lex(&val, &str); /* read in (new) token */
+ switch (tok)
+ {
+ case tCASE:
+ if (swdefault != FALSE)
+ error(15); /* "default" case must be last in switch
+ * statement */
+ lbl_case = getlabel();
+ sc_allowtags = FALSE; /* do not allow tagnames here */
+ do
+ {
+ casecount++;
+
+ /* ??? enforce/document that, in a switch, a statement cannot
+ * start an opening brace (marks the start of a compound
+ * statement) and search for the right-most colon before that
+ * statement.
+ * Now, by replacing the ':' by a special COLON token, you can
+ * parse all expressions until that special token.
+ */
+
+ constexpr(&val, NULL);
+ /* Search the insertion point (the table is kept in sorted
+ * order, so that advanced abstract machines can sift the
+ * case table with a binary search). Check for duplicate
+ * case values at the same time.
+ */
+ for (csp = &caselist, cse = caselist.next;
+ cse && cse->value < val;
+ csp = cse, cse = cse->next)
+ /* nothing */ ;
+ if (cse && cse->value == val)
+ error(40, val); /* duplicate "case" label */
+ /* Since the label is stored as a string in the
+ * "constvalue", the size of an identifier must
+ * be at least 8, as there are 8
+ * hexadecimal digits in a 32-bit number.
+ */
+#if sNAMEMAX < 8
+#error Length of identifier (sNAMEMAX) too small.
+#endif
+ insert_constval(csp, cse, itoh(lbl_case), val, 0);
+ if (matchtoken(tDBLDOT))
+ {
+ cell end;
+
+ constexpr(&end, NULL);
+ if (end <= val)
+ error(50); /* invalid range */
+ while (++val <= end)
+ {
+ casecount++;
+ /* find the new insertion point */
+ for (csp = &caselist, cse = caselist.next;
+ cse && cse->value < val;
+ csp = cse, cse = cse->next)
+ /* nothing */ ;
+ if (cse && cse->value == val)
+ error(40, val); /* duplicate "case" label */
+ insert_constval(csp, cse, itoh(lbl_case), val, 0);
+ } /* if */
+ } /* if */
+ }
+ while (matchtoken(','));
+ needtoken(':'); /* ':' ends the case */
+ sc_allowtags = TRUE; /* reset */
+ setlabel(lbl_case);
+ statement(NULL, FALSE);
+ jumplabel(lbl_exit);
+ break;
+ case tDEFAULT:
+ if (swdefault != FALSE)
+ error(16); /* multiple defaults in switch */
+ lbl_case = getlabel();
+ setlabel(lbl_case);
+ needtoken(':');
+ swdefault = TRUE;
+ statement(NULL, FALSE);
+ /* Jump to lbl_exit, even thouh this is the last clause in the
+ *switch, because the jump table is generated between the last
+ * clause of the switch and the exit label.
+ */
+ jumplabel(lbl_exit);
+ break;
+ case '}':
+ /* nothing, but avoid dropping into "default" */
+ break;
+ default:
+ error(2);
+ indent_nowarn = TRUE; /* disable this check */
+ tok = '}'; /* break out of the loop after an error */
+ } /* switch */
+ }
+ while (tok != '}');
+
+#if !defined NDEBUG
+ /* verify that the case table is sorted (unfortunately, duplicates can
+ * occur; there really shouldn't be duplicate cases, but the compiler
+ * may not crash or drop into an assertion for a user error). */
+ for (cse = caselist.next; cse && cse->next; cse = cse->next)
+ ; /* empty. no idea whether this is correct, but we MUST NOT do
+ * the setlabel(lbl_table) call in the loop body. doing so breaks
+ * switch statements that only have one case statement following.
+ */
+#endif
+
+ /* generate the table here, before lbl_exit (general jump target) */
+ setlabel(lbl_table);
+
+ if (swdefault == FALSE)
+ {
+ /* store lbl_exit as the "none-matched" label in the switch table */
+ strcpy(labelname, itoh(lbl_exit));
+ }
+ else
+ {
+ /* lbl_case holds the label of the "default" clause */
+ strcpy(labelname, itoh(lbl_case));
+ } /* if */
+ ffcase(casecount, labelname, TRUE);
+ /* generate the rest of the table */
+ for (cse = caselist.next; cse; cse = cse->next)
+ ffcase(cse->value, cse->name, FALSE);
+
+ setlabel(lbl_exit);
+ delete_consttable(&caselist); /* clear list of case labels */
+}
+
+static void
+doassert(void)
+{
+ int flab1, idx;
+ cell cidx;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+
+ if ((sc_debug & sCHKBOUNDS) != 0)
+ {
+ flab1 = getlabel(); /* get label number for "OK" branch */
+ test(flab1, FALSE, TRUE); /* get expression and branch
+ * to flab1 if true */
+ setline(fline, fcurrent); /* make sure we abort on the correct
+ * line number */
+ ffabort(xASSERTION);
+ setlabel(flab1);
+ }
+ else
+ {
+ stgset(TRUE); /* start staging */
+ stgget(&idx, &cidx); /* mark position in code generator */
+ do
+ {
+ if (hier14(&lval))
+ rvalue(&lval);
+ stgdel(idx, cidx); /* just scrap the code */
+ }
+ while (matchtoken(','));
+ stgset(FALSE); /* stop staging */
+ } /* if */
+ needtoken(tTERM);
+}
+
+static void
+dogoto(void)
+{
+ char *st;
+ cell val;
+ symbol *sym;
+
+ if (lex(&val, &st) == tSYMBOL)
+ {
+ sym = fetchlab(st);
+ jumplabel((int)sym->addr);
+ sym->usage |= uREAD; /* set "uREAD" bit */
+ /*
+ * // ??? if the label is defined (check sym->usage & uDEFINE), check
+ * // sym->compound (nesting level of the label) against nestlevel;
+ * // if sym->compound < nestlevel, call the destructor operator
+ */
+ }
+ else
+ {
+ error(20, st); /* illegal symbol name */
+ } /* if */
+ needtoken(tTERM);
+}
+
+static void
+dolabel(void)
+{
+ char *st;
+ cell val;
+ symbol *sym;
+
+ tokeninfo(&val, &st); /* retrieve label name again */
+ if (find_constval(&tagname_tab, st, 0))
+ error(221, st); /* label name shadows tagname */
+ sym = fetchlab(st);
+ setlabel((int)sym->addr);
+ /* since one can jump around variable declarations or out of compound
+ * blocks, the stack must be manually adjusted
+ */
+ setstk(-declared * sizeof(cell));
+ sym->usage |= uDEFINE; /* label is now defined */
+}
+
+/* fetchlab
+ *
+ * Finds a label from the (local) symbol table or adds one to it.
+ * Labels are local in scope.
+ *
+ * Note: The "_usage" bit is set to zero. The routines that call
+ * "fetchlab()" must set this bit accordingly.
+ */
+static symbol *
+fetchlab(char *name)
+{
+ symbol *sym;
+
+ sym = findloc(name); /* labels are local in scope */
+ if (sym)
+ {
+ if (sym->ident != iLABEL)
+ error(19, sym->name); /* not a label: ... */
+ }
+ else
+ {
+ sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
+ sym->x.declared = (int)declared;
+ sym->compound = nestlevel;
+ } /* if */
+ return sym;
+}
+
+/* doreturn
+ *
+ * Global references: rettype (altered)
+ */
+static void
+doreturn(void)
+{
+ int tag;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ if ((rettype & uRETNONE) != 0)
+ error(208); /* mix "return;" and "return value;" */
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ rettype |= uRETVALUE; /* function returns a value */
+ /* check tagname with function tagname */
+ assert(curfunc != NULL);
+ if (!matchtag(curfunc->tag, tag, TRUE))
+ error(213); /* tagname mismatch */
+ }
+ else
+ {
+ /* this return statement contains no expression */
+ const1(0);
+ if ((rettype & uRETVALUE) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user
+ * defined operators */
+ assert(curfunc != NULL);
+ funcdisplayname(symname, curfunc->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ rettype |= uRETNONE; /* function does not return anything */
+ } /* if */
+ destructsymbols(&loctab, 0); /*call destructor for *all* locals */
+ modstk((int)declared * sizeof(cell)); /* end of function, remove
+ *all* * local variables*/
+ ffret();
+}
+
+static void
+dobreak(void)
+{
+ int *ptr;
+
+ ptr = readwhile(); /* readwhile() gives an error if not in loop */
+ needtoken(tTERM);
+ if (!ptr)
+ return;
+ destructsymbols(&loctab, nestlevel);
+ modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
+ jumplabel(ptr[wqEXIT]);
+}
+
+static void
+docont(void)
+{
+ int *ptr;
+
+ ptr = readwhile(); /* readwhile() gives an error if not in loop */
+ needtoken(tTERM);
+ if (!ptr)
+ return;
+ destructsymbols(&loctab, nestlevel);
+ modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
+ jumplabel(ptr[wqLOOP]);
+}
+
+void
+exporttag(int tag)
+{
+ /* find the tag by value in the table, then set the top bit to mark it
+ * "public"
+ */
+ if (tag != 0)
+ {
+ constvalue *ptr;
+
+ assert((tag & PUBLICTAG) == 0);
+ for (ptr = tagname_tab.next;
+ ptr && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
+ /* nothing */ ;
+ if (ptr)
+ ptr->value |= PUBLICTAG;
+ } /* if */
+}
+
+static void
+doexit(void)
+{
+ int tag = 0;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ }
+ else
+ {
+ const1(0);
+ } /* if */
+ const2(tag);
+ exporttag(tag);
+ destructsymbols(&loctab, 0); /* call destructor for *all* locals */
+ ffabort(xEXIT);
+}
+
+static void
+dosleep(void)
+{
+ int tag = 0;
+
+ if (matchtoken(tTERM) == 0)
+ {
+ doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+ needtoken(tTERM);
+ }
+ else
+ {
+ const1(0);
+ } /* if */
+ const2(tag);
+ exporttag(tag);
+ ffabort(xSLEEP);
+}
+
+static void
+addwhile(int *ptr)
+{
+ int k;
+
+ ptr[wqBRK] = (int)declared; /* stack pointer (for "break") */
+ ptr[wqCONT] = (int)declared; /* for "continue", possibly adjusted later */
+ ptr[wqLOOP] = getlabel();
+ ptr[wqEXIT] = getlabel();
+ if (wqptr >= (wq + wqTABSZ - wqSIZE))
+ error(102, "loop table"); /* loop table overflow (too many active loops) */
+ k = 0;
+ while (k < wqSIZE)
+ { /* copy "ptr" to while queue table */
+ *wqptr = *ptr;
+ wqptr += 1;
+ ptr += 1;
+ k += 1;
+ } /* while */
+}
+
+static void
+delwhile(void)
+{
+ if (wqptr > wq)
+ wqptr -= wqSIZE;
+}
+
+static int *
+readwhile(void)
+{
+ if (wqptr <= wq)
+ {
+ error(24); /* out of context */
+ return NULL;
+ }
+ else
+ {
+ return (wqptr - wqSIZE);
+ } /* if */
+}
--- /dev/null
+/* Small compiler - File input, preprocessing and lexical analysis functions
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include "embryo_cc_sc.h"
+#include "Embryo.h"
+
+static int match(char *st, int end);
+static cell litchar(char **lptr, int rawmode);
+static int alpha(char c);
+
+static int icomment; /* currently in multiline comment? */
+static int iflevel; /* nesting level if #if/#else/#endif */
+static int skiplevel; /* level at which we started skipping */
+static int elsedone; /* level at which we have seen an #else */
+static char term_expr[] = "";
+static int listline = -1; /* "current line" for the list file */
+
+/* pushstk & popstk
+ *
+ * Uses a LIFO stack to store information. The stack is used by doinclude(),
+ * doswitch() (to hold the state of "swactive") and some other routines.
+ *
+ * Porting note: I made the bold assumption that an integer will not be
+ * larger than a pointer (it may be smaller). That is, the stack element
+ * is typedef'ed as a pointer type, but I also store integers on it. See
+ * SC.H for "stkitem"
+ *
+ * Global references: stack,stkidx (private to pushstk() and popstk())
+ */
+static stkitem stack[sSTKMAX];
+static int stkidx;
+void
+pushstk(stkitem val)
+{
+ if (stkidx >= sSTKMAX)
+ error(102, "parser stack"); /* stack overflow (recursive include?) */
+ stack[stkidx] = val;
+ stkidx += 1;
+}
+
+stkitem
+popstk(void)
+{
+ if (stkidx == 0)
+ return (stkitem) - 1; /* stack is empty */
+ stkidx -= 1;
+ return stack[stkidx];
+}
+
+int
+plungequalifiedfile(char *name)
+{
+ static char *extensions[] = { ".inc", ".sma", ".small" };
+ FILE *fp;
+ char *ext;
+ int ext_idx;
+
+ ext_idx = 0;
+ do
+ {
+ fp = (FILE *) sc_opensrc(name);
+ ext = strchr(name, '\0'); /* save position */
+ if (!fp)
+ {
+ /* try to append an extension */
+ strcpy(ext, extensions[ext_idx]);
+ fp = (FILE *) sc_opensrc(name);
+ if (!fp)
+ *ext = '\0'; /* on failure, restore filename */
+ } /* if */
+ ext_idx++;
+ }
+ while ((!fp) &&
+ (ext_idx < (int)(sizeof extensions / sizeof extensions[0])));
+ if (!fp)
+ {
+ *ext = '\0'; /* restore filename */
+ return FALSE;
+ } /* if */
+ pushstk((stkitem) inpf);
+ pushstk((stkitem) inpfname); /* pointer to current file name */
+ pushstk((stkitem) curlibrary);
+ pushstk((stkitem) iflevel);
+ assert(skiplevel == 0);
+ pushstk((stkitem) icomment);
+ pushstk((stkitem) fcurrent);
+ pushstk((stkitem) fline);
+ inpfname = strdup(name); /* set name of include file */
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ inpf = fp; /* set input file pointer to include file */
+ fnumber++;
+ fline = 0; /* set current line number to 0 */
+ fcurrent = fnumber;
+ icomment = FALSE;
+ setfile(inpfname, fcurrent);
+ listline = -1; /* force a #line directive when changing the file */
+ setactivefile(fcurrent);
+ return TRUE;
+}
+
+int
+plungefile(char *name, int try_currentpath, int try_includepaths)
+{
+ int result = FALSE;
+ int i;
+ char *ptr;
+
+ if (try_currentpath)
+ result = plungequalifiedfile(name);
+
+ if (try_includepaths && name[0] != DIRSEP_CHAR)
+ {
+ for (i = 0; !result && (ptr = get_path(i)); i++)
+ {
+ char path[PATH_MAX];
+
+ strncpy(path, ptr, sizeof path);
+ path[sizeof path - 1] = '\0'; /* force '\0' termination */
+ strncat(path, name, sizeof(path) - strlen(path));
+ path[sizeof path - 1] = '\0';
+ result = plungequalifiedfile(path);
+ } /* while */
+ } /* if */
+ return result;
+}
+
+static void
+check_empty(char *lptr)
+{
+ /* verifies that the string contains only whitespace */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr != '\0')
+ error(38); /* extra characters on line */
+}
+
+/* doinclude
+ *
+ * Gets the name of an include file, pushes the old file on the stack and
+ * sets some options. This routine doesn't use lex(), since lex() doesn't
+ * recognize file names (and directories).
+ *
+ * Global references: inpf (altered)
+ * inpfname (altered)
+ * fline (altered)
+ * lptr (altered)
+ */
+static void
+doinclude(void)
+{
+ char name[PATH_MAX], c;
+ int i, result;
+
+ while (*lptr <= ' ' && *lptr != 0) /* skip leading whitespace */
+ lptr++;
+ if (*lptr == '<' || *lptr == '\"')
+ {
+ c = (char)((*lptr == '\"') ? '\"' : '>'); /* termination character */
+ lptr++;
+ while (*lptr <= ' ' && *lptr != 0) /* skip whitespace after quote */
+ lptr++;
+ }
+ else
+ {
+ c = '\0';
+ } /* if */
+
+ i = 0;
+ while ((*lptr != c) && (*lptr != '\0') && (i < (int)(sizeof(name) - 1))) /* find the end of the string */
+ name[i++] = *lptr++;
+ while (i > 0 && name[i - 1] <= ' ')
+ i--; /* strip trailing whitespace */
+ assert((i >= 0) && (i < (int)(sizeof(name))));
+ name[i] = '\0'; /* zero-terminate the string */
+
+ if (*lptr != c)
+ { /* verify correct string termination */
+ error(37); /* invalid string */
+ return;
+ } /* if */
+ if (c != '\0')
+ check_empty(lptr + 1); /* verify that the rest of the line is whitespace */
+
+ /* Include files between "..." or without quotes are read from the current
+ * directory, or from a list of "include directories". Include files
+ * between <...> are only read from the list of include directories.
+ */
+ result = plungefile(name, (c != '>'), TRUE);
+ if (!result)
+ error(100, name); /* cannot read from ... (fatal error) */
+}
+
+/* readline
+ *
+ * Reads in a new line from the input file pointed to by "inpf". readline()
+ * concatenates lines that end with a \ with the next line. If no more data
+ * can be read from the file, readline() attempts to pop off the previous file
+ * from the stack. If that fails too, it sets "freading" to 0.
+ *
+ * Global references: inpf,fline,inpfname,freading,icomment (altered)
+ */
+static void
+readline(char *line)
+{
+ int i, num, cont;
+ char *ptr;
+
+ if (lptr == term_expr)
+ return;
+ num = sLINEMAX;
+ cont = FALSE;
+ do
+ {
+ if (!inpf || sc_eofsrc(inpf))
+ {
+ if (cont)
+ error(49); /* invalid line continuation */
+ if (inpf && inpf != inpf_org)
+ sc_closesrc(inpf);
+ i = (int)(long)popstk();
+ if (i == -1)
+ { /* All's done; popstk() returns "stack is empty" */
+ freading = FALSE;
+ *line = '\0';
+ /* when there is nothing more to read, the #if/#else stack should
+ * be empty and we should not be in a comment
+ */
+ assert(iflevel >= 0);
+ if (iflevel > 0)
+ error(1, "#endif", "-end of file-");
+ else if (icomment)
+ error(1, "*/", "-end of file-");
+ return;
+ } /* if */
+ fline = i;
+ fcurrent = (int)(long)popstk();
+ icomment = (int)(long)popstk();
+ assert(skiplevel == 0); /* skiplevel was not stored on stack, because it should always be zero at this point */
+ iflevel = (int)(long)popstk();
+ curlibrary = (constvalue *) popstk();
+ free(inpfname); /* return memory allocated for the include file name */
+ inpfname = (char *)popstk();
+ inpf = (FILE *) popstk();
+ setactivefile(fcurrent);
+ listline = -1; /* force a #line directive when changing the file */
+ elsedone = 0;
+ } /* if */
+
+ if (!sc_readsrc(inpf, line, num))
+ {
+ *line = '\0'; /* delete line */
+ cont = FALSE;
+ }
+ else
+ {
+ /* check whether to erase leading spaces */
+ if (cont)
+ {
+ char *ptr = line;
+
+ while (*ptr == ' ' || *ptr == '\t')
+ ptr++;
+ if (ptr != line)
+ memmove(line, ptr, strlen(ptr) + 1);
+ } /* if */
+ cont = FALSE;
+ /* check whether a full line was read */
+ if (!strchr(line, '\n') && !sc_eofsrc(inpf))
+ error(75); /* line too long */
+ /* check if the next line must be concatenated to this line */
+ if ((ptr = strchr(line, '\n')) && ptr > line)
+ {
+ assert(*(ptr + 1) == '\0'); /* '\n' should be last in the string */
+ while (ptr > line
+ && (*ptr == '\n' || *ptr == ' ' || *ptr == '\t'))
+ ptr--; /* skip trailing whitespace */
+ if (*ptr == '\\')
+ {
+ cont = TRUE;
+ /* set '\a' at the position of '\\' to make it possible to check
+ * for a line continuation in a single line comment (error 49)
+ */
+ *ptr++ = '\a';
+ *ptr = '\0'; /* erase '\n' (and any trailing whitespace) */
+ } /* if */
+ } /* if */
+ num -= strlen(line);
+ line += strlen(line);
+ } /* if */
+ fline += 1;
+ }
+ while (num >= 0 && cont);
+}
+
+/* stripcom
+ *
+ * Replaces all comments from the line by space characters. It updates
+ * a global variable ("icomment") for multiline comments.
+ *
+ * This routine also supports the C++ extension for single line comments.
+ * These comments are started with "//" and end at the end of the line.
+ *
+ * Global references: icomment (private to "stripcom")
+ */
+static void
+stripcom(char *line)
+{
+ char c;
+
+ while (*line)
+ {
+ if (icomment)
+ {
+ if (*line == '*' && *(line + 1) == '/')
+ {
+ icomment = FALSE; /* comment has ended */
+ *line = ' '; /* replace '*' and '/' characters by spaces */
+ *(line + 1) = ' ';
+ line += 2;
+ }
+ else
+ {
+ if (*line == '/' && *(line + 1) == '*')
+ error(216); /* nested comment */
+ *line = ' '; /* replace comments by spaces */
+ line += 1;
+ } /* if */
+ }
+ else
+ {
+ if (*line == '/' && *(line + 1) == '*')
+ {
+ icomment = TRUE; /* start comment */
+ *line = ' '; /* replace '/' and '*' characters by spaces */
+ *(line + 1) = ' ';
+ line += 2;
+ }
+ else if (*line == '/' && *(line + 1) == '/')
+ { /* comment to end of line */
+ if (strchr(line, '\a'))
+ error(49); /* invalid line continuation */
+ *line++ = '\n'; /* put "newline" at first slash */
+ *line = '\0'; /* put "zero-terminator" at second slash */
+ }
+ else
+ {
+ if (*line == '\"' || *line == '\'')
+ { /* leave literals unaltered */
+ c = *line; /* ending quote, single or double */
+ line += 1;
+ while ((*line != c || *(line - 1) == '\\')
+ && *line != '\0')
+ line += 1;
+ line += 1; /* skip final quote */
+ }
+ else
+ {
+ line += 1;
+ } /* if */
+ } /* if */
+ } /* if */
+ } /* while */
+}
+
+/* btoi
+ *
+ * Attempts to interpret a numeric symbol as a boolean value. On success
+ * it returns the number of characters processed (so the line pointer can be
+ * adjusted) and the value is stored in "val". Otherwise it returns 0 and
+ * "val" is garbage.
+ *
+ * A boolean value must start with "0b"
+ */
+static int
+btoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (*ptr == '0' && *(ptr + 1) == 'b')
+ {
+ ptr += 2;
+ while (*ptr == '0' || *ptr == '1' || *ptr == '_')
+ {
+ if (*ptr != '_')
+ *val = (*val << 1) | (*ptr - '0');
+ ptr++;
+ } /* while */
+ }
+ else
+ {
+ return 0;
+ } /* if */
+ if (alphanum(*ptr)) /* number must be delimited by non-alphanumeric char */
+ return 0;
+ else
+ return (int)(ptr - curptr);
+}
+
+/* dtoi
+ *
+ * Attempts to interpret a numeric symbol as a decimal value. On success
+ * it returns the number of characters processed and the value is stored in
+ * "val". Otherwise it returns 0 and "val" is garbage.
+ */
+static int
+dtoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ *val = (*val * 10) + (*ptr - '0');
+ ptr++;
+ } /* while */
+ if (alphanum(*ptr)) /* number must be delimited by non-alphanumerical */
+ return 0;
+ if (*ptr == '.' && sc_isdigit(*(ptr + 1)))
+ return 0; /* but a fractional part must not be present */
+ return (int)(ptr - curptr);
+}
+
+/* htoi
+ *
+ * Attempts to interpret a numeric symbol as a hexadecimal value. On
+ * success it returns the number of characters processed and the value is
+ * stored in "val". Otherwise it return 0 and "val" is garbage.
+ */
+static int
+htoi(cell * val, char *curptr)
+{
+ char *ptr;
+
+ *val = 0;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ if (*ptr == '0' && *(ptr + 1) == 'x')
+ { /* C style hexadecimal notation */
+ ptr += 2;
+ while (sc_isxdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ assert(sc_isxdigit(*ptr));
+ *val = *val << 4;
+ if (sc_isdigit(*ptr))
+ *val += (*ptr - '0');
+ else
+ *val += (tolower(*ptr) - 'a' + 10);
+ } /* if */
+ ptr++;
+ } /* while */
+ }
+ else
+ {
+ return 0;
+ } /* if */
+ if (alphanum(*ptr))
+ return 0;
+ else
+ return (int)(ptr - curptr);
+}
+
+#if defined LINUX
+static double
+pow10(int value)
+{
+ double res = 1.0;
+
+ while (value >= 4)
+ {
+ res *= 10000.0;
+ value -= 5;
+ } /* while */
+ while (value >= 2)
+ {
+ res *= 100.0;
+ value -= 2;
+ } /* while */
+ while (value >= 1)
+ {
+ res *= 10.0;
+ value -= 1;
+ } /* while */
+ return res;
+}
+#endif
+
+/* ftoi
+ *
+ * Attempts to interpret a numeric symbol as a rational number, either as
+ * IEEE 754 single precision floating point or as a fixed point integer.
+ * On success it returns the number of characters processed and the value is
+ * stored in "val". Otherwise it returns 0 and "val" is unchanged.
+ *
+ * Small has stricter definition for floating point numbers than most:
+ * o the value must start with a digit; ".5" is not a valid number, you
+ * should write "0.5"
+ * o a period must appear in the value, even if an exponent is given; "2e3"
+ * is not a valid number, you should write "2.0e3"
+ * o at least one digit must follow the period; "6." is not a valid number,
+ * you should write "6.0"
+ */
+static int
+ftoi(cell * val, char *curptr)
+{
+ char *ptr;
+ double fnum, ffrac, fmult;
+ unsigned long dnum, dbase;
+ int i, ignore;
+
+ assert(rational_digits >= 0 && rational_digits < 9);
+ for (i = 0, dbase = 1; i < rational_digits; i++)
+ dbase *= 10;
+ fnum = 0.0;
+ dnum = 0L;
+ ptr = curptr;
+ if (!sc_isdigit(*ptr)) /* should start with digit */
+ return 0;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ fnum = (fnum * 10.0) + (*ptr - '0');
+ dnum = (dnum * 10L) + (*ptr - '0') * dbase;
+ } /* if */
+ ptr++;
+ } /* while */
+ if (*ptr != '.')
+ return 0; /* there must be a period */
+ ptr++;
+ if (!sc_isdigit(*ptr)) /* there must be at least one digit after the dot */
+ return 0;
+ ffrac = 0.0;
+ fmult = 1.0;
+ ignore = FALSE;
+ while (sc_isdigit(*ptr) || *ptr == '_')
+ {
+ if (*ptr != '_')
+ {
+ ffrac = (ffrac * 10.0) + (*ptr - '0');
+ fmult = fmult / 10.0;
+ dbase /= 10L;
+ dnum += (*ptr - '0') * dbase;
+ if (dbase == 0L && sc_rationaltag && rational_digits > 0
+ && !ignore)
+ {
+ error(222); /* number of digits exceeds rational number precision */
+ ignore = TRUE;
+ } /* if */
+ } /* if */
+ ptr++;
+ } /* while */
+ fnum += ffrac * fmult; /* form the number so far */
+ if (*ptr == 'e')
+ { /* optional fractional part */
+ int exp, sign;
+
+ ptr++;
+ if (*ptr == '-')
+ {
+ sign = -1;
+ ptr++;
+ }
+ else
+ {
+ sign = 1;
+ } /* if */
+ if (!sc_isdigit(*ptr)) /* 'e' should be followed by a digit */
+ return 0;
+ exp = 0;
+ while (sc_isdigit(*ptr))
+ {
+ exp = (exp * 10) + (*ptr - '0');
+ ptr++;
+ } /* while */
+#if defined LINUX
+ fmult = pow10(exp * sign);
+#else
+ fmult = pow(10, exp * sign);
+#endif
+ fnum *= fmult;
+ dnum *= (unsigned long)(fmult + 0.5);
+ } /* if */
+
+ /* decide how to store the number */
+ if (sc_rationaltag == 0)
+ {
+ error(70); /* rational number support was not enabled */
+ *val = 0;
+ }
+ else if (rational_digits == 0)
+ {
+ float f = (float) fnum;
+ /* floating point */
+ *val = EMBRYO_FLOAT_TO_CELL(f);
+#if !defined NDEBUG
+ /* I assume that the C/C++ compiler stores "float" values in IEEE 754
+ * format (as mandated in the ANSI standard). Test this assumption anyway.
+ */
+ {
+ float test1 = 0.0, test2 = 50.0;
+ Embryo_Cell c1 = EMBRYO_FLOAT_TO_CELL(test1);
+ Embryo_Cell c2 = EMBRYO_FLOAT_TO_CELL(test2);
+
+ if (c1 != 0x00000000L)
+ {
+ fprintf(stderr,
+ "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+ "point math as embryo expects. this could be bad.\n"
+ "\n"
+ "(float 0.0 != 0x00000000 bitpattern, 0x%08x instead)\n"
+ "\n"
+ "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+ "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+ , c1);
+ }
+ else if (c2 != 0x42480000L)
+ {
+ fprintf(stderr,
+ "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+ "point math as embryo expects. This could be bad.\n"
+ "\n"
+ "(float 50.0 != 0x42480000 bitpattern, 0x%08x instead)\n"
+ "\n"
+ "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+ "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+ , c2);
+ }
+ }
+#endif
+ }
+ else
+ {
+ /* fixed point */
+ *val = (cell) dnum;
+ } /* if */
+
+ return (int)(ptr - curptr);
+}
+
+/* number
+ *
+ * Reads in a number (binary, decimal or hexadecimal). It returns the number
+ * of characters processed or 0 if the symbol couldn't be interpreted as a
+ * number (in this case the argument "val" remains unchanged). This routine
+ * relies on the 'early dropout' implementation of the logical or (||)
+ * operator.
+ *
+ * Note: the routine doesn't check for a sign (+ or -). The - is checked
+ * for at "hier2()" (in fact, it is viewed as an operator, not as a
+ * sign) and the + is invalid (as in K&R C, and unlike ANSI C).
+ */
+static int
+number(cell * val, char *curptr)
+{
+ int i;
+ cell value;
+
+ if ((i = btoi(&value, curptr)) != 0 /* binary? */
+ || (i = htoi(&value, curptr)) != 0 /* hexadecimal? */
+ || (i = dtoi(&value, curptr)) != 0) /* decimal? */
+ {
+ *val = value;
+ return i;
+ }
+ else
+ {
+ return 0; /* else not a number */
+ } /* if */
+}
+
+static void
+chrcat(char *str, char chr)
+{
+ str = strchr(str, '\0');
+ *str++ = chr;
+ *str = '\0';
+}
+
+static int
+preproc_expr(cell * val, int *tag)
+{
+ int result;
+ int idx;
+ cell code_index;
+ char *term;
+
+ /* Disable staging; it should be disabled already because
+ * expressions may not be cut off half-way between conditional
+ * compilations. Reset the staging index, but keep the code
+ * index.
+ */
+ if (stgget(&idx, &code_index))
+ {
+ error(57); /* unfinished expression */
+ stgdel(0, code_index);
+ stgset(FALSE);
+ } /* if */
+ /* append a special symbol to the string, so the expression
+ * analyzer won't try to read a next line when it encounters
+ * an end-of-line
+ */
+ assert(strlen(pline) < sLINEMAX);
+ term = strchr(pline, '\0');
+ assert(term != NULL);
+ chrcat(pline, PREPROC_TERM); /* the "DEL" code (see SC.H) */
+ result = constexpr(val, tag); /* get value (or 0 on error) */
+ *term = '\0'; /* erase the token (if still present) */
+ lexclr(FALSE); /* clear any "pushed" tokens */
+ return result;
+}
+
+/* getstring
+ * Returns returns a pointer behind the closing quote or to the other
+ * character that caused the input to be ended.
+ */
+static char *
+getstring(char *dest, int max)
+{
+ assert(dest != NULL);
+ *dest = '\0';
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++; /* skip whitespace */
+ if (*lptr != '"')
+ {
+ error(37); /* invalid string */
+ }
+ else
+ {
+ int len = 0;
+
+ lptr++; /* skip " */
+ while (*lptr != '"' && *lptr != '\0')
+ {
+ if (len < max - 1)
+ dest[len++] = *lptr;
+ lptr++;
+ } /* if */
+ dest[len] = '\0';
+ if (*lptr == '"')
+ lptr++; /* skip closing " */
+ else
+ error(37); /* invalid string */
+ } /* if */
+ return lptr;
+}
+
+enum
+{
+ CMD_NONE,
+ CMD_TERM,
+ CMD_EMPTYLINE,
+ CMD_CONDFALSE,
+ CMD_INCLUDE,
+ CMD_DEFINE,
+ CMD_IF,
+ CMD_DIRECTIVE,
+};
+
+/* command
+ *
+ * Recognizes the compiler directives. The function returns:
+ * CMD_NONE the line must be processed
+ * CMD_TERM a pending expression must be completed before processing further lines
+ * Other value: the line must be skipped, because:
+ * CMD_CONDFALSE false "#if.." code
+ * CMD_EMPTYLINE line is empty
+ * CMD_INCLUDE the line contains a #include directive
+ * CMD_DEFINE the line contains a #subst directive
+ * CMD_IF the line contains a #if/#else/#endif directive
+ * CMD_DIRECTIVE the line contains some other compiler directive
+ *
+ * Global variables: iflevel, skiplevel, elsedone (altered)
+ * lptr (altered)
+ */
+static int
+command(void)
+{
+ int tok, ret;
+ cell val;
+ char *str;
+ int idx;
+ cell code_index;
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr += 1;
+ if (*lptr == '\0')
+ return CMD_EMPTYLINE; /* empty line */
+ if (*lptr != '#')
+ return skiplevel > 0 ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */
+ /* compiler directive found */
+ indent_nowarn = TRUE; /* allow loose indentation" */
+ lexclr(FALSE); /* clear any "pushed" tokens */
+ /* on a pending expression, force to return a silent ';' token and force to
+ * re-read the line
+ */
+ if (!sc_needsemicolon && stgget(&idx, &code_index))
+ {
+ lptr = term_expr;
+ return CMD_TERM;
+ } /* if */
+ tok = lex(&val, &str);
+ ret = skiplevel > 0 ? CMD_CONDFALSE : CMD_DIRECTIVE; /* preset 'ret' to CMD_DIRECTIVE (most common case) */
+ switch (tok)
+ {
+ case tpIF: /* conditional compilation */
+ ret = CMD_IF;
+ iflevel += 1;
+ if (skiplevel)
+ break; /* break out of switch */
+ preproc_expr(&val, NULL); /* get value (or 0 on error) */
+ if (!val)
+ skiplevel = iflevel;
+ check_empty(lptr);
+ break;
+ case tpELSE:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26); /* no matching #if */
+ errorset(sRESET);
+ }
+ else
+ {
+ if (elsedone == iflevel)
+ error(60); /* multiple #else directives between #if ... #endif */
+ elsedone = iflevel;
+ if (skiplevel == iflevel)
+ skiplevel = 0;
+ else if (skiplevel == 0)
+ skiplevel = iflevel;
+ } /* if */
+ check_empty(lptr);
+ break;
+#if 0 /* ??? *really* need to use a stack here */
+ case tpELSEIF:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26); /* no matching #if */
+ errorset(sRESET);
+ }
+ else if (elsedone == iflevel)
+ {
+ error(61); /* #elseif directive may not follow an #else */
+ errorset(sRESET);
+ }
+ else
+ {
+ preproc_expr(&val, NULL); /* get value (or 0 on error) */
+ if (skiplevel == 0)
+ skiplevel = iflevel; /* we weren't skipping, start skipping now */
+ else if (val)
+ skiplevel = 0; /* we were skipping, condition is valid -> stop skipping */
+ /* else: we were skipping and condition is invalid -> keep skipping */
+ check_empty(lptr);
+ } /* if */
+ break;
+#endif
+ case tpENDIF:
+ ret = CMD_IF;
+ if (iflevel == 0 && skiplevel == 0)
+ {
+ error(26);
+ errorset(sRESET);
+ }
+ else
+ {
+ if (skiplevel == iflevel)
+ skiplevel = 0;
+ if (elsedone == iflevel)
+ elsedone = 0; /* ??? actually, should build a stack of #if/#endif and keep
+ * the state whether an #else was seen per nesting level */
+ iflevel -= 1;
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tINCLUDE: /* #include directive */
+ ret = CMD_INCLUDE;
+ if (skiplevel == 0)
+ doinclude();
+ break;
+ case tpFILE:
+ if (skiplevel == 0)
+ {
+ char pathname[PATH_MAX];
+
+ lptr = getstring(pathname, sizeof pathname);
+ if (pathname[0] != '\0')
+ {
+ free(inpfname);
+ inpfname = strdup(pathname);
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ } /* if */
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tpLINE:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) != tNUMBER)
+ error(8); /* invalid/non-constant expression */
+ fline = (int)val;
+
+ while (*lptr == ' ' && *lptr != '\0')
+ lptr++; /* skip whitespace */
+ if (*lptr == '"')
+ {
+ char pathname[PATH_MAX];
+
+ lptr = getstring(pathname, sizeof pathname);
+ if (pathname[0] != '\0')
+ {
+ free(inpfname);
+ inpfname = strdup(pathname);
+ if (!inpfname)
+ error(103); /* insufficient memory */
+ } /* if */
+ }
+ } /* if */
+ check_empty(lptr);
+ break;
+ case tpASSERT:
+ if (skiplevel == 0 && (sc_debug & sCHKBOUNDS) != 0)
+ {
+ preproc_expr(&val, NULL); /* get constant expression (or 0 on error) */
+ if (!val)
+ error(7); /* assertion failed */
+ check_empty(lptr);
+ } /* if */
+ break;
+ case tpPRAGMA:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) == tSYMBOL)
+ {
+ if (strcmp(str, "ctrlchar") == 0)
+ {
+ if (lex(&val, &str) != tNUMBER)
+ error(27); /* invalid character constant */
+ sc_ctrlchar = (char)val;
+ }
+ else if (strcmp(str, "compress") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_compress = (int)val; /* switch code packing on/off */
+ }
+ else if (strcmp(str, "dynamic") == 0)
+ {
+ preproc_expr(&sc_stksize, NULL);
+ }
+ else if (strcmp(str, "library") == 0)
+ {
+ char name[sNAMEMAX + 1];
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr == '"')
+ {
+ lptr = getstring(name, sizeof name);
+ }
+ else
+ {
+ int i;
+
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (alphanum(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ } /* if */
+ if (name[0] == '\0')
+ {
+ curlibrary = NULL;
+ }
+ else
+ {
+ if (strlen(name) > sEXPMAX)
+ error(220, name, sEXPMAX); /* exported symbol is truncated */
+ /* add the name if it does not yet exist in the table */
+ if (!find_constval(&libname_tab, name, 0))
+ curlibrary =
+ append_constval(&libname_tab, name, 0, 0);
+ } /* if */
+ }
+ else if (strcmp(str, "pack") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL); /* default = packed/unpacked */
+ sc_packstr = (int)val;
+ }
+ else if (strcmp(str, "rational") == 0)
+ {
+ char name[sNAMEMAX + 1];
+ cell digits = 0;
+ int i;
+
+ /* first gather all information, start with the tag name */
+ while ((*lptr <= ' ') && (*lptr != '\0'))
+ lptr++;
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (alphanum(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ /* then the precision (for fixed point arithmetic) */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr == '(')
+ {
+ preproc_expr(&digits, NULL);
+ if (digits <= 0 || digits > 9)
+ {
+ error(68); /* invalid rational number precision */
+ digits = 0;
+ } /* if */
+ if (*lptr == ')')
+ lptr++;
+ } /* if */
+ /* add the tag (make it public) and check the values */
+ i = sc_addtag(name);
+ exporttag(i);
+ if (sc_rationaltag == 0
+ || (sc_rationaltag == i
+ && rational_digits == (int)digits))
+ {
+ sc_rationaltag = i;
+ rational_digits = (int)digits;
+ }
+ else
+ {
+ error(69); /* rational number format already set, can only be set once */
+ } /* if */
+ }
+ else if (strcmp(str, "semicolon") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_needsemicolon = (int)val;
+ }
+ else if (strcmp(str, "tabsize") == 0)
+ {
+ cell val;
+
+ preproc_expr(&val, NULL);
+ sc_tabsize = (int)val;
+ }
+ else if (strcmp(str, "align") == 0)
+ {
+ sc_alignnext = TRUE;
+ }
+ else if (strcmp(str, "unused") == 0)
+ {
+ char name[sNAMEMAX + 1];
+ int i, comma;
+ symbol *sym;
+
+ do
+ {
+ /* get the name */
+ while ((*lptr <= ' ') && (*lptr != '\0'))
+ lptr++;
+ for (i = 0;
+ (i < (int)(sizeof(name))) &&
+ (sc_isalpha(*lptr));
+ i++, lptr++)
+ name[i] = *lptr;
+ name[i] = '\0';
+ /* get the symbol */
+ sym = findloc(name);
+ if (!sym)
+ sym = findglb(name);
+ if (sym)
+ {
+ sym->usage |= uREAD;
+ if (sym->ident == iVARIABLE
+ || sym->ident == iREFERENCE
+ || sym->ident == iARRAY
+ || sym->ident == iREFARRAY)
+ sym->usage |= uWRITTEN;
+ }
+ else
+ {
+ error(17, name); /* undefined symbol */
+ } /* if */
+ /* see if a comma follows the name */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ comma = (*lptr == ',');
+ if (comma)
+ lptr++;
+ }
+ while (comma);
+ }
+ else
+ {
+ error(207); /* unknown #pragma */
+ } /* if */
+ }
+ else
+ {
+ error(207); /* unknown #pragma */
+ } /* if */
+ check_empty(lptr);
+ } /* if */
+ break;
+ case tpENDINPUT:
+ case tpENDSCRPT:
+ if (skiplevel == 0)
+ {
+ check_empty(lptr);
+ assert(inpf != NULL);
+ if (inpf != inpf_org)
+ sc_closesrc(inpf);
+ inpf = NULL;
+ } /* if */
+ break;
+#if !defined NOEMIT
+ case tpEMIT:
+ {
+ /* write opcode to output file */
+ char name[40];
+ int i;
+
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ for (i = 0; i < 40 && (sc_isalpha(*lptr) || *lptr == '.'); i++, lptr++)
+ name[i] = (char)tolower(*lptr);
+ name[i] = '\0';
+ stgwrite("\t");
+ stgwrite(name);
+ stgwrite(" ");
+ code_idx += opcodes(1);
+ /* write parameter (if any) */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ if (*lptr != '\0')
+ {
+ symbol *sym;
+
+ tok = lex(&val, &str);
+ switch (tok)
+ {
+ case tNUMBER:
+ case tRATIONAL:
+ outval(val, FALSE);
+ code_idx += opargs(1);
+ break;
+ case tSYMBOL:
+ sym = findloc(str);
+ if (!sym)
+ sym = findglb(str);
+ if (!sym || (sym->ident != iFUNCTN
+ && sym->ident != iREFFUNC
+ && (sym->usage & uDEFINE) == 0))
+ {
+ error(17, str); /* undefined symbol */
+ }
+ else
+ {
+ outval(sym->addr, FALSE);
+ /* mark symbol as "used", unknown whether for read or write */
+ markusage(sym, uREAD | uWRITTEN);
+ code_idx += opargs(1);
+ } /* if */
+ break;
+ default:
+ {
+ char s2[20];
+ extern char *sc_tokens[]; /* forward declaration */
+
+ if (tok < 256)
+ sprintf(s2, "%c", (char)tok);
+ else
+ strcpy(s2, sc_tokens[tok - tFIRST]);
+ error(1, sc_tokens[tSYMBOL - tFIRST], s2);
+ break;
+ } /* case */
+ } /* switch */
+ } /* if */
+ stgwrite("\n");
+ check_empty(lptr);
+ break;
+ } /* case */
+#endif
+#if !defined NO_DEFINE
+ case tpDEFINE:
+ {
+ ret = CMD_DEFINE;
+ if (skiplevel == 0)
+ {
+ char *pattern, *substitution;
+ char *start, *end;
+ int count, prefixlen;
+ stringpair *def;
+
+ /* find the pattern to match */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ start = lptr; /* save starting point of the match pattern */
+ count = 0;
+ while (*lptr > ' ' && *lptr != '\0')
+ {
+ litchar(&lptr, FALSE); /* litchar() advances "lptr" and handles escape characters */
+ count++;
+ } /* while */
+ end = lptr;
+ /* check pattern to match */
+ if (!sc_isalpha(*start) && *start != '_')
+ {
+ error(74); /* pattern must start with an alphabetic character */
+ break;
+ } /* if */
+ /* store matched pattern */
+ pattern = malloc(count + 1);
+ if (!pattern)
+ error(103); /* insufficient memory */
+ lptr = start;
+ count = 0;
+ while (lptr != end)
+ {
+ assert(lptr < end);
+ assert(*lptr != '\0');
+ pattern[count++] = (char)litchar(&lptr, FALSE);
+ } /* while */
+ pattern[count] = '\0';
+ /* special case, erase trailing variable, because it could match anything */
+ if (count >= 2 && sc_isdigit(pattern[count - 1])
+ && pattern[count - 2] == '%')
+ pattern[count - 2] = '\0';
+ /* find substitution string */
+ while (*lptr <= ' ' && *lptr != '\0')
+ lptr++;
+ start = lptr; /* save starting point of the match pattern */
+ count = 0;
+ end = NULL;
+ while (*lptr != '\0')
+ {
+ /* keep position of the start of trailing whitespace */
+ if (*lptr <= ' ')
+ {
+ if (!end)
+ end = lptr;
+ }
+ else
+ {
+ end = NULL;
+ } /* if */
+ count++;
+ lptr++;
+ } /* while */
+ if (!end)
+ end = lptr;
+ /* store matched substitution */
+ substitution = malloc(count + 1); /* +1 for '\0' */
+ if (!substitution)
+ error(103); /* insufficient memory */
+ lptr = start;
+ count = 0;
+ while (lptr != end)
+ {
+ assert(lptr < end);
+ assert(*lptr != '\0');
+ substitution[count++] = *lptr++;
+ } /* while */
+ substitution[count] = '\0';
+ /* check whether the definition already exists */
+ for (prefixlen = 0, start = pattern;
+ sc_isalpha(*start) || sc_isdigit(*start) || *start == '_';
+ prefixlen++, start++)
+ /* nothing */ ;
+ assert(prefixlen > 0);
+ if ((def = find_subst(pattern, prefixlen)))
+ {
+ if (strcmp(def->first, pattern) != 0
+ || strcmp(def->second, substitution) != 0)
+ error(201, pattern); /* redefinition of macro (non-identical) */
+ delete_subst(pattern, prefixlen);
+ } /* if */
+ /* add the pattern/substitution pair to the list */
+ assert(pattern[0] != '\0');
+ insert_subst(pattern, substitution, prefixlen);
+ free(pattern);
+ free(substitution);
+ } /* if */
+ break;
+ } /* case */
+ case tpUNDEF:
+ if (skiplevel == 0)
+ {
+ if (lex(&val, &str) == tSYMBOL)
+ {
+ if (!delete_subst(str, strlen(str)))
+ error(17, str); /* undefined symbol */
+ }
+ else
+ {
+ error(20, str); /* invalid symbol name */
+ } /* if */
+ check_empty(lptr);
+ } /* if */
+ break;
+#endif
+ default:
+ error(31); /* unknown compiler directive */
+ ret = skiplevel > 0 ? CMD_DIRECTIVE : CMD_NONE; /* line must be processed (if skiplevel==0) */
+ } /* switch */
+ return ret;
+}
+
+#if !defined NO_DEFINE
+static int
+is_startstring(char *string)
+{
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* "..." */
+
+ if (*string == '!')
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* !"..." */
+ if (*string == sc_ctrlchar)
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* !\"..." */
+ } /* if */
+ }
+ else if (*string == sc_ctrlchar)
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* \"..." */
+ if (*string == '!')
+ {
+ string++;
+ if (*string == '\"' || *string == '\'')
+ return TRUE; /* \!"..." */
+ } /* if */
+ } /* if */
+
+ return FALSE;
+}
+
+static char *
+skipstring(char *string)
+{
+ char endquote;
+ int rawstring = FALSE;
+
+ while (*string == '!' || *string == sc_ctrlchar)
+ {
+ rawstring = (*string == sc_ctrlchar);
+ string++;
+ } /* while */
+
+ endquote = *string;
+ assert(endquote == '\"' || endquote == '\'');
+ string++; /* skip open quote */
+ while (*string != endquote && *string != '\0')
+ litchar(&string, rawstring);
+ return string;
+}
+
+static char *
+skippgroup(char *string)
+{
+ int nest = 0;
+ char open = *string;
+ char close;
+
+ switch (open)
+ {
+ case '(':
+ close = ')';
+ break;
+ case '{':
+ close = '}';
+ break;
+ case '[':
+ close = ']';
+ break;
+ case '<':
+ close = '>';
+ break;
+ default:
+ assert(0);
+ close = '\0'; /* only to avoid a compiler warning */
+ } /* switch */
+
+ string++;
+ while (*string != close || nest > 0)
+ {
+ if (*string == open)
+ nest++;
+ else if (*string == close)
+ nest--;
+ else if (is_startstring(string))
+ string = skipstring(string);
+ if (*string == '\0')
+ break;
+ string++;
+ } /* while */
+ return string;
+}
+
+static char *
+strdel(char *str, size_t len)
+{
+ size_t length = strlen(str);
+
+ if (len > length)
+ len = length;
+ memmove(str, str + len, length - len + 1); /* include EOS byte */
+ return str;
+}
+
+static char *
+strins(char *dest, char *src, size_t srclen)
+{
+ size_t destlen = strlen(dest);
+
+ assert(srclen <= strlen(src));
+ memmove(dest + srclen, dest, destlen + 1); /* include EOS byte */
+ memcpy(dest, src, srclen);
+ return dest;
+}
+
+static int
+substpattern(char *line, size_t buffersize, char *pattern, char *substitution)
+{
+ int prefixlen;
+ char *p, *s, *e, *args[10];
+ int match, arg, len;
+
+ memset(args, 0, sizeof args);
+
+ /* check the length of the prefix */
+ for (prefixlen = 0, s = pattern; sc_isalpha(*s) || sc_isdigit(*s) || *s == '_';
+ prefixlen++, s++)
+ /* nothing */ ;
+ assert(prefixlen > 0);
+ assert(strncmp(line, pattern, prefixlen) == 0);
+
+ /* pattern prefix matches; match the rest of the pattern, gather
+ * the parameters
+ */
+ s = line + prefixlen;
+ p = pattern + prefixlen;
+ match = TRUE; /* so far, pattern matches */
+ while (match && *s != '\0' && *p != '\0')
+ {
+ if (*p == '%')
+ {
+ p++; /* skip '%' */
+ if (sc_isdigit(*p))
+ {
+ arg = *p - '0';
+ assert(arg >= 0 && arg <= 9);
+ p++; /* skip parameter id */
+ assert(*p != '\0');
+ /* match the source string up to the character after the digit
+ * (skipping strings in the process
+ */
+ e = s;
+ while (*e != *p && *e != '\0' && *e != '\n')
+ {
+ if (is_startstring(e)) /* skip strings */
+ e = skipstring(e);
+ else if (strchr("({[", *e)) /* skip parenthized groups */
+ e = skippgroup(e);
+ if (*e != '\0')
+ e++; /* skip non-alphapetic character (or closing quote of
+ * a string, or the closing paranthese of a group) */
+ } /* while */
+ /* store the parameter (overrule any earlier) */
+ if (args[arg])
+ free(args[arg]);
+ len = (int)(e - s);
+ args[arg] = malloc(len + 1);
+ if (!args[arg])
+ error(103); /* insufficient memory */
+ strncpy(args[arg], s, len);
+ args[arg][len] = '\0';
+ /* character behind the pattern was matched too */
+ if (*e == *p)
+ {
+ s = e + 1;
+ }
+ else if (*e == '\n' && *p == ';' && *(p + 1) == '\0'
+ && !sc_needsemicolon)
+ {
+ s = e; /* allow a trailing ; in the pattern match to end of line */
+ }
+ else
+ {
+ assert(*e == '\0' || *e == '\n');
+ match = FALSE;
+ s = e;
+ } /* if */
+ p++;
+ }
+ else
+ {
+ match = FALSE;
+ } /* if */
+ }
+ else if (*p == ';' && *(p + 1) == '\0' && !sc_needsemicolon)
+ {
+ /* source may be ';' or end of the line */
+ while (*s <= ' ' && *s != '\0')
+ s++; /* skip white space */
+ if (*s != ';' && *s != '\0')
+ match = FALSE;
+ p++; /* skip the semicolon in the pattern */
+ }
+ else
+ {
+ cell ch;
+
+ /* skip whitespace between two non-alphanumeric characters, except
+ * for two identical symbols
+ */
+ assert(p > pattern);
+ if (!alphanum(*p) && *(p - 1) != *p)
+ while (*s <= ' ' && *s != '\0')
+ s++; /* skip white space */
+ ch = litchar(&p, FALSE); /* this increments "p" */
+ if (*s != ch)
+ match = FALSE;
+ else
+ s++; /* this character matches */
+ } /* if */
+ } /* while */
+
+ if (match && *p == '\0')
+ {
+ /* if the last character to match is an alphanumeric character, the
+ * current character in the source may not be alphanumeric
+ */
+ assert(p > pattern);
+ if (alphanum(*(p - 1)) && alphanum(*s))
+ match = FALSE;
+ } /* if */
+
+ if (match)
+ {
+ /* calculate the length of the substituted string */
+ for (e = substitution, len = 0; *e != '\0'; e++)
+ {
+ if (*e == '%' && sc_isdigit(*(e + 1)))
+ {
+ arg = *(e + 1) - '0';
+ assert(arg >= 0 && arg <= 9);
+ if (args[arg])
+ len += strlen(args[arg]);
+ e++; /* skip %, digit is skipped later */
+ }
+ else
+ {
+ len++;
+ } /* if */
+ } /* for */
+ /* check length of the string after substitution */
+ if (strlen(line) + len - (int)(s - line) > buffersize)
+ {
+ error(75); /* line too long */
+ }
+ else
+ {
+ /* substitute pattern */
+ strdel(line, (int)(s - line));
+ for (e = substitution, s = line; *e != '\0'; e++)
+ {
+ if (*e == '%' && sc_isdigit(*(e + 1)))
+ {
+ arg = *(e + 1) - '0';
+ assert(arg >= 0 && arg <= 9);
+ if (args[arg])
+ {
+ strins(s, args[arg], strlen(args[arg]));
+ s += strlen(args[arg]);
+ } /* if */
+ e++; /* skip %, digit is skipped later */
+ }
+ else
+ {
+ strins(s, e, 1);
+ s++;
+ } /* if */
+ } /* for */
+ } /* if */
+ } /* if */
+
+ for (arg = 0; arg < 10; arg++)
+ if (args[arg])
+ free(args[arg]);
+
+ return match;
+}
+
+static void
+substallpatterns(char *line, int buffersize)
+{
+ char *start, *end;
+ int prefixlen;
+ stringpair *subst;
+
+ start = line;
+ while (*start != '\0')
+ {
+ /* find the start of a prefix (skip all non-alphabetic characters),
+ * also skip strings
+ */
+ while (!sc_isalpha(*start) && *start != '_' && *start != '\0')
+ {
+ /* skip strings */
+ if (is_startstring(start))
+ {
+ start = skipstring(start);
+ if (*start == '\0')
+ break; /* abort loop on error */
+ } /* if */
+ start++; /* skip non-alphapetic character (or closing quote of a string) */
+ } /* while */
+ if (*start == '\0')
+ break; /* abort loop on error */
+ /* get the prefix (length), look for a matching definition */
+ prefixlen = 0;
+ end = start;
+ while (sc_isalpha(*end) || sc_isdigit(*end) || *end == '_')
+ {
+ prefixlen++;
+ end++;
+ } /* while */
+ assert(prefixlen > 0);
+ subst = find_subst(start, prefixlen);
+ if (subst)
+ {
+ /* properly match the pattern and substitute */
+ if (!substpattern
+ (start, buffersize - (start - line), subst->first,
+ subst->second))
+ start = end; /* match failed, skip this prefix */
+ /* match succeeded: do not update "start", because the substitution text
+ * may be matched by other macros
+ */
+ }
+ else
+ {
+ start = end; /* no macro with this prefix, skip this prefix */
+ } /* if */
+ } /* while */
+}
+#endif
+
+/* preprocess
+ *
+ * Reads a line by readline() into "pline" and performs basic preprocessing:
+ * deleting comments, skipping lines with false "#if.." code and recognizing
+ * other compiler directives. There is an indirect recursion: lex() calls
+ * preprocess() if a new line must be read, preprocess() calls command(),
+ * which at his turn calls lex() to identify the token.
+ *
+ * Global references: lptr (altered)
+ * pline (altered)
+ * freading (referred to only)
+ */
+void
+preprocess(void)
+{
+ int iscommand;
+
+ if (!freading)
+ return;
+ do
+ {
+ readline(pline);
+ stripcom(pline); /* ??? no need for this when reading back from list file (in the second pass) */
+ lptr = pline; /* set "line pointer" to start of the parsing buffer */
+ iscommand = command();
+ if (iscommand != CMD_NONE)
+ errorset(sRESET); /* reset error flag ("panic mode") on empty line or directive */
+#if !defined NO_DEFINE
+ if (iscommand == CMD_NONE)
+ {
+ assert(lptr != term_expr);
+ substallpatterns(pline, sLINEMAX);
+ lptr = pline; /* reset "line pointer" to start of the parsing buffer */
+ } /* if */
+#endif
+ }
+ while (iscommand != CMD_NONE && iscommand != CMD_TERM && freading); /* enddo */
+}
+
+static char *
+unpackedstring(char *lptr, int rawstring)
+{
+ while (*lptr != '\0')
+ {
+ /* check for doublequotes indicating the end of the string */
+ if (*lptr == '\"')
+ {
+ /* check whether there's another pair of quotes following.
+ * If so, paste the two strings together, thus
+ * "pants""off" becomes "pantsoff"
+ */
+ if (*(lptr + 1) == '\"')
+ lptr += 2;
+ else
+ break;
+ }
+
+ if (*lptr == '\a')
+ { /* ignore '\a' (which was inserted at a line concatenation) */
+ lptr++;
+ continue;
+ } /* if */
+ stowlit(litchar(&lptr, rawstring)); /* litchar() alters "lptr" */
+ } /* while */
+ stowlit(0); /* terminate string */
+ return lptr;
+}
+
+static char *
+packedstring(char *lptr, int rawstring)
+{
+ int i;
+ ucell val, c;
+
+ i = sizeof(ucell) - (charbits / 8); /* start at most significant byte */
+ val = 0;
+ while (*lptr != '\0')
+ {
+ /* check for doublequotes indicating the end of the string */
+ if (*lptr == '\"')
+ {
+ /* check whether there's another pair of quotes following.
+ * If so, paste the two strings together, thus
+ * "pants""off" becomes "pantsoff"
+ */
+ if (*(lptr + 1) == '\"')
+ lptr += 2;
+ else
+ break;
+ }
+
+ if (*lptr == '\a')
+ { /* ignore '\a' (which was inserted at a line concatenation) */
+ lptr++;
+ continue;
+ } /* if */
+ c = litchar(&lptr, rawstring); /* litchar() alters "lptr" */
+ if (c >= (ucell) (1 << charbits))
+ error(43); /* character constant exceeds range */
+ val |= (c << 8 * i);
+ if (i == 0)
+ {
+ stowlit(val);
+ val = 0;
+ } /* if */
+ i = (i + sizeof(ucell) - (charbits / 8)) % sizeof(ucell);
+ } /* if */
+ /* save last code; make sure there is at least one terminating zero character */
+ if (i != (int)(sizeof(ucell) - (charbits / 8)))
+ stowlit(val); /* at least one zero character in "val" */
+ else
+ stowlit(0); /* add full cell of zeros */
+ return lptr;
+}
+
+/* lex(lexvalue,lexsym) Lexical Analysis
+ *
+ * lex() first deletes leading white space, then checks for multi-character
+ * operators, keywords (including most compiler directives), numbers,
+ * labels, symbols and literals (literal characters are converted to a number
+ * and are returned as such). If every check fails, the line must contain
+ * a single-character operator. So, lex() returns this character. In the other
+ * case (something did match), lex() returns the number of the token. All
+ * these tokens have been assigned numbers above 255.
+ *
+ * Some tokens have "attributes":
+ * tNUMBER the value of the number is return in "lexvalue".
+ * tRATIONAL the value is in IEEE 754 encoding or in fixed point
+ * encoding in "lexvalue".
+ * tSYMBOL the first sNAMEMAX characters of the symbol are
+ * stored in a buffer, a pointer to this buffer is
+ * returned in "lexsym".
+ * tLABEL the first sNAMEMAX characters of the label are
+ * stored in a buffer, a pointer to this buffer is
+ * returned in "lexsym".
+ * tSTRING the string is stored in the literal pool, the index
+ * in the literal pool to this string is stored in
+ * "lexvalue".
+ *
+ * lex() stores all information (the token found and possibly its attribute)
+ * in global variables. This allows a token to be examined twice. If "_pushed"
+ * is true, this information is returned.
+ *
+ * Global references: lptr (altered)
+ * fline (referred to only)
+ * litidx (referred to only)
+ * _lextok, _lexval, _lexstr
+ * _pushed
+ */
+
+static int _pushed;
+static int _lextok;
+static cell _lexval;
+static char _lexstr[sLINEMAX + 1];
+static int _lexnewline;
+
+void
+lexinit(void)
+{
+ stkidx = 0; /* index for pushstk() and popstk() */
+ iflevel = 0; /* preprocessor: nesting of "#if" */
+ skiplevel = 0; /* preprocessor: skipping lines or compiling lines */
+ icomment = FALSE; /* currently not in a multiline comment */
+ _pushed = FALSE; /* no token pushed back into lex */
+ _lexnewline = FALSE;
+}
+
+char *sc_tokens[] = {
+ "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
+ "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
+ "...", "..",
+ "assert", "break", "case", "char", "const", "continue", "default",
+ "defined", "do", "else", "enum", "exit", "for", "forward", "goto",
+ "if", "native", "new", "operator", "public", "return", "sizeof",
+ "sleep", "static", "stock", "switch", "tagof", "while",
+ "#assert", "#define", "#else", "#emit", "#endif", "#endinput",
+ "#endscript", "#file", "#if", "#include", "#line", "#pragma", "#undef",
+ ";", ";", "-integer value-", "-rational value-", "-identifier-",
+ "-label-", "-string-"
+};
+
+int
+lex(cell * lexvalue, char **lexsym)
+{
+ int i, toolong, newline, rawstring;
+ char **tokptr;
+
+ if (_pushed)
+ {
+ _pushed = FALSE; /* reset "_pushed" flag */
+ *lexvalue = _lexval;
+ *lexsym = _lexstr;
+ return _lextok;
+ } /* if */
+
+ _lextok = 0; /* preset all values */
+ _lexval = 0;
+ _lexstr[0] = '\0';
+ *lexvalue = _lexval;
+ *lexsym = _lexstr;
+ _lexnewline = FALSE;
+ if (!freading)
+ return 0;
+
+ newline = (lptr == pline); /* does lptr point to start of line buffer */
+ while (*lptr <= ' ')
+ { /* delete leading white space */
+ if (*lptr == '\0')
+ {
+ preprocess(); /* preprocess resets "lptr" */
+ if (!freading)
+ return 0;
+ if (lptr == term_expr) /* special sequence to terminate a pending expression */
+ return (_lextok = tENDEXPR);
+ _lexnewline = TRUE; /* set this after preprocess(), because
+ * preprocess() calls lex() recursively */
+ newline = TRUE;
+ }
+ else
+ {
+ lptr += 1;
+ } /* if */
+ } /* while */
+ if (newline)
+ {
+ stmtindent = 0;
+ for (i = 0; i < (int)(lptr - pline); i++)
+ if (pline[i] == '\t' && sc_tabsize > 0)
+ stmtindent +=
+ (int)(sc_tabsize - (stmtindent + sc_tabsize) % sc_tabsize);
+ else
+ stmtindent++;
+ } /* if */
+
+ i = tFIRST;
+ tokptr = sc_tokens;
+ while (i <= tMIDDLE)
+ { /* match multi-character operators */
+ if (match(*tokptr, FALSE))
+ {
+ _lextok = i;
+ return _lextok;
+ } /* if */
+ i += 1;
+ tokptr += 1;
+ } /* while */
+ while (i <= tLAST)
+ { /* match reserved words and compiler directives */
+ if (match(*tokptr, TRUE))
+ {
+ _lextok = i;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ return _lextok;
+ } /* if */
+ i += 1;
+ tokptr += 1;
+ } /* while */
+
+ if ((i = number(&_lexval, lptr)) != 0)
+ { /* number */
+ _lextok = tNUMBER;
+ *lexvalue = _lexval;
+ lptr += i;
+ }
+ else if ((i = ftoi(&_lexval, lptr)) != 0)
+ {
+ _lextok = tRATIONAL;
+ *lexvalue = _lexval;
+ lptr += i;
+ }
+ else if (alpha(*lptr))
+ { /* symbol or label */
+ /* Note: only sNAMEMAX characters are significant. The compiler
+ * generates a warning if a symbol exceeds this length.
+ */
+ _lextok = tSYMBOL;
+ i = 0;
+ toolong = 0;
+ while (alphanum(*lptr))
+ {
+ _lexstr[i] = *lptr;
+ lptr += 1;
+ if (i < sNAMEMAX)
+ i += 1;
+ else
+ toolong = 1;
+ } /* while */
+ _lexstr[i] = '\0';
+ if (toolong)
+ error(200, _lexstr, sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
+ if (_lexstr[0] == PUBLIC_CHAR && _lexstr[1] == '\0')
+ {
+ _lextok = PUBLIC_CHAR; /* '@' all alone is not a symbol, it is an operator */
+ }
+ else if (_lexstr[0] == '_' && _lexstr[1] == '\0')
+ {
+ _lextok = '_'; /* '_' by itself is not a symbol, it is a placeholder */
+ } /* if */
+ if (*lptr == ':' && sc_allowtags && _lextok != PUBLIC_CHAR)
+ {
+ _lextok = tLABEL; /* it wasn't a normal symbol, it was a label/tagname */
+ lptr += 1; /* skip colon */
+ } /* if */
+ }
+ else if (*lptr == '\"' || (*lptr == sc_ctrlchar && *(lptr + 1) == '\"'))
+ { /* unpacked string literal */
+ _lextok = tSTRING;
+ rawstring = (*lptr == sc_ctrlchar);
+ *lexvalue = _lexval = litidx;
+ lptr += 1; /* skip double quote */
+ if (rawstring)
+ lptr += 1; /* skip "escape" character too */
+ lptr =
+ sc_packstr ? packedstring(lptr, rawstring) : unpackedstring(lptr,
+ rawstring);
+ if (*lptr == '\"')
+ lptr += 1; /* skip final quote */
+ else
+ error(37); /* invalid (non-terminated) string */
+ }
+ else if ((*lptr == '!' && *(lptr + 1) == '\"')
+ || (*lptr == '!' && *(lptr + 1) == sc_ctrlchar && *(lptr + 2) == '\"')
+ || (*lptr == sc_ctrlchar && *(lptr + 1) == '!'
+ && *(lptr + 2) == '\"'))
+ { /* packed string literal */
+ _lextok = tSTRING;
+ rawstring = (*lptr == sc_ctrlchar || *(lptr + 1) == sc_ctrlchar);
+ *lexvalue = _lexval = litidx;
+ lptr += 2; /* skip exclamation point and double quote */
+ if (rawstring)
+ lptr += 1; /* skip "escape" character too */
+ lptr =
+ sc_packstr ? unpackedstring(lptr, rawstring) : packedstring(lptr,
+ rawstring);
+ if (*lptr == '\"')
+ lptr += 1; /* skip final quote */
+ else
+ error(37); /* invalid (non-terminated) string */
+ }
+ else if (*lptr == '\'')
+ { /* character literal */
+ lptr += 1; /* skip quote */
+ _lextok = tNUMBER;
+ *lexvalue = _lexval = litchar(&lptr, FALSE);
+ if (*lptr == '\'')
+ lptr += 1; /* skip final quote */
+ else
+ error(27); /* invalid character constant (must be one character) */
+ }
+ else if (*lptr == ';')
+ { /* semicolumn resets "error" flag */
+ _lextok = ';';
+ lptr += 1;
+ errorset(sRESET); /* reset error flag (clear the "panic mode") */
+ }
+ else
+ {
+ _lextok = *lptr; /* if every match fails, return the character */
+ lptr += 1; /* increase the "lptr" pointer */
+ } /* if */
+ return _lextok;
+}
+
+/* lexpush
+ *
+ * Pushes a token back, so the next call to lex() will return the token
+ * last examined, instead of a new token.
+ *
+ * Only one token can be pushed back.
+ *
+ * In fact, lex() already stores the information it finds into global
+ * variables, so all that is to be done is set a flag that informs lex()
+ * to read and return the information from these variables, rather than
+ * to read in a new token from the input file.
+ */
+void
+lexpush(void)
+{
+ assert(_pushed == FALSE);
+ _pushed = TRUE;
+}
+
+/* lexclr
+ *
+ * Sets the variable "_pushed" to 0 to make sure lex() will read in a new
+ * symbol (a not continue with some old one). This is required upon return
+ * from Assembler mode.
+ */
+void
+lexclr(int clreol)
+{
+ _pushed = FALSE;
+ if (clreol)
+ {
+ lptr = strchr(pline, '\0');
+ assert(lptr != NULL);
+ } /* if */
+}
+
+/* matchtoken
+ *
+ * This routine is useful if only a simple check is needed. If the token
+ * differs from the one expected, it is pushed back.
+ */
+int
+matchtoken(int token)
+{
+ cell val;
+ char *str;
+ int tok;
+
+ tok = lex(&val, &str);
+ if (tok == token || (token == tTERM && (tok == ';' || tok == tENDEXPR)))
+ {
+ return 1;
+ }
+ else if (!sc_needsemicolon && token == tTERM && (_lexnewline || !freading))
+ {
+ lexpush(); /* push "tok" back, we use the "hidden" newline token */
+ return 1;
+ }
+ else
+ {
+ lexpush();
+ return 0;
+ } /* if */
+}
+
+/* tokeninfo
+ *
+ * Returns additional information of a token after using "matchtoken()"
+ * or needtoken(). It does no harm using this routine after a call to
+ * "lex()", but lex() already returns the same information.
+ *
+ * The token itself is the return value. Normally, this one is already known.
+ */
+int
+tokeninfo(cell * val, char **str)
+{
+ /* if the token was pushed back, tokeninfo() returns the token and
+ * parameters of the *next* token, not of the *current* token.
+ */
+ assert(!_pushed);
+ *val = _lexval;
+ *str = _lexstr;
+ return _lextok;
+}
+
+/* needtoken
+ *
+ * This routine checks for a required token and gives an error message if
+ * it isn't there (and returns FALSE in that case).
+ *
+ * Global references: _lextok;
+ */
+int
+needtoken(int token)
+{
+ char s1[20], s2[20];
+
+ if (matchtoken(token))
+ {
+ return TRUE;
+ }
+ else
+ {
+ /* token already pushed back */
+ assert(_pushed);
+ if (token < 256)
+ sprintf(s1, "%c", (char)token); /* single character token */
+ else
+ strcpy(s1, sc_tokens[token - tFIRST]); /* multi-character symbol */
+ if (!freading)
+ strcpy(s2, "-end of file-");
+ else if (_lextok < 256)
+ sprintf(s2, "%c", (char)_lextok);
+ else
+ strcpy(s2, sc_tokens[_lextok - tFIRST]);
+ error(1, s1, s2); /* expected ..., but found ... */
+ return FALSE;
+ } /* if */
+}
+
+/* match
+ *
+ * Compares a series of characters from the input file with the characters
+ * in "st" (that contains a token). If the token on the input file matches
+ * "st", the input file pointer "lptr" is adjusted to point to the next
+ * token, otherwise "lptr" remains unaltered.
+ *
+ * If the parameter "end: is true, match() requires that the first character
+ * behind the recognized token is non-alphanumeric.
+ *
+ * Global references: lptr (altered)
+ */
+static int
+match(char *st, int end)
+{
+ int k;
+ char *ptr;
+
+ k = 0;
+ ptr = lptr;
+ while (st[k])
+ {
+ if (st[k] != *ptr)
+ return 0;
+ k += 1;
+ ptr += 1;
+ } /* while */
+ if (end)
+ { /* symbol must terminate with non-alphanumeric char */
+ if (alphanum(*ptr))
+ return 0;
+ } /* if */
+ lptr = ptr; /* match found, skip symbol */
+ return 1;
+}
+
+/* stowlit
+ *
+ * Stores a value into the literal queue. The literal queue is used for
+ * literal strings used in functions and for initializing array variables.
+ *
+ * Global references: litidx (altered)
+ * litq (altered)
+ */
+void
+stowlit(cell value)
+{
+ if (litidx >= litmax)
+ {
+ cell *p;
+
+ litmax += sDEF_LITMAX;
+ p = (cell *) realloc(litq, litmax * sizeof(cell));
+ if (!p)
+ error(102, "literal table"); /* literal table overflow (fatal error) */
+ litq = p;
+ } /* if */
+ assert(litidx < litmax);
+ litq[litidx++] = value;
+}
+
+/* litchar
+ *
+ * Return current literal character and increase the pointer to point
+ * just behind this literal character.
+ *
+ * Note: standard "escape sequences" are suported, but the backslash may be
+ * replaced by another character; the syntax '\ddd' is supported,
+ * but ddd must be decimal!
+ */
+static cell
+litchar(char **lptr, int rawmode)
+{
+ cell c = 0;
+ unsigned char *cptr;
+
+ cptr = (unsigned char *)*lptr;
+ if (rawmode || *cptr != sc_ctrlchar)
+ { /* no escape character */
+ c = *cptr;
+ cptr += 1;
+ }
+ else
+ {
+ cptr += 1;
+ if (*cptr == sc_ctrlchar)
+ {
+ c = *cptr; /* \\ == \ (the escape character itself) */
+ cptr += 1;
+ }
+ else
+ {
+ switch (*cptr)
+ {
+ case 'a': /* \a == audible alarm */
+ c = 7;
+ cptr += 1;
+ break;
+ case 'b': /* \b == backspace */
+ c = 8;
+ cptr += 1;
+ break;
+ case 'e': /* \e == escape */
+ c = 27;
+ cptr += 1;
+ break;
+ case 'f': /* \f == form feed */
+ c = 12;
+ cptr += 1;
+ break;
+ case 'n': /* \n == NewLine character */
+ c = 10;
+ cptr += 1;
+ break;
+ case 'r': /* \r == carriage return */
+ c = 13;
+ cptr += 1;
+ break;
+ case 't': /* \t == horizontal TAB */
+ c = 9;
+ cptr += 1;
+ break;
+ case 'v': /* \v == vertical TAB */
+ c = 11;
+ cptr += 1;
+ break;
+ case '\'': /* \' == ' (single quote) */
+ case '"': /* \" == " (single quote) */
+ case '%': /* \% == % (percent) */
+ c = *cptr;
+ cptr += 1;
+ break;
+ default:
+ if (sc_isdigit(*cptr))
+ { /* \ddd */
+ c = 0;
+ while (*cptr >= '0' && *cptr <= '9') /* decimal! */
+ c = c * 10 + *cptr++ - '0';
+ if (*cptr == ';')
+ cptr++; /* swallow a trailing ';' */
+ }
+ else
+ {
+ error(27); /* invalid character constant */
+ } /* if */
+ } /* switch */
+ } /* if */
+ } /* if */
+ *lptr = (char *)cptr;
+ assert(c >= 0 && c < 256);
+ return c;
+}
+
+/* alpha
+ *
+ * Test if character "c" is alphabetic ("a".."z"), an underscore ("_")
+ * or an "at" sign ("@"). The "@" is an extension to standard C.
+ */
+static int
+alpha(char c)
+{
+ return (sc_isalpha(c) || c == '_' || c == PUBLIC_CHAR);
+}
+
+/* alphanum
+ *
+ * Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")
+ */
+int
+alphanum(char c)
+{
+ return (alpha(c) || sc_isdigit(c));
+}
+
+/* The local variable table must be searched backwards, so that the deepest
+ * nesting of local variables is searched first. The simplest way to do
+ * this is to insert all new items at the head of the list.
+ * In the global list, the symbols are kept in sorted order, so that the
+ * public functions are written in sorted order.
+ */
+static symbol *
+add_symbol(symbol * root, symbol * entry, int sort)
+{
+ symbol *newsym;
+
+ if (sort)
+ while (root->next && strcmp(entry->name, root->next->name) > 0)
+ root = root->next;
+
+ if (!(newsym = (symbol *)malloc(sizeof(symbol))))
+ {
+ error(103);
+ return NULL;
+ } /* if */
+ memcpy(newsym, entry, sizeof(symbol));
+ newsym->next = root->next;
+ root->next = newsym;
+ return newsym;
+}
+
+static void
+free_symbol(symbol * sym)
+{
+ arginfo *arg;
+
+ /* free all sub-symbol allocated memory blocks, depending on the
+ * kind of the symbol
+ */
+ assert(sym != NULL);
+ if (sym->ident == iFUNCTN)
+ {
+ /* run through the argument list; "default array" arguments
+ * must be freed explicitly; the tag list must also be freed */
+ assert(sym->dim.arglist != NULL);
+ for (arg = sym->dim.arglist; arg->ident != 0; arg++)
+ {
+ if (arg->ident == iREFARRAY && arg->hasdefault)
+ free(arg->defvalue.array.data);
+ else if (arg->ident == iVARIABLE
+ && ((arg->hasdefault & uSIZEOF) != 0
+ || (arg->hasdefault & uTAGOF) != 0))
+ free(arg->defvalue.size.symname);
+ assert(arg->tags != NULL);
+ free(arg->tags);
+ } /* for */
+ free(sym->dim.arglist);
+ } /* if */
+ assert(sym->refer != NULL);
+ free(sym->refer);
+ free(sym);
+}
+
+void
+delete_symbol(symbol * root, symbol * sym)
+{
+ /* find the symbol and its predecessor
+ * (this function assumes that you will never delete a symbol that is not
+ * in the table pointed at by "root")
+ */
+ assert(root != sym);
+ while (root->next != sym)
+ {
+ root = root->next;
+ assert(root != NULL);
+ } /* while */
+
+ /* unlink it, then free it */
+ root->next = sym->next;
+ free_symbol(sym);
+}
+
+void
+delete_symbols(symbol * root, int level, int delete_labels,
+ int delete_functions)
+{
+ symbol *sym;
+
+ /* erase only the symbols with a deeper nesting level than the
+ * specified nesting level */
+ while (root->next)
+ {
+ sym = root->next;
+ if (sym->compound < level)
+ break;
+ if ((delete_labels || sym->ident != iLABEL)
+ && (delete_functions || sym->ident != iFUNCTN
+ || (sym->usage & uNATIVE) != 0) && (delete_functions
+ || sym->ident != iCONSTEXPR
+ || (sym->usage & uPREDEF) ==
+ 0) && (delete_functions
+ || (sym->ident !=
+ iVARIABLE
+ && sym->ident !=
+ iARRAY)))
+ {
+ root->next = sym->next;
+ free_symbol(sym);
+ }
+ else
+ {
+ /* if the function was prototyped, but not implemented in this source,
+ * mark it as such, so that its use can be flagged
+ */
+ if (sym->ident == iFUNCTN && (sym->usage & uDEFINE) == 0)
+ sym->usage |= uMISSING;
+ if (sym->ident == iFUNCTN || sym->ident == iVARIABLE
+ || sym->ident == iARRAY)
+ sym->usage &= ~uDEFINE; /* clear "defined" flag */
+ /* for user defined operators, also remove the "prototyped" flag, as
+ * user-defined operators *must* be declared before use
+ */
+ if (sym->ident == iFUNCTN && !sc_isalpha(*sym->name)
+ && *sym->name != '_' && *sym->name != PUBLIC_CHAR)
+ sym->usage &= ~uPROTOTYPED;
+ root = sym; /* skip the symbol */
+ } /* if */
+ } /* if */
+}
+
+/* The purpose of the hash is to reduce the frequency of a "name"
+ * comparison (which is costly). There is little interest in avoiding
+ * clusters in similar names, which is why this function is plain simple.
+ */
+unsigned int
+namehash(char *name)
+{
+ unsigned char *ptr = (unsigned char *)name;
+ int len = strlen(name);
+
+ if (len == 0)
+ return 0L;
+ assert(len < 256);
+ return (len << 24Lu) + (ptr[0] << 16Lu) + (ptr[len - 1] << 8Lu) +
+ (ptr[len >> 1Lu]);
+}
+
+static symbol *
+find_symbol(symbol * root, char *name, int fnumber)
+{
+ symbol *ptr = root->next;
+ unsigned long hash = namehash(name);
+
+ while (ptr)
+ {
+ if (hash == ptr->hash && strcmp(name, ptr->name) == 0
+ && !ptr->parent && (ptr->fnumber < 0
+ || ptr->fnumber == fnumber))
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+static symbol *
+find_symbol_child(symbol * root, symbol * sym)
+{
+ symbol *ptr = root->next;
+
+ while (ptr)
+ {
+ if (ptr->parent == sym)
+ return ptr;
+ ptr = ptr->next;
+ } /* while */
+ return NULL;
+}
+
+/* Adds "bywhom" to the list of referrers of "entry". Typically,
+ * bywhom will be the function that uses a variable or that calls
+ * the function.
+ */
+int
+refer_symbol(symbol * entry, symbol * bywhom)
+{
+ int count;
+
+ assert(bywhom != NULL); /* it makes no sense to add a "void" referrer */
+ assert(entry != NULL);
+ assert(entry->refer != NULL);
+
+ /* see if it is already there */
+ for (count = 0; count < entry->numrefers && entry->refer[count] != bywhom;
+ count++)
+ /* nothing */ ;
+ if (count < entry->numrefers)
+ {
+ assert(entry->refer[count] == bywhom);
+ return TRUE;
+ } /* if */
+
+ /* see if there is an empty spot in the referrer list */
+ for (count = 0; count < entry->numrefers && entry->refer[count];
+ count++)
+ /* nothing */ ;
+ assert(count <= entry->numrefers);
+ if (count == entry->numrefers)
+ {
+ symbol **refer;
+ int newsize = 2 * entry->numrefers;
+
+ assert(newsize > 0);
+ /* grow the referrer list */
+ refer = (symbol **) realloc(entry->refer, newsize * sizeof(symbol *));
+ if (!refer)
+ return FALSE; /* insufficient memory */
+ /* initialize the new entries */
+ entry->refer = refer;
+ for (count = entry->numrefers; count < newsize; count++)
+ entry->refer[count] = NULL;
+ count = entry->numrefers; /* first empty spot */
+ entry->numrefers = newsize;
+ } /* if */
+
+ /* add the referrer */
+ assert(entry->refer[count] == NULL);
+ entry->refer[count] = bywhom;
+ return TRUE;
+}
+
+void
+markusage(symbol * sym, int usage)
+{
+ sym->usage |= (char)usage;
+ /* check if (global) reference must be added to the symbol */
+ if ((usage & (uREAD | uWRITTEN)) != 0)
+ {
+ /* only do this for global symbols */
+ if (sym->vclass == sGLOBAL)
+ {
+ /* "curfunc" should always be valid, since statements may not occurs
+ * outside functions; in the case of syntax errors, however, the
+ * compiler may arrive through this function
+ */
+ if (curfunc)
+ refer_symbol(sym, curfunc);
+ } /* if */
+ } /* if */
+}
+
+/* findglb
+ *
+ * Returns a pointer to the global symbol (if found) or NULL (if not found)
+ */
+symbol *
+findglb(char *name)
+{
+ return find_symbol(&glbtab, name, fcurrent);
+}
+
+/* findloc
+ *
+ * Returns a pointer to the local symbol (if found) or NULL (if not found).
+ * See add_symbol() how the deepest nesting level is searched first.
+ */
+symbol *
+findloc(char *name)
+{
+ return find_symbol(&loctab, name, -1);
+}
+
+symbol *
+findconst(char *name)
+{
+ symbol *sym;
+
+ sym = find_symbol(&loctab, name, -1); /* try local symbols first */
+ if (!sym || sym->ident != iCONSTEXPR) /* not found, or not a constant */
+ sym = find_symbol(&glbtab, name, fcurrent);
+ if (!sym || sym->ident != iCONSTEXPR)
+ return NULL;
+ assert(sym->parent == NULL); /* constants have no hierarchy */
+ return sym;
+}
+
+symbol *
+finddepend(symbol * parent)
+{
+ symbol *sym;
+
+ sym = find_symbol_child(&loctab, parent); /* try local symbols first */
+ if (!sym) /* not found */
+ sym = find_symbol_child(&glbtab, parent);
+ return sym;
+}
+
+/* addsym
+ *
+ * Adds a symbol to the symbol table (either global or local variables,
+ * or global and local constants).
+ */
+symbol *
+addsym(char *name, cell addr, int ident, int vclass, int tag, int usage)
+{
+ symbol entry, **refer;
+
+ /* global variables/constants/functions may only be defined once */
+ assert(!(ident == iFUNCTN || ident == iCONSTEXPR) || vclass != sGLOBAL
+ || findglb(name) == NULL);
+ /* labels may only be defined once */
+ assert(ident != iLABEL || findloc(name) == NULL);
+
+ /* create an empty referrer list */
+ if (!(refer = (symbol **)malloc(sizeof(symbol *))))
+ {
+ error(103); /* insufficient memory */
+ return NULL;
+ } /* if */
+ *refer = NULL;
+
+ /* first fill in the entry */
+ strcpy(entry.name, name);
+ entry.hash = namehash(name);
+ entry.addr = addr;
+ entry.vclass = (char)vclass;
+ entry.ident = (char)ident;
+ entry.tag = tag;
+ entry.usage = (char)usage;
+ entry.compound = 0; /* may be overridden later */
+ entry.fnumber = -1; /* assume global visibility (ignored for local symbols) */
+ entry.numrefers = 1;
+ entry.refer = refer;
+ entry.parent = NULL;
+
+ /* then insert it in the list */
+ if (vclass == sGLOBAL)
+ return add_symbol(&glbtab, &entry, TRUE);
+ else
+ return add_symbol(&loctab, &entry, FALSE);
+}
+
+symbol *
+addvariable(char *name, cell addr, int ident, int vclass, int tag,
+ int dim[], int numdim, int idxtag[])
+{
+ symbol *sym, *parent, *top;
+ int level;
+
+ /* global variables may only be defined once */
+ assert(vclass != sGLOBAL || (sym = findglb(name)) == NULL
+ || (sym->usage & uDEFINE) == 0);
+
+ if (ident == iARRAY || ident == iREFARRAY)
+ {
+ parent = NULL;
+ sym = NULL; /* to avoid a compiler warning */
+ for (level = 0; level < numdim; level++)
+ {
+ top = addsym(name, addr, ident, vclass, tag, uDEFINE);
+ top->dim.array.length = dim[level];
+ top->dim.array.level = (short)(numdim - level - 1);
+ top->x.idxtag = idxtag[level];
+ top->parent = parent;
+ parent = top;
+ if (level == 0)
+ sym = top;
+ } /* for */
+ }
+ else
+ {
+ sym = addsym(name, addr, ident, vclass, tag, uDEFINE);
+ } /* if */
+ return sym;
+}
+
+/* getlabel
+ *
+ * Return next available internal label number.
+ */
+int
+getlabel(void)
+{
+ return labnum++;
+}
+
+/* itoh
+ *
+ * Converts a number to a hexadecimal string and returns a pointer to that
+ * string.
+ */
+char *
+itoh(ucell val)
+{
+ static char itohstr[15]; /* hex number is 10 characters long at most */
+ char *ptr;
+ int i, nibble[8]; /* a 32-bit hexadecimal cell has 8 nibbles */
+ int max;
+
+#if defined(BIT16)
+ max = 4;
+#else
+ max = 8;
+#endif
+ ptr = itohstr;
+ for (i = 0; i < max; i += 1)
+ {
+ nibble[i] = (int)(val & 0x0f); /* nibble 0 is lowest nibble */
+ val >>= 4;
+ } /* endfor */
+ i = max - 1;
+ while (nibble[i] == 0 && i > 0) /* search for highest non-zero nibble */
+ i -= 1;
+ while (i >= 0)
+ {
+ if (nibble[i] >= 10)
+ *ptr++ = (char)('a' + (nibble[i] - 10));
+ else
+ *ptr++ = (char)('0' + nibble[i]);
+ i -= 1;
+ } /* while */
+ *ptr = '\0'; /* and a zero-terminator */
+ return itohstr;
+}
--- /dev/null
+/* Small compiler - Recursive descend expresion parser
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <limits.h> /* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+static int skim(int *opstr, void (*testfunc) (int), int dropval,
+ int endval, int (*hier) (value *), value * lval);
+static void dropout(int lvalue, void (*testfunc) (int val), int exit1,
+ value * lval);
+static int plnge(int *opstr, int opoff, int (*hier) (value * lval),
+ value * lval, char *forcetag, int chkbitwise);
+static int plnge1(int (*hier) (value * lval), value * lval);
+static void plnge2(void (*oper) (void),
+ int (*hier) (value * lval),
+ value * lval1, value * lval2);
+static cell calc(cell left, void (*oper) (), cell right,
+ char *boolresult);
+static int hier13(value * lval);
+static int hier12(value * lval);
+static int hier11(value * lval);
+static int hier10(value * lval);
+static int hier9(value * lval);
+static int hier8(value * lval);
+static int hier7(value * lval);
+static int hier6(value * lval);
+static int hier5(value * lval);
+static int hier4(value * lval);
+static int hier3(value * lval);
+static int hier2(value * lval);
+static int hier1(value * lval1);
+static int primary(value * lval);
+static void clear_value(value * lval);
+static void callfunction(symbol * sym);
+static int dbltest(void (*oper) (), value * lval1, value * lval2);
+static int commutative(void (*oper) ());
+static int constant(value * lval);
+
+static char lastsymbol[sNAMEMAX + 1]; /* name of last function/variable */
+static int bitwise_opercount; /* count of bitwise operators in an expression */
+
+/* Function addresses of binary operators for signed operations */
+static void (*op1[17]) (void) =
+{
+ os_mult, os_div, os_mod, /* hier3, index 0 */
+ ob_add, ob_sub, /* hier4, index 3 */
+ ob_sal, os_sar, ou_sar, /* hier5, index 5 */
+ ob_and, /* hier6, index 8 */
+ ob_xor, /* hier7, index 9 */
+ ob_or, /* hier8, index 10 */
+ os_le, os_ge, os_lt, os_gt, /* hier9, index 11 */
+ ob_eq, ob_ne, /* hier10, index 15 */
+};
+/* These two functions are defined because the functions inc() and dec() in
+ * SC4.C have a different prototype than the other code generation functions.
+ * The arrays for user-defined functions use the function pointers for
+ * identifying what kind of operation is requested; these functions must all
+ * have the same prototype. As inc() and dec() are special cases already, it
+ * is simplest to add two "do-nothing" functions.
+ */
+static void
+user_inc(void)
+{
+}
+static void
+user_dec(void)
+{
+}
+
+/*
+ * Searches for a binary operator a list of operators. The list is stored in
+ * the array "list". The last entry in the list should be set to 0.
+ *
+ * The index of an operator in "list" (if found) is returned in "opidx". If
+ * no operator is found, nextop() returns 0.
+ */
+static int
+nextop(int *opidx, int *list)
+{
+ *opidx = 0;
+ while (*list)
+ {
+ if (matchtoken(*list))
+ {
+ return TRUE; /* found! */
+ }
+ else
+ {
+ list += 1;
+ *opidx += 1;
+ } /* if */
+ } /* while */
+ return FALSE; /* entire list scanned, nothing found */
+}
+
+int
+check_userop(void (*oper) (void), int tag1, int tag2, int numparam,
+ value * lval, int *resulttag)
+{
+ static char *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "",
+ "", "", "", "<=", ">=", "<", ">", "==", "!="
+ };
+ static int binoper_savepri[] =
+ { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+ FALSE, FALSE, FALSE, FALSE, FALSE,
+ TRUE, TRUE, TRUE, TRUE, FALSE, FALSE
+ };
+ static char *unoperstr[] = { "!", "-", "++", "--" };
+ static void (*unopers[]) (void) =
+ {
+ lneg, neg, user_inc, user_dec};
+ char opername[4] = "", symbolname[sNAMEMAX + 1];
+ int i, swapparams, savepri, savealt;
+ int paramspassed;
+ symbol *sym;
+
+ /* since user-defined operators on untagged operands are forbidden, we have
+ * a quick exit.
+ */
+ assert(numparam == 1 || numparam == 2);
+ if (tag1 == 0 && (numparam == 1 || tag2 == 0))
+ return FALSE;
+
+ savepri = savealt = FALSE;
+ /* find the name with the operator */
+ if (numparam == 2)
+ {
+ if (!oper)
+ {
+ /* assignment operator: a special case */
+ strcpy(opername, "=");
+ if (lval
+ && (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR))
+ savealt = TRUE;
+ }
+ else
+ {
+ assert((sizeof binoperstr / sizeof binoperstr[0]) ==
+ (sizeof op1 / sizeof op1[0]));
+ for (i = 0; i < (int)(sizeof op1 / sizeof op1[0]); i++)
+ {
+ if (oper == op1[i])
+ {
+ strcpy(opername, binoperstr[i]);
+ savepri = binoper_savepri[i];
+ break;
+ } /* if */
+ } /* for */
+ } /* if */
+ }
+ else
+ {
+ assert(oper != NULL);
+ assert(numparam == 1);
+ /* try a select group of unary operators */
+ assert((sizeof unoperstr / sizeof unoperstr[0]) ==
+ (sizeof unopers / sizeof unopers[0]));
+ if (opername[0] == '\0')
+ {
+ for (i = 0; i < (int)(sizeof unopers / sizeof unopers[0]); i++)
+ {
+ if (oper == unopers[i])
+ {
+ strcpy(opername, unoperstr[i]);
+ break;
+ } /* if */
+ } /* for */
+ } /* if */
+ } /* if */
+ /* if not found, quit */
+ if (opername[0] == '\0')
+ return FALSE;
+
+ /* create a symbol name from the tags and the operator name */
+ assert(numparam == 1 || numparam == 2);
+ operator_symname(symbolname, opername, tag1, tag2, numparam, tag2);
+ swapparams = FALSE;
+ sym = findglb(symbolname);
+ if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+ { /* ??? should not check uDEFINE; first pass clears these bits */
+ /* check for commutative operators */
+ if (tag1 == tag2 || !oper || !commutative(oper))
+ return FALSE; /* not commutative, cannot swap operands */
+ /* if arrived here, the operator is commutative and the tags are different,
+ * swap tags and try again
+ */
+ assert(numparam == 2); /* commutative operator must be a binary operator */
+ operator_symname(symbolname, opername, tag2, tag1, numparam, tag1);
+ swapparams = TRUE;
+ sym = findglb(symbolname);
+ if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+ return FALSE;
+ } /* if */
+
+ /* check existence and the proper declaration of this function */
+ if ((sym->usage & uMISSING) != 0 || (sym->usage & uPROTOTYPED) == 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ if ((sym->usage & uMISSING) != 0)
+ error(4, symname); /* function not defined */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ error(71, symname); /* operator must be declared before use */
+ } /* if */
+
+ /* we don't want to use the redefined operator in the function that
+ * redefines the operator itself, otherwise the snippet below gives
+ * an unexpected recursion:
+ * fixed:operator+(fixed:a, fixed:b)
+ * return a + b
+ */
+ if (sym == curfunc)
+ return FALSE;
+
+ /* for increment and decrement operators, the symbol must first be loaded
+ * (and stored back afterwards)
+ */
+ if (oper == user_inc || oper == user_dec)
+ {
+ assert(!savepri);
+ assert(lval != NULL);
+ if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+ push1(); /* save current address in PRI */
+ rvalue(lval); /* get the symbol's value in PRI */
+ } /* if */
+
+ assert(!savepri || !savealt); /* either one MAY be set, but not both */
+ if (savepri)
+ {
+ /* the chained comparison operators require that the ALT register is
+ * unmodified, so we save it here; actually, we save PRI because the normal
+ * instruction sequence (without user operator) swaps PRI and ALT
+ */
+ push1(); /* right-hand operand is in PRI */
+ }
+ else if (savealt)
+ {
+ /* for the assignment operator, ALT may contain an address at which the
+ * result must be stored; this address must be preserved across the
+ * call
+ */
+ assert(lval != NULL); /* this was checked earlier */
+ assert(lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR); /* checked earlier */
+ push2();
+ } /* if */
+
+ /* push parameters, call the function */
+ paramspassed = (!oper) ? 1 : numparam;
+ switch (paramspassed)
+ {
+ case 1:
+ push1();
+ break;
+ case 2:
+ /* note that 1) a function expects that the parameters are pushed
+ * in reversed order, and 2) the left operand is in the secondary register
+ * and the right operand is in the primary register */
+ if (swapparams)
+ {
+ push2();
+ push1();
+ }
+ else
+ {
+ push1();
+ push2();
+ } /* if */
+ break;
+ default:
+ assert(0);
+ } /* switch */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ pushval((cell) paramspassed * sizeof(cell));
+ assert(sym->ident == iFUNCTN);
+ ffcall(sym, paramspassed);
+ if (sc_status != statSKIP)
+ markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
+ if (sym->x.lib)
+ sym->x.lib->value += 1; /* increment "usage count" of the library */
+ sideeffect = TRUE; /* assume functions carry out a side-effect */
+ assert(resulttag != NULL);
+ *resulttag = sym->tag; /* save tag of the called function */
+
+ if (savepri || savealt)
+ pop2(); /* restore the saved PRI/ALT that into ALT */
+ if (oper == user_inc || oper == user_dec)
+ {
+ assert(lval != NULL);
+ if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+ pop2(); /* restore address (in ALT) */
+ store(lval); /* store PRI in the symbol */
+ moveto1(); /* make sure PRI is restored on exit */
+ } /* if */
+ return TRUE;
+}
+
+int
+matchtag(int formaltag, int actualtag, int allowcoerce)
+{
+ if (formaltag != actualtag)
+ {
+ /* if the formal tag is zero and the actual tag is not "fixed", the actual
+ * tag is "coerced" to zero
+ */
+ if (!allowcoerce || formaltag != 0 || (actualtag & FIXEDTAG) != 0)
+ return FALSE;
+ } /* if */
+ return TRUE;
+}
+
+/*
+ * The AMX pseudo-processor has no direct support for logical (boolean)
+ * operations. These have to be done via comparing and jumping. Since we are
+ * already jumping through the code, we might as well implement an "early
+ * drop-out" evaluation (also called "short-circuit"). This conforms to
+ * standard C:
+ *
+ * expr1 || expr2 expr2 will only be evaluated if expr1 is false.
+ * expr1 && expr2 expr2 will only be evaluated if expr1 is true.
+ *
+ * expr1 || expr2 && expr3 expr2 will only be evaluated if expr1 is false
+ * and expr3 will only be evaluated if expr1 is
+ * false and expr2 is true.
+ *
+ * Code generation for the last example proceeds thus:
+ *
+ * evaluate expr1
+ * operator || found
+ * jump to "l1" if result of expr1 not equal to 0
+ * evaluate expr2
+ * -> operator && found; skip to higher level in hierarchy diagram
+ * jump to "l2" if result of expr2 equal to 0
+ * evaluate expr3
+ * jump to "l2" if result of expr3 equal to 0
+ * set expression result to 1 (true)
+ * jump to "l3"
+ * l2: set expression result to 0 (false)
+ * l3:
+ * <- drop back to previous hierarchy level
+ * jump to "l1" if result of expr2 && expr3 not equal to 0
+ * set expression result to 0 (false)
+ * jump to "l4"
+ * l1: set expression result to 1 (true)
+ * l4:
+ *
+ */
+
+/* Skim over terms adjoining || and && operators
+ * dropval The value of the expression after "dropping out". An "or" drops
+ * out when the left hand is TRUE, so dropval must be 1 on "or"
+ * expressions.
+ * endval The value of the expression when no expression drops out. In an
+ * "or" expression, this happens when both the left hand and the
+ * right hand are FALSE, so endval must be 0 for "or" expressions.
+ */
+static int
+skim(int *opstr, void (*testfunc) (int), int dropval, int endval,
+ int (*hier) (value *), value * lval)
+{
+ int lvalue, hits, droplab, endlab, opidx;
+ int allconst;
+ cell constval;
+ int index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ hits = FALSE; /* no logical operators "hit" yet */
+ allconst = TRUE; /* assume all values "const" */
+ constval = 0;
+ droplab = 0; /* to avoid a compiler warning */
+ for (;;)
+ {
+ lvalue = plnge1(hier, lval); /* evaluate left expression */
+
+ allconst = allconst && (lval->ident == iCONSTEXPR);
+ if (allconst)
+ {
+ if (hits)
+ {
+ /* one operator was already found */
+ if (testfunc == jmp_ne0)
+ lval->constval = lval->constval || constval;
+ else
+ lval->constval = lval->constval && constval;
+ } /* if */
+ constval = lval->constval; /* save result accumulated so far */
+ } /* if */
+
+ if (nextop(&opidx, opstr))
+ {
+ if (!hits)
+ {
+ /* this is the first operator in the list */
+ hits = TRUE;
+ droplab = getlabel();
+ } /* if */
+ dropout(lvalue, testfunc, droplab, lval);
+ }
+ else if (hits)
+ { /* no (more) identical operators */
+ dropout(lvalue, testfunc, droplab, lval); /* found at least one operator! */
+ const1(endval);
+ jumplabel(endlab = getlabel());
+ setlabel(droplab);
+ const1(dropval);
+ setlabel(endlab);
+ lval->sym = NULL;
+ lval->tag = 0;
+ if (allconst)
+ {
+ lval->ident = iCONSTEXPR;
+ lval->constval = constval;
+ stgdel(index, cidx); /* scratch generated code and calculate */
+ }
+ else
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ } /* if */
+ return FALSE;
+ }
+ else
+ {
+ return lvalue; /* none of the operators in "opstr" were found */
+ } /* if */
+
+ } /* while */
+}
+
+/*
+ * Reads into the primary register the variable pointed to by lval if
+ * plunging through the hierarchy levels detected an lvalue. Otherwise
+ * if a constant was detected, it is loaded. If there is no constant and
+ * no lvalue, the primary register must already contain the expression
+ * result.
+ *
+ * After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which
+ * compare the primary register against 0, and jump to the "early drop-out"
+ * label "exit1" if the condition is true.
+ */
+static void
+dropout(int lvalue, void (*testfunc) (int val), int exit1, value * lval)
+{
+ if (lvalue)
+ rvalue(lval);
+ else if (lval->ident == iCONSTEXPR)
+ const1(lval->constval);
+ (*testfunc) (exit1);
+}
+
+static void
+checkfunction(value * lval)
+{
+ symbol *sym = lval->sym;
+
+ if (!sym || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+ return; /* no known symbol, or not a function result */
+
+ if ((sym->usage & uDEFINE) != 0)
+ {
+ /* function is defined, can now check the return value (but make an
+ * exception for directly recursive functions)
+ */
+ if (sym != curfunc && (sym->usage & uRETVALUE) == 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ error(209, symname); /* function should return a value */
+ } /* if */
+ }
+ else
+ {
+ /* function not yet defined, set */
+ sym->usage |= uRETVALUE; /* make sure that a future implementation of
+ * the function uses "return <value>" */
+ } /* if */
+}
+
+/*
+ * Plunge to a lower level
+ */
+static int
+plnge(int *opstr, int opoff, int (*hier) (value * lval), value * lval,
+ char *forcetag, int chkbitwise)
+{
+ int lvalue, opidx;
+ int count;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+
+ lvalue = plnge1(hier, lval);
+ if (nextop(&opidx, opstr) == 0)
+ return lvalue; /* no operator in "opstr" found */
+ if (lvalue)
+ rvalue(lval);
+ count = 0;
+ do
+ {
+ if (chkbitwise && count++ > 0 && bitwise_opercount != 0)
+ error(212);
+ opidx += opoff; /* add offset to index returned by nextop() */
+ plnge2(op1[opidx], hier, lval, &lval2);
+ if (op1[opidx] == ob_and || op1[opidx] == ob_or)
+ bitwise_opercount++;
+ if (forcetag)
+ lval->tag = sc_addtag(forcetag);
+ }
+ while (nextop(&opidx, opstr)); /* do */
+ return FALSE; /* result of expression is not an lvalue */
+}
+
+/* plnge_rel
+ *
+ * Binary plunge to lower level; this is very simular to plnge, but
+ * it has special code generation sequences for chained operations.
+ */
+static int
+plnge_rel(int *opstr, int opoff, int (*hier) (value * lval), value * lval)
+{
+ int lvalue, opidx;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ int count;
+
+ /* this function should only be called for relational operators */
+ assert(op1[opoff] == os_le);
+ lvalue = plnge1(hier, lval);
+ if (nextop(&opidx, opstr) == 0)
+ return lvalue; /* no operator in "opstr" found */
+ if (lvalue)
+ rvalue(lval);
+ count = 0;
+ lval->boolresult = TRUE;
+ do
+ {
+ /* same check as in plnge(), but "chkbitwise" is always TRUE */
+ if (count > 0 && bitwise_opercount != 0)
+ error(212);
+ if (count > 0)
+ {
+ relop_prefix();
+ *lval = lval2; /* copy right hand expression of the previous iteration */
+ } /* if */
+ opidx += opoff;
+ plnge2(op1[opidx], hier, lval, &lval2);
+ if (count++ > 0)
+ relop_suffix();
+ }
+ while (nextop(&opidx, opstr)); /* enddo */
+ lval->constval = lval->boolresult;
+ lval->tag = sc_addtag("bool"); /* force tag to be "bool" */
+ return FALSE; /* result of expression is not an lvalue */
+}
+
+/* plnge1
+ *
+ * Unary plunge to lower level
+ * Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()
+ */
+static int
+plnge1(int (*hier) (value * lval), value * lval)
+{
+ int lvalue, index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ lvalue = (*hier) (lval);
+ if (lval->ident == iCONSTEXPR)
+ stgdel(index, cidx); /* load constant later */
+ return lvalue;
+}
+
+/* plnge2
+ *
+ * Binary plunge to lower level
+ * Called by: plnge(), plnge_rel(), hier14() and hier1()
+ */
+static void
+plnge2(void (*oper) (void),
+ int (*hier) (value * lval), value * lval1, value * lval2)
+{
+ int index;
+ cell cidx;
+
+ stgget(&index, &cidx); /* mark position in code generator */
+ if (lval1->ident == iCONSTEXPR)
+ { /* constant on left side; it is not yet loaded */
+ if (plnge1(hier, lval2))
+ rvalue(lval2); /* load lvalue now */
+ else if (lval2->ident == iCONSTEXPR)
+ const1(lval2->constval << dbltest(oper, lval2, lval1));
+ const2(lval1->constval << dbltest(oper, lval2, lval1));
+ /* ^ doubling of constants operating on integer addresses */
+ /* is restricted to "add" and "subtract" operators */
+ }
+ else
+ { /* non-constant on left side */
+ push1();
+ if (plnge1(hier, lval2))
+ rvalue(lval2);
+ if (lval2->ident == iCONSTEXPR)
+ { /* constant on right side */
+ if (commutative(oper))
+ { /* test for commutative operators */
+ value lvaltmp = { NULL, 0, 0, 0, 0, NULL };
+ stgdel(index, cidx); /* scratch push1() and constant fetch (then
+ * fetch the constant again */
+ const2(lval2->constval << dbltest(oper, lval1, lval2));
+ /* now, the primary register has the left operand and the secondary
+ * register the right operand; swap the "lval" variables so that lval1
+ * is associated with the secondary register and lval2 with the
+ * primary register, as is the "normal" case.
+ */
+ lvaltmp = *lval1;
+ *lval1 = *lval2;
+ *lval2 = lvaltmp;
+ }
+ else
+ {
+ const1(lval2->constval << dbltest(oper, lval1, lval2));
+ pop2(); /* pop result of left operand into secondary register */
+ } /* if */
+ }
+ else
+ { /* non-constants on both sides */
+ pop2();
+ if (dbltest(oper, lval1, lval2))
+ cell2addr(); /* double primary register */
+ if (dbltest(oper, lval2, lval1))
+ cell2addr_alt(); /* double secondary register */
+ } /* if */
+ } /* if */
+ if (oper)
+ {
+ /* If used in an expression, a function should return a value.
+ * If the function has been defined, we can check this. If the
+ * function was not defined, we can set this requirement (so that
+ * a future function definition can check this bit.
+ */
+ checkfunction(lval1);
+ checkfunction(lval2);
+ if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval1->sym) ? lval1->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ }
+ else if (lval2->ident == iARRAY || lval2->ident == iREFARRAY)
+ {
+ char *ptr =
+ (lval2->sym) ? lval2->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ /* ??? ^^^ should do same kind of error checking with functions */
+
+ /* check whether an "operator" function is defined for the tag names
+ * (a constant expression cannot be optimized in that case)
+ */
+ if (check_userop(oper, lval1->tag, lval2->tag, 2, NULL, &lval1->tag))
+ {
+ lval1->ident = iEXPRESSION;
+ lval1->constval = 0;
+ }
+ else if (lval1->ident == iCONSTEXPR && lval2->ident == iCONSTEXPR)
+ {
+ /* only constant expression if both constant */
+ stgdel(index, cidx); /* scratch generated code and calculate */
+ if (!matchtag(lval1->tag, lval2->tag, FALSE))
+ error(213); /* tagname mismatch */
+ lval1->constval =
+ calc(lval1->constval, oper, lval2->constval,
+ &lval1->boolresult);
+ }
+ else
+ {
+ if (!matchtag(lval1->tag, lval2->tag, FALSE))
+ error(213); /* tagname mismatch */
+ (*oper) (); /* do the (signed) operation */
+ lval1->ident = iEXPRESSION;
+ } /* if */
+ } /* if */
+}
+
+static cell
+truemodulus(cell a, cell b)
+{
+ return (a % b + b) % b;
+}
+
+static cell
+calc(cell left, void (*oper) (), cell right, char *boolresult)
+{
+ if (oper == ob_or)
+ return (left | right);
+ else if (oper == ob_xor)
+ return (left ^ right);
+ else if (oper == ob_and)
+ return (left & right);
+ else if (oper == ob_eq)
+ return (left == right);
+ else if (oper == ob_ne)
+ return (left != right);
+ else if (oper == os_le)
+ return *boolresult &= (char)(left <= right), right;
+ else if (oper == os_ge)
+ return *boolresult &= (char)(left >= right), right;
+ else if (oper == os_lt)
+ return *boolresult &= (char)(left < right), right;
+ else if (oper == os_gt)
+ return *boolresult &= (char)(left > right), right;
+ else if (oper == os_sar)
+ return (left >> (int)right);
+ else if (oper == ou_sar)
+ return ((ucell) left >> (ucell) right);
+ else if (oper == ob_sal)
+ return ((ucell) left << (int)right);
+ else if (oper == ob_add)
+ return (left + right);
+ else if (oper == ob_sub)
+ return (left - right);
+ else if (oper == os_mult)
+ return (left * right);
+ else if (oper == os_div)
+ return (left - truemodulus(left, right)) / right;
+ else if (oper == os_mod)
+ return truemodulus(left, right);
+ else
+ error(29); /* invalid expression, assumed 0 (this should never occur) */
+ return 0;
+}
+
+int
+expression(int *constant, cell * val, int *tag, int chkfuncresult)
+{
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+
+ if (hier14(&lval))
+ rvalue(&lval);
+ if (lval.ident == iCONSTEXPR)
+ { /* constant expression */
+ *constant = TRUE;
+ *val = lval.constval;
+ }
+ else
+ {
+ *constant = FALSE;
+ *val = 0;
+ } /* if */
+ if (tag)
+ *tag = lval.tag;
+ if (chkfuncresult)
+ checkfunction(&lval);
+ return lval.ident;
+}
+
+static cell
+array_totalsize(symbol * sym)
+{
+ cell length;
+
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ length = sym->dim.array.length;
+ if (sym->dim.array.level > 0)
+ {
+ cell sublength = array_totalsize(finddepend(sym));
+
+ if (sublength > 0)
+ length = length + length * sublength;
+ else
+ length = 0;
+ } /* if */
+ return length;
+}
+
+static cell
+array_levelsize(symbol * sym, int level)
+{
+ assert(sym != NULL);
+ assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+ assert(level <= sym->dim.array.level);
+ while (level-- > 0)
+ {
+ sym = finddepend(sym);
+ assert(sym != NULL);
+ } /* if */
+ return sym->dim.array.length;
+}
+
+/* hier14
+ *
+ * Lowest hierarchy level (except for the , operator).
+ *
+ * Global references: intest (referred to only)
+ */
+int
+hier14(value * lval1)
+{
+ int lvalue;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ value lval3 = { NULL, 0, 0, 0, 0, NULL };
+ void (*oper) (void);
+ int tok, level, i;
+ cell val;
+ char *st;
+ int bwcount;
+ cell arrayidx1[sDIMEN_MAX], arrayidx2[sDIMEN_MAX]; /* last used array indices */
+ cell *org_arrayidx;
+
+ bwcount = bitwise_opercount;
+ bitwise_opercount = 0;
+ for (i = 0; i < sDIMEN_MAX; i++)
+ arrayidx1[i] = arrayidx2[i] = 0;
+ org_arrayidx = lval1->arrayidx; /* save current pointer, to reset later */
+ if (!lval1->arrayidx)
+ lval1->arrayidx = arrayidx1;
+ lvalue = plnge1(hier13, lval1);
+ if (lval1->ident != iARRAYCELL && lval1->ident != iARRAYCHAR)
+ lval1->arrayidx = NULL;
+ if (lval1->ident == iCONSTEXPR) /* load constant here */
+ const1(lval1->constval);
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case taOR:
+ oper = ob_or;
+ break;
+ case taXOR:
+ oper = ob_xor;
+ break;
+ case taAND:
+ oper = ob_and;
+ break;
+ case taADD:
+ oper = ob_add;
+ break;
+ case taSUB:
+ oper = ob_sub;
+ break;
+ case taMULT:
+ oper = os_mult;
+ break;
+ case taDIV:
+ oper = os_div;
+ break;
+ case taMOD:
+ oper = os_mod;
+ break;
+ case taSHRU:
+ oper = ou_sar;
+ break;
+ case taSHR:
+ oper = os_sar;
+ break;
+ case taSHL:
+ oper = ob_sal;
+ break;
+ case '=': /* simple assignment */
+ oper = NULL;
+ if (intest)
+ error(211); /* possibly unintended assignment */
+ break;
+ default:
+ lexpush();
+ bitwise_opercount = bwcount;
+ lval1->arrayidx = org_arrayidx; /* restore array index pointer */
+ return lvalue;
+ } /* switch */
+
+ /* if we get here, it was an assignment; first check a few special cases
+ * and then the general */
+ if (lval1->ident == iARRAYCHAR)
+ {
+ /* special case, assignment to packed character in a cell is permitted */
+ lvalue = TRUE;
+ }
+ else if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ /* array assignment is permitted too (with restrictions) */
+ if (oper)
+ return error(23); /* array assignment must be simple assigment */
+ assert(lval1->sym != NULL);
+ if (array_totalsize(lval1->sym) == 0)
+ return error(46, lval1->sym->name); /* unknown array size */
+ lvalue = TRUE;
+ } /* if */
+
+ /* operand on left side of assignment must be lvalue */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ /* may not change "constant" parameters */
+ assert(lval1->sym != NULL);
+ if ((lval1->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ lval3 = *lval1; /* save symbol to enable storage of expresion result */
+ lval1->arrayidx = org_arrayidx; /* restore array index pointer */
+ if (lval1->ident == iARRAYCELL || lval1->ident == iARRAYCHAR
+ || lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+ {
+ /* if indirect fetch: save PRI (cell address) */
+ if (oper)
+ {
+ push1();
+ rvalue(lval1);
+ } /* if */
+ lval2.arrayidx = arrayidx2;
+ plnge2(oper, hier14, lval1, &lval2);
+ if (lval2.ident != iARRAYCELL && lval2.ident != iARRAYCHAR)
+ lval2.arrayidx = NULL;
+ if (oper)
+ pop2();
+ if (!oper && lval3.arrayidx && lval2.arrayidx
+ && lval3.ident == lval2.ident && lval3.sym == lval2.sym)
+ {
+ int same = TRUE;
+
+ assert(lval3.arrayidx == arrayidx1);
+ assert(lval2.arrayidx == arrayidx2);
+ for (i = 0; i < sDIMEN_MAX; i++)
+ same = same && (lval3.arrayidx[i] == lval2.arrayidx[i]);
+ if (same)
+ error(226, lval3.sym->name); /* self-assignment */
+ } /* if */
+ }
+ else
+ {
+ if (oper)
+ {
+ rvalue(lval1);
+ plnge2(oper, hier14, lval1, &lval2);
+ }
+ else
+ {
+ /* if direct fetch and simple assignment: no "push"
+ * and "pop" needed -> call hier14() directly, */
+ if (hier14(&lval2))
+ rvalue(&lval2); /* instead of plnge2(). */
+ checkfunction(&lval2);
+ /* check whether lval2 and lval3 (old lval1) refer to the same variable */
+ if (lval2.ident == iVARIABLE && lval3.ident == lval2.ident
+ && lval3.sym == lval2.sym)
+ {
+ assert(lval3.sym != NULL);
+ error(226, lval3.sym->name); /* self-assignment */
+ } /* if */
+ } /* if */
+ } /* if */
+ if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+ {
+ /* left operand is an array, right operand should be an array variable
+ * of the same size and the same dimension, an array literal (of the
+ * same size) or a literal string.
+ */
+ int exactmatch = TRUE;
+
+ if (lval2.ident != iARRAY && lval2.ident != iREFARRAY)
+ error(33, lval3.sym->name); /* array must be indexed */
+ if (lval2.sym)
+ {
+ val = lval2.sym->dim.array.length; /* array variable */
+ level = lval2.sym->dim.array.level;
+ }
+ else
+ {
+ val = lval2.constval; /* literal array */
+ level = 0;
+ /* If val is negative, it means that lval2 is a
+ * literal string. The string array size may be
+ * smaller than the destination array.
+ */
+ if (val < 0)
+ {
+ val = -val;
+ exactmatch = FALSE;
+ } /* if */
+ } /* if */
+ if (lval3.sym->dim.array.level != level)
+ return error(48); /* array dimensions must match */
+ else if (lval3.sym->dim.array.length < val
+ || (exactmatch && lval3.sym->dim.array.length > val))
+ return error(47); /* array sizes must match */
+ if (level > 0)
+ {
+ /* check the sizes of all sublevels too */
+ symbol *sym1 = lval3.sym;
+ symbol *sym2 = lval2.sym;
+ int i;
+
+ assert(sym1 != NULL && sym2 != NULL);
+ /* ^^^ sym2 must be valid, because only variables can be
+ * multi-dimensional (there are no multi-dimensional arrays),
+ * sym1 must be valid because it must be an lvalue
+ */
+ assert(exactmatch);
+ for (i = 0; i < level; i++)
+ {
+ sym1 = finddepend(sym1);
+ sym2 = finddepend(sym2);
+ assert(sym1 != NULL && sym2 != NULL);
+ /* ^^^ both arrays have the same dimensions (this was checked
+ * earlier) so the dependend should always be found
+ */
+ if (sym1->dim.array.length != sym2->dim.array.length)
+ error(47); /* array sizes must match */
+ } /* for */
+ /* get the total size in cells of the multi-dimensional array */
+ val = array_totalsize(lval3.sym);
+ assert(val > 0); /* already checked */
+ } /* if */
+ }
+ else
+ {
+ /* left operand is not an array, right operand should then not be either */
+ if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+ error(6); /* must be assigned to an array */
+ } /* if */
+ if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+ {
+ memcopy(val * sizeof(cell));
+ }
+ else
+ {
+ check_userop(NULL, lval2.tag, lval3.tag, 2, &lval3, &lval2.tag);
+ store(&lval3); /* now, store the expression result */
+ } /* if */
+ if (!oper && !matchtag(lval3.tag, lval2.tag, TRUE))
+ error(213); /* tagname mismatch (if "oper", warning already given in plunge2()) */
+ if (lval3.sym)
+ markusage(lval3.sym, uWRITTEN);
+ sideeffect = TRUE;
+ bitwise_opercount = bwcount;
+ return FALSE; /* expression result is never an lvalue */
+}
+
+static int
+hier13(value * lval)
+{
+ int lvalue, flab1, flab2;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ int array1, array2;
+
+ lvalue = plnge1(hier12, lval);
+ if (matchtoken('?'))
+ {
+ flab1 = getlabel();
+ flab2 = getlabel();
+ if (lvalue)
+ {
+ rvalue(lval);
+ }
+ else if (lval->ident == iCONSTEXPR)
+ {
+ const1(lval->constval);
+ error(lval->constval ? 206 : 205); /* redundant test */
+ } /* if */
+ jmp_eq0(flab1); /* go to second expression if primary register==0 */
+ if (hier14(lval))
+ rvalue(lval);
+ jumplabel(flab2);
+ setlabel(flab1);
+ needtoken(':');
+ if (hier14(&lval2))
+ rvalue(&lval2);
+ array1 = (lval->ident == iARRAY || lval->ident == iREFARRAY);
+ array2 = (lval2.ident == iARRAY || lval2.ident == iREFARRAY);
+ if (array1 && !array2)
+ {
+ char *ptr =
+ (lval->sym->name) ? lval->sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ }
+ else if (!array1 && array2)
+ {
+ char *ptr =
+ (lval2.sym->name) ? lval2.sym->name : "-unknown-";
+ error(33, ptr); /* array must be indexed */
+ } /* if */
+ /* ??? if both are arrays, should check dimensions */
+ if (!matchtag(lval->tag, lval2.tag, FALSE))
+ error(213); /* tagname mismatch ('true' and 'false' expressions) */
+ setlabel(flab2);
+ if (lval->ident == iARRAY)
+ lval->ident = iREFARRAY; /* iARRAY becomes iREFARRAY */
+ else if (lval->ident != iREFARRAY)
+ lval->ident = iEXPRESSION; /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */
+ return FALSE; /* conditional expression is no lvalue */
+ }
+ else
+ {
+ return lvalue;
+ } /* endif */
+}
+
+/* the order of the operators in these lists is important and must cohere */
+/* with the order of the operators in the array "op1" */
+static int list3[] = { '*', '/', '%', 0 };
+static int list4[] = { '+', '-', 0 };
+static int list5[] = { tSHL, tSHR, tSHRU, 0 };
+static int list6[] = { '&', 0 };
+static int list7[] = { '^', 0 };
+static int list8[] = { '|', 0 };
+static int list9[] = { tlLE, tlGE, '<', '>', 0 };
+static int list10[] = { tlEQ, tlNE, 0 };
+static int list11[] = { tlAND, 0 };
+static int list12[] = { tlOR, 0 };
+
+static int
+hier12(value * lval)
+{
+ return skim(list12, jmp_ne0, 1, 0, hier11, lval);
+}
+
+static int
+hier11(value * lval)
+{
+ return skim(list11, jmp_eq0, 0, 1, hier10, lval);
+}
+
+static int
+hier10(value * lval)
+{ /* ==, != */
+ return plnge(list10, 15, hier9, lval, "bool", TRUE);
+} /* ^ this variable is the starting index in the op1[]
+ * array of the operators of this hierarchy level */
+
+static int
+hier9(value * lval)
+{ /* <=, >=, <, > */
+ return plnge_rel(list9, 11, hier8, lval);
+}
+
+static int
+hier8(value * lval)
+{ /* | */
+ return plnge(list8, 10, hier7, lval, NULL, FALSE);
+}
+
+static int
+hier7(value * lval)
+{ /* ^ */
+ return plnge(list7, 9, hier6, lval, NULL, FALSE);
+}
+
+static int
+hier6(value * lval)
+{ /* & */
+ return plnge(list6, 8, hier5, lval, NULL, FALSE);
+}
+
+static int
+hier5(value * lval)
+{ /* <<, >>, >>> */
+ return plnge(list5, 5, hier4, lval, NULL, FALSE);
+}
+
+static int
+hier4(value * lval)
+{ /* +, - */
+ return plnge(list4, 3, hier3, lval, NULL, FALSE);
+}
+
+static int
+hier3(value * lval)
+{ /* *, /, % */
+ return plnge(list3, 0, hier2, lval, NULL, FALSE);
+}
+
+static int
+hier2(value * lval)
+{
+ int lvalue, tok;
+ int tag, paranthese;
+ cell val;
+ char *st;
+ symbol *sym;
+ int saveresult;
+
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case tINC: /* ++lval */
+ if (!hier2(lval))
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ if (!check_userop(user_inc, lval->tag, 0, 1, lval, &lval->tag))
+ inc(lval); /* increase variable first */
+ rvalue(lval); /* and read the result into PRI */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case tDEC: /* --lval */
+ if (!hier2(lval))
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ if (!check_userop(user_dec, lval->tag, 0, 1, lval, &lval->tag))
+ dec(lval); /* decrease variable first */
+ rvalue(lval); /* and read the result into PRI */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case '~': /* ~ (one's complement) */
+ if (hier2(lval))
+ rvalue(lval);
+ invert(); /* bitwise NOT */
+ lval->constval = ~lval->constval;
+ return FALSE;
+ case '!': /* ! (logical negate) */
+ if (hier2(lval))
+ rvalue(lval);
+ if (check_userop(lneg, lval->tag, 0, 1, NULL, &lval->tag))
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ }
+ else
+ {
+ lneg(); /* 0 -> 1, !0 -> 0 */
+ lval->constval = !lval->constval;
+ lval->tag = sc_addtag("bool");
+ } /* if */
+ return FALSE;
+ case '-': /* unary - (two's complement) */
+ if (hier2(lval))
+ rvalue(lval);
+ /* make a special check for a constant expression with the tag of a
+ * rational number, so that we can simple swap the sign of that constant.
+ */
+ if (lval->ident == iCONSTEXPR && lval->tag == sc_rationaltag
+ && sc_rationaltag != 0)
+ {
+ if (rational_digits == 0)
+ {
+ float *f = (float *)&lval->constval;
+
+ *f = -*f; /* this modifies lval->constval */
+ }
+ else
+ {
+ /* the negation of a fixed point number is just an integer negation */
+ lval->constval = -lval->constval;
+ } /* if */
+ }
+ else if (check_userop(neg, lval->tag, 0, 1, NULL, &lval->tag))
+ {
+ lval->ident = iEXPRESSION;
+ lval->constval = 0;
+ }
+ else
+ {
+ neg(); /* arithmic negation */
+ lval->constval = -lval->constval;
+ } /* if */
+ return FALSE;
+ case tLABEL: /* tagname override */
+ tag = sc_addtag(st);
+ lvalue = hier2(lval);
+ lval->tag = tag;
+ return lvalue;
+ case tDEFINED:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL)
+ return error(20, st); /* illegal symbol name */
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (sym && sym->ident != iFUNCTN && sym->ident != iREFFUNC
+ && (sym->usage & uDEFINE) == 0)
+ sym = NULL; /* symbol is not a function, it is in the table, but not "defined" */
+ val = !!sym;
+ if (!val && find_subst(st, strlen(st)))
+ val = 1;
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = val;
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ case tSIZEOF:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL)
+ return error(20, st); /* illegal symbol name */
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (!sym)
+ return error(17, st); /* undefined symbol */
+ if (sym->ident == iCONSTEXPR)
+ error(39); /* constant symbol has no size */
+ else if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+ error(72); /* "function" symbol has no size */
+ else if ((sym->usage & uDEFINE) == 0)
+ return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = 1; /* preset */
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ int level;
+
+ for (level = 0; matchtoken('['); level++)
+ needtoken(']');
+ if (level > sym->dim.array.level)
+ error(28); /* invalid subscript */
+ else
+ lval->constval = array_levelsize(sym, level);
+ if (lval->constval == 0 && !strchr(lptr, PREPROC_TERM))
+ error(224, st); /* indeterminate array size in "sizeof" expression */
+ } /* if */
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ case tTAGOF:
+ paranthese = 0;
+ while (matchtoken('('))
+ paranthese++;
+ tok = lex(&val, &st);
+ if (tok != tSYMBOL && tok != tLABEL)
+ return error(20, st); /* illegal symbol name */
+ if (tok == tLABEL)
+ {
+ tag = sc_addtag(st);
+ }
+ else
+ {
+ sym = findloc(st);
+ if (!sym)
+ sym = findglb(st);
+ if (!sym)
+ return error(17, st); /* undefined symbol */
+ if ((sym->usage & uDEFINE) == 0)
+ return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
+ tag = sym->tag;
+ } /* if */
+ exporttag(tag);
+ clear_value(lval);
+ lval->ident = iCONSTEXPR;
+ lval->constval = tag;
+ const1(lval->constval);
+ while (paranthese--)
+ needtoken(')');
+ return FALSE;
+ default:
+ lexpush();
+ lvalue = hier1(lval);
+ /* check for postfix operators */
+ if (matchtoken(';'))
+ {
+ /* Found a ';', do not look further for postfix operators */
+ lexpush(); /* push ';' back after successful match */
+ return lvalue;
+ }
+ else if (matchtoken(tTERM))
+ {
+ /* Found a newline that ends a statement (this is the case when
+ * semicolons are optional). Note that an explicit semicolon was
+ * handled above. This case is similar, except that the token must
+ * not be pushed back.
+ */
+ return lvalue;
+ }
+ else
+ {
+ tok = lex(&val, &st);
+ switch (tok)
+ {
+ case tINC: /* lval++ */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ /* on incrementing array cells, the address in PRI must be saved for
+ * incremening the value, whereas the current value must be in PRI
+ * on exit.
+ */
+ saveresult = (lval->ident == iARRAYCELL
+ || lval->ident == iARRAYCHAR);
+ if (saveresult)
+ push1(); /* save address in PRI */
+ rvalue(lval); /* read current value into PRI */
+ if (saveresult)
+ swap1(); /* save PRI on the stack, restore address in PRI */
+ if (!check_userop
+ (user_inc, lval->tag, 0, 1, lval, &lval->tag))
+ inc(lval); /* increase variable afterwards */
+ if (saveresult)
+ pop1(); /* restore PRI (result of rvalue()) */
+ sideeffect = TRUE;
+ return FALSE; /* result is no longer lvalue */
+ case tDEC: /* lval-- */
+ if (!lvalue)
+ return error(22); /* must be lvalue */
+ assert(lval->sym != NULL);
+ if ((lval->sym->usage & uCONST) != 0)
+ return error(22); /* assignment to const argument */
+ saveresult = (lval->ident == iARRAYCELL
+ || lval->ident == iARRAYCHAR);
+ if (saveresult)
+ push1(); /* save address in PRI */
+ rvalue(lval); /* read current value into PRI */
+ if (saveresult)
+ swap1(); /* save PRI on the stack, restore address in PRI */
+ if (!check_userop
+ (user_dec, lval->tag, 0, 1, lval, &lval->tag))
+ dec(lval); /* decrease variable afterwards */
+ if (saveresult)
+ pop1(); /* restore PRI (result of rvalue()) */
+ sideeffect = TRUE;
+ return FALSE;
+ case tCHAR: /* char (compute required # of cells */
+ if (lval->ident == iCONSTEXPR)
+ {
+ lval->constval *= charbits / 8; /* from char to bytes */
+ lval->constval =
+ (lval->constval + sizeof(cell) - 1) / sizeof(cell);
+ }
+ else
+ {
+ if (lvalue)
+ rvalue(lval); /* fetch value if not already in PRI */
+ char2addr(); /* from characters to bytes */
+ addconst(sizeof(cell) - 1); /* make sure the value is rounded up */
+ addr2cell(); /* truncate to number of cells */
+ } /* if */
+ return FALSE;
+ default:
+ lexpush();
+ return lvalue;
+ } /* switch */
+ } /* if */
+ } /* switch */
+}
+
+/* hier1
+ *
+ * The highest hierarchy level: it looks for pointer and array indices
+ * and function calls.
+ * Generates code to fetch a pointer value if it is indexed and code to
+ * add to the pointer value or the array address (the address is already
+ * read at primary()). It also generates code to fetch a function address
+ * if that hasn't already been done at primary() (check lval[4]) and calls
+ * callfunction() to call the function.
+ */
+static int
+hier1(value * lval1)
+{
+ int lvalue, index, tok, symtok;
+ cell val, cidx;
+ value lval2 = { NULL, 0, 0, 0, 0, NULL };
+ char *st;
+ char close;
+ symbol *sym;
+
+ lvalue = primary(lval1);
+ symtok = tokeninfo(&val, &st); /* get token read by primary() */
+ restart:
+ sym = lval1->sym;
+ if (matchtoken('[') || matchtoken('{') || matchtoken('('))
+ {
+ tok = tokeninfo(&val, &st); /* get token read by matchtoken() */
+ if (!sym && symtok != tSYMBOL)
+ {
+ /* we do not have a valid symbol and we appear not to have read a valid
+ * symbol name (so it is unlikely that we would have read a name of an
+ * undefined symbol) */
+ error(29); /* expression error, assumed 0 */
+ lexpush(); /* analyse '(', '{' or '[' again later */
+ return FALSE;
+ } /* if */
+ if (tok == '[' || tok == '{')
+ { /* subscript */
+ close = (char)((tok == '[') ? ']' : '}');
+ if (!sym)
+ { /* sym==NULL if lval is a constant or a literal */
+ error(28); /* cannot subscript */
+ needtoken(close);
+ return FALSE;
+ }
+ else if (sym->ident != iARRAY && sym->ident != iREFARRAY)
+ {
+ error(28); /* cannot subscript, variable is not an array */
+ needtoken(close);
+ return FALSE;
+ }
+ else if (sym->dim.array.level > 0 && close != ']')
+ {
+ error(51); /* invalid subscript, must use [ ] */
+ needtoken(close);
+ return FALSE;
+ } /* if */
+ stgget(&index, &cidx); /* mark position in code generator */
+ push1(); /* save base address of the array */
+ if (hier14(&lval2)) /* create expression for the array index */
+ rvalue(&lval2);
+ if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+ error(33, lval2.sym->name); /* array must be indexed */
+ needtoken(close);
+ if (!matchtag(sym->x.idxtag, lval2.tag, TRUE))
+ error(213);
+ if (lval2.ident == iCONSTEXPR)
+ { /* constant expression */
+ stgdel(index, cidx); /* scratch generated code */
+ if (lval1->arrayidx)
+ { /* keep constant index, for checking */
+ assert(sym->dim.array.level >= 0
+ && sym->dim.array.level < sDIMEN_MAX);
+ lval1->arrayidx[sym->dim.array.level] = lval2.constval;
+ } /* if */
+ if (close == ']')
+ {
+ /* normal array index */
+ if (lval2.constval < 0 || (sym->dim.array.length != 0
+ && sym->dim.array.length <= lval2.constval))
+ error(32, sym->name); /* array index out of bounds */
+ if (lval2.constval != 0)
+ {
+ /* don't add offsets for zero subscripts */
+#if defined(BIT16)
+ const2(lval2.constval << 1);
+#else
+ const2(lval2.constval << 2);
+#endif
+ ob_add();
+ } /* if */
+ }
+ else
+ {
+ /* character index */
+ if (lval2.constval < 0 || (sym->dim.array.length != 0
+ && sym->dim.array.length * ((8 * sizeof(cell)) /
+ charbits) <=
+ (ucell) lval2.constval))
+ error(32, sym->name); /* array index out of bounds */
+ if (lval2.constval != 0)
+ {
+ /* don't add offsets for zero subscripts */
+ if (charbits == 16)
+ const2(lval2.constval << 1); /* 16-bit character */
+ else
+ const2(lval2.constval); /* 8-bit character */
+ ob_add();
+ } /* if */
+ charalign(); /* align character index into array */
+ } /* if */
+ }
+ else
+ {
+ /* array index is not constant */
+ lval1->arrayidx = NULL; /* reset, so won't be checked */
+ if (close == ']')
+ {
+ if (sym->dim.array.length != 0)
+ ffbounds(sym->dim.array.length - 1); /* run time check for array bounds */
+ cell2addr(); /* normal array index */
+ }
+ else
+ {
+ if (sym->dim.array.length != 0)
+ ffbounds(sym->dim.array.length * (32 / charbits) - 1);
+ char2addr(); /* character array index */
+ } /* if */
+ pop2();
+ ob_add(); /* base address was popped into secondary register */
+ if (close != ']')
+ charalign(); /* align character index into array */
+ } /* if */
+ /* the indexed item may be another array (multi-dimensional arrays) */
+ assert(lval1->sym == sym && sym != NULL); /* should still be set */
+ if (sym->dim.array.level > 0)
+ {
+ assert(close == ']'); /* checked earlier */
+ /* read the offset to the subarray and add it to the current address */
+ lval1->ident = iARRAYCELL;
+ push1(); /* the optimizer makes this to a MOVE.alt */
+ rvalue(lval1);
+ pop2();
+ ob_add();
+ /* adjust the "value" structure and find the referenced array */
+ lval1->ident = iREFARRAY;
+ lval1->sym = finddepend(sym);
+ assert(lval1->sym != NULL);
+ assert(lval1->sym->dim.array.level ==
+ sym->dim.array.level - 1);
+ /* try to parse subsequent array indices */
+ lvalue = FALSE; /* for now, a iREFARRAY is no lvalue */
+ goto restart;
+ } /* if */
+ assert(sym->dim.array.level == 0);
+ /* set type to fetch... INDIRECTLY */
+ lval1->ident = (char)((close == ']') ? iARRAYCELL : iARRAYCHAR);
+ lval1->tag = sym->tag;
+ /* a cell in an array is an lvalue, a character in an array is not
+ * always a *valid* lvalue */
+ return TRUE;
+ }
+ else
+ { /* tok=='(' -> function(...) */
+ if (!sym
+ || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+ {
+ if (!sym && sc_status == statFIRST)
+ {
+ /* could be a "use before declaration"; in that case, create a stub
+ * function so that the usage can be marked.
+ */
+ sym = fetchfunc(lastsymbol, 0);
+ if (sym)
+ markusage(sym, uREAD);
+ } /* if */
+ return error(12); /* invalid function call */
+ }
+ else if ((sym->usage & uMISSING) != 0)
+ {
+ char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
+
+ funcdisplayname(symname, sym->name);
+ error(4, symname); /* function not defined */
+ } /* if */
+ callfunction(sym);
+ lval1->ident = iEXPRESSION;
+ lval1->constval = 0;
+ lval1->tag = sym->tag;
+ return FALSE; /* result of function call is no lvalue */
+ } /* if */
+ } /* if */
+ if (sym && lval1->ident == iFUNCTN)
+ {
+ assert(sym->ident == iFUNCTN);
+ address(sym);
+ lval1->sym = NULL;
+ lval1->ident = iREFFUNC;
+ /* ??? however... function pointers (or function references are not (yet) allowed */
+ error(29); /* expression error, assumed 0 */
+ return FALSE;
+ } /* if */
+ return lvalue;
+}
+
+/* primary
+ *
+ * Returns 1 if the operand is an lvalue (everything except arrays, functions
+ * constants and -of course- errors).
+ * Generates code to fetch the address of arrays. Code for constants is
+ * already generated by constant().
+ * This routine first clears the entire lval array (all fields are set to 0).
+ *
+ * Global references: intest (may be altered, but restored upon termination)
+ */
+static int
+primary(value * lval)
+{
+ char *st;
+ int lvalue, tok;
+ cell val;
+ symbol *sym;
+
+ if (matchtoken('('))
+ { /* sub-expression - (expression,...) */
+ pushstk((stkitem) intest);
+ pushstk((stkitem) sc_allowtags);
+
+ intest = 0; /* no longer in "test" expression */
+ sc_allowtags = TRUE; /* allow tagnames to be used in parenthised expressions */
+ do
+ lvalue = hier14(lval);
+ while (matchtoken(','));
+ needtoken(')');
+ lexclr(FALSE); /* clear lex() push-back, it should have been
+ * cleared already by needtoken() */
+ sc_allowtags = (int)(long)popstk();
+ intest = (int)(long)popstk();
+ return lvalue;
+ } /* if */
+
+ clear_value(lval); /* clear lval */
+ tok = lex(&val, &st);
+ if (tok == tSYMBOL)
+ {
+ /* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol
+ * to sNAMEMAX significant characters */
+ assert(strlen(st) < sizeof lastsymbol);
+ strcpy(lastsymbol, st);
+ } /* if */
+ if (tok == tSYMBOL && !findconst(st))
+ {
+ /* first look for a local variable */
+ if ((sym = findloc(st)))
+ {
+ if (sym->ident == iLABEL)
+ {
+ error(29); /* expression error, assumed 0 */
+ const1(0); /* load 0 */
+ return FALSE; /* return 0 for labels (expression error) */
+ } /* if */
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ address(sym); /* get starting address in primary register */
+ return FALSE; /* return 0 for array (not lvalue) */
+ }
+ else
+ {
+ return TRUE; /* return 1 if lvalue (not label or array) */
+ } /* if */
+ } /* if */
+ /* now try a global variable */
+ if ((sym = findglb(st)))
+ {
+ if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+ {
+ /* if the function is only in the table because it was inserted as a
+ * stub in the first pass (i.e. it was "used" but never declared or
+ * implemented, issue an error
+ */
+ if ((sym->usage & uPROTOTYPED) == 0)
+ error(17, st);
+ }
+ else
+ {
+ if ((sym->usage & uDEFINE) == 0)
+ error(17, st);
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+ {
+ address(sym); /* get starting address in primary register */
+ return FALSE; /* return 0 for array (not lvalue) */
+ }
+ else
+ {
+ return TRUE; /* return 1 if lvalue (not function or array) */
+ } /* if */
+ } /* if */
+ }
+ else
+ {
+ return error(17, st); /* undefined symbol */
+ } /* endif */
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN || sym->ident != iREFFUNC);
+ lval->sym = sym;
+ lval->ident = sym->ident;
+ lval->tag = sym->tag;
+ return FALSE; /* return 0 for function (not an lvalue) */
+ } /* if */
+ lexpush(); /* push the token, it is analyzed by constant() */
+ if (constant(lval) == 0)
+ {
+ error(29); /* expression error, assumed 0 */
+ const1(0); /* load 0 */
+ } /* if */
+ return FALSE; /* return 0 for constants (or errors) */
+}
+
+static void
+clear_value(value * lval)
+{
+ lval->sym = NULL;
+ lval->constval = 0L;
+ lval->tag = 0;
+ lval->ident = 0;
+ lval->boolresult = FALSE;
+ /* do not clear lval->arrayidx, it is preset in hier14() */
+}
+
+static void
+setdefarray(cell * string, cell size, cell array_sz, cell * dataaddr,
+ int fconst)
+{
+ /* The routine must copy the default array data onto the heap, as to avoid
+ * that a function can change the default value. An optimization is that
+ * the default array data is "dumped" into the data segment only once (on the
+ * first use).
+ */
+ assert(string != NULL);
+ assert(size > 0);
+ /* check whether to dump the default array */
+ assert(dataaddr != NULL);
+ if (sc_status == statWRITE && *dataaddr < 0)
+ {
+ int i;
+
+ *dataaddr = (litidx + glb_declared) * sizeof(cell);
+ for (i = 0; i < size; i++)
+ stowlit(*string++);
+ } /* if */
+
+ /* if the function is known not to modify the array (meaning that it also
+ * does not modify the default value), directly pass the address of the
+ * array in the data segment.
+ */
+ if (fconst)
+ {
+ const1(*dataaddr);
+ }
+ else
+ {
+ /* Generate the code:
+ * CONST.pri dataaddr ;address of the default array data
+ * HEAP array_sz*sizeof(cell) ;heap address in ALT
+ * MOVS size*sizeof(cell) ;copy data from PRI to ALT
+ * MOVE.PRI ;PRI = address on the heap
+ */
+ const1(*dataaddr);
+ /* "array_sz" is the size of the argument (the value between the brackets
+ * in the declaration), "size" is the size of the default array data.
+ */
+ assert(array_sz >= size);
+ modheap((int)array_sz * sizeof(cell));
+ /* ??? should perhaps fill with zeros first */
+ memcopy(size * sizeof(cell));
+ moveto1();
+ } /* if */
+}
+
+static int
+findnamedarg(arginfo * arg, char *name)
+{
+ int i;
+
+ for (i = 0; arg[i].ident != 0 && arg[i].ident != iVARARGS; i++)
+ if (strcmp(arg[i].name, name) == 0)
+ return i;
+ return -1;
+}
+
+static int
+checktag(int tags[], int numtags, int exprtag)
+{
+ int i;
+
+ assert(tags != 0);
+ assert(numtags > 0);
+ for (i = 0; i < numtags; i++)
+ if (matchtag(tags[i], exprtag, TRUE))
+ return TRUE; /* matching tag */
+ return FALSE; /* no tag matched */
+}
+
+enum
+{
+ ARG_UNHANDLED,
+ ARG_IGNORED,
+ ARG_DONE,
+};
+
+/* callfunction
+ *
+ * Generates code to call a function. This routine handles default arguments
+ * and positional as well as named parameters.
+ */
+static void
+callfunction(symbol * sym)
+{
+ int close, lvalue;
+ int argpos; /* index in the output stream (argpos==nargs if positional parameters) */
+ int argidx = 0; /* index in "arginfo" list */
+ int nargs = 0; /* number of arguments */
+ int heapalloc = 0;
+ int namedparams = FALSE;
+ value lval = { NULL, 0, 0, 0, 0, NULL };
+ arginfo *arg;
+ char arglist[sMAXARGS];
+ constvalue arrayszlst = { NULL, "", 0, 0 }; /* array size list starts empty */
+ cell lexval;
+ char *lexstr;
+
+ assert(sym != NULL);
+ arg = sym->dim.arglist;
+ assert(arg != NULL);
+ stgmark(sSTARTREORDER);
+ for (argpos = 0; argpos < sMAXARGS; argpos++)
+ arglist[argpos] = ARG_UNHANDLED;
+ if (!matchtoken(')'))
+ {
+ do
+ {
+ if (matchtoken('.'))
+ {
+ namedparams = TRUE;
+ if (needtoken(tSYMBOL))
+ tokeninfo(&lexval, &lexstr);
+ else
+ lexstr = "";
+ argpos = findnamedarg(arg, lexstr);
+ if (argpos < 0)
+ {
+ error(17, lexstr); /* undefined symbol */
+ break; /* exit loop, argpos is invalid */
+ } /* if */
+ needtoken('=');
+ argidx = argpos;
+ }
+ else
+ {
+ if (namedparams)
+ error(44); /* positional parameters must precede named parameters */
+ argpos = nargs;
+ } /* if */
+ stgmark((char)(sEXPRSTART + argpos)); /* mark beginning of new expression in stage */
+ if (arglist[argpos] != ARG_UNHANDLED)
+ error(58); /* argument already set */
+ if (matchtoken('_'))
+ {
+ arglist[argpos] = ARG_IGNORED; /* flag argument as "present, but ignored" */
+ if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS)
+ {
+ error(202); /* argument count mismatch */
+ }
+ else if (!arg[argidx].hasdefault)
+ {
+ error(34, nargs + 1); /* argument has no default value */
+ } /* if */
+ if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS)
+ argidx++;
+ /* The rest of the code to handle default values is at the bottom
+ * of this routine where default values for unspecified parameters
+ * are (also) handled. Note that above, the argument is flagged as
+ * ARG_IGNORED.
+ */
+ }
+ else
+ {
+ arglist[argpos] = ARG_DONE; /* flag argument as "present" */
+ lvalue = hier14(&lval);
+ switch (arg[argidx].ident)
+ {
+ case 0:
+ error(202); /* argument count mismatch */
+ break;
+ case iVARARGS:
+ /* always pass by reference */
+ if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+ {
+ assert(lval.sym != NULL);
+ if ((lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ {
+ /* treat a "const" variable passed to a function with a non-const
+ * "variable argument list" as a constant here */
+ assert(lvalue);
+ rvalue(&lval); /* get value in PRI */
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ }
+ else if (lvalue)
+ {
+ address(lval.sym);
+ }
+ else
+ {
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ }
+ else if (lval.ident == iCONSTEXPR
+ || lval.ident == iEXPRESSION
+ || lval.ident == iARRAYCHAR)
+ {
+ /* fetch value if needed */
+ if (lval.ident == iARRAYCHAR)
+ rvalue(&lval);
+ /* allocate a cell on the heap and store the
+ * value (already in PRI) there */
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ /* ??? handle const array passed by reference */
+ /* otherwise, the address is already in PRI */
+ if (lval.sym)
+ markusage(lval.sym, uWRITTEN);
+/*
+ * Dont need this warning - its varargs. there is no way of knowing the
+ * required tag/type...
+ *
+ if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
+ error(213);
+ */
+ break;
+ case iVARIABLE:
+ if (lval.ident == iLABEL || lval.ident == iFUNCTN
+ || lval.ident == iREFFUNC || lval.ident == iARRAY
+ || lval.ident == iREFARRAY)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lvalue)
+ rvalue(&lval); /* get value (direct or indirect) */
+ /* otherwise, the expression result is already in PRI */
+ assert(arg[argidx].numtags > 0);
+ check_userop(NULL, lval.tag, arg[argidx].tags[0], 2,
+ NULL, &lval.tag);
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ argidx++; /* argument done */
+ break;
+ case iREFERENCE:
+ if (!lvalue || lval.ident == iARRAYCHAR)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lval.sym && (lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ error(35, argidx + 1); /* argument type mismatch */
+ if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+ {
+ if (lvalue)
+ {
+ assert(lval.sym != NULL);
+ address(lval.sym);
+ }
+ else
+ {
+ setheap_pri(); /* address of the value on the heap in PRI */
+ heapalloc++;
+ } /* if */
+ } /* if */
+ /* otherwise, the address is already in PRI */
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ argidx++; /* argument done */
+ if (lval.sym)
+ markusage(lval.sym, uWRITTEN);
+ break;
+ case iREFARRAY:
+ if (lval.ident != iARRAY && lval.ident != iREFARRAY
+ && lval.ident != iARRAYCELL)
+ {
+ error(35, argidx + 1); /* argument type mismatch */
+ break;
+ } /* if */
+ if (lval.sym && (lval.sym->usage & uCONST) != 0
+ && (arg[argidx].usage & uCONST) == 0)
+ error(35, argidx + 1); /* argument type mismatch */
+ /* Verify that the dimensions match with those in arg[argidx].
+ * A literal array always has a single dimension.
+ * An iARRAYCELL parameter is also assumed to have a single dimension.
+ */
+ if (!lval.sym || lval.ident == iARRAYCELL)
+ {
+ if (arg[argidx].numdim != 1)
+ {
+ error(48); /* array dimensions must match */
+ }
+ else if (arg[argidx].dim[0] != 0)
+ {
+ assert(arg[argidx].dim[0] > 0);
+ if (lval.ident == iARRAYCELL)
+ {
+ error(47); /* array sizes must match */
+ }
+ else
+ {
+ assert(lval.constval != 0); /* literal array must have a size */
+ /* A literal array must have exactly the same size as the
+ * function argument; a literal string may be smaller than
+ * the function argument.
+ */
+ if ((lval.constval > 0
+ && arg[argidx].dim[0] != lval.constval)
+ || (lval.constval < 0
+ && arg[argidx].dim[0] <
+ -lval.constval))
+ error(47); /* array sizes must match */
+ } /* if */
+ } /* if */
+ if (lval.ident != iARRAYCELL)
+ {
+ /* save array size, for default values with uSIZEOF flag */
+ cell array_sz = lval.constval;
+
+ assert(array_sz != 0); /* literal array must have a size */
+ if (array_sz < 0)
+ array_sz = -array_sz;
+ append_constval(&arrayszlst, arg[argidx].name,
+ array_sz, 0);
+ } /* if */
+ }
+ else
+ {
+ symbol *sym = lval.sym;
+ short level = 0;
+
+ assert(sym != NULL);
+ if (sym->dim.array.level + 1 != arg[argidx].numdim)
+ error(48); /* array dimensions must match */
+ /* the lengths for all dimensions must match, unless the dimension
+ * length was defined at zero (which means "undefined")
+ */
+ while (sym->dim.array.level > 0)
+ {
+ assert(level < sDIMEN_MAX);
+ if (arg[argidx].dim[level] != 0
+ && sym->dim.array.length !=
+ arg[argidx].dim[level])
+ error(47); /* array sizes must match */
+ append_constval(&arrayszlst, arg[argidx].name,
+ sym->dim.array.length, level);
+ sym = finddepend(sym);
+ assert(sym != NULL);
+ level++;
+ } /* if */
+ /* the last dimension is checked too, again, unless it is zero */
+ assert(level < sDIMEN_MAX);
+ assert(sym != NULL);
+ if (arg[argidx].dim[level] != 0
+ && sym->dim.array.length !=
+ arg[argidx].dim[level])
+ error(47); /* array sizes must match */
+ append_constval(&arrayszlst, arg[argidx].name,
+ sym->dim.array.length, level);
+ } /* if */
+ /* address already in PRI */
+ if (!checktag
+ (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+ error(213);
+ // ??? set uWRITTEN?
+ argidx++; /* argument done */
+ break;
+ } /* switch */
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ } /* if */
+ assert(arglist[argpos] != ARG_UNHANDLED);
+ nargs++;
+ close = matchtoken(')');
+ if (!close) /* if not paranthese... */
+ if (!needtoken(',')) /* ...should be comma... */
+ break; /* ...but abort loop if neither */
+ }
+ while (!close && freading && !matchtoken(tENDEXPR)); /* do */
+ } /* if */
+ /* check remaining function arguments (they may have default values) */
+ for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+ argidx++)
+ {
+ if (arglist[argidx] == ARG_DONE)
+ continue; /* already seen and handled this argument */
+ /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;
+ * these are handled last
+ */
+ if ((arg[argidx].hasdefault & uSIZEOF) != 0
+ || (arg[argidx].hasdefault & uTAGOF) != 0)
+ {
+ assert(arg[argidx].ident == iVARIABLE);
+ continue;
+ } /* if */
+ stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
+ if (arg[argidx].hasdefault)
+ {
+ if (arg[argidx].ident == iREFARRAY)
+ {
+ short level;
+
+ setdefarray(arg[argidx].defvalue.array.data,
+ arg[argidx].defvalue.array.size,
+ arg[argidx].defvalue.array.arraysize,
+ &arg[argidx].defvalue.array.addr,
+ (arg[argidx].usage & uCONST) != 0);
+ if ((arg[argidx].usage & uCONST) == 0)
+ heapalloc += arg[argidx].defvalue.array.arraysize;
+ /* keep the lengths of all dimensions of a multi-dimensional default array */
+ assert(arg[argidx].numdim > 0);
+ if (arg[argidx].numdim == 1)
+ {
+ append_constval(&arrayszlst, arg[argidx].name,
+ arg[argidx].defvalue.array.arraysize, 0);
+ }
+ else
+ {
+ for (level = 0; level < arg[argidx].numdim; level++)
+ {
+ assert(level < sDIMEN_MAX);
+ append_constval(&arrayszlst, arg[argidx].name,
+ arg[argidx].dim[level], level);
+ } /* for */
+ } /* if */
+ }
+ else if (arg[argidx].ident == iREFERENCE)
+ {
+ setheap(arg[argidx].defvalue.val);
+ /* address of the value on the heap in PRI */
+ heapalloc++;
+ }
+ else
+ {
+ int dummytag = arg[argidx].tags[0];
+
+ const1(arg[argidx].defvalue.val);
+ assert(arg[argidx].numtags > 0);
+ check_userop(NULL, arg[argidx].defvalue_tag,
+ arg[argidx].tags[0], 2, NULL, &dummytag);
+ assert(dummytag == arg[argidx].tags[0]);
+ } /* if */
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE); /* mark the end of a sub-expression */
+ }
+ else
+ {
+ error(202, argidx); /* argument count mismatch */
+ } /* if */
+ if (arglist[argidx] == ARG_UNHANDLED)
+ nargs++;
+ arglist[argidx] = ARG_DONE;
+ } /* for */
+ /* now a second loop to catch the arguments with default values that are
+ * the "sizeof" or "tagof" of other arguments
+ */
+ for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+ argidx++)
+ {
+ constvalue *asz;
+ cell array_sz;
+
+ if (arglist[argidx] == ARG_DONE)
+ continue; /* already seen and handled this argument */
+ stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
+ assert(arg[argidx].ident == iVARIABLE); /* if "sizeof", must be single cell */
+ /* if unseen, must be "sizeof" or "tagof" */
+ assert((arg[argidx].hasdefault & uSIZEOF) != 0
+ || (arg[argidx].hasdefault & uTAGOF) != 0);
+ if ((arg[argidx].hasdefault & uSIZEOF) != 0)
+ {
+ /* find the argument; if it isn't found, the argument's default value
+ * was a "sizeof" of a non-array (a warning for this was already given
+ * when declaring the function)
+ */
+ asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname,
+ arg[argidx].defvalue.size.level);
+ if (asz)
+ {
+ array_sz = asz->value;
+ if (array_sz == 0)
+ error(224, arg[argidx].name); /* indeterminate array size in "sizeof" expression */
+ }
+ else
+ {
+ array_sz = 1;
+ } /* if */
+ }
+ else
+ {
+ symbol *sym;
+
+ assert((arg[argidx].hasdefault & uTAGOF) != 0);
+ sym = findloc(arg[argidx].defvalue.size.symname);
+ if (!sym)
+ sym = findglb(arg[argidx].defvalue.size.symname);
+ array_sz = (sym) ? sym->tag : 0;
+ exporttag(array_sz);
+ } /* if */
+ const1(array_sz);
+ push1(); /* store the function argument on the stack */
+ endexpr(FALSE);
+ if (arglist[argidx] == ARG_UNHANDLED)
+ nargs++;
+ arglist[argidx] = ARG_DONE;
+ } /* for */
+ stgmark(sENDREORDER); /* mark end of reversed evaluation */
+ pushval((cell) nargs * sizeof(cell));
+ ffcall(sym, nargs);
+ if (sc_status != statSKIP)
+ markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
+ if (sym->x.lib)
+ sym->x.lib->value += 1; /* increment "usage count" of the library */
+ modheap(-heapalloc * sizeof(cell));
+ sideeffect = TRUE; /* assume functions carry out a side-effect */
+ delete_consttable(&arrayszlst); /* clear list of array sizes */
+}
+
+/* dbltest
+ *
+ * Returns a non-zero value if lval1 an array and lval2 is not an array and
+ * the operation is addition or subtraction.
+ *
+ * Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell
+ * to an array offset.
+ */
+static int
+dbltest(void (*oper) (), value * lval1, value * lval2)
+{
+ if ((oper != ob_add) && (oper != ob_sub))
+ return 0;
+ if (lval1->ident != iARRAY)
+ return 0;
+ if (lval2->ident == iARRAY)
+ return 0;
+ return sizeof(cell) / 2; /* 1 for 16-bit, 2 for 32-bit */
+}
+
+/* commutative
+ *
+ * Test whether an operator is commutative, i.e. x oper y == y oper x.
+ * Commutative operators are: + (addition)
+ * * (multiplication)
+ * == (equality)
+ * != (inequality)
+ * & (bitwise and)
+ * ^ (bitwise xor)
+ * | (bitwise or)
+ *
+ * If in an expression, code for the left operand has been generated and
+ * the right operand is a constant and the operator is commutative, the
+ * precautionary "push" of the primary register is scrapped and the constant
+ * is read into the secondary register immediately.
+ */
+static int
+commutative(void (*oper) ())
+{
+ return oper == ob_add || oper == os_mult
+ || oper == ob_eq || oper == ob_ne
+ || oper == ob_and || oper == ob_xor || oper == ob_or;
+}
+
+/* constant
+ *
+ * Generates code to fetch a number, a literal character (which is returned
+ * by lex() as a number as well) or a literal string (lex() stores the
+ * strings in the literal queue). If the operand was a number, it is stored
+ * in lval->constval.
+ *
+ * The function returns 1 if the token was a constant or a string, 0
+ * otherwise.
+ */
+static int
+constant(value * lval)
+{
+ int tok, index, constant;
+ cell val, item, cidx;
+ char *st;
+ symbol *sym;
+
+ tok = lex(&val, &st);
+ if (tok == tSYMBOL && (sym = findconst(st)))
+ {
+ lval->constval = sym->addr;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ lval->tag = sym->tag;
+ markusage(sym, uREAD);
+ }
+ else if (tok == tNUMBER)
+ {
+ lval->constval = val;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ }
+ else if (tok == tRATIONAL)
+ {
+ lval->constval = val;
+ const1(lval->constval);
+ lval->ident = iCONSTEXPR;
+ lval->tag = sc_rationaltag;
+ }
+ else if (tok == tSTRING)
+ {
+ /* lex() stores starting index of string in the literal table in 'val' */
+ const1((val + glb_declared) * sizeof(cell));
+ lval->ident = iARRAY; /* pretend this is a global array */
+ lval->constval = val - litidx; /* constval == the negative value of the
+ * size of the literal array; using a negative
+ * value distinguishes between literal arrays
+ * and literal strings (this was done for
+ * array assignment). */
+ }
+ else if (tok == '{')
+ {
+ int tag, lasttag = -1;
+
+ val = litidx;
+ do
+ {
+ /* cannot call constexpr() here, because "staging" is already turned
+ * on at this point */
+ assert(staging);
+ stgget(&index, &cidx); /* mark position in code generator */
+ expression(&constant, &item, &tag, FALSE);
+ stgdel(index, cidx); /* scratch generated code */
+ if (constant == 0)
+ error(8); /* must be constant expression */
+ if (lasttag < 0)
+ lasttag = tag;
+ else if (!matchtag(lasttag, tag, FALSE))
+ error(213); /* tagname mismatch */
+ stowlit(item); /* store expression result in literal table */
+ }
+ while (matchtoken(','));
+ needtoken('}');
+ const1((val + glb_declared) * sizeof(cell));
+ lval->ident = iARRAY; /* pretend this is a global array */
+ lval->constval = litidx - val; /* constval == the size of the literal array */
+ }
+ else
+ {
+ return FALSE; /* no, it cannot be interpreted as a constant */
+ } /* if */
+ return TRUE; /* yes, it was a constant value */
+}
--- /dev/null
+/* Small compiler - code generation (unoptimized "assembler" code)
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <limits.h> /* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+/* When a subroutine returns to address 0, the AMX must halt. In earlier
+ * releases, the RET and RETN opcodes checked for the special case 0 address.
+ * Today, the compiler simply generates a HALT instruction at address 0. So
+ * a subroutine can savely return to 0, and then encounter a HALT.
+ */
+void
+writeleader(void)
+{
+ assert(code_idx == 0);
+ stgwrite(";program exit point\n");
+ stgwrite("\thalt 0\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* writetrailer
+ * Not much left of this once important function.
+ *
+ * Global references: sc_stksize (referred to only)
+ * sc_dataalign (referred to only)
+ * code_idx (altered)
+ * glb_declared (altered)
+ */
+void
+writetrailer(void)
+{
+ assert(sc_dataalign % opcodes(1) == 0); /* alignment must be a multiple of
+ * the opcode size */
+ assert(sc_dataalign != 0);
+
+ /* pad code to align data segment */
+ if ((code_idx % sc_dataalign) != 0)
+ {
+ begcseg();
+ while ((code_idx % sc_dataalign) != 0)
+ nooperation();
+ } /* if */
+
+ /* pad data segment to align the stack and the heap */
+ assert(litidx == 0); /* literal queue should have been emptied */
+ assert(sc_dataalign % sizeof(cell) == 0);
+ if (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ begdseg();
+ defstorage();
+ while (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+ {
+ stgwrite("0 ");
+ glb_declared++;
+ } /* while */
+ } /* if */
+
+ stgwrite("\nSTKSIZE "); /* write stack size (align stack top) */
+ outval(sc_stksize - (sc_stksize % sc_dataalign), TRUE);
+}
+
+/*
+ * Start (or restart) the CODE segment.
+ *
+ * In fact, the code and data segment specifiers are purely informational;
+ * the "DUMP" instruction itself already specifies that the following values
+ * should go to the data segment. All otherinstructions go to the code
+ * segment.
+ *
+ * Global references: curseg
+ */
+void
+begcseg(void)
+{
+ if (curseg != sIN_CSEG)
+ {
+ stgwrite("\n");
+ stgwrite("CODE\t; ");
+ outval(code_idx, TRUE);
+ curseg = sIN_CSEG;
+ } /* endif */
+}
+
+/*
+ * Start (or restart) the DATA segment.
+ *
+ * Global references: curseg
+ */
+void
+begdseg(void)
+{
+ if (curseg != sIN_DSEG)
+ {
+ stgwrite("\n");
+ stgwrite("DATA\t; ");
+ outval(glb_declared - litidx, TRUE);
+ curseg = sIN_DSEG;
+ } /* if */
+}
+
+void
+setactivefile(int fnumber)
+{
+ stgwrite("curfile ");
+ outval(fnumber, TRUE);
+}
+
+cell
+nameincells(char *name)
+{
+ cell clen =
+ (strlen(name) + sizeof(cell)) & ~(sizeof(cell) - 1);
+ return clen;
+}
+
+void
+setfile(char *name, int fileno)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg();
+ stgwrite("file ");
+ outval(fileno, FALSE);
+ stgwrite(" ");
+ stgwrite(name);
+ stgwrite("\n");
+ /* calculate code length */
+ code_idx += opcodes(1) + opargs(2) + nameincells(name);
+ } /* if */
+}
+
+void
+setline(int line, int fileno)
+{
+ if ((sc_debug & (sSYMBOLIC | sCHKBOUNDS)) != 0)
+ {
+ stgwrite("line ");
+ outval(line, FALSE);
+ stgwrite(" ");
+ outval(fileno, FALSE);
+ stgwrite("\t; ");
+ outval(code_idx, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* setlabel
+ *
+ * Post a code label (specified as a number), on a new line.
+ */
+void
+setlabel(int number)
+{
+ assert(number >= 0);
+ stgwrite("l.");
+ stgwrite((char *)itoh(number));
+ /* To assist verification of the assembled code, put the address of the
+ * label as a comment. However, labels that occur inside an expression
+ * may move (through optimization or through re-ordering). So write the
+ * address only if it is known to accurate.
+ */
+ if (!staging)
+ {
+ stgwrite("\t\t; ");
+ outval(code_idx, FALSE);
+ } /* if */
+ stgwrite("\n");
+}
+
+/* Write a token that signifies the end of an expression, or the end of a
+ * function parameter. This allows several simple optimizations by the peephole
+ * optimizer.
+ */
+void
+endexpr(int fullexpr)
+{
+ if (fullexpr)
+ stgwrite("\t;$exp\n");
+ else
+ stgwrite("\t;$par\n");
+}
+
+/* startfunc - declare a CODE entry point (function start)
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+startfunc(char *fname __UNUSED__)
+{
+ stgwrite("\tproc");
+ stgwrite("\n");
+ code_idx += opcodes(1);
+}
+
+/* endfunc
+ *
+ * Declare a CODE ending point (function end)
+ */
+void
+endfunc(void)
+{
+ stgwrite("\n"); /* skip a line */
+}
+
+/* alignframe
+ *
+ * Aligns the frame (and the stack) of the current function to a multiple
+ * of the specified byte count. Two caveats: the alignment ("numbytes") should
+ * be a power of 2, and this alignment must be done right after the frame
+ * is set up (before the first variable is declared)
+ */
+void
+alignframe(int numbytes)
+{
+#if !defined NDEBUG
+ /* "numbytes" should be a power of 2 for this code to work */
+ int i, count = 0;
+
+ for (i = 0; i < (int)(sizeof(numbytes) * 8); i++)
+ if (numbytes & (1 << i))
+ count++;
+ assert(count == 1);
+#endif
+
+ stgwrite("\tlctrl 4\n"); /* get STK in PRI */
+ stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
+ outval(~(numbytes - 1), TRUE);
+ stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
+ stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
+ stgwrite("\tsctrl 5\n"); /* ... and FRM */
+ code_idx += opcodes(5) + opargs(4);
+}
+
+/* Define a variable or function
+ */
+void
+defsymbol(char *name, int ident, int vclass, cell offset, int tag)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("symbol ");
+
+ stgwrite(name);
+ stgwrite(" ");
+
+ outval(offset, FALSE);
+ stgwrite(" ");
+
+ outval(vclass, FALSE);
+ stgwrite(" ");
+
+ outval(ident, TRUE);
+
+ code_idx += opcodes(1) + opargs(3) + nameincells(name); /* class and ident encoded in "flags" */
+
+ /* also write the optional tag */
+ if (tag != 0)
+ {
+ assert((tag & TAGMASK) != 0);
+ stgwrite("symtag ");
+ outval(tag & TAGMASK, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+ } /* if */
+}
+
+void
+symbolrange(int level, cell size)
+{
+ if ((sc_debug & sSYMBOLIC) != 0)
+ {
+ begcseg(); /* symbol definition in code segment */
+ stgwrite("srange ");
+ outval(level, FALSE);
+ stgwrite(" ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(2);
+ } /* if */
+}
+
+/* rvalue
+ *
+ * Generate code to get the value of a symbol into "primary".
+ */
+void
+rvalue(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect fetch, address already in PRI */
+ stgwrite("\tload.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect fetch of a character from a pack, address already in PRI */
+ stgwrite("\tlodb.i ");
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ /* indirect fetch, but address not yet in PRI */
+ assert(sym != NULL);
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ /* direct or stack relative fetch */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tload.s.pri ");
+ else
+ stgwrite("\tload.pri ");
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Get the address of a symbol into the primary register (used for arrays,
+ * and for passing arguments by reference).
+ */
+void
+address(symbol * sym)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY || sym->ident == iREFERENCE)
+ {
+ /* reference to a variable or to an array; currently this is
+ * always a local variable */
+ stgwrite("\tload.s.pri ");
+ }
+ else
+ {
+ /* a local array or local variable */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.pri ");
+ else
+ stgwrite("\tconst.pri ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uREAD);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* store
+ *
+ * Saves the contents of "primary" into a memory cell, either directly
+ * or indirectly (at the address given in the alternate register).
+ */
+void
+store(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstor.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* store at address in ALT */
+ stgwrite("\tstrb.i ");
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ }
+ else
+ {
+ assert(sym != NULL);
+ markusage(sym, uWRITTEN);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tstor.s.pri ");
+ else
+ stgwrite("\tstor.pri ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* source must in PRI, destination address in ALT. The "size"
+ * parameter is in bytes, not cells.
+ */
+void
+memcopy(cell size)
+{
+ stgwrite("\tmovs ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Address of the source must already have been loaded in PRI
+ * "size" is the size in bytes (not cells).
+ */
+void
+copyarray(symbol * sym, cell size)
+{
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ code_idx += opcodes(1) + opargs(1);
+ memcopy(size);
+}
+
+void
+fillarray(symbol * sym, cell size, cell val)
+{
+ const1(val); /* load val in PRI */
+
+ assert(sym != NULL);
+ /* the symbol can be a local array, a global array, or an array
+ * that is passed by reference.
+ */
+ if (sym->ident == iREFARRAY)
+ {
+ /* reference to an array; currently this is always a local variable */
+ assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
+ stgwrite("\tload.s.alt ");
+ }
+ else
+ {
+ /* a local or global array */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\taddr.alt ");
+ else
+ stgwrite("\tconst.alt ");
+ } /* if */
+ outval(sym->addr, TRUE);
+ markusage(sym, uWRITTEN);
+
+ stgwrite("\tfill ");
+ outval(size, TRUE);
+
+ code_idx += opcodes(2) + opargs(2);
+}
+
+/*
+ * Instruction to get an immediate value into the primary register
+ */
+void
+const1(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.pri\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.pri ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Instruction to get an immediate value into the secondary register
+ */
+void
+const2(cell val)
+{
+ if (val == 0)
+ {
+ stgwrite("\tzero.alt\n");
+ code_idx += opcodes(1);
+ }
+ else
+ {
+ stgwrite("\tconst.alt ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Copy value in secondary register to the primary register */
+void
+moveto1(void)
+{
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(1) + opargs(0);
+}
+
+/*
+ * Push primary register onto the stack
+ */
+void
+push1(void)
+{
+ stgwrite("\tpush.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push alternate register onto the stack
+ */
+void
+push2(void)
+{
+ stgwrite("\tpush.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * Push a constant value onto the stack
+ */
+void
+pushval(cell val)
+{
+ stgwrite("\tpush.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * pop stack to the primary register
+ */
+void
+pop1(void)
+{
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * pop stack to the secondary register
+ */
+void
+pop2(void)
+{
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * swap the top-of-stack with the value in primary register
+ */
+void
+swap1(void)
+{
+ stgwrite("\tswap.pri\n");
+ code_idx += opcodes(1);
+}
+
+/* Switch statements
+ * The "switch" statement generates a "case" table using the "CASE" opcode.
+ * The case table contains a list of records, each record holds a comparison
+ * value and a label to branch to on a match. The very first record is an
+ * exception: it holds the size of the table (excluding the first record) and
+ * the label to branch to when none of the values in the case table match.
+ * The case table is sorted on the comparison value. This allows more advanced
+ * abstract machines to sift the case table with a binary search.
+ */
+void
+ffswitch(int label)
+{
+ stgwrite("\tswitch ");
+ outval(label, TRUE); /* the label is the address of the case table */
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffcase(cell val, char *labelname, int newtable)
+{
+ if (newtable)
+ {
+ stgwrite("\tcasetbl\n");
+ code_idx += opcodes(1);
+ } /* if */
+ stgwrite("\tcase ");
+ outval(val, FALSE);
+ stgwrite(" ");
+ stgwrite(labelname);
+ stgwrite("\n");
+ code_idx += opcodes(0) + opargs(2);
+}
+
+/*
+ * Call specified function
+ */
+void
+ffcall(symbol * sym, int numargs)
+{
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN);
+ if ((sym->usage & uNATIVE) != 0)
+ {
+ /* reserve a SYSREQ id if called for the first time */
+ if (sc_status == statWRITE && (sym->usage & uREAD) == 0
+ && sym->addr >= 0)
+ sym->addr = ntv_funcid++;
+ stgwrite("\tsysreq.c ");
+ outval(sym->addr, FALSE);
+ stgwrite("\n\tstack ");
+ outval((numargs + 1) * sizeof(cell), TRUE);
+ code_idx += opcodes(2) + opargs(2);
+ }
+ else
+ {
+ /* normal function */
+ stgwrite("\tcall ");
+ stgwrite(sym->name);
+ stgwrite("\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Return from function
+ *
+ * Global references: funcstatus (referred to only)
+ */
+void
+ffret(void)
+{
+ stgwrite("\tretn\n");
+ code_idx += opcodes(1);
+}
+
+void
+ffabort(int reason)
+{
+ stgwrite("\thalt ");
+ outval(reason, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffbounds(cell size)
+{
+ if ((sc_debug & sCHKBOUNDS) != 0)
+ {
+ stgwrite("\tbounds ");
+ outval(size, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jump to local label number (the number is converted to a name)
+ */
+void
+jumplabel(int number)
+{
+ stgwrite("\tjump ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Define storage (global and static variables)
+ */
+void
+defstorage(void)
+{
+ stgwrite("dump ");
+}
+
+/*
+ * Inclrement/decrement stack pointer. Note that this routine does
+ * nothing if the delta is zero.
+ */
+void
+modstk(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\tstack ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* set the stack to a hard offset from the frame */
+void
+setstk(cell val)
+{
+ stgwrite("\tlctrl 5\n"); /* get FRM */
+ assert(val <= 0); /* STK should always become <= FRM */
+ if (val < 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE); /* add (negative) offset */
+ code_idx += opcodes(1) + opargs(1);
+ // ??? write zeros in the space between STK and the val in PRI (the new stk)
+ // get val of STK in ALT
+ // zero PRI
+ // need new FILL opcode that takes a variable size
+ } /* if */
+ stgwrite("\tsctrl 4\n"); /* store in STK */
+ code_idx += opcodes(2) + opargs(2);
+}
+
+void
+modheap(int delta)
+{
+ if (delta)
+ {
+ stgwrite("\theap ");
+ outval(delta, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+void
+setheap_pri(void)
+{
+ stgwrite("\theap "); /* ALT = HEA++ */
+ outval(sizeof(cell), TRUE);
+ stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
+ code_idx += opcodes(3) + opargs(1);
+}
+
+void
+setheap(cell val)
+{
+ stgwrite("\tconst.pri "); /* load default val in PRI */
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ setheap_pri();
+}
+
+/*
+ * Convert a cell number to a "byte" address; i.e. double or quadruple
+ * the primary register.
+ */
+void
+cell2addr(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.pri 1\n");
+#else
+ stgwrite("\tshl.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Double or quadruple the alternate register.
+ */
+void
+cell2addr_alt(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshl.c.alt 1\n");
+#else
+ stgwrite("\tshl.c.alt 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Convert "distance of addresses" to "number of cells" in between.
+ * Or convert a number of packed characters to the number of cells (with
+ * truncation).
+ */
+void
+addr2cell(void)
+{
+#if defined(BIT16)
+ stgwrite("\tshr.c.pri 1\n");
+#else
+ stgwrite("\tshr.c.pri 2\n");
+#endif
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* Convert from character index to byte address. This routine does
+ * nothing if a character has the size of a byte.
+ */
+void
+char2addr(void)
+{
+ if (charbits == 16)
+ {
+ stgwrite("\tshl.c.pri 1\n");
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* Align PRI (which should hold a character index) to an address.
+ * The first character in a "pack" occupies the highest bits of
+ * the cell. This is at the lower memory address on Big Endian
+ * computers and on the higher address on Little Endian computers.
+ * The ALIGN.pri/alt instructions must solve this machine dependence;
+ * that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
+ * and on Little Endian computers they should toggle the address.
+ */
+void
+charalign(void)
+{
+ stgwrite("\talign.pri ");
+ outval(charbits / 8, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Add a constant to the primary register.
+ */
+void
+addconst(cell val)
+{
+ if (val != 0)
+ {
+ stgwrite("\tadd.c ");
+ outval(val, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * signed multiply of primary and secundairy registers (result in primary)
+ */
+void
+os_mult(void)
+{
+ stgwrite("\tsmul\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * signed divide of alternate register by primary register (quotient in
+ * primary; remainder in alternate)
+ */
+void
+os_div(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * modulus of (alternate % primary), result in primary (signed)
+ */
+void
+os_mod(void)
+{
+ stgwrite("\tsdiv.alt\n");
+ stgwrite("\tmove.pri\n"); /* move ALT to PRI */
+ code_idx += opcodes(2);
+}
+
+/*
+ * Add primary and alternate registers (result in primary).
+ */
+void
+ob_add(void)
+{
+ stgwrite("\tadd\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * subtract primary register from alternate register (result in primary)
+ */
+void
+ob_sub(void)
+{
+ stgwrite("\tsub.alt\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * arithmic shift left alternate register the number of bits
+ * given in the primary register (result in primary).
+ * There is no need for a "logical shift left" routine, since
+ * logical shift left is identical to arithmic shift left.
+ */
+void
+ob_sal(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshl\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * arithmic shift right alternate register the number of bits
+ * given in the primary register (result in primary).
+ */
+void
+os_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical (unsigned) shift right of the alternate register by the
+ * number of bits given in the primary register (result in primary).
+ */
+void
+ou_sar(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tshr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * inclusive "or" of primary and secondary registers (result in primary)
+ */
+void
+ob_or(void)
+{
+ stgwrite("\tor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "exclusive or" of primary and alternate registers (result in primary)
+ */
+void
+ob_xor(void)
+{
+ stgwrite("\txor\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * "and" of primary and secundairy registers (result in primary)
+ */
+void
+ob_and(void)
+{
+ stgwrite("\tand\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT==PRI; result in primary register (1 or 0).
+ */
+void
+ob_eq(void)
+{
+ stgwrite("\teq\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * test ALT!=PRI
+ */
+void
+ob_ne(void)
+{
+ stgwrite("\tneq\n");
+ code_idx += opcodes(1);
+}
+
+/* The abstract machine defines the relational instructions so that PRI is
+ * on the left side and ALT on the right side of the operator. For example,
+ * SLESS sets PRI to either 1 or 0 depending on whether the expression
+ * "PRI < ALT" is true.
+ *
+ * The compiler generates comparisons with ALT on the left side of the
+ * relational operator and PRI on the right side. The XCHG instruction
+ * prefixing the relational operators resets this. We leave it to the
+ * peephole optimizer to choose more compact instructions where possible.
+ */
+
+/* Relational operator prefix for chained relational expressions. The
+ * "suffix" code restores the stack.
+ * For chained relational operators, the goal is to keep the comparison
+ * result "so far" in PRI and the value of the most recent operand in
+ * ALT, ready for a next comparison.
+ * The "prefix" instruction pushed the comparison result (PRI) onto the
+ * stack and moves the value of ALT into PRI. If there is a next comparison,
+ * PRI can now serve as the "left" operand of the relational operator.
+ */
+void
+relop_prefix(void)
+{
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tmove.pri\n");
+ code_idx += opcodes(2);
+}
+
+void
+relop_suffix(void)
+{
+ stgwrite("\tswap.alt\n");
+ stgwrite("\tand\n");
+ stgwrite("\tpop.alt\n");
+ code_idx += opcodes(3);
+}
+
+/*
+ * test ALT<PRI (signed)
+ */
+void
+os_lt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsless\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT<=PRI (signed)
+ */
+void
+os_le(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsleq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>PRI (signed)
+ */
+void
+os_gt(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgrtr\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * test ALT>=PRI (signed)
+ */
+void
+os_ge(void)
+{
+ stgwrite("\txchg\n");
+ stgwrite("\tsgeq\n");
+ code_idx += opcodes(2);
+}
+
+/*
+ * logical negation of primary register
+ */
+void
+lneg(void)
+{
+ stgwrite("\tnot\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * two's complement primary register
+ */
+void
+neg(void)
+{
+ stgwrite("\tneg\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * one's complement of primary register
+ */
+void
+invert(void)
+{
+ stgwrite("\tinvert\n");
+ code_idx += opcodes(1);
+}
+
+/*
+ * nop
+ */
+void
+nooperation(void)
+{
+ stgwrite("\tnop\n");
+ code_idx += opcodes(1);
+}
+
+/* increment symbol
+ */
+void
+inc(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect increment, address already in PRI */
+ stgwrite("\tinc.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect increment of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tinc.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* increment */
+ stgwrite("\tinc.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tinc.s ");
+ else
+ stgwrite("\tinc ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/* decrement symbol
+ *
+ * in case of an integer pointer, the symbol must be incremented by 2.
+ */
+void
+dec(value * lval)
+{
+ symbol *sym;
+
+ sym = lval->sym;
+ if (lval->ident == iARRAYCELL)
+ {
+ /* indirect decrement, address already in PRI */
+ stgwrite("\tdec.i\n");
+ code_idx += opcodes(1);
+ }
+ else if (lval->ident == iARRAYCHAR)
+ {
+ /* indirect decrement of single character, address already in PRI */
+ stgwrite("\tpush.pri\n");
+ stgwrite("\tpush.alt\n");
+ stgwrite("\tmove.alt\n"); /* copy address */
+ stgwrite("\tlodb.i "); /* read from PRI into PRI */
+ outval(charbits / 8, TRUE); /* read one or two bytes */
+ stgwrite("\tdec.pri\n");
+ stgwrite("\tstrb.i "); /* write PRI to ALT */
+ outval(charbits / 8, TRUE); /* write one or two bytes */
+ stgwrite("\tpop.alt\n");
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(8) + opargs(2);
+ }
+ else if (lval->ident == iREFERENCE)
+ {
+ assert(sym != NULL);
+ stgwrite("\tpush.pri\n");
+ /* load dereferenced value */
+ assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tlref.s.pri ");
+ else
+ stgwrite("\tlref.pri ");
+ outval(sym->addr, TRUE);
+ /* decrement */
+ stgwrite("\tdec.pri\n");
+ /* store dereferenced value */
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tsref.s.pri ");
+ else
+ stgwrite("\tsref.pri ");
+ outval(sym->addr, TRUE);
+ stgwrite("\tpop.pri\n");
+ code_idx += opcodes(5) + opargs(2);
+ }
+ else
+ {
+ /* local or global variable */
+ assert(sym != NULL);
+ if (sym->vclass == sLOCAL)
+ stgwrite("\tdec.s ");
+ else
+ stgwrite("\tdec ");
+ outval(sym->addr, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+ } /* if */
+}
+
+/*
+ * Jumps to "label" if PRI != 0
+ */
+void
+jmp_ne0(int number)
+{
+ stgwrite("\tjnz ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ * Jumps to "label" if PRI == 0
+ */
+void
+jmp_eq0(int number)
+{
+ stgwrite("\tjzer ");
+ outval(number, TRUE);
+ code_idx += opcodes(1) + opargs(1);
+}
+
+/* write a value in hexadecimal; optionally adds a newline */
+void
+outval(cell val, int newline)
+{
+ stgwrite(itoh(val));
+ if (newline)
+ stgwrite("\n");
+}
--- /dev/null
+/* Small compiler - Error message system
+ * In fact a very simple system, using only 'panic mode'.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_sc5.scp"
+
+static int errflag;
+static int errstart; /* line number at which the instruction started */
+
+/* error
+ *
+ * Outputs an error message (note: msg is passed optionally).
+ * If an error is found, the variable "errflag" is set and subsequent
+ * errors are ignored until lex() finds a semicolumn or a keyword
+ * (lex() resets "errflag" in that case).
+ *
+ * Global references: inpfname (referred to only)
+ * fline (referred to only)
+ * fcurrent (referred to only)
+ * errflag (altered)
+ */
+int
+error(int number, ...)
+{
+ static int lastline, lastfile, errorcount;
+ char *msg;
+ va_list argptr;
+ char string[1024];
+ int start;
+
+ /* errflag is reset on each semicolon.
+ * In a two-pass compiler, an error should not be reported twice. Therefore
+ * the error reporting is enabled only in the second pass (and only when
+ * actually producing output). Fatal errors may never be ignored.
+ */
+ if (((errflag) || (sc_status != statWRITE)) &&
+ ((number < 100) || (number >= 200)))
+ return 0;
+
+ if (number < 100)
+ {
+ msg = errmsg[number - 1];
+ errflag = TRUE; /* set errflag (skip rest of erroneous expression) */
+ errnum++;
+ }
+ else if (number < 200)
+ {
+ msg = fatalmsg[number - 100];
+ errnum++; /* a fatal error also counts as an error */
+ }
+ else
+ {
+ msg = warnmsg[number - 200];
+ warnnum++;
+ }
+
+ strexpand(string, (unsigned char *)msg, sizeof string, SCPACK_TABLE);
+
+ va_start(argptr, number);
+
+ start = (errstart == fline) ? -1 : errstart;
+
+ if (sc_error(number, string, inpfname, start, fline, argptr))
+ {
+ sc_closeasm(outf);
+ outf = NULL;
+ longjmp(errbuf, 3);
+ }
+
+ va_end(argptr);
+
+ if (((number >= 100) && (number < 200)) || (errnum > 250))
+ {
+ va_start(argptr, number);
+ sc_error(0, "\nCompilation aborted.", NULL, 0, 0, argptr);
+ va_end(argptr);
+
+ if (outf)
+ {
+ sc_closeasm(outf);
+ outf = NULL;
+ } /* if */
+ longjmp(errbuf, 2); /* fatal error, quit */
+ } /* if */
+
+ /* check whether we are seeing many errors on the same line */
+ if (((errstart < 0) && (lastline != fline)) ||
+ (lastline < errstart) || (lastline > fline) || (fcurrent != lastfile))
+ errorcount = 0;
+ lastline = fline;
+ lastfile = fcurrent;
+ if (number < 200)
+ errorcount++;
+ if (errorcount >= 3)
+ error(107); /* too many error/warning messages on one line */
+ return 0;
+}
+
+void
+errorset(int code)
+{
+ switch (code)
+ {
+ case sRESET:
+ errflag = FALSE; /* start reporting errors */
+ break;
+ case sFORCESET:
+ errflag = TRUE; /* stop reporting errors */
+ break;
+ case sEXPRMARK:
+ errstart = fline; /* save start line number */
+ break;
+ case sEXPRRELEASE:
+ errstart = -1; /* forget start line number */
+ break;
+ default:
+ break;
+ }
+}
--- /dev/null
+/* Small compiler - Error message strings (plain and compressed formats)
+ *
+ * Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+int strexpand(char *dest, unsigned char *source, int maxlen,
+ unsigned char pairtable[128][2]);
+
+#define SCPACK_TABLE errstr_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char errstr_table[][2] = {
+ {101, 32}, {116, 32}, {111, 110}, {105, 110}, {97, 114}, {100, 32}, {105,
+ 130},
+ {101, 114}, {101, 110}, {115, 32}, {97, 108}, {97, 116}, {117, 110}, {115,
+ 34},
+ {37, 141}, {34, 142},
+ {109, 136}, {121, 32}, {97, 110}, {114, 101}, {99, 116}, {134, 32}, {110,
+ 111},
+ {101, 133}, {118, 138}, {115, 105}, {98, 108}, {111, 114}, {115, 116},
+ {41, 10}, {109, 98}, {100, 101},
+ {117, 115}, {150, 129}, {102, 140}, {117, 144}, {162, 148}, {103, 163}, {132,
+ 165},
+ {114, 97}, {105, 133}, {152, 168}, {99, 104}, {32, 143}, {97, 32}, {131,
+ 169},
+ {97, 115}, {164, 149},
+ {111, 108}, {101, 120}, {97, 154}, {135, 32}, {132, 167}, {111, 102}, {105,
+ 116},
+ {166, 129}, {101, 100}, {98, 128}, {178, 128}, {160, 129}, {105, 137},
+ {180, 145}, {121, 158}, {190, 176},
+ {109, 187}, {115, 191}, {118, 132}, {101, 10}, {115, 10}, {112, 147}, {155,
+ 32},
+ {181, 32}, {159, 102}, {194, 105}, {99, 130}, {103, 32}, {201, 186}, {116,
+ 111},
+ {34, 32}, {109, 97},
+ {153, 122}, {171, 10}, {104, 97}, {100, 105}, {108, 111}, {111, 112}, {200,
+ 131},
+ {139, 134}, {213, 135}, {101, 137}, {202, 156}, {143, 157}, {138, 32},
+ {192, 185}, {58, 209}, {105, 99},
+ {112, 111}, {115, 115}, {110, 117}, {115, 117}, {146, 129}, {226, 158}, {229,
+ 179},
+ {177, 197}, {231, 225}, {132, 97}, {98, 101}, {99, 111}, {216, 139}, {109,
+ 139},
+ {116, 10}, {99, 146},
+ {44, 32}, {237, 170}, {131, 203}, {116, 104}, {117, 108}, {152, 117}, {108,
+ 128},
+ {118, 128}, {101, 144}, {233, 148}, {174, 153}, {110, 32}, {131, 32},
+ {146, 32}, {239, 161}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+static char *errmsg[] = {
+#ifdef SCPACK
+/*001*/ "expected token: \"%s\", but found \"%s\"\n",
+/*002*/ "only a single statement (or expression) can follow each \"case\"\n",
+/*003*/ "declaration of a local variable must appear in a compound block\n",
+/*004*/ "function \"%s\" is not implemented\n",
+/*005*/ "function may not have arguments\n",
+/*006*/ "must be assigned to an array\n",
+/*007*/ "assertion failed\n",
+/*008*/ "must be a constant expression; assumed zero\n",
+/*009*/ "invalid array size (negative or zero)\n",
+/*010*/ "invalid function or declaration\n",
+/*011*/ "invalid outside functions\n",
+/*012*/ "invalid function call, not a valid address\n",
+/*013*/ "no entry point (no public functions)\n",
+/*014*/ "invalid statement; not in switch\n",
+/*015*/ "\"default\" case must be the last case in switch statement\n",
+/*016*/ "multiple defaults in \"switch\"\n",
+/*017*/ "undefined symbol \"%s\"\n",
+/*018*/ "initialization data exceeds declared size\n",
+/*019*/ "not a label: \"%s\"\n",
+/*020*/ "invalid symbol name \"%s\"\n",
+/*021*/ "symbol already defined: \"%s\"\n",
+/*022*/ "must be lvalue (non-constant)\n",
+/*023*/ "array assignment must be simple assignment\n",
+/*024*/ "\"break\" or \"continue\" is out of context\n",
+/*025*/ "function heading differs from prototype\n",
+/*026*/ "no matching \"#if...\"\n",
+/*027*/ "invalid character constant\n",
+/*028*/ "invalid subscript (not an array or too many subscripts)\n",
+/*029*/ "invalid expression, assumed zero\n",
+/*030*/ "compound statement not closed at the end of file\n",
+/*031*/ "unknown directive\n",
+/*032*/ "array index out of bounds (variable \"%s\")\n",
+/*033*/ "array must be indexed (variable \"%s\")\n",
+/*034*/ "argument does not have a default value (argument %d)\n",
+/*035*/ "argument type mismatch (argument %d)\n",
+/*036*/ "empty statement\n",
+/*037*/ "invalid string (possibly non-terminated string)\n",
+/*038*/ "extra characters on line\n",
+/*039*/ "constant symbol has no size\n",
+/*040*/ "duplicate \"case\" label (value %d)\n",
+/*041*/ "invalid ellipsis, array size is not known\n",
+/*042*/ "invalid combination of class specifiers\n",
+/*043*/ "character constant exceeds range for packed string\n",
+/*044*/ "positional parameters must precede all named parameters\n",
+/*045*/ "too many function arguments\n",
+/*046*/ "unknown array size (variable \"%s\")\n",
+/*047*/ "array sizes must match\n",
+/*048*/ "array dimensions must match\n",
+/*049*/ "invalid line continuation\n",
+/*050*/ "invalid range\n",
+/*051*/ "invalid subscript, use \"[ ]\" operators on major dimensions\n",
+/*052*/ "only the last dimension may be variable length\n",
+/*053*/ "exceeding maximum number of dimensions\n",
+/*054*/ "unmatched closing brace\n",
+/*055*/ "start of function body without function header\n",
+/*056*/
+ "arrays, local variables and function arguments cannot be public (variable \"%s\")\n",
+/*057*/ "unfinished expression before compiler directive\n",
+/*058*/ "duplicate argument; same argument is passed twice\n",
+/*059*/ "function argument may not have a default value (variable \"%s\")\n",
+/*060*/ "multiple \"#else\" directives between \"#if ... #endif\"\n",
+/*061*/ "operator cannot be redefined\n",
+/*062*/ "number of operands does not fit the operator\n",
+/*063*/ "function result tag of operator \"%s\" must be \"%s\"\n",
+/*064*/ "cannot change predefined operators\n",
+/*065*/ "function argument may only have a single tag (argument %d)\n",
+/*066*/
+ "function argument may not be a reference argument or an array (argument \"%s\")\n",
+/*067*/
+ "variable cannot be both a reference and an array (variable \"%s\")\n",
+/*068*/ "invalid rational number precision in #pragma\n",
+/*069*/ "rational number format already defined\n",
+/*070*/ "rational number support was not enabled\n",
+/*071*/
+ "user-defined operator must be declared before use (function \"%s\")\n",
+/*072*/ "\"sizeof\" operator is invalid on \"function\" symbols\n",
+/*073*/ "function argument must be an array (argument \"%s\")\n",
+/*074*/ "#define pattern must start with an alphabetic character\n",
+/*075*/ "input line too long (after substitutions)\n"
+#else
+ "\261pe\224\227\315k\210:\253\360bu\201fo\214\205\217\012",
+ "\202l\221\254s\203g\366\234\213\370\201(\306\350\206) \357 f\260\324w ea\252 \042c\256e\042\012",
+ "\237cl\204\213\225\307\254\324c\334\314\300appe\204 \374\254\353m\340\214\205\232ock\012",
+ "\257\217 \274\241impl\370t\270\012",
+ "\257\317\221\241\322\367\246t\304",
+ "\335\372gn\227\315 \375\264y\012",
+ "\256s\207t\225fail\270\012",
+ "\335\254\332\344\350\206; \256\343m\227z\207o\012",
+ "\255\275\320\200(neg\213i\367\306z\207o\235",
+ "\255\257\306\237cl\204\327\012",
+ "\255out\231d\200\244\206\304",
+ "\255\257c\212l\360\241\254\251add\223s\304",
+ "\226 \210tr\221\340\203\201(\226 pu\232\337 \244\206s\235",
+ "\255\234\213\370t; \241\374sw\266\252\012",
+ "\042\310a\364t\316c\256\200\335\363\200l\256\201c\256\200\374sw\266\252 \234\213\370\356",
+ "m\364tip\366\310a\364t\211\374\042sw\266\252\042\012",
+ "\214\326\227\301\321",
+ "\203\266i\212iz\213\225d\213\254\261ce\270\211\237cl\204\227\320\303",
+ "\241\254la\352l\336",
+ "\255\301 nam\200\217\012",
+ "\301 \212\223ad\221\326\270\336",
+ "\335l\365\200(n\202-\332\222t\235",
+ "\275\372gn\220\201\335\231mp\366\372gn\220\356",
+ "\042b\223ak\316\306\042\312t\203ue\316\274ou\201\307\312t\261\356",
+ "\257head\362\323ff\207\211from pro\315typ\303",
+ "\226 \361\362\042#if...\042\012",
+ "\255\252\371\263\332\222\356",
+ "\255\343bscrip\201(\241\375\275\306\315o m\222\221\343bscripts\235",
+ "\255\350\206\360\256\343m\227z\207o\012",
+ "\353m\340\214\205\234\213\370\201\241c\324s\227a\201\363\200\210\205\307fil\303",
+ "\214k\226w\373\323\223\224iv\303",
+ "\275\203\237x ou\201\307bo\214d\211(\314\333",
+ "\275\335\203\237x\227(\314\333",
+ "\267do\331\241\322\367\254\310a\364\201\365\200(\267%d\235",
+ "\267typ\200mis\361 (\267%d\235",
+ "empt\221\234\213\370\356",
+ "\255\234r\362(\340s\231\232\221n\202-t\207m\203\213\227\234r\203g\235",
+ "\261t\247 \252\371\207\211\202 l\203\303",
+ "\332\344\301 \322\211\226 \320\303",
+ "dupl\337\213\200\042c\256e\316la\352l (\365\200%d\235",
+ "\255ellip\231s\360\275\320\200\274\241k\226wn\012",
+ "\255\353\236\203\213\225\307cl\256\211specifi\207\304",
+ "\252\371\263\332\344\261ce\270\211r\222g\200f\306pack\227\234r\203g\012",
+ "\340\231t\206\334p\351met\207\211\300\305c\270\200\212l nam\227p\351met\207\304",
+ "\315o m\222\221\257\246t\304",
+ "\214k\226w\373\275\320\200(\314\333",
+ "\275\320\331\300\361\012",
+ "\275\323\220s\206\211\300\361\012",
+ "\255l\203\200\312t\203u\327\012",
+ "\255r\222g\303",
+ "\255\343bscript\360\240\200\042[ ]\316\354\233\211\202 \317j\306\323\220s\206\304",
+ "\202l\221\363\200l\256\201\323\220s\225\317\221\271\314l\210g\363\012",
+ "\261ce\270\362\317ximum \346\307\323\220s\206\304",
+ "\214\361\227c\324s\362b\247c\303",
+ "\234\204\201\307\257bod\221w\266hou\201\257head\207\012",
+ "\264ys\360\324c\334\311\262\331\222\205\257\246t\211\376\271pu\232\337 (\314\333",
+ "\214f\203ish\227\350\225\352f\233\200\353mpil\263\323\223\224iv\303",
+ "dupl\337\213\200\246t; sam\200\267\274p\256s\227tw\337\303",
+ "\257\267\317\221\241\322\367\254\310a\364\201\365\200(\314\333",
+ "m\364tip\366\042#else\316\323\223\224iv\331\352twe\210 \042#if ... #\210\323f\042\012",
+ "\354\306\376\271\223\326\270\012",
+ "\346\307\330\222d\211do\331\241fi\201\363\200\354\233\012",
+ "\257\223\343l\201ta\313\307\354\233\253 \335\217\012",
+ "\376\252\222g\200\305\326\227\354\233\304",
+ "\257\267\317\221\202l\221\322\367\254s\203g\366ta\313(\267%d\235",
+ "\257\267\317\221\241\271\254\223f\207\210c\200\267\306\375\275(\267\333",
+ "\314\376\271bo\363 \254\223f\207\210c\200\222\205\375\275(\314\333",
+ "\255r\327\334\346\305cis\225\374#p\247g\317\012",
+ "r\327\334\346f\233\317\201\212\223ad\221\326\270\012",
+ "r\327\334\346\343pp\233\201wa\211\241\210\262\270\012",
+ "\240\207-\326\227\354\306\335\237cl\204\227\352f\233\200\240\200(\257\333",
+ "\042\320e\265\316\354\306\274\255\202 \042\244\206\316\301\304",
+ "\257\267\335\375\275(\267\333",
+ "#\326\200p\213t\207\373\300\234\204\201w\266h \375\212p\322\352t\337 \252\371\207\012",
+ "\203pu\201l\203\200\315o l\202\313(aft\263\343b\234\266ut\206s\235"
+#endif
+};
+
+static char *fatalmsg[] = {
+#ifdef SCPACK
+/*100*/ "cannot read from file: \"%s\"\n",
+/*101*/ "cannot write to file: \"%s\"\n",
+/*102*/ "table overflow: \"%s\"\n",
+ /* table can be: loop table
+ * literal table
+ * staging buffer
+ * parser stack (recursive include?)
+ * option table (response file)
+ * peephole optimizer table
+ */
+/*103*/ "insufficient memory\n",
+/*104*/ "invalid assembler instruction \"%s\"\n",
+/*105*/ "numeric overflow, exceeding capacity\n",
+/*106*/ "compaction buffer overflow\n",
+/*107*/ "too many error messages on one line\n"
+#else
+ "\376\223a\205from file\336",
+ "\376wr\266\200\315 file\336",
+ "t\272ov\207f\324w\336",
+ "\203\343ff\337i\210\201mem\233y\012",
+ "\255\256sem\232\263\203\234ru\224\225\217\012",
+ "\342m\207\337 ov\207f\324w\360\261ce\270\362capac\266y\012",
+ "\353mpa\224\225buff\263ov\207f\324w\012",
+ "\315o m\222\221\207r\306me\341ag\331\202 \202\200l\203\303"
+#endif
+};
+
+static char *warnmsg[] = {
+#ifdef SCPACK
+/*200*/ "symbol \"%s\" is truncated to %d characters\n",
+/*201*/ "redefinition of constant/macro (symbol \"%s\")\n",
+/*202*/ "number of arguments does not match definition\n",
+/*203*/ "symbol is never used: \"%s\"\n",
+/*204*/ "symbol is assigned a value that is never used: \"%s\"\n",
+/*205*/ "redundant code: constant expression is zero\n",
+/*206*/ "redundant test: constant expression is non-zero\n",
+/*207*/ "unknown #pragma\n",
+/*208*/ "function uses both \"return;\" and \"return <value>;\"\n",
+/*209*/ "function \"%s\" should return a value\n",
+/*210*/ "possible use of symbol before initialization: \"%s\"\n",
+/*211*/ "possibly unintended assignment\n",
+/*212*/ "possibly unintended bitwise operation\n",
+/*213*/ "tag mismatch\n",
+/*214*/ "possibly a \"const\" array argument was intended: \"%s\"\n",
+/*215*/ "expression has no effect\n",
+/*216*/ "nested comment\n",
+/*217*/ "loose indentation\n",
+/*218*/ "old style prototypes used with optional semicolumns\n",
+/*219*/ "local variable \"%s\" shadows a variable at a preceding level\n",
+/*220*/ "exported or native symbol \"%s\" is truncated to %d characters\n",
+/*221*/ "label name \"%s\" shadows tag name\n",
+/*222*/ "number of digits exceeds rational number precision\n",
+/*223*/ "redundant \"sizeof\": argument size is always 1 (symbol \"%s\")\n",
+/*224*/
+ "indeterminate array size in \"sizeof\" expression (symbol \"%s\")\n",
+/*225*/ "unreachable code\n",
+/*226*/ "a variable is assigned to itself (symbol \"%s\")\n"
+#else
+ "\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+ "\223\326\266\225\307\332\222t/\317cro (\301\253\235",
+ "\346\307\246t\211do\331\241\361 \326\266\206\012",
+ "\301 \274nev\263\240\270\336",
+ "\301 \274\372gn\227\254\365\200t\322\201\274nev\263\240\270\336",
+ "\223d\214d\344\353\237: \332\344\350\225\274z\207o\012",
+ "\223d\214d\344te\234: \332\344\350\225\274n\202-z\207o\012",
+ "\214k\226w\373#p\247g\317\012",
+ "\257\240\331bo\363 \042\223turn;\316\222\205\042\223tur\373<\365e>;\042\012",
+ "\257\217 sho\364\205\223tur\373\254\365\303",
+ "\340s\231\232\200\240\200\307\301 \352f\233\200\203\266i\212iz\327\336",
+ "\340s\231\232\221\214\203t\210d\227\372gn\220\356",
+ "\340s\231\232\221\214\203t\210d\227b\266wis\200\330\327\012",
+ "ta\313mis\361\012",
+ "\340s\231\232\221\254\042\332\316\275\267wa\211\203t\210\237d\336",
+ "\350\225\322\211\226 effe\224\012",
+ "ne\234\227\353m\220\356",
+ "\324os\200\203d\210t\327\012",
+ "\260\205\234y\366pro\315typ\331\240\227w\266h \325t\206\334sem\337\260umn\304",
+ "\324c\334\314\217 s\322dow\211\254\314a\201\254\305c\270\362level\012",
+ "\261p\233t\227\306n\213i\367\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+ "la\352l nam\200\217 s\322dow\211ta\313nam\303",
+ "\346\307\323g\266\211\261ce\270\211r\327\334\346\305cis\206\012",
+ "\223d\214d\344\042\320e\265\042: \267\320\200\274\212way\2111 (\301\253\235",
+ "\203\237t\207m\203\213\200\275\320\200\374\042\320e\265\316\350\225(\301\253\235",
+ "\214\223a\252\272\353\237\012",
+ "\254\314\274\372gn\227\315 \266self (\301\253\235"
+#endif
+};
--- /dev/null
+/* Small compiler - Binary code generation (the "assembler")
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h> /* for macro max() */
+#include <string.h>
+#include <ctype.h>
+#include "embryo_cc_sc.h"
+
+typedef cell(*OPCODE_PROC) (FILE * fbin, char *params, cell opcode);
+
+typedef struct
+{
+ cell opcode;
+ char *name;
+ int segment; /* sIN_CSEG=parse in cseg, sIN_DSEG=parse in dseg */
+ OPCODE_PROC func;
+} OPCODE;
+
+static cell codeindex; /* similar to "code_idx" */
+static cell *lbltab; /* label table */
+static int writeerror;
+static int bytes_in, bytes_out;
+
+/* apparently, strtol() does not work correctly on very large (unsigned)
+ * hexadecimal values */
+static ucell
+hex2long(char *s, char **n)
+{
+ unsigned long result = 0L;
+ int negate = FALSE;
+ int digit;
+
+ /* ignore leading whitespace */
+ while (*s == ' ' || *s == '\t')
+ s++;
+
+ /* allow a negation sign to create the two's complement of numbers */
+ if (*s == '-')
+ {
+ negate = TRUE;
+ s++;
+ } /* if */
+
+ assert((*s >= '0' && *s <= '9') || (*s >= 'a' && *s <= 'f')
+ || (*s >= 'a' && *s <= 'f'));
+ for (;;)
+ {
+ if (*s >= '0' && *s <= '9')
+ digit = *s - '0';
+ else if (*s >= 'a' && *s <= 'f')
+ digit = *s - 'a' + 10;
+ else if (*s >= 'A' && *s <= 'F')
+ digit = *s - 'A' + 10;
+ else
+ break; /* probably whitespace */
+ result = (result << 4) | digit;
+ s++;
+ } /* for */
+ if (n)
+ *n = s;
+ if (negate)
+ result = (~result) + 1; /* take two's complement of the result */
+ return (ucell) result;
+}
+
+#ifdef WORDS_BIGENDIAN
+static short *
+align16(short *v)
+{
+ unsigned char *s = (unsigned char *)v;
+ unsigned char t;
+
+ /* swap two bytes */
+ t = s[0];
+ s[0] = s[1];
+ s[1] = t;
+ return v;
+}
+
+static long *
+align32(long *v)
+{
+ unsigned char *s = (unsigned char *)v;
+ unsigned char t;
+
+ /* swap outer two bytes */
+ t = s[0];
+ s[0] = s[3];
+ s[3] = t;
+ /* swap inner two bytes */
+ t = s[1];
+ s[1] = s[2];
+ s[2] = t;
+ return v;
+}
+#if defined BIT16
+#define aligncell(v) align16(v)
+#else
+#define aligncell(v) align32(v)
+#endif
+#else
+#define align16(v) (v)
+#define align32(v) (v)
+#define aligncell(v) (v)
+#endif
+
+static char *
+skipwhitespace(char *str)
+{
+ while (sc_isspace(*str))
+ str++;
+ return str;
+}
+
+static char *
+stripcomment(char *str)
+{
+ char *ptr = strchr(str, ';');
+
+ if (ptr)
+ {
+ *ptr++ = '\n'; /* terminate the line, but leave the '\n' */
+ *ptr = '\0';
+ } /* if */
+ return str;
+}
+
+static void
+write_encoded(FILE * fbin, ucell * c, int num)
+{
+ assert(sizeof(cell) <= 4); /* code must be adjusted for larger cells */
+ assert(fbin != NULL);
+ while (num-- > 0)
+ {
+ if (sc_compress)
+ {
+ ucell p = (ucell) * c;
+ unsigned char t[5]; /* a 32-bit cell is encoded in max. 5 bytes (3 bytes for a 16-bit cell) */
+ unsigned char code;
+ int index;
+
+ for (index = 0; index < 5; index++)
+ {
+ t[index] = (unsigned char)(p & 0x7f); /* store 7 bits */
+ p >>= 7;
+ } /* for */
+ /* skip leading zeros */
+ while (index > 1 && t[index - 1] == 0
+ && (t[index - 2] & 0x40) == 0)
+ index--;
+ /* skip leading -1s *//* ??? for BIT16, check for index==3 && t[index-1]==0x03 */
+ if (index == 5 && t[index - 1] == 0x0f
+ && (t[index - 2] & 0x40) != 0)
+ index--;
+ while (index > 1 && t[index - 1] == 0x7f
+ && (t[index - 2] & 0x40) != 0)
+ index--;
+ /* write high byte first, write continuation bits */
+ assert(index > 0);
+ while (index-- > 0)
+ {
+ code =
+ (unsigned char)((index == 0) ? t[index]
+ : (t[index] | 0x80));
+ writeerror |= !sc_writebin(fbin, &code, 1);
+ bytes_out++;
+ } /* while */
+ bytes_in += sizeof *c;
+ assert(AMX_EXPANDMARGIN > 2);
+ if (bytes_out - bytes_in >= AMX_EXPANDMARGIN - 2)
+ error(106); /* compression buffer overflow */
+ }
+ else
+ {
+ assert((sc_lengthbin(fbin) % sizeof(cell)) == 0);
+ writeerror |= !sc_writebin(fbin, aligncell(c), sizeof *c);
+ } /* if */
+ c++;
+ } /* while */
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+noop(FILE * fbin __UNUSED__, char *params __UNUSED__, cell opcode __UNUSED__)
+{
+ return 0;
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+parm0(FILE * fbin, char *params __UNUSED__, cell opcode)
+{
+ if (fbin)
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ return opcodes(1);
+}
+
+static cell
+parm1(FILE * fbin, char *params, cell opcode)
+{
+ ucell p = hex2long(params, NULL);
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+parm2(FILE * fbin, char *params, cell opcode)
+{
+ ucell p[2];
+
+ p[0] = hex2long(params, ¶ms);
+ p[1] = hex2long(params, NULL);
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, p, 2);
+ } /* if */
+ return opcodes(1) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_dump(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+ ucell p;
+ int num = 0;
+
+ while (*params != '\0')
+ {
+ p = hex2long(params, ¶ms);
+ if (fbin)
+ write_encoded(fbin, &p, 1);
+ num++;
+ while (sc_isspace(*params))
+ params++;
+ } /* while */
+ return num * sizeof(cell);
+}
+
+static cell
+do_call(FILE * fbin, char *params, cell opcode)
+{
+ char name[sNAMEMAX + 1];
+ int i;
+ symbol *sym;
+ ucell p;
+
+ for (i = 0; !sc_isspace(*params); i++, params++)
+ {
+ assert(*params != '\0');
+ assert(i < sNAMEMAX);
+ name[i] = *params;
+ } /* for */
+ name[i] = '\0';
+
+ /* look up the function address; note that the correct file number must
+ * already have been set (in order for static globals to be found).
+ */
+ sym = findglb(name);
+ assert(sym != NULL);
+ assert(sym->ident == iFUNCTN || sym->ident == iREFFUNC);
+ assert(sym->vclass == sGLOBAL);
+
+ p = sym->addr;
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+do_jump(FILE * fbin, char *params, cell opcode)
+{
+ int i;
+ ucell p;
+
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+static cell
+do_file(FILE * fbin, char *params, cell opcode)
+{
+ ucell p, clen;
+ int len;
+
+ p = hex2long(params, ¶ms);
+
+ /* remove leading and trailing white space from the filename */
+ while (sc_isspace(*params))
+ params++;
+ len = strlen(params);
+ while (len > 0 && sc_isspace(params[len - 1]))
+ len--;
+ params[len++] = '\0'; /* zero-terminate */
+ while (len % sizeof(cell) != 0)
+ params[len++] = '\0'; /* pad with zeros up to full cell */
+ assert(len > 0 && len < 256);
+ clen = len + sizeof(cell); /* add size of file ordinal */
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &clen, 1);
+ write_encoded(fbin, &p, 1);
+ write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+ } /* if */
+ return opcodes(1) + opargs(1) + clen; /* other argument is in clen */
+}
+
+static cell
+do_symbol(FILE * fbin, char *params, cell opcode)
+{
+ char *endptr;
+ ucell offset, clen, flags;
+ int len;
+ unsigned char mclass, type;
+
+ for (endptr = params; !sc_isspace(*endptr) && endptr != '\0'; endptr++)
+ /* nothing */ ;
+ assert(*endptr == ' ');
+
+ len = (int)(endptr - params);
+ assert(len > 0 && len < sNAMEMAX);
+ /* first get the other parameters from the line */
+ offset = hex2long(endptr, &endptr);
+ mclass = (unsigned char)hex2long(endptr, &endptr);
+ type = (unsigned char)hex2long(endptr, NULL);
+ flags = type + 256 * mclass;
+ /* now finish up the name (overwriting the input line) */
+ params[len++] = '\0'; /* zero-terminate */
+ while (len % sizeof(cell) != 0)
+ params[len++] = '\0'; /* pad with zeros up to full cell */
+ clen = len + 2 * sizeof(cell); /* add size of symbol address and flags */
+
+ if (fbin)
+ {
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &clen, 1);
+ write_encoded(fbin, &offset, 1);
+ write_encoded(fbin, &flags, 1);
+ write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+ } /* if */
+
+#if !defined NDEBUG
+ /* function should start right after the symbolic information */
+ if (!fbin && mclass == 0 && type == iFUNCTN)
+ assert(offset == codeindex + opcodes(1) + opargs(1) + clen);
+#endif
+
+ return opcodes(1) + opargs(1) + clen; /* other 2 arguments are in clen */
+}
+
+static cell
+do_switch(FILE * fbin, char *params, cell opcode)
+{
+ int i;
+ ucell p;
+
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, (ucell *) & opcode, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(1) + opargs(1);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_case(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+ int i;
+ ucell p, v;
+
+ v = hex2long(params, ¶ms);
+ i = (int)hex2long(params, NULL);
+ assert(i >= 0 && i < labnum);
+
+ if (fbin)
+ {
+ assert(lbltab != NULL);
+ p = lbltab[i];
+ write_encoded(fbin, &v, 1);
+ write_encoded(fbin, &p, 1);
+ } /* if */
+ return opcodes(0) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+curfile(FILE * fbin __UNUSED__, char *params, cell opcode __UNUSED__)
+{
+ fcurrent = (int)hex2long(params, NULL);
+ return 0;
+}
+
+static OPCODE opcodelist[] = {
+ /* node for "invalid instruction" */
+ {0, NULL, 0, noop},
+ /* opcodes in sorted order */
+ {78, "add", sIN_CSEG, parm0},
+ {87, "add.c", sIN_CSEG, parm1},
+ {14, "addr.alt", sIN_CSEG, parm1},
+ {13, "addr.pri", sIN_CSEG, parm1},
+ {30, "align.alt", sIN_CSEG, parm1},
+ {29, "align.pri", sIN_CSEG, parm1},
+ {81, "and", sIN_CSEG, parm0},
+ {121, "bounds", sIN_CSEG, parm1},
+ {49, "call", sIN_CSEG, do_call},
+ {50, "call.pri", sIN_CSEG, parm0},
+ {0, "case", sIN_CSEG, do_case},
+ {130, "casetbl", sIN_CSEG, parm0}, /* version 1 */
+ {118, "cmps", sIN_CSEG, parm1},
+ {0, "code", 0, noop},
+ {12, "const.alt", sIN_CSEG, parm1},
+ {11, "const.pri", sIN_CSEG, parm1},
+ {0, "curfile", sIN_CSEG, curfile},
+ {0, "data", 0, noop},
+ {114, "dec", sIN_CSEG, parm1},
+ {113, "dec.alt", sIN_CSEG, parm0},
+ {116, "dec.i", sIN_CSEG, parm0},
+ {112, "dec.pri", sIN_CSEG, parm0},
+ {115, "dec.s", sIN_CSEG, parm1},
+ {0, "dump", sIN_DSEG, do_dump},
+ {95, "eq", sIN_CSEG, parm0},
+ {106, "eq.c.alt", sIN_CSEG, parm1},
+ {105, "eq.c.pri", sIN_CSEG, parm1},
+ {124, "file", sIN_CSEG, do_file},
+ {119, "fill", sIN_CSEG, parm1},
+ {100, "geq", sIN_CSEG, parm0},
+ {99, "grtr", sIN_CSEG, parm0},
+ {120, "halt", sIN_CSEG, parm1},
+ {45, "heap", sIN_CSEG, parm1},
+ {27, "idxaddr", sIN_CSEG, parm0},
+ {28, "idxaddr.b", sIN_CSEG, parm1},
+ {109, "inc", sIN_CSEG, parm1},
+ {108, "inc.alt", sIN_CSEG, parm0},
+ {111, "inc.i", sIN_CSEG, parm0},
+ {107, "inc.pri", sIN_CSEG, parm0},
+ {110, "inc.s", sIN_CSEG, parm1},
+ {86, "invert", sIN_CSEG, parm0},
+ {55, "jeq", sIN_CSEG, do_jump},
+ {60, "jgeq", sIN_CSEG, do_jump},
+ {59, "jgrtr", sIN_CSEG, do_jump},
+ {58, "jleq", sIN_CSEG, do_jump},
+ {57, "jless", sIN_CSEG, do_jump},
+ {56, "jneq", sIN_CSEG, do_jump},
+ {54, "jnz", sIN_CSEG, do_jump},
+ {52, "jrel", sIN_CSEG, parm1}, /* always a number */
+ {64, "jsgeq", sIN_CSEG, do_jump},
+ {63, "jsgrtr", sIN_CSEG, do_jump},
+ {62, "jsleq", sIN_CSEG, do_jump},
+ {61, "jsless", sIN_CSEG, do_jump},
+ {51, "jump", sIN_CSEG, do_jump},
+ {128, "jump.pri", sIN_CSEG, parm0}, /* version 1 */
+ {53, "jzer", sIN_CSEG, do_jump},
+ {31, "lctrl", sIN_CSEG, parm1},
+ {98, "leq", sIN_CSEG, parm0},
+ {97, "less", sIN_CSEG, parm0},
+ {25, "lidx", sIN_CSEG, parm0},
+ {26, "lidx.b", sIN_CSEG, parm1},
+ {125, "line", sIN_CSEG, parm2},
+ {2, "load.alt", sIN_CSEG, parm1},
+ {9, "load.i", sIN_CSEG, parm0},
+ {1, "load.pri", sIN_CSEG, parm1},
+ {4, "load.s.alt", sIN_CSEG, parm1},
+ {3, "load.s.pri", sIN_CSEG, parm1},
+ {10, "lodb.i", sIN_CSEG, parm1},
+ {6, "lref.alt", sIN_CSEG, parm1},
+ {5, "lref.pri", sIN_CSEG, parm1},
+ {8, "lref.s.alt", sIN_CSEG, parm1},
+ {7, "lref.s.pri", sIN_CSEG, parm1},
+ {34, "move.alt", sIN_CSEG, parm0},
+ {33, "move.pri", sIN_CSEG, parm0},
+ {117, "movs", sIN_CSEG, parm1},
+ {85, "neg", sIN_CSEG, parm0},
+ {96, "neq", sIN_CSEG, parm0},
+ {134, "nop", sIN_CSEG, parm0}, /* version 6 */
+ {84, "not", sIN_CSEG, parm0},
+ {82, "or", sIN_CSEG, parm0},
+ {43, "pop.alt", sIN_CSEG, parm0},
+ {42, "pop.pri", sIN_CSEG, parm0},
+ {46, "proc", sIN_CSEG, parm0},
+ {40, "push", sIN_CSEG, parm1},
+ {37, "push.alt", sIN_CSEG, parm0},
+ {39, "push.c", sIN_CSEG, parm1},
+ {36, "push.pri", sIN_CSEG, parm0},
+ {38, "push.r", sIN_CSEG, parm1},
+ {41, "push.s", sIN_CSEG, parm1},
+ {133, "pushaddr", sIN_CSEG, parm1}, /* version 4 */
+ {47, "ret", sIN_CSEG, parm0},
+ {48, "retn", sIN_CSEG, parm0},
+ {32, "sctrl", sIN_CSEG, parm1},
+ {73, "sdiv", sIN_CSEG, parm0},
+ {74, "sdiv.alt", sIN_CSEG, parm0},
+ {104, "sgeq", sIN_CSEG, parm0},
+ {103, "sgrtr", sIN_CSEG, parm0},
+ {65, "shl", sIN_CSEG, parm0},
+ {69, "shl.c.alt", sIN_CSEG, parm1},
+ {68, "shl.c.pri", sIN_CSEG, parm1},
+ {66, "shr", sIN_CSEG, parm0},
+ {71, "shr.c.alt", sIN_CSEG, parm1},
+ {70, "shr.c.pri", sIN_CSEG, parm1},
+ {94, "sign.alt", sIN_CSEG, parm0},
+ {93, "sign.pri", sIN_CSEG, parm0},
+ {102, "sleq", sIN_CSEG, parm0},
+ {101, "sless", sIN_CSEG, parm0},
+ {72, "smul", sIN_CSEG, parm0},
+ {88, "smul.c", sIN_CSEG, parm1},
+ {127, "srange", sIN_CSEG, parm2}, /* version 1 */
+ {20, "sref.alt", sIN_CSEG, parm1},
+ {19, "sref.pri", sIN_CSEG, parm1},
+ {22, "sref.s.alt", sIN_CSEG, parm1},
+ {21, "sref.s.pri", sIN_CSEG, parm1},
+ {67, "sshr", sIN_CSEG, parm0},
+ {44, "stack", sIN_CSEG, parm1},
+ {0, "stksize", 0, noop},
+ {16, "stor.alt", sIN_CSEG, parm1},
+ {23, "stor.i", sIN_CSEG, parm0},
+ {15, "stor.pri", sIN_CSEG, parm1},
+ {18, "stor.s.alt", sIN_CSEG, parm1},
+ {17, "stor.s.pri", sIN_CSEG, parm1},
+ {24, "strb.i", sIN_CSEG, parm1},
+ {79, "sub", sIN_CSEG, parm0},
+ {80, "sub.alt", sIN_CSEG, parm0},
+ {132, "swap.alt", sIN_CSEG, parm0}, /* version 4 */
+ {131, "swap.pri", sIN_CSEG, parm0}, /* version 4 */
+ {129, "switch", sIN_CSEG, do_switch}, /* version 1 */
+ {126, "symbol", sIN_CSEG, do_symbol},
+ {136, "symtag", sIN_CSEG, parm1}, /* version 7 */
+ {123, "sysreq.c", sIN_CSEG, parm1},
+ {135, "sysreq.d", sIN_CSEG, parm1}, /* version 7, not generated directly */
+ {122, "sysreq.pri", sIN_CSEG, parm0},
+ {76, "udiv", sIN_CSEG, parm0},
+ {77, "udiv.alt", sIN_CSEG, parm0},
+ {75, "umul", sIN_CSEG, parm0},
+ {35, "xchg", sIN_CSEG, parm0},
+ {83, "xor", sIN_CSEG, parm0},
+ {91, "zero", sIN_CSEG, parm1},
+ {90, "zero.alt", sIN_CSEG, parm0},
+ {89, "zero.pri", sIN_CSEG, parm0},
+ {92, "zero.s", sIN_CSEG, parm1},
+};
+
+#define MAX_INSTR_LEN 30
+static int
+findopcode(char *instr, int maxlen)
+{
+ int low, high, mid, cmp;
+ char str[MAX_INSTR_LEN];
+
+ if (maxlen >= MAX_INSTR_LEN)
+ return 0;
+ strncpy(str, instr, maxlen);
+ str[maxlen] = '\0'; /* make sure the string is zero terminated */
+ /* look up the instruction with a binary search
+ * the assembler is case insensitive to instructions (but case sensitive
+ * to symbols)
+ */
+ low = 1; /* entry 0 is reserved (for "not found") */
+ high = (sizeof opcodelist / sizeof opcodelist[0]) - 1;
+ while (low < high)
+ {
+ mid = (low + high) / 2;
+ assert(opcodelist[mid].name != NULL);
+ cmp = strcasecmp(str, opcodelist[mid].name);
+ if (cmp > 0)
+ low = mid + 1;
+ else
+ high = mid;
+ } /* while */
+
+ assert(low == high);
+ if (strcasecmp(str, opcodelist[low].name) == 0)
+ return low; /* found */
+ return 0; /* not found, return special index */
+}
+
+void
+assemble(FILE * fout, FILE * fin)
+{
+ typedef struct tagFUNCSTUB
+ {
+ unsigned int address, nameofs;
+ } FUNCSTUB;
+ AMX_HEADER hdr;
+ FUNCSTUB func;
+ int numpublics, numnatives, numlibraries, numpubvars,
+ numtags, padding;
+ long nametablesize, nameofs;
+ char line[256], *instr, *params;
+ int i, pass;
+ short count;
+ symbol *sym, **nativelist;
+ constvalue *constptr;
+ cell mainaddr;
+ int nametable, tags, libraries, publics, natives, pubvars;
+ int cod, defsize;
+
+#if !defined NDEBUG
+ /* verify that the opcode list is sorted (skip entry 1; it is reserved
+ * for a non-existent opcode)
+ */
+ assert(opcodelist[1].name != NULL);
+ for (i = 2; i < (int)(sizeof(opcodelist) / sizeof(opcodelist[0])); i++)
+ {
+ assert(opcodelist[i].name != NULL);
+ assert(strcasecmp(opcodelist[i].name, opcodelist[i - 1].name) > 0);
+ } /* for */
+#endif
+
+ writeerror = FALSE;
+ nametablesize = sizeof(short);
+ numpublics = 0;
+ numnatives = 0;
+ numpubvars = 0;
+ mainaddr = -1;
+ /* count number of public and native functions and public variables */
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ char alias[sNAMEMAX + 1] = "";
+ int match = 0;
+
+ if (sym->ident == iFUNCTN)
+ {
+ assert(strlen(sym->name) <= sNAMEMAX);
+ if ((sym->usage & uNATIVE) != 0 && (sym->usage & uREAD) != 0
+ && sym->addr >= 0)
+ {
+ match = ++numnatives;
+ if (!lookup_alias(alias, sym->name))
+ strcpy(alias, sym->name);
+ } /* if */
+ if ((sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+ {
+ match = ++numpublics;
+ strcpy(alias, sym->name);
+ } /* if */
+ if (strcmp(sym->name, uMAINFUNC) == 0)
+ {
+ assert(sym->vclass == sGLOBAL);
+ mainaddr = sym->addr;
+ } /* if */
+ }
+ else if (sym->ident == iVARIABLE)
+ {
+ if ((sym->usage & uPUBLIC) != 0)
+ {
+ match = ++numpubvars;
+ strcpy(alias, sym->name);
+ } /* if */
+ } /* if */
+ if (match)
+ {
+ assert(alias[0] != '\0');
+ nametablesize += strlen(alias) + 1;
+ } /* if */
+ } /* for */
+ assert(numnatives == ntv_funcid);
+
+ /* count number of libraries */
+ numlibraries = 0;
+ for (constptr = libname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if (constptr->value > 0)
+ {
+ assert(constptr->name[0] != '\0');
+ numlibraries++;
+ nametablesize += strlen(constptr->name) + 1;
+ } /* if */
+ } /* for */
+
+ /* count number of public tags */
+ numtags = 0;
+ for (constptr = tagname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if ((constptr->value & PUBLICTAG) != 0)
+ {
+ assert(constptr->name[0] != '\0');
+ numtags++;
+ nametablesize += strlen(constptr->name) + 1;
+ } /* if */
+ } /* for */
+
+ /* pad the header to sc_dataalign
+ * => thereby the code segment is aligned
+ * => since the code segment is padded to a sc_dataalign boundary, the data segment is aligned
+ * => and thereby the stack top is aligned too
+ */
+ assert(sc_dataalign != 0);
+ padding = sc_dataalign - (sizeof hdr + nametablesize) % sc_dataalign;
+ if (padding == sc_dataalign)
+ padding = 0;
+
+ /* write the abstract machine header */
+ memset(&hdr, 0, sizeof hdr);
+ hdr.magic = (unsigned short)0xF1E0;
+ hdr.file_version = CUR_FILE_VERSION;
+ hdr.amx_version = MIN_AMX_VERSION;
+ hdr.flags = (short)(sc_debug & sSYMBOLIC);
+ if (charbits == 16)
+ hdr.flags |= AMX_FLAG_CHAR16;
+ if (sc_compress)
+ hdr.flags |= AMX_FLAG_COMPACT;
+ if (sc_debug == 0)
+ hdr.flags |= AMX_FLAG_NOCHECKS;
+// #ifdef WORDS_BIGENDIAN
+// hdr.flags|=AMX_FLAG_BIGENDIAN;
+// #endif
+ defsize = hdr.defsize = sizeof(FUNCSTUB);
+ assert((hdr.defsize % sizeof(cell)) == 0);
+ publics = hdr.publics = sizeof hdr; /* public table starts right after the header */
+ natives = hdr.natives = hdr.publics + numpublics * sizeof(FUNCSTUB);
+ libraries = hdr.libraries = hdr.natives + numnatives * sizeof(FUNCSTUB);
+ pubvars = hdr.pubvars = hdr.libraries + numlibraries * sizeof(FUNCSTUB);
+ tags = hdr.tags = hdr.pubvars + numpubvars * sizeof(FUNCSTUB);
+ nametable = hdr.nametable = hdr.tags + numtags * sizeof(FUNCSTUB);
+ cod = hdr.cod = hdr.nametable + nametablesize + padding;
+ hdr.dat = hdr.cod + code_idx;
+ hdr.hea = hdr.dat + glb_declared * sizeof(cell);
+ hdr.stp = hdr.hea + sc_stksize * sizeof(cell);
+ hdr.cip = mainaddr;
+ hdr.size = hdr.hea; /* preset, this is incorrect in case of compressed output */
+#ifdef WORDS_BIGENDIAN
+ align32(&hdr.size);
+ align16(&hdr.magic);
+ align16(&hdr.flags);
+ align16(&hdr.defsize);
+ align32(&hdr.cod);
+ align32(&hdr.dat);
+ align32(&hdr.hea);
+ align32(&hdr.stp);
+ align32(&hdr.cip);
+ align32(&hdr.publics);
+ align32(&hdr.natives);
+ align32(&hdr.libraries);
+ align32(&hdr.pubvars);
+ align32(&hdr.tags);
+ align32(&hdr.nametable);
+#endif
+ sc_writebin(fout, &hdr, sizeof hdr);
+
+ /* dump zeros up to the rest of the header, so that we can easily "seek" */
+ for (nameofs = sizeof hdr; nameofs < cod; nameofs++)
+ putc(0, fout);
+ nameofs = nametable + sizeof(short);
+
+ /* write the public functions table */
+ count = 0;
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iFUNCTN
+ && (sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+ {
+ assert(sym->vclass == sGLOBAL);
+ func.address = sym->addr;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, publics + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+ nameofs += strlen(sym->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the natives table */
+ /* The native functions must be written in sorted order. (They are
+ * sorted on their "id", not on their name). A nested loop to find
+ * each successive function would be an O(n^2) operation. But we
+ * do not really need to sort, because the native function id's
+ * are sequential and there are no duplicates. So we first walk
+ * through the complete symbol list and store a pointer to every
+ * native function of interest in a temporary table, where its id
+ * serves as the index in the table. Now we can walk the table and
+ * have all native functions in sorted order.
+ */
+ if (numnatives > 0)
+ {
+ nativelist = (symbol **) malloc(numnatives * sizeof(symbol *));
+ if (!nativelist)
+ error(103); /* insufficient memory */
+#if !defined NDEBUG
+ memset(nativelist, 0, numnatives * sizeof(symbol *)); /* for NULL checking */
+#endif
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iFUNCTN && (sym->usage & uNATIVE) != 0
+ && (sym->usage & uREAD) != 0 && sym->addr >= 0)
+ {
+ assert(sym->addr < numnatives);
+ nativelist[(int)sym->addr] = sym;
+ } /* if */
+ } /* for */
+ count = 0;
+ for (i = 0; i < numnatives; i++)
+ {
+ char alias[sNAMEMAX + 1];
+
+ sym = nativelist[i];
+ assert(sym != NULL);
+ if (!lookup_alias(alias, sym->name))
+ {
+ assert(strlen(sym->name) <= sNAMEMAX);
+ strcpy(alias, sym->name);
+ } /* if */
+ assert(sym->vclass == sGLOBAL);
+ func.address = 0;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, natives + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, alias, strlen(alias) + 1);
+ nameofs += strlen(alias) + 1;
+ count++;
+ } /* for */
+ free(nativelist);
+ } /* if */
+
+ /* write the libraries table */
+ count = 0;
+ for (constptr = libname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if (constptr->value > 0)
+ {
+ assert(constptr->name[0] != '\0');
+ func.address = 0;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, libraries + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+ nameofs += strlen(constptr->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the public variables table */
+ count = 0;
+ for (sym = glbtab.next; sym; sym = sym->next)
+ {
+ if (sym->ident == iVARIABLE && (sym->usage & uPUBLIC) != 0)
+ {
+ assert((sym->usage & uDEFINE) != 0);
+ assert(sym->vclass == sGLOBAL);
+ func.address = sym->addr;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, pubvars + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+ nameofs += strlen(sym->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the public tagnames table */
+ count = 0;
+ for (constptr = tagname_tab.next; constptr;
+ constptr = constptr->next)
+ {
+ if ((constptr->value & PUBLICTAG) != 0)
+ {
+ assert(constptr->name[0] != '\0');
+ func.address = constptr->value & TAGMASK;
+ func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+ align32(&func.address);
+ align32(&func.nameofs);
+#endif
+ fseek(fout, tags + count * sizeof(FUNCSTUB), SEEK_SET);
+ sc_writebin(fout, &func, sizeof func);
+ fseek(fout, nameofs, SEEK_SET);
+ sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+ nameofs += strlen(constptr->name) + 1;
+ count++;
+ } /* if */
+ } /* for */
+
+ /* write the "maximum name length" field in the name table */
+ assert(nameofs == nametable + nametablesize);
+ fseek(fout, nametable, SEEK_SET);
+ count = sNAMEMAX;
+#ifdef WORDS_BIGENDIAN
+ align16(&count);
+#endif
+ sc_writebin(fout, &count, sizeof count);
+ fseek(fout, cod, SEEK_SET);
+
+ /* First pass: relocate all labels */
+ /* This pass is necessary because the code addresses of labels is only known
+ * after the peephole optimization flag. Labels can occur inside expressions
+ * (e.g. the conditional operator), which are optimized.
+ */
+ lbltab = NULL;
+ if (labnum > 0)
+ {
+ /* only very short programs have zero labels; no first pass is needed
+ * if there are no labels */
+ lbltab = (cell *) malloc(labnum * sizeof(cell));
+ if (!lbltab)
+ error(103); /* insufficient memory */
+ codeindex = 0;
+ sc_resetasm(fin);
+ while (sc_readasm(fin, line, sizeof line))
+ {
+ stripcomment(line);
+ instr = skipwhitespace(line);
+ /* ignore empty lines */
+ if (*instr == '\0')
+ continue;
+ if (tolower(*instr) == 'l' && *(instr + 1) == '.')
+ {
+ int lindex = (int)hex2long(instr + 2, NULL);
+
+ assert(lindex < labnum);
+ lbltab[lindex] = codeindex;
+ }
+ else
+ {
+ /* get to the end of the instruction (make use of the '\n' that fgets()
+ * added at the end of the line; this way we will *always* drop on a
+ * whitespace character) */
+ for (params = instr; *params != '\0' && !sc_isspace(*params);
+ params++)
+ /* nothing */ ;
+ assert(params > instr);
+ i = findopcode(instr, (int)(params - instr));
+ if (!opcodelist[i].name)
+ {
+ *params = '\0';
+ error(104, instr); /* invalid assembler instruction */
+ } /* if */
+ if (opcodelist[i].segment == sIN_CSEG)
+ codeindex +=
+ opcodelist[i].func(NULL, skipwhitespace(params),
+ opcodelist[i].opcode);
+ } /* if */
+ } /* while */
+ } /* if */
+
+ /* Second pass (actually 2 more passes, one for all code and one for all data) */
+ bytes_in = 0;
+ bytes_out = 0;
+ for (pass = sIN_CSEG; pass <= sIN_DSEG; pass++)
+ {
+ sc_resetasm(fin);
+ while (sc_readasm(fin, line, sizeof line))
+ {
+ stripcomment(line);
+ instr = skipwhitespace(line);
+ /* ignore empty lines and labels (labels have a special syntax, so these
+ * must be parsed separately) */
+ if (*instr == '\0' || (tolower(*instr) == 'l'
+ && *(instr + 1) == '.'))
+ continue;
+ /* get to the end of the instruction (make use of the '\n' that fgets()
+ * added at the end of the line; this way we will *always* drop on a
+ * whitespace character) */
+ for (params = instr; *params != '\0' && !sc_isspace(*params);
+ params++)
+ /* nothing */ ;
+ assert(params > instr);
+ i = findopcode(instr, (int)(params - instr));
+ assert(opcodelist[i].name != NULL);
+ if (opcodelist[i].segment == pass)
+ opcodelist[i].func(fout, skipwhitespace(params),
+ opcodelist[i].opcode);
+ } /* while */
+ } /* for */
+ if (bytes_out - bytes_in > 0)
+ error(106); /* compression buffer overflow */
+
+ if (lbltab)
+ {
+ free(lbltab);
+#if !defined NDEBUG
+ lbltab = NULL;
+#endif
+ } /* if */
+
+ if (writeerror)
+ error(101, "disk full");
+
+ /* adjust the header */
+ if (sc_compress)
+ {
+ hdr.size = sc_lengthbin(fout);
+#ifdef WORDS_BIGENDIAN
+ align32(&hdr.size);
+#endif
+ sc_resetbin(fout); /* "size" is the very first field */
+ sc_writebin(fout, &hdr.size, sizeof hdr.size);
+ } /* if */
+}
--- /dev/null
+/* Small compiler - Staging buffer and optimizer
+ *
+ * The staging buffer
+ * ------------------
+ * The staging buffer allows buffered output of generated code, deletion
+ * of redundant code, optimization by a tinkering process and reversing
+ * the ouput of evaluated expressions (which is used for the reversed
+ * evaluation of arguments in functions).
+ * Initially, stgwrite() writes to the file directly, but after a call to
+ * stgset(TRUE), output is redirected to the buffer. After a call to
+ * stgset(FALSE), stgwrite()'s output is directed to the file again. Thus
+ * only one routine is used for writing to the output, which can be
+ * buffered output or direct output.
+ *
+ * staging buffer variables: stgbuf - the buffer
+ * stgidx - current index in the staging buffer
+ * staging - if true, write to the staging buffer;
+ * if false, write to file directly.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h> /* for atoi() */
+#include <string.h>
+#include <ctype.h>
+
+#include "embryo_cc_sc.h"
+
+#if defined _MSC_VER
+#pragma warning(push)
+#pragma warning(disable:4125) /* decimal digit terminates octal escape sequence */
+#endif
+
+#include "embryo_cc_sc7.scp"
+
+#if defined _MSC_VER
+#pragma warning(pop)
+#endif
+
+static void stgstring(char *start, char *end);
+static void stgopt(char *start, char *end);
+
+#define sSTG_GROW 512
+#define sSTG_MAX 20480
+
+static char *stgbuf = NULL;
+static int stgmax = 0; /* current size of the staging buffer */
+
+#define CHECK_STGBUFFER(index) if ((int)(index)>=stgmax) grow_stgbuffer((index)+1)
+
+static void
+grow_stgbuffer(int requiredsize)
+{
+ char *p;
+ int clear = !stgbuf; /* if previously none, empty buffer explicitly */
+
+ assert(stgmax < requiredsize);
+ /* if the staging buffer (holding intermediate code for one line) grows
+ * over a few kBytes, there is probably a run-away expression
+ */
+ if (requiredsize > sSTG_MAX)
+ error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
+ stgmax = requiredsize + sSTG_GROW;
+ if (stgbuf)
+ p = (char *)realloc(stgbuf, stgmax * sizeof(char));
+ else
+ p = (char *)malloc(stgmax * sizeof(char));
+ if (!p)
+ error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
+ stgbuf = p;
+ if (clear)
+ *stgbuf = '\0';
+}
+
+void
+stgbuffer_cleanup(void)
+{
+ if (stgbuf)
+ {
+ free(stgbuf);
+ stgbuf = NULL;
+ stgmax = 0;
+ } /* if */
+}
+
+/* the variables "stgidx" and "staging" are declared in "scvars.c" */
+
+/* stgmark
+ *
+ * Copies a mark into the staging buffer. At this moment there are three
+ * possible marks:
+ * sSTARTREORDER identifies the beginning of a series of expression
+ * strings that must be written to the output file in
+ * reordered order
+ * sENDREORDER identifies the end of 'reverse evaluation'
+ * sEXPRSTART + idx only valid within a block that is evaluated in
+ * reordered order, it identifies the start of an
+ * expression; the "idx" value is the argument position
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (altered)
+ * staging (referred to only)
+ */
+void
+stgmark(char mark)
+{
+ if (staging)
+ {
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = mark;
+ } /* if */
+}
+
+static int
+filewrite(char *str)
+{
+ if (sc_status == statWRITE)
+ return sc_writeasm(outf, str);
+ return TRUE;
+}
+
+/* stgwrite
+ *
+ * Writes the string "st" to the staging buffer or to the output file. In the
+ * case of writing to the staging buffer, the terminating byte of zero is
+ * copied too, but... the optimizer can only work on complete lines (not on
+ * fractions of it. Therefore if the string is staged, if the last character
+ * written to the buffer is a '\0' and the previous-to-last is not a '\n',
+ * the string is concatenated to the last string in the buffer (the '\0' is
+ * overwritten). This also means an '\n' used in the middle of a string isn't
+ * recognized and could give wrong results with the optimizer.
+ * Even when writing to the output file directly, all strings are buffered
+ * until a whole line is complete.
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (altered)
+ * staging (referred to only)
+ */
+void
+stgwrite(char *st)
+{
+ int len;
+
+ CHECK_STGBUFFER(0);
+ if (staging)
+ {
+ if (stgidx >= 2 && stgbuf[stgidx - 1] == '\0'
+ && stgbuf[stgidx - 2] != '\n')
+ stgidx -= 1; /* overwrite last '\0' */
+ while (*st != '\0')
+ { /* copy to staging buffer */
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = *st++;
+ } /* while */
+ CHECK_STGBUFFER(stgidx);
+ stgbuf[stgidx++] = '\0';
+ }
+ else
+ {
+ CHECK_STGBUFFER(strlen(stgbuf) + strlen(st) + 1);
+ strcat(stgbuf, st);
+ len = strlen(stgbuf);
+ if (len > 0 && stgbuf[len - 1] == '\n')
+ {
+ filewrite(stgbuf);
+ stgbuf[0] = '\0';
+ } /* if */
+ } /* if */
+}
+
+/* stgout
+ *
+ * Writes the staging buffer to the output file via stgstring() (for
+ * reversing expressions in the buffer) and stgopt() (for optimizing). It
+ * resets "stgidx".
+ *
+ * Global references: stgidx (altered)
+ * stgbuf (referred to only)
+ * staging (referred to only)
+ */
+void
+stgout(int index)
+{
+ if (!staging)
+ return;
+ stgstring(&stgbuf[index], &stgbuf[stgidx]);
+ stgidx = index;
+}
+
+typedef struct
+{
+ char *start, *end;
+} argstack;
+
+/* stgstring
+ *
+ * Analyses whether code strings should be output to the file as they appear
+ * in the staging buffer or whether portions of it should be re-ordered.
+ * Re-ordering takes place in function argument lists; Small passes arguments
+ * to functions from right to left. When arguments are "named" rather than
+ * positional, the order in the source stream is indeterminate.
+ * This function calls itself recursively in case it needs to re-order code
+ * strings, and it uses a private stack (or list) to mark the start and the
+ * end of expressions in their correct (reversed) order.
+ * In any case, stgstring() sends a block as large as possible to the
+ * optimizer stgopt().
+ *
+ * In "reorder" mode, each set of code strings must start with the token
+ * sEXPRSTART, even the first. If the token sSTARTREORDER is represented
+ * by '[', sENDREORDER by ']' and sEXPRSTART by '|' the following applies:
+ * '[]...' valid, but useless; no output
+ * '[|...] valid, but useless; only one string
+ * '[|...|...] valid and useful
+ * '[...|...] invalid, first string doesn't start with '|'
+ * '[|...|] invalid
+ */
+static void
+stgstring(char *start, char *end)
+{
+ char *ptr;
+ int nest, argc, arg;
+ argstack *stack;
+
+ while (start < end)
+ {
+ if (*start == sSTARTREORDER)
+ {
+ start += 1; /* skip token */
+ /* allocate a argstack with sMAXARGS items */
+ stack = (argstack *) malloc(sMAXARGS * sizeof(argstack));
+ if (!stack)
+ error(103); /* insufficient memory */
+ nest = 1; /* nesting counter */
+ argc = 0; /* argument counter */
+ arg = -1; /* argument index; no valid argument yet */
+ do
+ {
+ switch (*start)
+ {
+ case sSTARTREORDER:
+ nest++;
+ start++;
+ break;
+ case sENDREORDER:
+ nest--;
+ start++;
+ break;
+ default:
+ if ((*start & sEXPRSTART) == sEXPRSTART)
+ {
+ if (nest == 1)
+ {
+ if (arg >= 0)
+ stack[arg].end = start - 1; /* finish previous argument */
+ arg = (unsigned char)*start - sEXPRSTART;
+ stack[arg].start = start + 1;
+ if (arg >= argc)
+ argc = arg + 1;
+ } /* if */
+ start++;
+ }
+ else
+ {
+ start += strlen(start) + 1;
+ } /* if */
+ } /* switch */
+ }
+ while (nest); /* enddo */
+ if (arg >= 0)
+ stack[arg].end = start - 1; /* finish previous argument */
+ while (argc > 0)
+ {
+ argc--;
+ stgstring(stack[argc].start, stack[argc].end);
+ } /* while */
+ free(stack);
+ }
+ else
+ {
+ ptr = start;
+ while (ptr < end && *ptr != sSTARTREORDER)
+ ptr += strlen(ptr) + 1;
+ stgopt(start, ptr);
+ start = ptr;
+ } /* if */
+ } /* while */
+}
+
+/* stgdel
+ *
+ * Scraps code from the staging buffer by resetting "stgidx" to "index".
+ *
+ * Global references: stgidx (altered)
+ * staging (referred to only)
+ */
+void
+stgdel(int index, cell code_index)
+{
+ if (staging)
+ {
+ stgidx = index;
+ code_idx = code_index;
+ } /* if */
+}
+
+int
+stgget(int *index, cell * code_index)
+{
+ if (staging)
+ {
+ *index = stgidx;
+ *code_index = code_idx;
+ } /* if */
+ return staging;
+}
+
+/* stgset
+ *
+ * Sets staging on or off. If it's turned off, the staging buffer must be
+ * initialized to an empty string. If it's turned on, the routine makes sure
+ * the index ("stgidx") is set to 0 (it should already be 0).
+ *
+ * Global references: staging (altered)
+ * stgidx (altered)
+ * stgbuf (contents altered)
+ */
+void
+stgset(int onoff)
+{
+ staging = onoff;
+ if (staging)
+ {
+ assert(stgidx == 0);
+ stgidx = 0;
+ CHECK_STGBUFFER(stgidx);
+ /* write any contents that may be put in the buffer by stgwrite()
+ * when "staging" was 0
+ */
+ if (stgbuf[0] != '\0')
+ filewrite(stgbuf);
+ } /* if */
+ stgbuf[0] = '\0';
+}
+
+/* phopt_init
+ * Initialize all sequence strings of the peehole optimizer. The strings
+ * are embedded in the .EXE file in compressed format, here we expand
+ * them (and allocate memory for the sequences).
+ */
+static SEQUENCE *sequences;
+
+int
+phopt_init(void)
+{
+ int number, i, len;
+ char str[160];
+
+ /* count number of sequences */
+ for (number = 0; sequences_cmp[number].find; number++)
+ /* nothing */ ;
+ number++; /* include an item for the NULL terminator */
+
+ if (!(sequences = (SEQUENCE *)malloc(number * sizeof(SEQUENCE))))
+ return FALSE;
+
+ /* pre-initialize all to NULL (in case of failure) */
+ for (i = 0; i < number; i++)
+ {
+ sequences[i].find = NULL;
+ sequences[i].replace = NULL;
+ sequences[i].savesize = 0;
+ } /* for */
+
+ /* expand all strings */
+ for (i = 0; i < number - 1; i++)
+ {
+ len =
+ strexpand(str, (unsigned char *)sequences_cmp[i].find, sizeof str,
+ SCPACK_TABLE);
+ assert(len <= (int)(sizeof(str)));
+ assert(len == (int)(strlen(str) + 1));
+ sequences[i].find = (char *)malloc(len);
+ if (sequences[i].find)
+ strcpy(sequences[i].find, str);
+ len =
+ strexpand(str, (unsigned char *)sequences_cmp[i].replace, sizeof str,
+ SCPACK_TABLE);
+ assert(len <= (int)(sizeof(str)));
+ assert(len == (int)(strlen(str) + 1));
+ sequences[i].replace = (char *)malloc(len);
+ if (sequences[i].replace)
+ strcpy(sequences[i].replace, str);
+ sequences[i].savesize = sequences_cmp[i].savesize;
+ if (!sequences[i].find || !sequences[i].replace)
+ return phopt_cleanup();
+ } /* for */
+
+ return TRUE;
+}
+
+int
+phopt_cleanup(void)
+{
+ int i;
+
+ if (sequences)
+ {
+ i = 0;
+ while (sequences[i].find || sequences[i].replace)
+ {
+ if (sequences[i].find)
+ free(sequences[i].find);
+ if (sequences[i].replace)
+ free(sequences[i].replace);
+ i++;
+ } /* while */
+ free(sequences);
+ sequences = NULL;
+ } /* if */
+ return FALSE;
+}
+
+#define _maxoptvars 4
+#define _aliasmax 10 /* a 32-bit number can be represented in
+ * 9 decimal digits */
+
+static int
+matchsequence(char *start, char *end, char *pattern,
+ char symbols[_maxoptvars][_aliasmax + 1], int *match_length)
+{
+ int var, i;
+ char str[_aliasmax + 1];
+ char *start_org = start;
+
+ *match_length = 0;
+ for (var = 0; var < _maxoptvars; var++)
+ symbols[var][0] = '\0';
+
+ while (*start == '\t' || *start == ' ')
+ start++;
+ while (*pattern)
+ {
+ if (start >= end)
+ return FALSE;
+ switch (*pattern)
+ {
+ case '%': /* new "symbol" */
+ pattern++;
+ assert(sc_isdigit(*pattern));
+ var = atoi(pattern) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(alphanum(*start));
+ for (i = 0; start < end && alphanum(*start); i++, start++)
+ {
+ assert(i <= _aliasmax);
+ str[i] = *start;
+ } /* for */
+ str[i] = '\0';
+ if (symbols[var][0] != '\0')
+ {
+ if (strcmp(symbols[var], str) != 0)
+ return FALSE; /* symbols should be identical */
+ }
+ else
+ {
+ strcpy(symbols[var], str);
+ } /* if */
+ break;
+ case ' ':
+ if (*start != '\t' && *start != ' ')
+ return FALSE;
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++;
+ break;
+ case '!':
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++; /* skip trailing white space */
+ if (*start != '\n')
+ return FALSE;
+ assert(*(start + 1) == '\0');
+ start += 2; /* skip '\n' and '\0' */
+ if (*(pattern + 1) != '\0')
+ while ((start < end && *start == '\t') || *start == ' ')
+ start++; /* skip leading white space of next instruction */
+ break;
+ default:
+ if (tolower(*start) != tolower(*pattern))
+ return FALSE;
+ start++;
+ } /* switch */
+ pattern++;
+ } /* while */
+
+ *match_length = (int)(start - start_org);
+ return TRUE;
+}
+
+static char *
+replacesequence(char *pattern, char symbols[_maxoptvars][_aliasmax + 1],
+ int *repl_length)
+{
+ char *lptr;
+ int var;
+ char *buffer;
+
+ /* calculate the length of the new buffer
+ * this is the length of the pattern plus the length of all symbols (note
+ * that the same symbol may occur multiple times in the pattern) plus
+ * line endings and startings ('\t' to start a line and '\n\0' to end one)
+ */
+ assert(repl_length != NULL);
+ *repl_length = 0;
+ lptr = pattern;
+ while (*lptr)
+ {
+ switch (*lptr)
+ {
+ case '%':
+ lptr++; /* skip '%' */
+ assert(sc_isdigit(*lptr));
+ var = atoi(lptr) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(symbols[var][0] != '\0'); /* variable should be defined */
+ *repl_length += strlen(symbols[var]);
+ break;
+ case '!':
+ *repl_length += 3; /* '\t', '\n' & '\0' */
+ break;
+ default:
+ *repl_length += 1;
+ } /* switch */
+ lptr++;
+ } /* while */
+
+ /* allocate a buffer to replace the sequence in */
+ if (!(buffer = malloc(*repl_length)))
+ {
+ error(103);
+ return NULL;
+ }
+
+ /* replace the pattern into this temporary buffer */
+ lptr = buffer;
+ *lptr++ = '\t'; /* the "replace" patterns do not have tabs */
+ while (*pattern)
+ {
+ assert((int)(lptr - buffer) < *repl_length);
+ switch (*pattern)
+ {
+ case '%':
+ /* write out the symbol */
+ pattern++;
+ assert(sc_isdigit(*pattern));
+ var = atoi(pattern) - 1;
+ assert(var >= 0 && var < _maxoptvars);
+ assert(symbols[var][0] != '\0'); /* variable should be defined */
+ strcpy(lptr, symbols[var]);
+ lptr += strlen(symbols[var]);
+ break;
+ case '!':
+ /* finish the line, optionally start the next line with an indent */
+ *lptr++ = '\n';
+ *lptr++ = '\0';
+ if (*(pattern + 1) != '\0')
+ *lptr++ = '\t';
+ break;
+ default:
+ *lptr++ = *pattern;
+ } /* switch */
+ pattern++;
+ } /* while */
+
+ assert((int)(lptr - buffer) == *repl_length);
+ return buffer;
+}
+
+static void
+strreplace(char *dest, char *replace, int sub_length, int repl_length,
+ int dest_length)
+{
+ int offset = sub_length - repl_length;
+
+ if (offset > 0) /* delete a section */
+ memmove(dest, dest + offset, dest_length - offset);
+ else if (offset < 0) /* insert a section */
+ memmove(dest - offset, dest, dest_length);
+ memcpy(dest, replace, repl_length);
+}
+
+/* stgopt
+ *
+ * Optimizes the staging buffer by checking for series of instructions that
+ * can be coded more compact. The routine expects the lines in the staging
+ * buffer to be separated with '\n' and '\0' characters.
+ *
+ * The longest sequences must be checked first.
+ */
+
+static void
+stgopt(char *start, char *end)
+{
+ char symbols[_maxoptvars][_aliasmax + 1];
+ int seq, match_length, repl_length;
+
+ assert(sequences != NULL);
+ while (start < end)
+ {
+ if ((sc_debug & sNOOPTIMIZE) != 0 || sc_status != statWRITE)
+ {
+ /* do not match anything if debug-level is maximum */
+ filewrite(start);
+ }
+ else
+ {
+ seq = 0;
+ while (sequences[seq].find)
+ {
+ assert(seq >= 0);
+ if (matchsequence
+ (start, end, sequences[seq].find, symbols, &match_length))
+ {
+ char *replace =
+ replacesequence(sequences[seq].replace, symbols,
+ &repl_length);
+ /* If the replacement is bigger than the original section, we may need
+ * to "grow" the staging buffer. This is quite complex, due to the
+ * re-ordering of expressions that can also happen in the staging
+ * buffer. In addition, it should not happen: the peephole optimizer
+ * must replace sequences with *shorter* sequences, not longer ones.
+ * So, I simply forbid sequences that are longer than the ones they
+ * are meant to replace.
+ */
+ assert(match_length >= repl_length);
+ if (match_length >= repl_length)
+ {
+ strreplace(start, replace, match_length,
+ repl_length, (int)(end - start));
+ end -= match_length - repl_length;
+ free(replace);
+ code_idx -= sequences[seq].savesize;
+ seq = 0; /* restart search for matches */
+ }
+ else
+ {
+ /* actually, we should never get here (match_length<repl_length) */
+ assert(0);
+ seq++;
+ } /* if */
+ }
+ else
+ {
+ seq++;
+ } /* if */
+ } /* while */
+ assert(sequences[seq].find == NULL);
+ filewrite(start);
+ } /* if */
+ assert(start < end);
+ start += strlen(start) + 1; /* to next string */
+ } /* while (start<end) */
+}
+
+#undef SCPACK_TABLE
--- /dev/null
+/* Small compiler - Peephole optimizer "sequences" strings (plain
+ * and compressed formats)
+ *
+ * Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+int strexpand(char *dest, unsigned char *source, int maxlen,
+ unsigned char pairtable[128][2]);
+
+#define SCPACK_TERMINATOR , /* end each section with a comma */
+
+#define SCPACK_TABLE sequences_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char sequences_table[][2] = {
+ {32, 37}, {114, 105}, {112, 129}, {46, 130}, {49, 33}, {128, 132}, {97, 100},
+ {46, 97}, {135, 108}, {136, 116}, {111, 134}, {108, 138}, {50, 33}, {115,
+ 104},
+ {128, 140}, {137, 33},
+ {46, 115}, {117, 141}, {112, 145}, {131, 133}, {139, 144}, {112, 143}, {131,
+ 142},
+ {115, 116}, {111, 149}, {112, 152}, {131, 33}, {134, 100}, {110, 151},
+ {111, 156}, {99, 157}, {59, 36},
+ {146, 154}, {148, 150}, {112, 33}, {120, 162}, {101, 163}, {159, 164}, {137,
+ 133},
+ {46, 99}, {122, 101}, {110, 100}, {155, 114}, {101, 113}, {168, 114},
+ {147, 160}, {51, 33}, {128, 174},
+ {103, 33}, {133, 165}, {104, 176}, {99, 178}, {120, 179}, {171, 33}, {106,
+ 172},
+ {173, 161}, {155, 33}, {108, 167}, {117, 169}, {115, 175}, {186, 187},
+ {153, 184}, {141, 185}, {111, 188},
+ {98, 191}, {105, 100}, {115, 103}, {115, 108}, {193, 120}, {182, 133}, {114,
+ 33},
+ {166, 161}, {190, 131}, {137, 142}, {169, 33}, {97, 202}, {139, 147},
+ {172, 111}, {158, 147}, {139, 150},
+ {105, 33}, {101, 115}, {209, 115}, {114, 116}, {148, 147}, {171, 133}, {189,
+ 139},
+ {32, 140}, {146, 167}, {196, 170}, {158, 183}, {170, 183}, {199, 192},
+ {108, 196}, {97, 198}, {194, 211},
+ {46, 208}, {195, 210}, {200, 215}, {112, 222}, {159, 227}, {46, 98}, {118,
+ 101},
+ {111, 230}, {109, 231}, {146, 143}, {99, 144}, {158, 150}, {97, 149},
+ {203, 153}, {52, 33}, {225, 33},
+ {158, 166}, {194, 181}, {195, 181}, {201, 180}, {223, 198}, {153, 203}, {214,
+ 224},
+ {100, 101}, {128, 238}, {119, 236}, {249, 237}, {105, 110}, {115, 250},
+ {232, 143}, {205, 154}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+#define seqsize(o,p) (opcodes(o)+opargs(p))
+typedef struct
+{
+ char *find;
+ char *replace;
+ int savesize; /* number of bytes saved (in bytecode) */
+} SEQUENCE;
+static SEQUENCE sequences_cmp[] = {
+ /* A very common sequence in four varieties
+ * load.s.pri n1 load.s.pri n2
+ * push.pri load.s.alt n1
+ * load.s.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.pri n1 load.s.pri n2
+ * push.pri load.alt n1
+ * load.s.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.s.pri n1 load.pri n2
+ * push.pri load.s.alt n1
+ * load.pri n2 -
+ * pop.alt -
+ * --------------------------------------
+ * load.pri n1 load.pri n2
+ * push.pri load.alt n1
+ * load.pri n2 -
+ * pop.alt -
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!load.s.alt %1!",
+#else
+ "\224\267\231",
+ "\241\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!load.alt %1!",
+#else
+ "\213\267\231",
+ "\241\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!load.s.alt %1!",
+#else
+ "\224\255\317\231",
+ "\317\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!load.alt %1!",
+#else
+ "\213\255\317\231",
+ "\317\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* (#1#) The above also occurs with "addr.pri" (array
+ * indexing) as the first line; so that adds 2 cases.
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "addr.alt %1!load.s.pri %2!",
+#else
+ "\333\231",
+ "\252\307",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.pri %2!pop.alt!",
+ "addr.alt %1!load.pri %2!",
+#else
+ "\252\255\317\231",
+ "\252\246\317",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* And the same sequence with const.pri as either the first
+ * or the second load instruction: four more cases.
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!pop.alt!",
+ "load.s.pri %2!const.alt %1!",
+#else
+ "\332\231",
+ "\241\360",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.pri %2!pop.alt!",
+ "load.pri %2!const.alt %1!",
+#else
+ "\236\255\317\231",
+ "\317\360",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!const.pri %2!pop.alt!",
+ "const.pri %2!load.s.alt %1!",
+#else
+ "\224\255\353\231",
+ "\353\224\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!const.pri %2!pop.alt!",
+ "const.pri %2!load.alt %1!",
+#else
+ "\213\255\353\231",
+ "\353\213\246",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* The same as above, but now with "addr.pri" (array
+ * indexing) on the first line and const.pri on
+ * the second.
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!const.pri %2!pop.alt!",
+ "addr.alt %1!const.pri %2!",
+#else
+ "\252\255\353\231",
+ "\252\246\353",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* ??? add references */
+ /* Chained relational operators can contain sequences like:
+ * move.pri load.s.pri n1
+ * push.pri -
+ * load.s.pri n1 -
+ * pop.alt -
+ * The above also accurs for "load.pri" and for "const.pri",
+ * so add another two cases.
+ */
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!load.s.pri %1!pop.alt!",
+ "load.s.pri %1!",
+#else
+ "\350\232\240\324\231",
+ "\324",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!load.pri %1!pop.alt!",
+ "load.pri %1!",
+#else
+ "\350\232\240\314\231",
+ "\314",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!const.pri %1!pop.alt!",
+ "const.pri %1!",
+#else
+ "\350\232\240\316\231",
+ "\316",
+#endif
+ seqsize(4, 1) - seqsize(1, 1)},
+ /* More optimizations for chained relational operators; the
+ * continuation sequences can be simplified if they turn out
+ * to be termination sequences:
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr pop.alt
+ * swap.alt and
+ * and ;$exp
+ * pop.alt -
+ * ;$exp -
+ * --------------------------------------
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr pop.alt
+ * swap.alt and
+ * and jzer n1
+ * pop.alt -
+ * jzer n1 -
+ * --------------------------------------
+ * xchg jsgeq n1 also for sless, sgeq and sleq
+ * sgrtr ;$exp (occurs for non-chained comparisons)
+ * jzer n1 -
+ * ;$exp -
+ * --------------------------------------
+ * xchg sless also for sless, sgeq and sleq
+ * sgrtr ;$exp (occurs for non-chained comparisons)
+ * ;$exp -
+ */
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!swap.alt!and!pop.alt!;$exp!",
+ "sless!pop.alt!and!;$exp!",
+#else
+ "\264\364\374\245",
+ "\357\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!swap.alt!and!pop.alt!;$exp!",
+ "sgrtr!pop.alt!and!;$exp!",
+#else
+ "\264\357\374\245",
+ "\364\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!swap.alt!and!pop.alt!;$exp!",
+ "sleq!pop.alt!and!;$exp!",
+#else
+ "\264\361\374\245",
+ "\362\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!swap.alt!and!pop.alt!;$exp!",
+ "sgeq!pop.alt!and!;$exp!",
+#else
+ "\264\362\374\245",
+ "\361\365\245",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!swap.alt!and!pop.alt!jzer %1!",
+ "sless!pop.alt!and!jzer %1!",
+#else
+ "\264\364\374\305",
+ "\357\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!swap.alt!and!pop.alt!jzer %1!",
+ "sgrtr!pop.alt!and!jzer %1!",
+#else
+ "\264\357\374\305",
+ "\364\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!swap.alt!and!pop.alt!jzer %1!",
+ "sleq!pop.alt!and!jzer %1!",
+#else
+ "\264\361\374\305",
+ "\362\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!swap.alt!and!pop.alt!jzer %1!",
+ "sgeq!pop.alt!and!jzer %1!",
+#else
+ "\264\362\374\305",
+ "\361\365\305",
+#endif
+ seqsize(5, 0) - seqsize(3, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!jzer %1!;$exp!",
+ "jsgeq %1!;$exp!",
+#else
+ "\264\364\266\261",
+ "j\302\253\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sless!jzer %1!;$exp!",
+ "jsleq %1!;$exp!",
+#else
+ "\264\357\266\261",
+ "j\303\253\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!jzer %1!;$exp!",
+ "jsgrtr %1!;$exp!",
+#else
+ "\264\361\266\261",
+ "j\337r\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!jzer %1!;$exp!",
+ "jsless %1!;$exp!",
+#else
+ "\264\362\266\261",
+ "j\341\261",
+#endif
+ seqsize(3, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "xchg!sgrtr!;$exp!",
+ "sless!;$exp!",
+#else
+ "\264\364\245",
+ "\357\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sless!;$exp!",
+ "sgrtr!;$exp!",
+#else
+ "\264\357\245",
+ "\364\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sgeq!;$exp!",
+ "sleq!;$exp!",
+#else
+ "\264\361\245",
+ "\362\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "xchg!sleq!;$exp!",
+ "sgeq!;$exp!",
+#else
+ "\264\362\245",
+ "\361\245",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* The entry to chained operators is also opt to optimization
+ * load.s.pri n1 load.s.pri n2
+ * load.s.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * load.s.pri n1 load.pri n2
+ * load.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * load.s.pri n1 const.pri n2
+ * const.alt n2 load.s.alt n1
+ * xchg -
+ * --------------------------------------
+ * and all permutations...
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!load.s.alt %1!",
+#else
+ "\324\224\363",
+ "\241\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!load.alt %2!xchg!",
+ "load.pri %2!load.s.alt %1!",
+#else
+ "\324\213\363",
+ "\317\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!const.alt %2!xchg!",
+ "const.pri %2!load.s.alt %1!",
+#else
+ "\324\236\363",
+ "\353\224\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!load.alt %1!",
+#else
+ "\314\224\363",
+ "\241\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!xchg!",
+ "load.pri %2!load.alt %1!",
+#else
+ "\314\213\363",
+ "\317\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!xchg!",
+ "const.pri %2!load.alt %1!",
+#else
+ "\314\236\363",
+ "\353\213\246",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.s.alt %2!xchg!",
+ "load.s.pri %2!const.alt %1!",
+#else
+ "\316\224\363",
+ "\241\360",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!xchg!",
+ "load.pri %2!const.alt %1!",
+#else
+ "\316\213\363",
+ "\317\360",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ /* Array indexing can merit from special instructions.
+ * Simple indexed array lookup can be optimized quite
+ * a bit.
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 lidx.b n4
+ * shl.c.pri n4 -
+ * pop.alt -
+ * add -
+ * load.i -
+ *
+ * And to prepare for storing a value in an array
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 idxaddr.b n4
+ * shl.c.pri n4 -
+ * pop.alt -
+ * add -
+ *
+ * Notes (additional cases):
+ * 1. instruction addr.pri can also be const.pri (for
+ * global arrays)
+ * 2. the bounds instruction can be absent
+ * 3. when "n4" (the shift value) is the 2 (with 32-bit cels), use the
+ * even more optimal instructions LIDX and IDDXADDR
+ *
+ * If the array index is more complex, one can only optimize
+ * the last four instructions:
+ * shl.c.pri n1 pop.alt
+ * pop.alt lidx.b n1
+ * add -
+ * loadi -
+ * --------------------------------------
+ * shl.c.pri n1 pop.alt
+ * pop.alt idxaddr.b n1
+ * add -
+ */
+#if !defined BIT16
+ /* loading from array, "cell" shifted */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+ "\333\300\342\366",
+ "\252\334\335!",
+#endif
+ seqsize(8, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+ "\332\300\342\366",
+ "\236\334\335!",
+#endif
+ seqsize(8, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!lidx!",
+#else
+ "\333\342\366",
+ "\252\307\335!",
+#endif
+ seqsize(7, 3) - seqsize(3, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!lidx!",
+#else
+ "\332\342\366",
+ "\236\307\335!",
+#endif
+ seqsize(7, 3) - seqsize(3, 2)},
+#endif
+ /* loading from array, not "cell" shifted */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+ "\333\300\310\370\366",
+ "\252\334\335\345\370",
+#endif
+ seqsize(8, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+ "\332\300\310\370\366",
+ "\236\334\335\345\370",
+#endif
+ seqsize(8, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+ "addr.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+ "\333\310\257\366",
+ "\252\307\335\345\257",
+#endif
+ seqsize(7, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+ "const.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+ "\332\310\257\366",
+ "\236\307\335\345\257",
+#endif
+ seqsize(7, 3) - seqsize(3, 3)},
+#if !defined BIT16
+ /* array index calculation for storing a value, "cell" aligned */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+ "\333\300\342\275",
+ "\252\334\331!",
+#endif
+ seqsize(7, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+ "\332\300\342\275",
+ "\236\334\331!",
+#endif
+ seqsize(7, 4) - seqsize(4, 3)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!idxaddr!",
+#else
+ "\333\342\275",
+ "\252\307\331!",
+#endif
+ seqsize(6, 3) - seqsize(3, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!idxaddr!",
+#else
+ "\332\342\275",
+ "\236\307\331!",
+#endif
+ seqsize(6, 3) - seqsize(3, 2)},
+#endif
+ /* array index calculation for storing a value, not "cell" packed */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+ "\333\300\310\370\275",
+ "\252\334\331\345\370",
+#endif
+ seqsize(7, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+ "\332\300\310\370\275",
+ "\236\334\331\345\370",
+#endif
+ seqsize(7, 4) - seqsize(4, 4)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+ "addr.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+ "\333\310\257\275",
+ "\252\307\331\345\257",
+#endif
+ seqsize(6, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+ "const.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+ "\332\310\257\275",
+ "\236\307\331\345\257",
+#endif
+ seqsize(6, 3) - seqsize(3, 3)},
+#if !defined BIT16
+ /* the shorter array indexing sequences, see above for comments */
+ {
+#ifdef SCPACK
+ "shl.c.pri 2!pop.alt!add!loadi!",
+ "pop.alt!lidx!",
+#else
+ "\342\326\320",
+ "\231\335!",
+#endif
+ seqsize(4, 1) - seqsize(2, 0)},
+ {
+#ifdef SCPACK
+ "shl.c.pri 2!pop.alt!add!",
+ "pop.alt!idxaddr!",
+#else
+ "\342\275",
+ "\231\331!",
+#endif
+ seqsize(3, 1) - seqsize(2, 0)},
+#endif
+ {
+#ifdef SCPACK
+ "shl.c.pri %1!pop.alt!add!loadi!",
+ "pop.alt!lidx.b %1!",
+#else
+ "\276\223\326\320",
+ "\231\335\345\205",
+#endif
+ seqsize(4, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "shl.c.pri %1!pop.alt!add!",
+ "pop.alt!idxaddr.b %1!",
+#else
+ "\276\223\275",
+ "\231\331\345\205",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ /* For packed arrays, there is another case (packed arrays
+ * do not take advantage of the LIDX or IDXADDR instructions).
+ * addr.pri n1 addr.alt n1
+ * push.pri load.s.pri n2
+ * load.s.pri n2 bounds n3
+ * bounds n3 -
+ * pop.alt -
+ *
+ * Notes (additional cases):
+ * 1. instruction addr.pri can also be const.pri (for
+ * global arrays)
+ * 2. the bounds instruction can be absent, but that
+ * case is already handled (see #1#)
+ */
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+ "addr.alt %1!load.s.pri %2!bounds %3!",
+#else
+ "\333\300\231",
+ "\252\334",
+#endif
+ seqsize(5, 3) - seqsize(3, 3)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+ "const.alt %1!load.s.pri %2!bounds %3!",
+#else
+ "\332\300\231",
+ "\236\334",
+#endif
+ seqsize(5, 3) - seqsize(3, 3)},
+ /* During a calculation, the intermediate result must sometimes
+ * be moved from PRI to ALT, like in:
+ * push.pri move.alt
+ * load.s.pri n1 load.s.pri n1
+ * pop.alt -
+ *
+ * The above also accurs for "load.pri" and for "const.pri",
+ * so add another two cases.
+ */
+ {
+#ifdef SCPACK
+ "push.pri!load.s.pri %1!pop.alt!",
+ "move.alt!load.s.pri %1!",
+#else
+ "\240\324\231",
+ "\375\324",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!load.pri %1!pop.alt!",
+ "move.alt!load.pri %1!",
+#else
+ "\240\314\231",
+ "\375\314",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!const.pri %1!pop.alt!",
+ "move.alt!const.pri %1!",
+#else
+ "\240\316\231",
+ "\375\316",
+#endif
+ seqsize(3, 1) - seqsize(2, 1)},
+ {
+#ifdef SCPACK
+ "push.pri!zero.pri!pop.alt!",
+ "move.alt!zero.pri!",
+#else
+ "\240\376\231",
+ "\375\376",
+#endif
+ seqsize(3, 0) - seqsize(2, 0)},
+ /* saving PRI and then loading from its address
+ * occurs when indexing a multi-dimensional array
+ */
+ {
+#ifdef SCPACK
+ "push.pri!load.i!pop.alt!",
+ "move.alt!load.i!",
+#else
+ "\240\213\340\231",
+ "\375\213\340",
+#endif
+ seqsize(3, 0) - seqsize(2, 0)},
+ /* An even simpler PUSH/POP optimization (occurs in
+ * switch statements):
+ * push.pri move.alt
+ * pop.alt -
+ */
+ {
+#ifdef SCPACK
+ "push.pri!pop.alt!",
+ "move.alt!",
+#else
+ "\240\231",
+ "\375",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* And what to think of this PUSH/POP sequence, which occurs
+ * due to the support for user-defined assignment operator):
+ * push.alt -
+ * pop.alt -
+ */
+//???
+//{
+// #ifdef SCPACK
+// "push.alt!pop.alt!",
+// ";$", /* SCPACK cannot handle empty strings */
+// #else
+// "\225\237",
+// "\353",
+// #endif
+// seqsize(2,0) - seqsize(0,0)
+//},
+ /* Functions with many parameters with the same default
+ * value have sequences like:
+ * push.c n1 const.pri n1
+ * ;$par push.r.pri n2 ; where n2 is the number of pushes
+ * push.c n1 ;$par
+ * ;$par -
+ * push.c n1 -
+ * ;$par -
+ * etc. etc.
+ * The shortest matched sequence is 3, because a sequence of two can also be
+ * optimized as two "push.c n1" instructions.
+ * => this optimization does not work, because the argument re-ordering in
+ * a function call causes each argument to be optimized individually
+ */
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 5!;$par!",
+// #else
+// "\327\327\254",
+// "\352\221.r\2745!",
+// #endif
+// seqsize(10,5) - seqsize(2,2)
+//},
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 4!;$par!",
+// #else
+// "\327\327",
+// "\352\221.r\274\326",
+// #endif
+// seqsize(8,4) - seqsize(2,2)
+//},
+//{
+// #ifdef SCPACK
+// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+// "const.pri %1!push.r.pri 3!;$par!",
+// #else
+// "\327\254",
+// "\352\221.r\274\247",
+// #endif
+// seqsize(6,3) - seqsize(2,2)
+//},
+ /* User-defined operators first load the operands into registers and
+ * then have them pushed onto the stack. This can give rise to sequences
+ * like:
+ * const.pri n1 push.c n1
+ * const.alt n2 push.c n2
+ * push.pri -
+ * push.alt -
+ * A similar sequence occurs with the two PUSH.pri/alt instructions inverted.
+ * The first, second, or both CONST.pri/alt instructions can also be
+ * LOAD.pri/alt.
+ * This gives 2 x 4 cases.
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!const.alt %2!push.pri!push.alt!",
+ "push.c %1!push.c %2!",
+#else
+ "\316\236\311\240\351",
+ "\330\205\330\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!const.alt %2!push.alt!push.pri!",
+ "push.c %2!push.c %1!",
+#else
+ "\316\236\311\351\240",
+ "\330\216\330\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!push.pri!push.alt!",
+ "push.c %1!push %2!",
+#else
+ "\316\213\311\240\351",
+ "\330\205\222\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!push.alt!push.pri!",
+ "push %2!push.c %1!",
+#else
+ "\316\213\311\351\240",
+ "\222\216\330\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!push.pri!push.alt!",
+ "push %1!push.c %2!",
+#else
+ "\314\236\311\240\351",
+ "\222\205\330\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!const.alt %2!push.alt!push.pri!",
+ "push.c %2!push %1!",
+#else
+ "\314\236\311\351\240",
+ "\330\216\222\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!push.pri!push.alt!",
+ "push %1!push %2!",
+#else
+ "\314\213\311\240\351",
+ "\222\205\222\216",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "load.pri %1!load.alt %2!push.alt!push.pri!",
+ "push %2!push %1!",
+#else
+ "\314\213\311\351\240",
+ "\222\216\222\205",
+#endif
+ seqsize(4, 2) - seqsize(2, 2)},
+ /* Function calls (parameters are passed on the stack)
+ * load.s.pri n1 push.s n1
+ * push.pri -
+ * --------------------------------------
+ * load.pri n1 push n1
+ * push.pri -
+ * --------------------------------------
+ * const.pri n1 push.c n1
+ * push.pri -
+ * --------------------------------------
+ * zero.pri push.c 0
+ * push.pri -
+ * --------------------------------------
+ * addr.pri n1 pushaddr n1
+ * push.pri -
+ *
+ * However, PRI must not be needed after this instruction
+ * if this shortcut is used. Check for the ;$par comment.
+ */
+ {
+#ifdef SCPACK
+ "load.s.pri %1!push.pri!;$par!",
+ "push.s %1!;$par!",
+#else
+ "\224\255\344",
+ "\222\220\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!push.pri!;$par!",
+ "push %1!;$par!",
+#else
+ "\213\255\344",
+ "\222\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri %1!push.pri!;$par!",
+ "push.c %1!;$par!",
+#else
+ "\236\255\344",
+ "\330\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!push.pri!;$par!",
+ "push.c 0!;$par!",
+#else
+ "\376\240\344",
+ "\330 0!\344",
+#endif
+ seqsize(2, 0) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "addr.pri %1!push.pri!;$par!",
+ "pushaddr %1!;$par!",
+#else
+ "\252\255\344",
+ "\222\252\205\344",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* References with a default value generate new cells on the heap
+ * dynamically. That code often ends with:
+ * move.pri push.alt
+ * push.pri -
+ */
+ {
+#ifdef SCPACK
+ "move.pri!push.pri!",
+ "push.alt!",
+#else
+ "\350\232\240",
+ "\351",
+#endif
+ seqsize(2, 0) - seqsize(1, 0)},
+ /* Simple arithmetic operations on constants. Noteworthy is the
+ * subtraction of a constant, since it is converted to the addition
+ * of the inverse value.
+ * const.alt n1 add.c n1
+ * add -
+ * --------------------------------------
+ * const.alt n1 add.c -n1
+ * sub -
+ * --------------------------------------
+ * const.alt n1 smul.c n1
+ * smul -
+ * --------------------------------------
+ * const.alt n1 eq.c.pri n1
+ * eq -
+ */
+ {
+#ifdef SCPACK
+ "const.alt %1!add!",
+ "add.c %1!",
+#else
+ "\360\270",
+ "\233\247\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!sub!",
+ "add.c -%1!",
+#else
+ "\360sub!",
+ "\233\247 -%\204",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!smul!",
+ "smul.c %1!",
+#else
+ "\360smul!",
+ "smu\271\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.alt %1!eq!",
+ "eq.c.pri %1!",
+#else
+ "\360\265",
+ "\253\247\223",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Some operations use the alternative subtraction operation --these
+ * can also be optimized.
+ * const.pri n1 load.s.pri n2
+ * load.s.alt n2 add.c -n1
+ * sub.alt -
+ * --------------------------------------
+ * const.pri n1 load.pri n2
+ * load.alt n2 add.c -n1
+ * sub.alt -
+ */
+ {
+#ifdef SCPACK
+ "const.pri %1!load.s.alt %2!sub.alt!",
+ "load.s.pri %2!add.c -%1!",
+#else
+ "\316\224\311sub\217",
+ "\241\233\247 -%\204",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ {
+#ifdef SCPACK
+ "const.pri %1!load.alt %2!sub.alt!",
+ "load.pri %2!add.c -%1!",
+#else
+ "\316\213\311sub\217",
+ "\317\233\247 -%\204",
+#endif
+ seqsize(3, 2) - seqsize(2, 2)},
+ /* Compare and jump
+ * eq jneq n1
+ * jzer n1 -
+ * --------------------------------------
+ * eq jeq n1
+ * jnz n1 -
+ * --------------------------------------
+ * neq jeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * neq jneq n1
+ * jnz n1 -
+ * Compares followed by jzer occur much more
+ * often than compares followed with jnz. So we
+ * take the easy route here.
+ * less jgeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * leq jgrtr n1
+ * jzer n1 -
+ * --------------------------------------
+ * grtr jleq n1
+ * jzer n1 -
+ * --------------------------------------
+ * geq jless n1
+ * jzer n1 -
+ * --------------------------------------
+ * sless jsgeq n1
+ * jzer n1 -
+ * --------------------------------------
+ * sleq jsgrtr n1
+ * jzer n1 -
+ * --------------------------------------
+ * sgrtr jsleq n1
+ * jzer n1 -
+ * --------------------------------------
+ * sgeq jsless n1
+ * jzer n1 -
+ */
+ {
+#ifdef SCPACK
+ "eq!jzer %1!",
+ "jneq %1!",
+#else
+ "\265\305",
+ "jn\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "eq!jnz %1!",
+ "jeq %1!",
+#else
+ "\265jnz\205",
+ "j\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "neq!jzer %1!",
+ "jeq %1!",
+#else
+ "n\265\305",
+ "j\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "neq!jnz %1!",
+ "jneq %1!",
+#else
+ "n\265jnz\205",
+ "jn\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "less!jzer %1!",
+ "jgeq %1!",
+#else
+ "l\322!\305",
+ "jg\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "leq!jzer %1!",
+ "jgrtr %1!",
+#else
+ "l\265\305",
+ "jg\323r\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "grtr!jzer %1!",
+ "jleq %1!",
+#else
+ "g\323\306\305",
+ "jl\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "geq!jzer %1!",
+ "jless %1!",
+#else
+ "g\265\305",
+ "jl\322\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sless!jzer %1!",
+ "jsgeq %1!",
+#else
+ "\357\305",
+ "j\302\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sleq!jzer %1!",
+ "jsgrtr %1!",
+#else
+ "\362\305",
+ "j\337r\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sgrtr!jzer %1!",
+ "jsleq %1!",
+#else
+ "\364\305",
+ "j\303\325",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "sgeq!jzer %1!",
+ "jsless %1!",
+#else
+ "\361\305",
+ "j\341\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Test for zero (common case, especially for strings)
+ * E.g. the test expression of: "for (i=0; str{i}!=0; ++i)"
+ *
+ * zero.alt jzer n1
+ * jeq n1 -
+ * --------------------------------------
+ * zero.alt jnz n1
+ * jneq n1 -
+ */
+ {
+#ifdef SCPACK
+ "zero.alt!jeq %1!",
+ "jzer %1!",
+#else
+ "\315\217j\325",
+ "\305",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.alt!jneq %1!",
+ "jnz %1!",
+#else
+ "\315\217jn\325",
+ "jnz\205",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ /* Incrementing and decrementing leaves a value in
+ * in PRI which may not be used (for example, as the
+ * third expression in a "for" loop).
+ * inc n1 inc n1 ; ++n
+ * load.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * load.pri n1 inc n1 ; n++, e.g. "for (n=0; n<10; n++)"
+ * inc n1 ;$exp
+ * ;$exp -
+ * Plus the varieties for stack relative increments
+ * and decrements.
+ */
+ {
+#ifdef SCPACK
+ "inc %1!load.pri %1!;$exp!",
+ "inc %1!;$exp!",
+#else
+ "\373c\205\314\245",
+ "\373c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!inc %1!;$exp!",
+ "inc %1!;$exp!",
+#else
+ "\314\373c\261",
+ "\373c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "inc.s %1!load.s.pri %1!;$exp!",
+ "inc.s %1!;$exp!",
+#else
+ "\373\352\205\324\245",
+ "\373\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!inc.s %1!;$exp!",
+ "inc.s %1!;$exp!",
+#else
+ "\324\373\352\261",
+ "\373\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "dec %1!load.pri %1!;$exp!",
+ "dec %1!;$exp!",
+#else
+ "\367c\205\314\245",
+ "\367c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.pri %1!dec %1!;$exp!",
+ "dec %1!;$exp!",
+#else
+ "\314\367c\261",
+ "\367c\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "dec.s %1!load.s.pri %1!;$exp!",
+ "dec.s %1!;$exp!",
+#else
+ "\367\352\205\324\245",
+ "\367\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "load.s.pri %1!dec.s %1!;$exp!",
+ "dec.s %1!;$exp!",
+#else
+ "\324\367\352\261",
+ "\367\352\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ /* ??? the same (increments and decrements) for references */
+ /* Loading the constant zero has a special opcode.
+ * When storing zero in memory, the value of PRI must not be later on.
+ * const.pri 0 zero n1
+ * stor.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * const.pri 0 zero.s n1
+ * stor.s.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * zero.pri zero n1
+ * stor.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * zero.pri zero.s n1
+ * stor.s.pri n1 ;$exp
+ * ;$exp -
+ * --------------------------------------
+ * const.pri 0 zero.pri
+ * --------------------------------------
+ * const.alt 0 zero.alt
+ * The last two alternatives save more memory than they save
+ * time, but anyway...
+ */
+ {
+#ifdef SCPACK
+ "const.pri 0!stor.pri %1!;$exp!",
+ "zero %1!;$exp!",
+#else
+ "\236\203 0!\227or\223\245",
+ "\315\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri 0!stor.s.pri %1!;$exp!",
+ "zero.s %1!;$exp!",
+#else
+ "\236\203 0!\227or\220\223\245",
+ "\315\220\261",
+#endif
+ seqsize(2, 2) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!stor.pri %1!;$exp!",
+ "zero %1!;$exp!",
+#else
+ "\376\227or\223\245",
+ "\315\261",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "zero.pri!stor.s.pri %1!;$exp!",
+ "zero.s %1!;$exp!",
+#else
+ "\376\227or\220\223\245",
+ "\315\220\261",
+#endif
+ seqsize(2, 1) - seqsize(1, 1)},
+ {
+#ifdef SCPACK
+ "const.pri 0!",
+ "zero.pri!",
+#else
+ "\236\203 0!",
+ "\376",
+#endif
+ seqsize(1, 1) - seqsize(1, 0)},
+ {
+#ifdef SCPACK
+ "const.alt 0!",
+ "zero.alt!",
+#else
+ "\236\211 0!",
+ "\315\217",
+#endif
+ seqsize(1, 1) - seqsize(1, 0)},
+ /* ----- */
+ {NULL, NULL, 0}
+};
--- /dev/null
+/* expand.c -- Byte Pair Encoding decompression */
+/* Copyright 1996 Philip Gage */
+
+/* Byte Pair Compression appeared in the September 1997
+ * issue of C/C++ Users Journal. The original source code
+ * may still be found at the web site of the magazine
+ * (www.cuj.com).
+ *
+ * The decompressor has been modified by me (Thiadmer
+ * Riemersma) to accept a string as input, instead of a
+ * complete file.
+ */
+
+
+#include "embryo_cc_sc.h"
+
+#define STACKSIZE 16
+
+int
+strexpand(char *dest, unsigned char *source, int maxlen, unsigned char pairtable[128][2])
+{
+ unsigned char stack[STACKSIZE];
+ short c, top = 0;
+ int len;
+
+ len = 1; /* already 1 byte for '\0' */
+ for (;;)
+ {
+ /* Pop byte from stack or read byte from the input string */
+ if (top)
+ c = stack[--top];
+ else if ((c = *(unsigned char *)source++) == '\0')
+ break;
+
+ /* Push pair on stack or output byte to the output string */
+ if (c > 127)
+ {
+ stack[top++] = pairtable[c - 128][1];
+ stack[top++] = pairtable[c - 128][0];
+ }
+ else
+ {
+ len++;
+ if (maxlen > 1)
+ {
+ *dest++ = (char)c;
+ maxlen--;
+ }
+ }
+ }
+ *dest = '\0';
+ return len;
+}
--- /dev/null
+/* Small compiler - maintenance of various lists
+ *
+ * Name list (aliases)
+ * Include path list
+ *
+ * Copyright (c) ITB CompuPhase, 2001-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+#include "embryo_cc_sc.h"
+
+static stringpair *
+insert_stringpair(stringpair * root, char *first, char *second, int matchlength)
+{
+ stringpair *cur, *pred;
+
+ assert(root != NULL);
+ assert(first != NULL);
+ assert(second != NULL);
+ /* create a new node, and check whether all is okay */
+ if (!(cur = (stringpair *)malloc(sizeof(stringpair))))
+ return NULL;
+ cur->first = strdup(first);
+ cur->second = strdup(second);
+ cur->matchlength = matchlength;
+ if (!cur->first || !cur->second)
+ {
+ if (cur->first)
+ free(cur->first);
+ if (cur->second)
+ free(cur->second);
+ free(cur);
+ return NULL;
+ } /* if */
+ /* link the node to the tree, find the position */
+ for (pred = root; pred->next && strcmp(pred->next->first, first) < 0;
+ pred = pred->next)
+ /* nothing */ ;
+ cur->next = pred->next;
+ pred->next = cur;
+ return cur;
+}
+
+static void
+delete_stringpairtable(stringpair * root)
+{
+ stringpair *cur, *next;
+
+ assert(root != NULL);
+ cur = root->next;
+ while (cur)
+ {
+ next = cur->next;
+ assert(cur->first != NULL);
+ assert(cur->second != NULL);
+ free(cur->first);
+ free(cur->second);
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(root, 0, sizeof(stringpair));
+}
+
+static stringpair *
+find_stringpair(stringpair * cur, char *first, int matchlength)
+{
+ int result = 0;
+
+ assert(matchlength > 0); /* the function cannot handle zero-length comparison */
+ assert(first != NULL);
+ while (cur && result <= 0)
+ {
+ result = (int)*cur->first - (int)*first;
+ if (result == 0 && matchlength == cur->matchlength)
+ {
+ result = strncmp(cur->first, first, matchlength);
+ if (result == 0)
+ return cur;
+ } /* if */
+ cur = cur->next;
+ } /* while */
+ return NULL;
+}
+
+static int
+delete_stringpair(stringpair * root, stringpair * item)
+{
+ stringpair *cur;
+
+ assert(root != NULL);
+ cur = root;
+ while (cur->next)
+ {
+ if (cur->next == item)
+ {
+ cur->next = item->next; /* unlink from list */
+ assert(item->first != NULL);
+ assert(item->second != NULL);
+ free(item->first);
+ free(item->second);
+ free(item);
+ return TRUE;
+ } /* if */
+ cur = cur->next;
+ } /* while */
+ return FALSE;
+}
+
+/* ----- alias table --------------------------------------------- */
+static stringpair alias_tab = { NULL, NULL, NULL, 0 }; /* alias table */
+
+stringpair *
+insert_alias(char *name, char *alias)
+{
+ stringpair *cur;
+
+ assert(name != NULL);
+ assert(strlen(name) <= sNAMEMAX);
+ assert(alias != NULL);
+ assert(strlen(alias) <= sEXPMAX);
+ if (!(cur = insert_stringpair(&alias_tab, name, alias, strlen(name))))
+ error(103); /* insufficient memory (fatal error) */
+ return cur;
+}
+
+int
+lookup_alias(char *target, char *name)
+{
+ stringpair *cur =
+ find_stringpair(alias_tab.next, name, strlen(name));
+ if (cur)
+ {
+ assert(strlen(cur->second) <= sEXPMAX);
+ strcpy(target, cur->second);
+ } /* if */
+ return !!cur;
+}
+
+void
+delete_aliastable(void)
+{
+ delete_stringpairtable(&alias_tab);
+}
+
+/* ----- include paths list -------------------------------------- */
+static stringlist includepaths = { NULL, NULL }; /* directory list for include files */
+
+stringlist *
+insert_path(char *path)
+{
+ stringlist *cur;
+
+ assert(path != NULL);
+ if (!(cur = (stringlist *)malloc(sizeof(stringlist))))
+ error(103); /* insufficient memory (fatal error) */
+ if (!(cur->line = strdup(path)))
+ error(103); /* insufficient memory (fatal error) */
+ cur->next = includepaths.next;
+ includepaths.next = cur;
+ return cur;
+}
+
+char *
+get_path(int index)
+{
+ stringlist *cur = includepaths.next;
+
+ while (cur && index-- > 0)
+ cur = cur->next;
+ if (cur)
+ {
+ assert(cur->line != NULL);
+ return cur->line;
+ } /* if */
+ return NULL;
+}
+
+void
+delete_pathtable(void)
+{
+ stringlist *cur = includepaths.next, *next;
+
+ while (cur)
+ {
+ next = cur->next;
+ assert(cur->line != NULL);
+ free(cur->line);
+ free(cur);
+ cur = next;
+ } /* while */
+ memset(&includepaths, 0, sizeof(stringlist));
+}
+
+/* ----- text substitution patterns ------------------------------ */
+
+static stringpair substpair = { NULL, NULL, NULL, 0 }; /* list of substitution pairs */
+static stringpair *substindex['z' - 'A' + 1]; /* quick index to first character */
+
+static void
+adjustindex(char c)
+{
+ stringpair *cur;
+
+ assert((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_');
+ assert('A' < '_' && '_' < 'z');
+
+ for (cur = substpair.next; cur && cur->first[0] != c;
+ cur = cur->next)
+ /* nothing */ ;
+ substindex[(int)c - 'A'] = cur;
+}
+
+stringpair *
+insert_subst(char *pattern, char *substitution, int prefixlen)
+{
+ stringpair *cur;
+
+ assert(pattern != NULL);
+ assert(substitution != NULL);
+ if (!(cur = insert_stringpair(&substpair, pattern, substitution, prefixlen)))
+ error(103); /* insufficient memory (fatal error) */
+ adjustindex(*pattern);
+ return cur;
+}
+
+stringpair *
+find_subst(char *name, int length)
+{
+ stringpair *item;
+
+ assert(name != NULL);
+ assert(length > 0);
+ assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+ || *name == '_');
+ item = substindex[(int)*name - 'A'];
+ if (item)
+ item = find_stringpair(item, name, length);
+ return item;
+}
+
+int
+delete_subst(char *name, int length)
+{
+ stringpair *item;
+
+ assert(name != NULL);
+ assert(length > 0);
+ assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+ || *name == '_');
+ item = substindex[(int)*name - 'A'];
+ if (item)
+ item = find_stringpair(item, name, length);
+ if (!item)
+ return FALSE;
+ delete_stringpair(&substpair, item);
+ adjustindex(*name);
+ return TRUE;
+}
+
+void
+delete_substtable(void)
+{
+ int i;
+
+ delete_stringpairtable(&substpair);
+ for (i = 0; i < (int)(sizeof(substindex) / sizeof(substindex[0])); i++)
+ substindex[i] = NULL;
+}
--- /dev/null
+/* Small compiler
+ *
+ * Global (cross-module) variables.
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ *
+ * Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h> /* for PATH_MAX */
+#endif
+
+#include "embryo_cc_sc.h"
+
+/* global variables
+ *
+ * All global variables that are shared amongst the compiler files are
+ * declared here.
+ */
+symbol loctab; /* local symbol table */
+symbol glbtab; /* global symbol table */
+cell *litq; /* the literal queue */
+char pline[sLINEMAX + 1]; /* the line read from the input file */
+char *lptr; /* points to the current position in "pline" */
+constvalue tagname_tab = { NULL, "", 0, 0 }; /* tagname table */
+constvalue libname_tab = { NULL, "", 0, 0 }; /* library table (#pragma library "..." syntax) */
+constvalue *curlibrary = NULL; /* current library */
+symbol *curfunc; /* pointer to current function */
+char *inpfname; /* pointer to name of the file currently read from */
+char outfname[PATH_MAX]; /* output file name */
+char sc_ctrlchar = CTRL_CHAR; /* the control character (or escape character) */
+int litidx = 0; /* index to literal table */
+int litmax = sDEF_LITMAX; /* current size of the literal table */
+int stgidx = 0; /* index to the staging buffer */
+int labnum = 0; /* number of (internal) labels */
+int staging = 0; /* true if staging output */
+cell declared = 0; /* number of local cells declared */
+cell glb_declared = 0; /* number of global cells declared */
+cell code_idx = 0; /* number of bytes with generated code */
+int ntv_funcid = 0; /* incremental number of native function */
+int errnum = 0; /* number of errors */
+int warnnum = 0; /* number of warnings */
+int sc_debug = sCHKBOUNDS; /* by default: bounds checking+assertions */
+int charbits = 8; /* a "char" is 8 bits */
+int sc_packstr = FALSE; /* strings are packed by default? */
+int sc_compress = TRUE; /* compress bytecode? */
+int sc_needsemicolon = TRUE; /* semicolon required to terminate expressions? */
+int sc_dataalign = sizeof(cell); /* data alignment value */
+int sc_alignnext = FALSE; /* must frame of the next function be aligned? */
+int curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
+cell sc_stksize = sDEF_AMXSTACK; /* default stack size */
+int freading = FALSE; /* Is there an input file ready for reading? */
+int fline = 0; /* the line number in the current file */
+int fnumber = 0; /* the file number in the file table (debugging) */
+int fcurrent = 0; /* current file being processed (debugging) */
+int intest = 0; /* true if inside a test */
+int sideeffect = 0; /* true if an expression causes a side-effect */
+int stmtindent = 0; /* current indent of the statement */
+int indent_nowarn = TRUE; /* skip warning "217 loose indentation" */
+int sc_tabsize = 8; /* number of spaces that a TAB represents */
+int sc_allowtags = TRUE; /* allow/detect tagnames in lex() */
+int sc_status; /* read/write status */
+int sc_rationaltag = 0; /* tag for rational numbers */
+int rational_digits = 0; /* number of fractional digits */
+
+FILE *inpf = NULL; /* file read from (source or include) */
+FILE *inpf_org = NULL; /* main source file */
+FILE *outf = NULL; /* file written to */
+
+jmp_buf errbuf;
--- /dev/null
+/**
+@brief Embryo Library
+
+These routines are used for Embryo.
+
+@mainpage Embryo Library Documentation
+
+@image html e_big.png
+
+@version 1.7.0
+@author Carsten Haitzler <raster\@rasterman.com>
+@author Compuphase http://www.compuphase.com
+@date 2004-2012
+
+@section intro What is Embryo?
+
+Embryo is a tiny library designed to interpret limited Small programs
+compiled by the included compiler, @c embryo_cc. It is mostly a cleaned
+up and smaller version of the original Small abstract machine. The
+compiler is mostly untouched.
+
+Small was renamed to Pawn.
+For more information about the Pawn language, see
+@htmlonly <a href=http://www.compuphase.com/pawn/pawn.htm>Pawn</a>
+@endhtmlonly
+@latexonly http://www.compuphase.com/pawn/pawn.htm @endlatexonly
+For the basics about the Small language, see @ref Small_Page.
+
+@section How_to_Use How to Use Embryo?
+
+To use Embryo in your code, you need to do at least the following:
+
+@li Include @ref Embryo.h.
+@li Load the Embryo program using one of the
+ @ref Embryo_Program_Creation_Group.
+@li Set up the native calls with @ref embryo_program_native_call_add.
+@li Create a virtual machine with @ref embryo_program_vm_push.
+@li Then run the program with @ref embryo_program_run.
+
+@todo Clean up compiler code.
+@todo Proper overview of the operation of the interpreter, that is how
+ the heap, stack, virtual machines, etc fit together.
+
+@page Small_Page Brief Introduction to Small
+
+This section describes the basics of Small, as compiled and interpreted
+with Embryo.
+
+This summary assumes that you are familar with C. For a full list of
+differences between C and Small, again, see the full documentation.
+
+@section Small_Variables_Section Variables
+
+@subsection Small_Type_Subsection Types
+
+There is only one type, known as the "cell", which can hold an integer.
+
+@subsection Small_Scope_Subsection Scope
+
+The scope and usage of a variable depends on its declaration.
+
+@li A local variable is normally declared with the @c new keyword. E.g.
+ @code new variable @endcode
+@li A static function variable is defined within a function with the
+ @c static keyword.
+@li A global static variable is one that is only available within the
+ file it was declared in. Again, use the @c static keyword, but outside
+ of any function.
+@li A stock variable is one that may not be compiled into a program if it
+ is not used. It is declared using @c stock.
+@li A public variable is one that can be read by the host program using
+ @ref embryo_program_variable_find. It is declared using @c public
+ keyword.
+
+Remember that the keywords above are to be used on their own. That is,
+for example: @code public testvar @endcode not:
+@code new public testvar @endcode
+
+@subsection Small_Constants_Subsection Constants
+
+You can declare constants in two ways:
+@li Using the preprocessor macro @c \#define.
+@li By inserting @c const between the keyword and variable name of a
+ variable declaration. For example, to declare the variable @c var1
+ constant, you type @code new const var1 = 2 @endcode Now @c var1
+ cannot be changed.
+
+@subsection Small_Arrays_Subsection Arrays
+
+To declare an array, append square brackets to the end of the variable
+name. The following examples show how to declare arrays. Note the
+use of the ellipsis operator, which bases the array based on the last two
+declared values:
+
+@code
+new msg[] = "A message."
+new ints[] = {1, 3, 4}
+new ints2[20] = {1, 3} // All other elements 0.
+new ints3[10] = {1, ... } // All elements = 1
+new ints4[10] = {10, 20, ... } // Elements = 10 -> 100.
+ // The difference can be negative.
+new ints5[3][3] = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
+@endcode
+
+@note Array initialisers need to be constant.
+
+@section Small_Func_Calls_Section Function Calls
+
+A typical function declaration is as follows:
+
+@code
+testfunc(param) {
+ // Do something ...
+ // over a couple of lines.
+}
+@endcode
+
+You can pass by reference. That is, the parameter you pass is changed
+outside of the function. For example:
+
+@code
+testfunc(¶m) {
+ param = 10
+ // The passed variable will be set to 10 outside of the function.
+}
+@endcode
+
+To pass an array:
+
+@code
+testfunc(param[]) {
+ // Do something to the array
+}
+@endcode
+
+@note Arrays are passed by reference.
+
+@section Small_Control_Subsection Control Structures.
+
+Small has the following control structures, which similar to their C
+counterparts:
+@li @code if (expression) statement1 else statement2 @endcode
+@li @code switch (expression) {
+ case 0:
+ statement1 // Can only be one statement. Look Ma, no breaks!
+ case 1..3: // For values between 1 and 3 inclusive.
+ statement2
+ default: // Optional
+ statement3
+}
+@endcode
+@li @code while(expression) statement @endcode
+@li @code do statement while (expression) @endcode
+@li @code for (init_expression; before_iter_test_expression; after_iter_expression) statement @endcode
+
+@section Small_Preprocessor_Section Preprocessor
+
+The following preprocessor directives are available:
+@li @code #assert constant_expression @endcode
+@li @code #define pattern replacement @endcode
+@li @code #define pattern(%1,%2,...) replacement @endcode
+@li @code #include filename @endcode
+@li @code #if constant_expression
+ // Various bits of code
+#else
+ // Other bits of code
+#endif
+@endcode
+@li @code #undef pattern @endcode
+
+
+@page Available_Native_Calls_Page Available Calls
+
+Embryo provides a minimal set of native calls that can be used within
+any Embryo script. Those calls are detailed here.
+
+@note Some of the "core" functions here are also described in the full
+ Small documentation given
+
+@todo Finish this section.
+
+@section Args_ANC_Section Argument Functions
+
+@subsection Numargs_Desc numargs
+
+Returns the number of arguments passed to a function. Useful
+when dealing with variable argument lists.
+
+@subsection Getargs_Desc getarg(arg, index=0)
+
+Retrieves the argument number @c arg. If the argument is an array,
+use @c index to specify the index of the array to return.
+
+@subsection Setargs_Desc setargs(arg, index=0, value)
+
+Sets the argument number @c arg to the given @c arg. @c index specifies
+the index of @c arg to set if @c arg is an array.
+
+@section String_ANC_Section String Functions
+
+Functions that work on strings.
+
+@subsection Atoi_Desc atoi
+
+Translates an number in string form into an integer.
+
+@subsection Fnmatch_Desc fnmatch
+
+Buggered if I know what this does?
+
+@subsection Strcmp_Desc strcmp
+
+String comparing function.
+
+
+@section Float_ANC_Section Float Functions
+
+@subsection Float_Desc float
+
+@subsection Atof_Desc atof
+
+@subsection Float_Mul_Desc float_mul
+
+@subsection Float_Div_Desc float_div
+
+@subsection Float_Add_Desc float_add
+
+@subsection Float_Sub_Desc float_sub
+
+@subsection Fract_Desc fract
+
+@subsection Round_Desc round
+
+@subsection Float_Cmp_Desc float_cmp
+
+@subsection Sqrt_Desc sqrt
+
+@subsection Pow_Desc pow
+
+@subsection Log_Desc log
+
+@subsection Sin_Desc sin
+
+@subsection Cos_Desc cos
+
+@subsection Tan_Desc tan
+
+@subsection Abs_Desc abs
+
+Returns the absolute value of the given float.
+
+@section Time_ANC_Section Time Functions
+
+@subsection Seconds_Desc seconds()
+
+@subsection Date_Desc date
+
+
+@section Rand_ANC_Section Random Functions
+
+@subsection Rand_Desc rand()
+
+Returns a random integer.
+
+@subsection Randf_Desc randf()
+
+Returns a random float.
+
+@file Embryo.h
+@brief Embryo virtual machine library.
+
+This file includes the routines needed for Embryo library interaction.
+This is the @e only file you need to include.
+
+*/
+
+// The following definitions are in Embryo.h, but I did not want to
+// mess up the formatting of the file
+
+/**
+ @def EMBRYO_FUNCTION_NONE
+ An invalid/non-existent function.
+*/
+
+/**
+ @def EMBRYO_FUNCTION_MAIN
+ Start at program entry point. For use with @ref embryo_program_run.
+*/
+
+/**
+ @def EMBRYO_FUNCTION_CONT
+ Continue from last address. For use with @ref embryo_program_run.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_OK
+ Program was run successfully.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_SLEEP
+ The program's execution was interrupted by a Small @c sleep command.
+*/
+
+/**
+ @def EMBRYO_PROGRAM_FAIL
+ An error in the program caused it to fail.
+*/
+
+#ifndef _EMBRYO_H
+#define _EMBRYO_H
+
+#ifdef EAPI
+# undef EAPI
+#endif
+
+#ifdef _WIN32
+# ifdef EFL_EMBRYO_BUILD
+# ifdef DLL_EXPORT
+# define EAPI __declspec(dllexport)
+# else
+# define EAPI
+# endif /* ! DLL_EXPORT */
+# else
+# define EAPI __declspec(dllimport)
+# endif /* ! EFL_EMBRYO_BUILD */
+#else
+# ifdef __GNUC__
+# if __GNUC__ >= 4
+# define EAPI __attribute__ ((visibility("default")))
+# else
+# define EAPI
+# endif
+# else
+# define EAPI
+# endif
+#endif /* ! _WIN32 */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define EMBRYO_VERSION_MAJOR 1
+#define EMBRYO_VERSION_MINOR 8
+
+ typedef struct _Embryo_Version
+ {
+ int major;
+ int minor;
+ int micro;
+ int revision;
+ } Embryo_Version;
+
+ EAPI extern Embryo_Version *embryo_version;
+
+ /* potential error values */
+ typedef enum _Embryo_Error
+ {
+ EMBRYO_ERROR_NONE,
+ /* reserve the first 15 error codes for exit codes of the abstract machine */
+ EMBRYO_ERROR_EXIT, /** Forced exit */
+ EMBRYO_ERROR_ASSERT, /** Assertion failed */
+ EMBRYO_ERROR_STACKERR, /** Stack/heap collision */
+ EMBRYO_ERROR_BOUNDS, /** Index out of bounds */
+ EMBRYO_ERROR_MEMACCESS, /** Invalid memory access */
+ EMBRYO_ERROR_INVINSTR, /** Invalid instruction */
+ EMBRYO_ERROR_STACKLOW, /** Stack underflow */
+ EMBRYO_ERROR_HEAPLOW, /** Heap underflow */
+ EMBRYO_ERROR_CALLBACK, /** No callback, or invalid callback */
+ EMBRYO_ERROR_NATIVE, /** Native function failed */
+ EMBRYO_ERROR_DIVIDE, /** Divide by zero */
+ EMBRYO_ERROR_SLEEP, /** Go into sleepmode - code can be restarted */
+
+ EMBRYO_ERROR_MEMORY = 16, /** Out of memory */
+ EMBRYO_ERROR_FORMAT, /** Invalid file format */
+ EMBRYO_ERROR_VERSION, /** File is for a newer version of the Embryo_Program */
+ EMBRYO_ERROR_NOTFOUND, /** Function not found */
+ EMBRYO_ERROR_INDEX, /** Invalid index parameter (bad entry point) */
+ EMBRYO_ERROR_DEBUG, /** Debugger cannot run */
+ EMBRYO_ERROR_INIT, /** Embryo_Program not initialized (or doubly initialized) */
+ EMBRYO_ERROR_USERDATA, /** Unable to set user data field (table full) */
+ EMBRYO_ERROR_INIT_JIT, /** Cannot initialize the JIT */
+ EMBRYO_ERROR_PARAMS, /** Parameter error */
+ EMBRYO_ERROR_DOMAIN, /** Domain error, expression result does not fit in range */
+ } Embryo_Error;
+
+ /* program run return values */
+ typedef enum _Embryo_Status
+ {
+ EMBRYO_PROGRAM_FAIL = 0,
+ EMBRYO_PROGRAM_OK = 1,
+ EMBRYO_PROGRAM_SLEEP = 2,
+ EMBRYO_PROGRAM_BUSY = 3,
+ EMBRYO_PROGRAM_TOOLONG = 4
+ } Embryo_Status;
+
+ typedef unsigned int Embryo_UCell;
+ typedef int Embryo_Cell;
+ /** An invalid cell reference */
+#define EMBRYO_CELL_NONE 0x7fffffff
+
+ typedef struct _Embryo_Program Embryo_Program;
+ typedef int Embryo_Function;
+ /* possible function type values that are enumerated */
+#define EMBRYO_FUNCTION_NONE 0x7fffffff /* An invalid/non existent function */
+#define EMBRYO_FUNCTION_MAIN -1 /* Start at program entry point */
+#define EMBRYO_FUNCTION_CONT -2 /* Continue from last address */
+
+ typedef union
+ {
+ float f;
+ Embryo_Cell c;
+ } Embryo_Float_Cell;
+
+#if defined _MSC_VER || defined __SUNPRO_C
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) (((Embryo_Float_Cell *)&(f))->c)
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) (((Embryo_Float_Cell *)&(c))->f)
+#else
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) ((Embryo_Float_Cell) f).c
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) ((Embryo_Float_Cell) c).f
+#endif
+
+ /**
+ * @defgroup Embryo_Library_Group Library Maintenance Functions
+ *
+ * Functions that start up and shutdown the Embryo library.
+ */
+
+
+/**
+ * Initialises the Embryo library.
+ * @return The number of times the library has been initialised without being
+ * shut down.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int embryo_init(void);
+
+/**
+ * Shuts down the Embryo library.
+ * @return The number of times the library has been initialised without being
+ * shutdown.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int embryo_shutdown(void);
+
+ /**
+ * @defgroup Embryo_Program_Creation_Group Program Creation and Destruction Functions
+ *
+ * Functions that set up programs, and destroy them.
+ */
+
+/**
+ * Creates a new Embryo program, with bytecode data that can be freed.
+ * @param data Pointer to the bytecode of the program.
+ * @param size Number of bytes of bytecode.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_new(void *data, int size);
+
+/**
+ * Creates a new Embryo program, with bytecode data that cannot be
+ * freed.
+ * @param data Pointer to the bytecode of the program.
+ * @param size Number of bytes of bytecode.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_const_new(void *data, int size);
+
+/**
+ * Creates a new Embryo program based on the bytecode data stored in the
+ * given file.
+ * @param file Filename of the given file.
+ * @return A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program *embryo_program_load(const char *file);
+
+/**
+ * Frees the given Embryo program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI void embryo_program_free(Embryo_Program *ep);
+
+/**
+ * Adds a native program call to the given Embryo program.
+ * @param ep The given Embryo program.
+ * @param name The name for the call used in the script.
+ * @param func The function to use when the call is made.
+ * @ingroup Embryo_Func_Group
+ */
+
+/**
+ * @defgroup Embryo_Func_Group Function Functions
+ *
+ * Functions that deal with Embryo program functions.
+ */
+EAPI void embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params));
+
+/**
+ * Resets the current virtual machine session of the given program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_VM_Group Virtual Machine Functions
+ *
+ * Functions that deal with creating and destroying virtual machine sessions
+ * for a given program.
+ *
+ * A given embryo program can have multiple virtual machine sessions running.
+ * This is useful when you have a native call that in turn calls a function in
+ * the embryo program. The native call can start a new virtual machine
+ * session to run the function it needs. Once completed, the session can be
+ * popped off the program's stack, and the native call can return its value
+ * to the old session.
+ *
+ * A new virtual machine session is created by pushing a new virtual machine
+ * onto the session stack of a program using @ref embryo_program_vm_push.
+ * The current virtual machine session can be destroyed by calling
+ * @ref embryo_program_vm_pop.
+ */
+EAPI void embryo_program_vm_reset(Embryo_Program *ep);
+
+/**
+ * Starts a new virtual machine session for the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ *
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void embryo_program_vm_push(Embryo_Program *ep);
+
+/**
+ * Frees the current virtual machine session associated with the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ * Note that you will need to retrieve any return data or data on the stack
+ * before you pop.
+ *
+ * @param ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void embryo_program_vm_pop(Embryo_Program *ep);
+
+/**
+ * Ensures that the given unsigned short integer is in the small
+ * endian format.
+ * @param v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+
+/**
+ * @defgroup Embryo_Swap_Group Byte Swapping Functions
+ *
+ * Functions that are used to ensure that integers passed to the
+ * virtual machine are in small endian format. These functions are
+ * used to ensure that the virtual machine operates correctly on big
+ * endian machines.
+ */
+EAPI void embryo_swap_16(unsigned short *v);
+
+/**
+ * Ensures that the given unsigned integer is in the small endian
+ * format.
+ * @param v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+EAPI void embryo_swap_32(unsigned int *v);
+
+/**
+ * Returns the function in the given program with the given name.
+ * @param ep The given program.
+ * @param name The given function name.
+ * @return The function if successful. Otherwise, @c EMBRYO_FUNCTION_NONE.
+ * @ingroup Embryo_Func_Group
+ */
+EAPI Embryo_Function embryo_program_function_find(Embryo_Program *ep, const char *name);
+
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given name.
+ * @param ep The given program.
+ * @param name The given name.
+ * @return The address of the variable if found. @c EMBRYO_CELL_NONE
+ * otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+
+/**
+ * @defgroup Embryo_Public_Variable_Group Public Variable Access Functions
+ *
+ * In an Embryo program, a global variable can be declared public, as
+ * described in @ref Small_Scope_Subsection. The functions here allow
+ * the host program to access these public variables.
+ */
+EAPI Embryo_Cell embryo_program_variable_find(Embryo_Program *ep, const char *name);
+
+/**
+ * Retrieves the number of public variables in the given program.
+ * @param ep The given program.
+ * @return The number of public variables.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI int embryo_program_variable_count_get(Embryo_Program *ep);
+
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given identifier.
+ * @param ep The given program.
+ * @param num The identifier of the public variable.
+ * @return The virtual machine address of the variable if found.
+ * @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI Embryo_Cell embryo_program_variable_get(Embryo_Program *ep, int num);
+
+/**
+ * Sets the error code for the given program to the given code.
+ * @param ep The given program.
+ * @param error The given error code.
+ * @ingroup Embryo_Error_Group
+ */
+
+/**
+ * @defgroup Embryo_Error_Group Error Functions
+ *
+ * Functions that set and retrieve error codes in Embryo programs.
+ */
+EAPI void embryo_program_error_set(Embryo_Program *ep, Embryo_Error error);
+
+/**
+ * Retrieves the current error code for the given program.
+ * @param ep The given program.
+ * @return The current error code.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI Embryo_Error embryo_program_error_get(Embryo_Program *ep);
+
+/**
+ * Sets the data associated to the given program.
+ * @param ep The given program.
+ * @param data New bytecode data.
+ * @ingroup Embryo_Program_Data_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_Data_Group Program Data Functions
+ *
+ * Functions that set and retrieve data associated with the given
+ * program.
+ */
+EAPI void embryo_program_data_set(Embryo_Program *ep, void *data);
+
+/**
+ * Retrieves the data associated to the given program.
+ * @param ep The given program.
+ * @ingroup Embryo_Program_Data_Group
+ */
+EAPI void *embryo_program_data_get(Embryo_Program *ep);
+
+/**
+ * Retrieves a string describing the given error code.
+ * @param error The given error code.
+ * @return String describing the given error code. If the given code is not
+ * known, the string "(unknown)" is returned.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI const char *embryo_error_string_get(Embryo_Error error);
+
+/**
+ * Retrieves the length of the string starting at the given cell.
+ * @param ep The program the cell is part of.
+ * @param str_cell Pointer to the first cell of the string.
+ * @return The length of the string. @c 0 is returned if there is an error.
+ * @ingroup Embryo_Data_String_Group
+ */
+
+/**
+ * @defgroup Embryo_Data_String_Group Embryo Data String Functions
+ *
+ * Functions that operate on strings in the memory of a virtual machine.
+ */
+EAPI int embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell);
+
+/**
+ * Copies the string starting at the given cell to the given buffer.
+ * @param ep The program the cell is part of.
+ * @param str_cell Pointer to the first cell of the string.
+ * @param dst The given buffer.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst);
+
+/**
+ * Copies string in the given buffer into the virtual machine memory
+ * starting at the given cell.
+ * @param ep The program the cell is part of.
+ * @param src The given buffer.
+ * @param str_cell Pointer to the first cell to copy the string to.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell);
+
+/**
+ * Retreives a pointer to the address in the virtual machine given by the
+ * given cell.
+ * @param ep The program whose virtual machine address is being queried.
+ * @param addr The given cell.
+ * @return A pointer to the cell at the given address.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI Embryo_Cell *embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr);
+
+/**
+ * Increases the size of the heap of the given virtual machine by the given
+ * number of Embryo_Cells.
+ * @param ep The program with the given virtual machine.
+ * @param cells The given number of Embryo_Cells.
+ * @return The address of the new memory region on success.
+ * @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Heap_Group
+ */
+
+/**
+ * @defgroup Embryo_Heap_Group Heap Functions
+ *
+ * The heap is an area of memory that can be allocated for program
+ * use at runtime. The heap functions here change the amount of heap
+ * memory available.
+ */
+EAPI Embryo_Cell embryo_data_heap_push(Embryo_Program *ep, int cells);
+
+/**
+ * Decreases the size of the heap of the given virtual machine down to the
+ * given size.
+ * @param ep The program with the given virtual machine.
+ * @param down_to The given size.
+ * @ingroup Embryo_Heap_Group
+ */
+EAPI void embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to);
+
+/**
+ * Returns the number of virtual machines are running for the given program.
+ * @param ep The given program.
+ * @return The number of virtual machines running.
+ * @ingroup Embryo_Run_Group
+ */
+
+/**
+ * @defgroup Embryo_Run_Group Program Run Functions
+ *
+ * Functions that are involved in actually running functions in an
+ * Embryo program.
+ */
+EAPI int embryo_program_recursion_get(Embryo_Program *ep);
+
+/**
+ * Runs the given function of the given Embryo program in the current
+ * virtual machine. The parameter @p fn can be found using
+ * @ref embryo_program_function_find.
+ *
+ * @note For Embryo to be able to run a function, it must have been
+ * declared @c public in the Small source code.
+ *
+ * @param ep The given program.
+ * @param func The given function. Normally "main", in which case the
+ * constant @c EMBRYO_FUNCTION_MAIN can be used.
+ * @return @c EMBRYO_PROGRAM_OK on success. @c EMBRYO_PROGRAM_SLEEP if the
+ * program is halted by the Small @c sleep call.
+ * @c EMBRYO_PROGRAM_FAIL if there is an error.
+ * @c EMBRYO_PROGRAM_TOOLONG if the program executes for longer than
+ * it is allowed to in abstract machine instruction count.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Status embryo_program_run(Embryo_Program *ep, Embryo_Function func);
+
+/**
+ * Retreives the return value of the last called function of the given
+ * program.
+ * @param ep The given program.
+ * @return An Embryo_Cell representing the return value of the function
+ * that was last called.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Cell embryo_program_return_value_get(Embryo_Program *ep);
+
+/**
+ * Sets the maximum number of abstract machine cycles any given program run
+ * can execute before being put to sleep and returning.
+ *
+ * @param ep The given program.
+ * @param max The number of machine cycles as a limit.
+ *
+ * This sets the maximum number of abstract machine (virtual machine)
+ * instructions that a single run of an embryo function (even if its main)
+ * can use before embryo embryo_program_run() reutrns with the value
+ * EMBRYO_PROGRAM_TOOLONG. If the function fully executes within this number
+ * of cycles, embryo_program_run() will return as normal with either
+ * EMBRYO_PROGRAM_OK, EMBRYO_PROGRAM_FAIL or EMBRYO_PROGRAM_SLEEP. If the
+ * run exceeds this instruction count, then EMBRYO_PROGRAM_TOOLONG will be
+ * returned indicating the program exceeded its run count. If the app wishes
+ * to continue running this anyway - it is free to process its own events or
+ * whatever it wants and continue the function by calling
+ * embryo_program_run(program, EMBRYO_FUNCTION_CONT); which will start the
+ * run again until the instruction count is reached. This can keep being done
+ * to allow the calling program to still be able to control things outside the
+ * embryo function being called. If the maximum run cycle count is 0 then the
+ * program is allowed to run forever only returning when it is done.
+ *
+ * It is important to note that abstract machine cycles are NOT the same as
+ * the host machine cpu cycles. They are not fixed in runtime per cycle, so
+ * this is more of a helper tool than a way to HARD-FORCE a script to only
+ * run for a specific period of time. If the cycle count is set to something
+ * low like 5000 or 1000, then every 1000 (or 5000) cycles control will be
+ * returned to the calling process where it can check a timer to see if a
+ * physical runtime limit has been elapsed and then abort running further
+ * assuming a "runaway script" or keep continuing the script run. This
+ * limits resolution to only that many cycles which do not take a determined
+ * amount of time to execute, as this varies from cpu to cpu and also depends
+ * on how loaded the system is. Making the max cycle run too low will
+ * impact performance requiring the abstract machine to do setup and teardown
+ * cycles too often comapred to cycles actually executed.
+ *
+ * Also note it does NOT include nested abstract machines. IF this abstract
+ * machine run calls embryo script that calls a native function that in turn
+ * calls more embryo script, then the 2nd (and so on) levels are not included
+ * in this run count. They can set their own max instruction count values
+ * separately.
+ *
+ * The default max cycle run value is 0 in any program until set with this
+ * function.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI void embryo_program_max_cycle_run_set(Embryo_Program *ep, int max);
+
+/**
+ * Retreives the maximum number of abstract machine cycles a program is allowed
+ * to run.
+ * @param ep The given program.
+ * @return The number of cycles a run cycle is allowed to run for this
+ * program.
+ *
+ * This returns the value set by embryo_program_max_cycle_run_set(). See
+ * embryo_program_max_cycle_run_set() for more information.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI int embryo_program_max_cycle_run_get(Embryo_Program *ep);
+
+/**
+ * Pushes an Embryo_Cell onto the function stack to use as a parameter for
+ * the next function that is called in the given program.
+ * @param ep The given program.
+ * @param cell The Embryo_Cell to push onto the stack.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+
+/**
+ * @defgroup Embryo_Parameter_Group Function Parameter Functions
+ *
+ * Functions that set parameters for the next function that is called.
+ */
+EAPI int embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell);
+
+/**
+ * Pushes a string onto the function stack to use as a parameter for the
+ * next function that is called in the given program.
+ * @param ep The given program.
+ * @param str The string to push onto the stack.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int embryo_parameter_string_push(Embryo_Program *ep, const char *str);
+
+/**
+ * Pushes an array of Embryo_Cells onto the function stack to be used as
+ * parameters for the next function that is called in the given program.
+ * @param ep The given program.
+ * @param cells The array of Embryo_Cells.
+ * @param num The number of cells in @p cells.
+ * @return @c 1 if successful. @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
--- /dev/null
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_builddir) \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir)/src/lib/include \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EVIL_CFLAGS@ \
+@EXOTIC_CFLAGS@ \
+@EMBRYO_CPPFLAGS@ \
+@EFL_EMBRYO_BUILD@
+
+includes_HEADERS = Embryo.h
+includesdir = $(includedir)/embryo-@VMAJ@
+
+lib_LTLIBRARIES = libembryo.la
+
+libembryo_la_SOURCES = \
+embryo_amx.c \
+embryo_args.c \
+embryo_float.c \
+embryo_main.c \
+embryo_rand.c \
+embryo_str.c \
+embryo_time.c
+
+libembryo_la_CFLAGS = @EMBRYO_CFLAGS@
+libembryo_la_LIBADD = @EXOTIC_LIBS@ @EVIL_LIBS@ -lm
+libembryo_la_LDFLAGS = -no-undefined @lt_enable_auto_import@ -version-info @version_info@ @release_info@
+
+EXTRA_DIST = embryo_private.h
--- /dev/null
+/* Abstract Machine for the Small compiler
+ *
+ * Copyright (c) ITB CompuPhase, 1997-2003
+ * Portions Copyright (c) Carsten Haitzler, 2004-2010 <raster@rasterman.com>
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+
+#define JUMPABS(base, ip) ((Embryo_Cell *)(code + (*ip)))
+
+#ifdef WORDS_BIGENDIAN
+static void _embryo_byte_swap_16 (unsigned short *v);
+static void _embryo_byte_swap_32 (unsigned int *v);
+#endif
+static int _embryo_native_call (Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params);
+static int _embryo_func_get (Embryo_Program *ep, int idx, char *funcname);
+static int _embryo_var_get (Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr);
+static int _embryo_program_init (Embryo_Program *ep, void *code);
+
+#ifdef WORDS_BIGENDIAN
+static void
+_embryo_byte_swap_16(unsigned short *v)
+{
+ unsigned char *s, t;
+
+ s = (unsigned char *)v;
+ t = s[0]; s[0] = s[1]; s[1] = t;
+}
+
+static void
+_embryo_byte_swap_32(unsigned int *v)
+{
+ unsigned char *s, t;
+
+ s = (unsigned char *)v;
+ t = s[0]; s[0] = s[3]; s[3] = t;
+ t = s[1]; s[1] = s[2]; s[2] = t;
+}
+#endif
+
+static int
+_embryo_native_call(Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func_entry;
+ Embryo_Native f;
+
+ hdr = (Embryo_Header *)ep->base;
+ func_entry = GETENTRY(hdr, natives, idx);
+ if ((func_entry->address <= 0) ||
+ (func_entry->address > ep->native_calls_size))
+ {
+ ep->error = EMBRYO_ERROR_CALLBACK;
+ return ep->error;
+ }
+ f = ep->native_calls[func_entry->address - 1];
+ if (!f)
+ {
+ ep->error = EMBRYO_ERROR_CALLBACK;
+ return ep->error;
+ }
+ ep->error = EMBRYO_ERROR_NONE;
+ *result = f(ep, params);
+ return ep->error;
+}
+
+static int
+_embryo_func_get(Embryo_Program *ep, int idx, char *funcname)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func;
+
+ hdr = (Embryo_Header *)ep->code;
+ if (idx >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+ return EMBRYO_ERROR_INDEX;
+
+ func = GETENTRY(hdr, publics, idx);
+ strcpy(funcname, GETENTRYNAME(hdr, func));
+ return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_var_get(Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr)
+{
+
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *var;
+
+ hdr=(Embryo_Header *)ep->base;
+ if (idx >= (Embryo_Cell)NUMENTRIES(hdr, pubvars, tags))
+ return EMBRYO_ERROR_INDEX;
+
+ var = GETENTRY(hdr, pubvars, idx);
+ strcpy(varname, GETENTRYNAME(hdr, var));
+ *ep_addr = var->address;
+ return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_program_init(Embryo_Program *ep, void *code)
+{
+ Embryo_Header *hdr;
+
+ if ((ep->flags & EMBRYO_FLAG_RELOC)) return 1;
+ ep->code = (unsigned char *)code;
+ hdr = (Embryo_Header *)ep->code;
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32((unsigned int *)&hdr->size);
+ embryo_swap_16((unsigned short *)&hdr->magic);
+ embryo_swap_16((unsigned short *)&hdr->flags);
+ embryo_swap_16((unsigned short *)&hdr->defsize);
+ embryo_swap_32((unsigned int *)&hdr->cod);
+ embryo_swap_32((unsigned int *)&hdr->dat);
+ embryo_swap_32((unsigned int *)&hdr->hea);
+ embryo_swap_32((unsigned int *)&hdr->stp);
+ embryo_swap_32((unsigned int *)&hdr->cip);
+ embryo_swap_32((unsigned int *)&hdr->publics);
+ embryo_swap_32((unsigned int *)&hdr->natives);
+ embryo_swap_32((unsigned int *)&hdr->libraries);
+ embryo_swap_32((unsigned int *)&hdr->pubvars);
+ embryo_swap_32((unsigned int *)&hdr->tags);
+ embryo_swap_32((unsigned int *)&hdr->nametable);
+#endif
+
+ if (hdr->magic != EMBRYO_MAGIC) return 0;
+ if ((hdr->file_version < MIN_FILE_VERSION) ||
+ (hdr->ep_version > CUR_FILE_VERSION)) return 0;
+ if ((hdr->defsize != sizeof(Embryo_Func_Stub)) &&
+ (hdr->defsize != (2 * sizeof(unsigned int)))) return 0;
+ if (hdr->defsize == (2 * sizeof(unsigned int)))
+ {
+ unsigned short *len;
+
+ len = (unsigned short*)((unsigned char*)ep->code + hdr->nametable);
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_16((unsigned short *)len);
+#endif
+ if (*len > sNAMEMAX) return 0;
+ }
+ if (hdr->stp <= 0) return 0;
+ if ((hdr->flags & EMBRYO_FLAG_COMPACT)) return 0;
+
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Func_Stub *fs;
+ int i, num;
+
+ /* also align all addresses in the public function, public variable and */
+ /* public tag tables */
+ fs = GETENTRY(hdr, publics, 0);
+ num = NUMENTRIES(hdr, publics, natives);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+
+ fs = GETENTRY(hdr, pubvars, 0);
+ num = NUMENTRIES(hdr, pubvars, tags);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+
+ fs = GETENTRY(hdr, tags, 0);
+ num = NUMENTRIES(hdr, tags, nametable);
+ for (i = 0; i < num; i++)
+ {
+ embryo_swap_32(&(fs->address));
+ fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+ }
+ }
+#endif
+ ep->flags = EMBRYO_FLAG_RELOC;
+
+ {
+ Embryo_Cell cip, code_size, cip_end;
+ Embryo_Cell *code;
+
+ code_size = hdr->dat - hdr->cod;
+ code = (Embryo_Cell *)((unsigned char *)ep->code + (int)hdr->cod);
+ cip_end = code_size / sizeof(Embryo_Cell);
+ for (cip = 0; cip < cip_end; cip++)
+ {
+/* move this here - later we probably want something that verifies opcodes
+ * are valid and ok...
+ */
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32(&(code[cip]));
+#endif
+
+ }
+ }
+ /* init native api for handling floating point - default in embryo */
+ _embryo_args_init(ep);
+ _embryo_fp_init(ep);
+ _embryo_rand_init(ep);
+ _embryo_str_init(ep);
+ _embryo_time_init(ep);
+ return 1;
+}
+
+/*** EXPORTED CALLS ***/
+
+EAPI Embryo_Program *
+embryo_program_new(void *data, int size)
+{
+ Embryo_Program *ep;
+ void *code_data;
+
+ if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+ ep = calloc(1, sizeof(Embryo_Program));
+ if (!ep) return NULL;
+
+ code_data = malloc(size);
+ if (!code_data)
+ {
+ free(ep);
+ return NULL;
+ }
+ memcpy(code_data, data, size);
+ if (_embryo_program_init(ep, code_data)) return ep;
+ free(code_data);
+ free(ep);
+ return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_const_new(void *data, int size)
+{
+ Embryo_Program *ep;
+
+ if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+ ep = calloc(1, sizeof(Embryo_Program));
+ if (!ep) return NULL;
+
+ if (_embryo_program_init(ep, data))
+ {
+ ep->dont_free_code = 1;
+ return ep;
+ }
+ free(ep);
+ return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_load(const char *file)
+{
+ Embryo_Program *ep;
+ Embryo_Header hdr;
+ FILE *f;
+ void *program = NULL;
+ int program_size = 0;
+
+ f = fopen(file, "rb");
+ if (!f) return NULL;
+ fseek(f, 0, SEEK_END);
+ program_size = ftell(f);
+ fseek(f, 0L, SEEK_SET);
+ if (program_size < (int)sizeof(Embryo_Header))
+ {
+ fclose(f);
+ return NULL;
+ }
+ if (fread(&hdr, sizeof(Embryo_Header), 1, f) != 1)
+ {
+ fclose(f);
+ return NULL;
+ }
+ fseek(f, 0L, SEEK_SET);
+#ifdef WORDS_BIGENDIAN
+ embryo_swap_32((unsigned int *)(&hdr.size));
+#endif
+ if ((int)hdr.size < program_size) program_size = hdr.size;
+ program = malloc(program_size);
+ if (!program)
+ {
+ fclose(f);
+ return NULL;
+ }
+ if (fread(program, program_size, 1, f) != 1)
+ {
+ free(program);
+ fclose(f);
+ return NULL;
+ }
+ ep = embryo_program_new(program, program_size);
+ free(program);
+ fclose(f);
+ return ep;
+}
+
+EAPI void
+embryo_program_free(Embryo_Program *ep)
+{
+ int i;
+
+ if (ep->base) free(ep->base);
+ if ((!ep->dont_free_code) && (ep->code)) free(ep->code);
+ if (ep->native_calls) free(ep->native_calls);
+ for (i = 0; i < ep->params_size; i++)
+ {
+ if (ep->params[i].string) free(ep->params[i].string);
+ if (ep->params[i].cell_array) free(ep->params[i].cell_array);
+ }
+ if (ep->params) free(ep->params);
+ free(ep);
+}
+
+
+EAPI void
+embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params))
+{
+ Embryo_Func_Stub *func_entry;
+ Embryo_Header *hdr;
+ int i, num;
+
+ if ((!ep ) || (!name) || (!func)) return;
+ if (strlen(name) > sNAMEMAX) return;
+
+ hdr = (Embryo_Header *)ep->code;
+ if (hdr->defsize < 1) return;
+ num = NUMENTRIES(hdr, natives, libraries);
+ if (num <= 0) return;
+
+ ep->native_calls_size++;
+ if (ep->native_calls_size > ep->native_calls_alloc)
+ {
+ Embryo_Native *calls;
+
+ ep->native_calls_alloc += 32;
+ calls = realloc(ep->native_calls,
+ ep->native_calls_alloc * sizeof(Embryo_Native));
+ if (!calls)
+ {
+ ep->native_calls_size--;
+ ep->native_calls_alloc -= 32;
+ return;
+ }
+ ep->native_calls = calls;
+ }
+ ep->native_calls[ep->native_calls_size - 1] = func;
+
+ func_entry = GETENTRY(hdr, natives, 0);
+ for (i = 0; i < num; i++)
+ {
+ if (func_entry->address == 0)
+ {
+ char *entry_name;
+
+ entry_name = GETENTRYNAME(hdr, func_entry);
+ if ((entry_name) && (!strcmp(entry_name, name)))
+ {
+ func_entry->address = ep->native_calls_size;
+ /* FIXME: embryo_cc is putting in multiple native */
+ /* function call entries - so we need to fill in all */
+ /* of them!!! */
+ /* return; */
+ }
+ }
+ func_entry =
+ (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+ }
+}
+
+
+EAPI void
+embryo_program_vm_reset(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if ((!ep) || (!ep->base)) return;
+ hdr = (Embryo_Header *)ep->code;
+ memcpy(ep->base, hdr, hdr->size);
+ *(Embryo_Cell *)(ep->base + (int)hdr->stp - sizeof(Embryo_Cell)) = 0;
+
+ ep->hlw = hdr->hea - hdr->dat; /* stack and heap relative to data segment */
+ ep->stp = hdr->stp - hdr->dat - sizeof(Embryo_Cell);
+ ep->hea = ep->hlw;
+ ep->stk = ep->stp;
+}
+
+EAPI void
+embryo_program_vm_push(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if (!ep) return;
+ ep->pushes++;
+ if (ep->pushes > 1)
+ {
+ embryo_program_vm_reset(ep);
+ return;
+ }
+ hdr = (Embryo_Header *)ep->code;
+ ep->base = calloc(1, hdr->stp);
+ if (!ep->base)
+ {
+ ep->pushes = 0;
+ return;
+ }
+ embryo_program_vm_reset(ep);
+}
+
+EAPI void
+embryo_program_vm_pop(Embryo_Program *ep)
+{
+ if ((!ep) || (!ep->base)) return;
+ ep->pushes--;
+ if (ep->pushes >= 1) return;
+ free(ep->base);
+ ep->base = NULL;
+}
+
+
+EAPI void
+embryo_swap_16(unsigned short *v
+#ifndef WORDS_BIGENDIAN
+ __UNUSED__
+#endif
+ )
+{
+#ifdef WORDS_BIGENDIAN
+ _embryo_byte_swap_16(v);
+#endif
+}
+
+EAPI void
+embryo_swap_32(unsigned int *v
+#ifndef WORDS_BIGENDIAN
+ __UNUSED__
+#endif
+ )
+{
+#ifdef WORDS_BIGENDIAN
+ _embryo_byte_swap_32(v);
+#endif
+}
+
+EAPI Embryo_Function
+embryo_program_function_find(Embryo_Program *ep, const char *name)
+{
+ int first, last, mid, result;
+ char pname[sNAMEMAX + 1];
+ Embryo_Header *hdr;
+
+ if (!ep) return EMBRYO_FUNCTION_NONE;
+ hdr = (Embryo_Header *)ep->code;
+ last = NUMENTRIES(hdr, publics, natives) - 1;
+ first = 0;
+ /* binary search */
+ while (first <= last)
+ {
+ mid = (first + last) / 2;
+ if (_embryo_func_get(ep, mid, pname) == EMBRYO_ERROR_NONE)
+ result = strcmp(pname, name);
+ else
+ return EMBRYO_FUNCTION_NONE;
+/* result = -1;*/
+ if (result > 0) last = mid - 1;
+ else if (result < 0) first = mid + 1;
+ else return mid;
+ }
+ return EMBRYO_FUNCTION_NONE;
+}
+
+
+EAPI Embryo_Cell
+embryo_program_variable_find(Embryo_Program *ep, const char *name)
+{
+ int first, last, mid, result;
+ char pname[sNAMEMAX + 1];
+ Embryo_Cell paddr;
+ Embryo_Header *hdr;
+
+ if (!ep) return EMBRYO_CELL_NONE;
+ if (!ep->base) return EMBRYO_CELL_NONE;
+ hdr = (Embryo_Header *)ep->base;
+ last = NUMENTRIES(hdr, pubvars, tags) - 1;
+ first = 0;
+ /* binary search */
+ while (first <= last)
+ {
+ mid = (first + last) / 2;
+ if (_embryo_var_get(ep, mid, pname, &paddr) == EMBRYO_ERROR_NONE)
+ result = strcmp(pname, name);
+ else
+ return EMBRYO_CELL_NONE;
+/* result = -1;*/
+ if (result > 0) last = mid - 1;
+ else if (result < 0) first = mid + 1;
+ else return paddr;
+ }
+ return EMBRYO_CELL_NONE;
+}
+
+EAPI int
+embryo_program_variable_count_get(Embryo_Program *ep)
+{
+ Embryo_Header *hdr;
+
+ if (!ep) return 0;
+ if (!ep->base) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ return NUMENTRIES(hdr, pubvars, tags);
+}
+
+EAPI Embryo_Cell
+embryo_program_variable_get(Embryo_Program *ep, int num)
+{
+ Embryo_Cell paddr;
+ char pname[sNAMEMAX + 1];
+
+ if (!ep) return EMBRYO_CELL_NONE;
+ if (!ep->base) return EMBRYO_CELL_NONE;
+ if (_embryo_var_get(ep, num, pname, &paddr) == EMBRYO_ERROR_NONE)
+ return paddr;
+ return EMBRYO_CELL_NONE;
+}
+
+
+EAPI void
+embryo_program_error_set(Embryo_Program *ep, Embryo_Error error)
+{
+ if (!ep) return;
+ ep->error = error;
+}
+
+EAPI Embryo_Error
+embryo_program_error_get(Embryo_Program *ep)
+{
+ if (!ep) return EMBRYO_ERROR_NONE;
+ return ep->error;
+}
+
+
+EAPI void
+embryo_program_data_set(Embryo_Program *ep, void *data)
+{
+ if (!ep) return;
+ ep->data = data;
+}
+
+EAPI void *
+embryo_program_data_get(Embryo_Program *ep)
+{
+ if (!ep) return NULL;
+ return ep->data;
+}
+
+EAPI const char *
+embryo_error_string_get(Embryo_Error error)
+{
+ const char *messages[] =
+ {
+ /* EMBRYO_ERROR_NONE */ "(none)",
+ /* EMBRYO_ERROR_EXIT */ "Forced exit",
+ /* EMBRYO_ERROR_ASSERT */ "Assertion failed",
+ /* EMBRYO_ERROR_STACKERR */ "Stack/heap collision (insufficient stack size)",
+ /* EMBRYO_ERROR_BOUNDS */ "Array index out of bounds",
+ /* EMBRYO_ERROR_MEMACCESS */ "Invalid memory access",
+ /* EMBRYO_ERROR_INVINSTR */ "Invalid instruction",
+ /* EMBRYO_ERROR_STACKLOW */ "Stack underflow",
+ /* EMBRYO_ERROR_HEAPLOW */ "Heap underflow",
+ /* EMBRYO_ERROR_CALLBACK */ "No (valid) native function callback",
+ /* EMBRYO_ERROR_NATIVE */ "Native function failed",
+ /* EMBRYO_ERROR_DIVIDE */ "Divide by zero",
+ /* EMBRYO_ERROR_SLEEP */ "(sleep mode)",
+ /* 13 */ "(reserved)",
+ /* 14 */ "(reserved)",
+ /* 15 */ "(reserved)",
+ /* EMBRYO_ERROR_MEMORY */ "Out of memory",
+ /* EMBRYO_ERROR_FORMAT */ "Invalid/unsupported P-code file format",
+ /* EMBRYO_ERROR_VERSION */ "File is for a newer version of the Embryo_Program",
+ /* EMBRYO_ERROR_NOTFOUND */ "Native/Public function is not found",
+ /* EMBRYO_ERROR_INDEX */ "Invalid index parameter (bad entry point)",
+ /* EMBRYO_ERROR_DEBUG */ "Debugger cannot run",
+ /* EMBRYO_ERROR_INIT */ "Embryo_Program not initialized (or doubly initialized)",
+ /* EMBRYO_ERROR_USERDATA */ "Unable to set user data field (table full)",
+ /* EMBRYO_ERROR_INIT_JIT */ "Cannot initialize the JIT",
+ /* EMBRYO_ERROR_PARAMS */ "Parameter error",
+ };
+ if (((int)error < 0) ||
+ ((int)error >= (int)(sizeof(messages) / sizeof(messages[0]))))
+ return (const char *)"(unknown)";
+ return messages[error];
+}
+
+
+EAPI int
+embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell)
+{
+ int len;
+ Embryo_Header *hdr;
+
+ if ((!ep) || (!ep->base)) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ return 0;
+ for (len = 0; str_cell[len] != 0; len++);
+ return len;
+}
+
+EAPI void
+embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst)
+{
+ int i;
+ Embryo_Header *hdr;
+
+ if (!dst) return;
+ if ((!ep) || (!ep->base))
+ {
+ dst[0] = 0;
+ return;
+ }
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ {
+ dst[0] = 0;
+ return;
+ }
+ for (i = 0; str_cell[i] != 0; i++)
+ {
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Cell tmp;
+
+ tmp = str_cell[i];
+ _embryo_byte_swap_32(&tmp);
+ dst[i] = tmp;
+ }
+#else
+ dst[i] = str_cell[i];
+#endif
+ }
+ dst[i] = 0;
+}
+
+EAPI void
+embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell)
+{
+ int i;
+ Embryo_Header *hdr;
+
+ if (!ep) return;
+ if (!ep->base) return;
+ hdr = (Embryo_Header *)ep->base;
+ if ((!str_cell) ||
+ ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+ ((void *)str_cell < (void *)ep->base))
+ return;
+ if (!src)
+ {
+ str_cell[0] = 0;
+ return;
+ }
+ for (i = 0; src[i] != 0; i++)
+ {
+ if ((void *)(&(str_cell[i])) >= (void *)(ep->base + hdr->stp)) return;
+ else if ((void *)(&(str_cell[i])) == (void *)(ep->base + hdr->stp - 1))
+ {
+ str_cell[i] = 0;
+ return;
+ }
+#ifdef WORDS_BIGENDIAN
+ {
+ Embryo_Cell tmp;
+
+ tmp = src[i];
+ _embryo_byte_swap_32(&tmp);
+ str_cell[i] = tmp;
+ }
+#else
+ str_cell[i] = src[i];
+#endif
+ }
+ str_cell[i] = 0;
+}
+
+EAPI Embryo_Cell *
+embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+
+ if ((!ep) || (!ep->base)) return NULL;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ if ((addr < 0) || (addr >= hdr->stp)) return NULL;
+ return (Embryo_Cell *)(data + (int)addr);
+}
+
+
+EAPI Embryo_Cell
+embryo_data_heap_push(Embryo_Program *ep, int cells)
+{
+ Embryo_Header *hdr;
+ Embryo_Cell addr;
+
+ if ((!ep) || (!ep->base)) return EMBRYO_CELL_NONE;
+ hdr = (Embryo_Header *)ep->base;
+ if (ep->stk - ep->hea - (cells * sizeof(Embryo_Cell)) < STKMARGIN)
+ return EMBRYO_CELL_NONE;
+ addr = ep->hea;
+ ep->hea += (cells * sizeof(Embryo_Cell));
+ return addr;
+}
+
+EAPI void
+embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to)
+{
+ if (!ep) return;
+ if (down_to < 0) down_to = 0;
+ if (ep->hea > down_to) ep->hea = down_to;
+}
+
+
+EAPI int
+embryo_program_recursion_get(Embryo_Program *ep)
+{
+ return ep->run_count;
+}
+
+#ifdef __GNUC__
+#if 1
+#define EMBRYO_EXEC_JUMPTABLE
+#endif
+#endif
+
+/* jump table optimization - only works for gcc though */
+#ifdef EMBRYO_EXEC_JUMPTABLE
+#define SWITCH(x) while (1) { goto *switchtable[x];
+#define SWITCHEND break; }
+#define CASE(x) SWITCHTABLE_##x:
+#define BREAK break;
+#else
+#define SWITCH(x) switch (x) {
+#define SWITCHEND }
+#define CASE(x) case x:
+#define BREAK break
+#endif
+
+EAPI Embryo_Status
+embryo_program_run(Embryo_Program *ep, Embryo_Function fn)
+{
+ Embryo_Header *hdr;
+ Embryo_Func_Stub *func;
+ unsigned char *code, *data;
+ Embryo_Cell pri, alt, stk, frm, hea, hea_start;
+ Embryo_Cell reset_stk, reset_hea, *cip;
+ Embryo_UCell codesize;
+ int i;
+ unsigned char op;
+ Embryo_Cell offs;
+ int num;
+ int max_run_cycles;
+ int cycle_count;
+#ifdef EMBRYO_EXEC_JUMPTABLE
+ /* we limit the jumptable to 256 elements. why? above we forced "op" to be
+ * a unsigned char - that means 256 max values. we limit opcode overflow
+ * here, so eliminating crashes on table lookups with bad/corrupt bytecode.
+ * no need to atuall do compares, branches etc. the datatype does the work
+ * for us. so that means EXCESS elements are all declared as OP_NONE to
+ * keep them innocuous.
+ */
+ static const void *switchtable[256] =
+ {
+ &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_LREF_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LOAD_I,
+ &&SWITCHTABLE_EMBRYO_OP_LODB_I,
+ &&SWITCHTABLE_EMBRYO_OP_CONST_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_CONST_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ADDR_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ADDR_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_S_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SREF_S_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STOR_I,
+ &&SWITCHTABLE_EMBRYO_OP_STRB_I,
+ &&SWITCHTABLE_EMBRYO_OP_LIDX,
+ &&SWITCHTABLE_EMBRYO_OP_LIDX_B,
+ &&SWITCHTABLE_EMBRYO_OP_IDXADDR,
+ &&SWITCHTABLE_EMBRYO_OP_IDXADDR_B,
+ &&SWITCHTABLE_EMBRYO_OP_ALIGN_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ALIGN_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_LCTRL,
+ &&SWITCHTABLE_EMBRYO_OP_SCTRL,
+ &&SWITCHTABLE_EMBRYO_OP_MOVE_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_MOVE_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_XCHG,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_R,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_C,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH,
+ &&SWITCHTABLE_EMBRYO_OP_PUSH_S,
+ &&SWITCHTABLE_EMBRYO_OP_POP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_POP_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_STACK,
+ &&SWITCHTABLE_EMBRYO_OP_HEAP,
+ &&SWITCHTABLE_EMBRYO_OP_PROC,
+ &&SWITCHTABLE_EMBRYO_OP_RET,
+ &&SWITCHTABLE_EMBRYO_OP_RETN,
+ &&SWITCHTABLE_EMBRYO_OP_CALL,
+ &&SWITCHTABLE_EMBRYO_OP_CALL_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_JUMP,
+ &&SWITCHTABLE_EMBRYO_OP_JREL,
+ &&SWITCHTABLE_EMBRYO_OP_JZER,
+ &&SWITCHTABLE_EMBRYO_OP_JNZ,
+ &&SWITCHTABLE_EMBRYO_OP_JEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JNEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JLESS,
+ &&SWITCHTABLE_EMBRYO_OP_JLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_JGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JSLESS,
+ &&SWITCHTABLE_EMBRYO_OP_JSLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_JSGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_JSGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SHL,
+ &&SWITCHTABLE_EMBRYO_OP_SHR,
+ &&SWITCHTABLE_EMBRYO_OP_SSHR,
+ &&SWITCHTABLE_EMBRYO_OP_SHL_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SHL_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SHR_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SHR_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_SMUL,
+ &&SWITCHTABLE_EMBRYO_OP_SDIV,
+ &&SWITCHTABLE_EMBRYO_OP_SDIV_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_UMUL,
+ &&SWITCHTABLE_EMBRYO_OP_UDIV,
+ &&SWITCHTABLE_EMBRYO_OP_UDIV_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ADD,
+ &&SWITCHTABLE_EMBRYO_OP_SUB,
+ &&SWITCHTABLE_EMBRYO_OP_SUB_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_AND,
+ &&SWITCHTABLE_EMBRYO_OP_OR,
+ &&SWITCHTABLE_EMBRYO_OP_XOR,
+ &&SWITCHTABLE_EMBRYO_OP_NOT,
+ &&SWITCHTABLE_EMBRYO_OP_NEG,
+ &&SWITCHTABLE_EMBRYO_OP_INVERT,
+ &&SWITCHTABLE_EMBRYO_OP_ADD_C,
+ &&SWITCHTABLE_EMBRYO_OP_SMUL_C,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO,
+ &&SWITCHTABLE_EMBRYO_OP_ZERO_S,
+ &&SWITCHTABLE_EMBRYO_OP_SIGN_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SIGN_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_EQ,
+ &&SWITCHTABLE_EMBRYO_OP_NEQ,
+ &&SWITCHTABLE_EMBRYO_OP_LESS,
+ &&SWITCHTABLE_EMBRYO_OP_LEQ,
+ &&SWITCHTABLE_EMBRYO_OP_GRTR,
+ &&SWITCHTABLE_EMBRYO_OP_GEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SLESS,
+ &&SWITCHTABLE_EMBRYO_OP_SLEQ,
+ &&SWITCHTABLE_EMBRYO_OP_SGRTR,
+ &&SWITCHTABLE_EMBRYO_OP_SGEQ,
+ &&SWITCHTABLE_EMBRYO_OP_EQ_C_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_EQ_C_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_INC_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_INC_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_INC,
+ &&SWITCHTABLE_EMBRYO_OP_INC_S,
+ &&SWITCHTABLE_EMBRYO_OP_INC_I,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_DEC,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_S,
+ &&SWITCHTABLE_EMBRYO_OP_DEC_I,
+ &&SWITCHTABLE_EMBRYO_OP_MOVS,
+ &&SWITCHTABLE_EMBRYO_OP_CMPS,
+ &&SWITCHTABLE_EMBRYO_OP_FILL,
+ &&SWITCHTABLE_EMBRYO_OP_HALT,
+ &&SWITCHTABLE_EMBRYO_OP_BOUNDS,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_C,
+ &&SWITCHTABLE_EMBRYO_OP_FILE,
+ &&SWITCHTABLE_EMBRYO_OP_LINE,
+ &&SWITCHTABLE_EMBRYO_OP_SYMBOL,
+ &&SWITCHTABLE_EMBRYO_OP_SRANGE,
+ &&SWITCHTABLE_EMBRYO_OP_JUMP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SWITCH,
+ &&SWITCHTABLE_EMBRYO_OP_CASETBL,
+ &&SWITCHTABLE_EMBRYO_OP_SWAP_PRI,
+ &&SWITCHTABLE_EMBRYO_OP_SWAP_ALT,
+ &&SWITCHTABLE_EMBRYO_OP_PUSHADDR,
+ &&SWITCHTABLE_EMBRYO_OP_NOP,
+ &&SWITCHTABLE_EMBRYO_OP_SYSREQ_D,
+ &&SWITCHTABLE_EMBRYO_OP_SYMTAG,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+ &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE
+ };
+#endif
+ if (!ep) return EMBRYO_PROGRAM_FAIL;
+ if (!(ep->flags & EMBRYO_FLAG_RELOC))
+ {
+ ep->error = EMBRYO_ERROR_INIT;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ if (!ep->base)
+ {
+ ep->error = EMBRYO_ERROR_INIT;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ if (ep->run_count > 0)
+ {
+ /* return EMBRYO_PROGRAM_BUSY; */
+ /* FIXME: test C->vm->C->vm recursion more fully */
+ /* it seems to work... just fine!!! - strange! */
+ }
+
+ /* set up the registers */
+ hdr = (Embryo_Header *)ep->base;
+ codesize = (Embryo_UCell)(hdr->dat - hdr->cod);
+ code = ep->base + (int)hdr->cod;
+ data = ep->base + (int)hdr->dat;
+ hea_start = hea = ep->hea;
+ stk = ep->stk;
+ reset_stk = stk;
+ reset_hea = hea;
+ frm = alt = pri = 0;
+
+ /* get the start address */
+ if (fn == EMBRYO_FUNCTION_MAIN)
+ {
+ if (hdr->cip < 0)
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ cip = (Embryo_Cell *)(code + (int)hdr->cip);
+ }
+ else if (fn == EMBRYO_FUNCTION_CONT)
+ {
+ /* all registers: pri, alt, frm, cip, hea, stk, reset_stk, reset_hea */
+ frm = ep->frm;
+ stk = ep->stk;
+ hea = ep->hea;
+ pri = ep->pri;
+ alt = ep->alt;
+ reset_stk = ep->reset_stk;
+ reset_hea = ep->reset_hea;
+ cip = (Embryo_Cell *)(code + (int)ep->cip);
+ }
+ else if (fn < 0)
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ else
+ {
+ if (fn >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+ {
+ ep->error = EMBRYO_ERROR_INDEX;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ func = GETENTRY(hdr, publics, fn);
+ cip = (Embryo_Cell *)(code + (int)func->address);
+ }
+ /* check values just copied */
+ CHKSTACK();
+ CHKHEAP();
+
+ if (fn != EMBRYO_FUNCTION_CONT)
+ {
+ int i;
+
+ for (i = ep->params_size - 1; i >= 0; i--)
+ {
+ Embryo_Param *pr;
+
+ pr = &(ep->params[i]);
+ if (pr->string)
+ {
+ int len;
+ Embryo_Cell ep_addr, *addr;
+
+ len = strlen(pr->string);
+ ep_addr = embryo_data_heap_push(ep, len + 1);
+ if (ep_addr == EMBRYO_CELL_NONE)
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ addr = embryo_data_address_get(ep, ep_addr);
+ if (addr)
+ embryo_data_string_set(ep, pr->string, addr);
+ else
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ PUSH(ep_addr);
+ free(pr->string);
+ }
+ else if (pr->cell_array)
+ {
+ int len;
+ Embryo_Cell ep_addr, *addr;
+
+ len = pr->cell_array_size;
+ ep_addr = embryo_data_heap_push(ep, len + 1);
+ if (ep_addr == EMBRYO_CELL_NONE)
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ addr = embryo_data_address_get(ep, ep_addr);
+ if (addr)
+ memcpy(addr, pr->cell_array,
+ pr->cell_array_size * sizeof(Embryo_Cell));
+ else
+ {
+ ep->error = EMBRYO_ERROR_HEAPLOW;
+ return EMBRYO_PROGRAM_FAIL;
+ }
+ PUSH(ep_addr);
+ free(pr->cell_array);
+ }
+ else
+ {
+ PUSH(pr->cell);
+ }
+ }
+ PUSH(ep->params_size * sizeof(Embryo_Cell));
+ PUSH(0);
+ if (ep->params)
+ {
+ free(ep->params);
+ ep->params = NULL;
+ }
+ ep->params_size = ep->params_alloc = 0;
+ }
+ /* check stack/heap before starting to run */
+ CHKMARGIN();
+
+ /* track recursion depth */
+ ep->run_count++;
+
+ max_run_cycles = ep->max_run_cycles;
+ /* start running */
+ for (cycle_count = 0;;)
+ {
+ if (max_run_cycles > 0)
+ {
+ if (cycle_count >= max_run_cycles)
+ {
+ TOOLONG(ep);
+ }
+ cycle_count++;
+ }
+ op = (Embryo_Opcode)*cip++;
+ SWITCH(op);
+ CASE(EMBRYO_OP_LOAD_PRI);
+ GETPARAM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_ALT);
+ GETPARAM(offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_S_PRI);
+ GETPARAM(offs);
+ pri = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_S_ALT);
+ GETPARAM(offs);
+ alt = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_S_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LREF_S_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ alt = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LOAD_I);
+ CHKMEM(pri);
+ pri = *(Embryo_Cell *)(data + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_LODB_I);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ switch (offs)
+ {
+ case 1:
+ pri = *(data + (int)pri);
+ break;
+ case 2:
+ pri = *(unsigned short *)(data + (int)pri);
+ break;
+ case 4:
+ pri = *(unsigned int *)(data + (int)pri);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_CONST_PRI);
+ GETPARAM(pri);
+ BREAK;
+ CASE(EMBRYO_OP_CONST_ALT);
+ GETPARAM(alt);
+ BREAK;
+ CASE(EMBRYO_OP_ADDR_PRI);
+ GETPARAM(pri);
+ pri += frm;
+ BREAK;
+ CASE(EMBRYO_OP_ADDR_ALT);
+ GETPARAM(alt);
+ alt += frm;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_PRI);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_ALT);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_S_PRI);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_S_ALT);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_S_PRI);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_SREF_S_ALT);
+ GETPARAM(offs);
+ offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+ *(Embryo_Cell *)(data + (int)offs) = alt;
+ BREAK;
+ CASE(EMBRYO_OP_STOR_I);
+ CHKMEM(alt);
+ *(Embryo_Cell *)(data + (int)alt) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_STRB_I);
+ GETPARAM(offs);
+ CHKMEM(alt);
+ switch (offs)
+ {
+ case 1:
+ *(data + (int)alt) = (unsigned char)pri;
+ break;
+ case 2:
+ *(unsigned short *)(data + (int)alt) = (unsigned short)pri;
+ break;
+ case 4:
+ *(unsigned int *)(data + (int)alt) = (unsigned int)pri;
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_LIDX);
+ offs = (pri * sizeof(Embryo_Cell)) + alt;
+ CHKMEM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_LIDX_B);
+ GETPARAM(offs);
+ offs = (pri << (int)offs) + alt;
+ CHKMEM(offs);
+ pri = *(Embryo_Cell *)(data + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_IDXADDR);
+ pri = (pri * sizeof(Embryo_Cell)) + alt;
+ BREAK;
+ CASE(EMBRYO_OP_IDXADDR_B);
+ GETPARAM(offs);
+ pri = (pri << (int)offs) + alt;
+ BREAK;
+ CASE(EMBRYO_OP_ALIGN_PRI);
+ GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+ if ((size_t)offs < sizeof(Embryo_Cell))
+ pri ^= sizeof(Embryo_Cell) - offs;
+#endif
+ BREAK;
+ CASE(EMBRYO_OP_ALIGN_ALT);
+ GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+ if ((size_t)offs < sizeof(Embryo_Cell))
+ alt ^= sizeof(Embryo_Cell) - offs;
+#endif
+ BREAK;
+ CASE(EMBRYO_OP_LCTRL);
+ GETPARAM(offs);
+ switch (offs)
+ {
+ case 0:
+ pri = hdr->cod;
+ break;
+ case 1:
+ pri = hdr->dat;
+ break;
+ case 2:
+ pri = hea;
+ break;
+ case 3:
+ pri = ep->stp;
+ break;
+ case 4:
+ pri = stk;
+ break;
+ case 5:
+ pri = frm;
+ break;
+ case 6:
+ pri = (Embryo_Cell)((unsigned char *)cip - code);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SCTRL);
+ GETPARAM(offs);
+ switch (offs)
+ {
+ case 0:
+ case 1:
+ case 2:
+ hea = pri;
+ break;
+ case 3:
+ /* cannot change these parameters */
+ break;
+ case 4:
+ stk = pri;
+ break;
+ case 5:
+ frm = pri;
+ break;
+ case 6:
+ cip = (Embryo_Cell *)(code + (int)pri);
+ break;
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+ break;
+ }
+ BREAK;
+ CASE(EMBRYO_OP_MOVE_PRI);
+ pri = alt;
+ BREAK;
+ CASE(EMBRYO_OP_MOVE_ALT);
+ alt = pri;
+ BREAK;
+ CASE(EMBRYO_OP_XCHG);
+ offs = pri; /* offs is a temporary variable */
+ pri = alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_PRI);
+ PUSH(pri);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_ALT);
+ PUSH(alt);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_C);
+ GETPARAM(offs);
+ PUSH(offs);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_R);
+ GETPARAM(offs);
+ while (offs--) PUSH(pri);
+ BREAK;
+ CASE(EMBRYO_OP_PUSH);
+ GETPARAM(offs);
+ PUSH(*(Embryo_Cell *)(data + (int)offs));
+ BREAK;
+ CASE(EMBRYO_OP_PUSH_S);
+ GETPARAM(offs);
+ PUSH(*(Embryo_Cell *)(data + (int)frm + (int)offs));
+ BREAK;
+ CASE(EMBRYO_OP_POP_PRI);
+ POP(pri);
+ BREAK;
+ CASE(EMBRYO_OP_POP_ALT);
+ POP(alt);
+ BREAK;
+ CASE(EMBRYO_OP_STACK);
+ GETPARAM(offs);
+ alt = stk;
+ stk += offs;
+ CHKMARGIN();
+ CHKSTACK();
+ BREAK;
+ CASE(EMBRYO_OP_HEAP);
+ GETPARAM(offs);
+ alt = hea;
+ hea += offs;
+ CHKMARGIN();
+ CHKHEAP();
+ BREAK;
+ CASE(EMBRYO_OP_PROC);
+ PUSH(frm);
+ frm = stk;
+ CHKMARGIN();
+ BREAK;
+ CASE(EMBRYO_OP_RET);
+ POP(frm);
+ POP(offs);
+ if ((Embryo_UCell)offs >= codesize)
+ ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+ cip = (Embryo_Cell *)(code + (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_RETN);
+ POP(frm);
+ POP(offs);
+ if ((Embryo_UCell)offs >= codesize)
+ ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+ cip = (Embryo_Cell *)(code + (int)offs);
+ stk += *(Embryo_Cell *)(data + (int)stk) + sizeof(Embryo_Cell); /* remove parameters from the stack */
+ ep->stk = stk;
+ BREAK;
+ CASE(EMBRYO_OP_CALL);
+ PUSH(((unsigned char *)cip - code) + sizeof(Embryo_Cell));/* skip address */
+ cip = JUMPABS(code, cip); /* jump to the address */
+ BREAK;
+ CASE(EMBRYO_OP_CALL_PRI);
+ PUSH((unsigned char *)cip - code);
+ cip = (Embryo_Cell *)(code + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_JUMP);
+ /* since the GETPARAM() macro modifies cip, you cannot
+ * do GETPARAM(cip) directly */
+ cip = JUMPABS(code, cip);
+ BREAK;
+ CASE(EMBRYO_OP_JREL);
+ offs = *cip;
+ cip = (Embryo_Cell *)((unsigned char *)cip + (int)offs + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JZER);
+ if (pri == 0)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JNZ);
+ if (pri != 0)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JEQ);
+ if (pri==alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JNEQ);
+ if (pri != alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JLESS);
+ if ((Embryo_UCell)pri < (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JLEQ);
+ if ((Embryo_UCell)pri <= (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JGRTR);
+ if ((Embryo_UCell)pri > (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JGEQ);
+ if ((Embryo_UCell)pri >= (Embryo_UCell)alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSLESS);
+ if (pri < alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSLEQ);
+ if (pri <= alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSGRTR);
+ if (pri > alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_JSGEQ);
+ if (pri >= alt)
+ cip = JUMPABS(code, cip);
+ else
+ cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+ BREAK;
+ CASE(EMBRYO_OP_SHL);
+ pri <<= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SHR);
+ pri = (Embryo_UCell)pri >> (int)alt;
+ BREAK;
+ CASE(EMBRYO_OP_SSHR);
+ pri >>= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SHL_C_PRI);
+ GETPARAM(offs);
+ pri <<= offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHL_C_ALT);
+ GETPARAM(offs);
+ alt <<= offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHR_C_PRI);
+ GETPARAM(offs);
+ pri = (Embryo_UCell)pri >> (int)offs;
+ BREAK;
+ CASE(EMBRYO_OP_SHR_C_ALT);
+ GETPARAM(offs);
+ alt = (Embryo_UCell)alt >> (int)offs;
+ BREAK;
+ CASE(EMBRYO_OP_SMUL);
+ pri *= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SDIV);
+ if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ /* divide must always round down; this is a bit
+ * involved to do in a machine-independent way.
+ */
+ offs = ((pri % alt) + alt) % alt; /* true modulus */
+ pri = (pri - offs) / alt; /* division result */
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_SDIV_ALT);
+ if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ /* divide must always round down; this is a bit
+ * involved to do in a machine-independent way.
+ */
+ offs = ((alt % pri) + pri) % pri; /* true modulus */
+ pri = (alt - offs) / pri; /* division result */
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_UMUL);
+ pri = (Embryo_UCell)pri * (Embryo_UCell)alt;
+ BREAK;
+ CASE(EMBRYO_OP_UDIV);
+ if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ offs = (Embryo_UCell)pri % (Embryo_UCell)alt; /* temporary storage */
+ pri = (Embryo_UCell)pri / (Embryo_UCell)alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_UDIV_ALT);
+ if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+ offs = (Embryo_UCell)alt % (Embryo_UCell)pri; /* temporary storage */
+ pri = (Embryo_UCell)alt / (Embryo_UCell)pri;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_ADD);
+ pri += alt;
+ BREAK;
+ CASE(EMBRYO_OP_SUB);
+ pri -= alt;
+ BREAK;
+ CASE(EMBRYO_OP_SUB_ALT);
+ pri = alt - pri;
+ BREAK;
+ CASE(EMBRYO_OP_AND);
+ pri &= alt;
+ BREAK;
+ CASE(EMBRYO_OP_OR);
+ pri |= alt;
+ BREAK;
+ CASE(EMBRYO_OP_XOR);
+ pri ^= alt;
+ BREAK;
+ CASE(EMBRYO_OP_NOT);
+ pri = !pri;
+ BREAK;
+ CASE(EMBRYO_OP_NEG);
+ pri = -pri;
+ BREAK;
+ CASE(EMBRYO_OP_INVERT);
+ pri = ~pri;
+ BREAK;
+ CASE(EMBRYO_OP_ADD_C);
+ GETPARAM(offs);
+ pri += offs;
+ BREAK;
+ CASE(EMBRYO_OP_SMUL_C);
+ GETPARAM(offs);
+ pri *= offs;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_PRI);
+ pri = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_ALT);
+ alt = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) = 0;
+ BREAK;
+ CASE(EMBRYO_OP_ZERO_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) = 0;
+ BREAK;
+ CASE(EMBRYO_OP_SIGN_PRI);
+ if ((pri & 0xff) >= 0x80) pri |= ~(Embryo_UCell)0xff;
+ BREAK;
+ CASE(EMBRYO_OP_SIGN_ALT);
+ if ((alt & 0xff) >= 0x80) alt |= ~(Embryo_UCell)0xff;
+ BREAK;
+ CASE(EMBRYO_OP_EQ);
+ pri = (pri == alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_NEQ);
+ pri = (pri != alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_LESS);
+ pri = ((Embryo_UCell)pri < (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_LEQ);
+ pri = ((Embryo_UCell)pri <= (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_GRTR);
+ pri = ((Embryo_UCell)pri > (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_GEQ);
+ pri = ((Embryo_UCell)pri >= (Embryo_UCell)alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SLESS);
+ pri = (pri < alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SLEQ);
+ pri = (pri <= alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SGRTR);
+ pri = (pri > alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_SGEQ);
+ pri = (pri >= alt) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_EQ_C_PRI);
+ GETPARAM(offs);
+ pri = (pri == offs) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_EQ_C_ALT);
+ GETPARAM(offs);
+ pri = (alt == offs) ? 1 : 0;
+ BREAK;
+ CASE(EMBRYO_OP_INC_PRI);
+ pri++;
+ BREAK;
+ CASE(EMBRYO_OP_INC_ALT);
+ alt++;
+ BREAK;
+ CASE(EMBRYO_OP_INC);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_INC_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_INC_I);
+ *(Embryo_Cell *)(data + (int)pri) += 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_PRI);
+ pri--;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_ALT);
+ alt--;
+ BREAK;
+ CASE(EMBRYO_OP_DEC);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)offs) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_S);
+ GETPARAM(offs);
+ *(Embryo_Cell *)(data + (int)frm + (int)offs) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_DEC_I);
+ *(Embryo_Cell *)(data + (int)pri) -= 1;
+ BREAK;
+ CASE(EMBRYO_OP_MOVS);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ CHKMEM(pri + offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ memcpy(data+(int)alt, data+(int)pri, (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_CMPS);
+ GETPARAM(offs);
+ CHKMEM(pri);
+ CHKMEM(pri + offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ pri = memcmp(data + (int)alt, data + (int)pri, (int)offs);
+ BREAK;
+ CASE(EMBRYO_OP_FILL);
+ GETPARAM(offs);
+ CHKMEM(alt);
+ CHKMEM(alt + offs);
+ for (i = (int)alt;
+ (size_t)offs >= sizeof(Embryo_Cell);
+ i += sizeof(Embryo_Cell), offs -= sizeof(Embryo_Cell))
+ *(Embryo_Cell *)(data + i) = pri;
+ BREAK;
+ CASE(EMBRYO_OP_HALT);
+ GETPARAM(offs);
+ ep->retval = pri;
+ /* store complete status */
+ ep->frm = frm;
+ ep->stk = stk;
+ ep->hea = hea;
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->cip = (Embryo_Cell)((unsigned char*)cip - code);
+ if (offs == EMBRYO_ERROR_SLEEP)
+ {
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ OK(ep, (int)offs);
+ CASE(EMBRYO_OP_BOUNDS);
+ GETPARAM(offs);
+ if ((Embryo_UCell)pri > (Embryo_UCell)offs)
+ ABORT(ep, EMBRYO_ERROR_BOUNDS);
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_PRI);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, pri, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ ABORT(ep, num);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_C);
+ GETPARAM(offs);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ {
+ Embryo_Header *hdr;
+ int i, num;
+ Embryo_Func_Stub *func_entry;
+
+ hdr = (Embryo_Header *)ep->code;
+ num = NUMENTRIES(hdr, natives, libraries);
+ func_entry = GETENTRY(hdr, natives, 0);
+ for (i = 0; i < num; i++)
+ {
+ char *entry_name;
+
+ entry_name = GETENTRYNAME(hdr, func_entry);
+ if (i == offs)
+ printf("EMBRYO: CALL [%i] %s() non-existent!\n", i, entry_name);
+ func_entry =
+ (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+ }
+ }
+ ABORT(ep, num);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SYSREQ_D);
+ GETPARAM(offs);
+ /* save a few registers */
+ ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+ ep->hea = hea;
+ ep->frm = frm;
+ ep->stk = stk;
+ num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+ if (num != EMBRYO_ERROR_NONE)
+ {
+ if (num == EMBRYO_ERROR_SLEEP)
+ {
+ ep->pri = pri;
+ ep->alt = alt;
+ ep->reset_stk = reset_stk;
+ ep->reset_hea = reset_hea;
+ ep->run_count--;
+ return EMBRYO_PROGRAM_SLEEP;
+ }
+ ABORT(ep, ep->error);
+ }
+ BREAK;
+ CASE(EMBRYO_OP_JUMP_PRI);
+ cip = (Embryo_Cell *)(code + (int)pri);
+ BREAK;
+ CASE(EMBRYO_OP_SWITCH);
+ {
+ Embryo_Cell *cptr;
+
+ /* +1, to skip the "casetbl" opcode */
+ cptr = (Embryo_Cell *)(code + (*cip)) + 1;
+ /* number of records in the case table */
+ num = (int)(*cptr);
+ /* preset to "none-matched" case */
+ cip = (Embryo_Cell *)(code + *(cptr + 1));
+ for (cptr += 2;
+ (num > 0) && (*cptr != pri);
+ num--, cptr += 2);
+ /* case found */
+ if (num > 0)
+ cip = (Embryo_Cell *)(code + *(cptr + 1));
+ }
+ BREAK;
+ CASE(EMBRYO_OP_SWAP_PRI);
+ offs = *(Embryo_Cell *)(data + (int)stk);
+ *(Embryo_Cell *)(data + (int)stk) = pri;
+ pri = offs;
+ BREAK;
+ CASE(EMBRYO_OP_SWAP_ALT);
+ offs = *(Embryo_Cell *)(data + (int)stk);
+ *(Embryo_Cell *)(data + (int)stk) = alt;
+ alt = offs;
+ BREAK;
+ CASE(EMBRYO_OP_PUSHADDR);
+ GETPARAM(offs);
+ PUSH(frm + offs);
+ BREAK;
+ CASE(EMBRYO_OP_NOP);
+ BREAK;
+ CASE(EMBRYO_OP_NONE);
+ CASE(EMBRYO_OP_FILE);
+ CASE(EMBRYO_OP_LINE);
+ CASE(EMBRYO_OP_SYMBOL);
+ CASE(EMBRYO_OP_SRANGE);
+ CASE(EMBRYO_OP_CASETBL);
+ CASE(EMBRYO_OP_SYMTAG);
+ BREAK;
+#ifndef EMBRYO_EXEC_JUMPTABLE
+ default:
+ ABORT(ep, EMBRYO_ERROR_INVINSTR);
+#endif
+ SWITCHEND;
+ }
+ ep->max_run_cycles = max_run_cycles;
+ ep->run_count--;
+ ep->hea = hea_start;
+ return EMBRYO_PROGRAM_OK;
+}
+
+EAPI Embryo_Cell
+embryo_program_return_value_get(Embryo_Program *ep)
+{
+ if (!ep) return 0;
+ return ep->retval;
+}
+
+EAPI void
+embryo_program_max_cycle_run_set(Embryo_Program *ep, int max)
+{
+ if (!ep) return;
+ if (max < 0) max = 0;
+ ep->max_run_cycles = max;
+}
+
+EAPI int
+embryo_program_max_cycle_run_get(Embryo_Program *ep)
+{
+ if (!ep) return 0;
+ return ep->max_run_cycles;
+}
+
+
+EAPI int
+embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell)
+{
+ Embryo_Param *pr;
+
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr) return 0;
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->cell = cell;
+ return 1;
+}
+
+EAPI int
+embryo_parameter_string_push(Embryo_Program *ep, const char *str)
+{
+ Embryo_Param *pr;
+ char *str_dup;
+
+ if (!str)
+ return embryo_parameter_string_push(ep, "");
+ str_dup = strdup(str);
+ if (!str_dup) return 0;
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr)
+ {
+ free(str_dup);
+ return 0;
+ }
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->string = str_dup;
+ return 1;
+}
+
+EAPI int
+embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num)
+{
+ Embryo_Param *pr;
+ Embryo_Cell *cell_array;
+
+ if ((!cells) || (num <= 0))
+ return embryo_parameter_cell_push(ep, 0);
+ cell_array = malloc(num * sizeof(Embryo_Cell));
+ ep->params_size++;
+ if (ep->params_size > ep->params_alloc)
+ {
+ ep->params_alloc += 8;
+ pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+ if (!pr)
+ {
+ free(cell_array);
+ return 0;
+ }
+ ep->params = pr;
+ }
+ pr = &(ep->params[ep->params_size - 1]);
+ pr->string = NULL;
+ pr->cell_array = NULL;
+ pr->cell_array_size = 0;
+ pr->cell = 0;
+ pr->cell_array = cell_array;
+ pr->cell_array_size = num;
+ memcpy(pr->cell_array, cells, num * sizeof(Embryo_Cell));
+ return 1;
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif defined __GNUC__
+# define alloca __builtin_alloca
+#elif defined _AIX
+# define alloca __alloca
+#elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+#else
+# include <stddef.h>
+# ifdef __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRSET(ep, par, str) { \
+ Embryo_Cell *___cptr; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ embryo_data_string_set(ep, str, ___cptr); \
+ } }
+
+/* exported args api */
+
+static Embryo_Cell
+_embryo_args_numargs(Embryo_Program *ep, Embryo_Cell *params __UNUSED__)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell bytes;
+
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ bytes = *(Embryo_Cell *)(data + (int)ep->frm +
+ (2 * sizeof(Embryo_Cell)));
+ return bytes / sizeof(Embryo_Cell);
+}
+
+static Embryo_Cell
+_embryo_args_getarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell val;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ val = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+ val += params[2] * sizeof(Embryo_Cell);
+ val = *(Embryo_Cell *)(data + (int)val);
+ return val;
+}
+
+static Embryo_Cell
+_embryo_args_setarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell val;
+
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ val = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+ val += params[2] * sizeof(Embryo_Cell);
+ if ((val < 0) || ((val >= ep->hea) && (val < ep->stk))) return 0;
+ *(Embryo_Cell *)(data + (int)val) = params[3];
+ return 1;
+}
+
+static Embryo_Cell
+_embryo_args_getsarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+ Embryo_Header *hdr;
+ unsigned char *data;
+ Embryo_Cell base_cell;
+ char *s;
+ int i = 0;
+
+ /* params[1] = arg_no */
+ /* params[2] = buf */
+ /* params[3] = buflen */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] <= 0) return 0; /* buflen must be > 0 */
+ hdr = (Embryo_Header *)ep->base;
+ data = ep->base + (int)hdr->dat;
+ base_cell = *(Embryo_Cell *)(data + (int)ep->frm +
+ (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+
+ s = alloca(params[3]);
+
+ while (i < params[3])
+ {
+ int offset = base_cell + (i * sizeof(Embryo_Cell));
+
+ s[i] = *(Embryo_Cell *)(data + offset);
+ if (!s[i++]) break;
+ }
+
+ s[i - 1] = 0;
+ STRSET(ep, params[2], s);
+
+ return i - 1; /* characters written minus terminator */
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_args_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "numargs", _embryo_args_numargs);
+ embryo_program_native_call_add(ep, "getarg", _embryo_args_getarg);
+ embryo_program_native_call_add(ep, "setarg", _embryo_args_setarg);
+ embryo_program_native_call_add(ep, "getfarg", _embryo_args_getarg);
+ embryo_program_native_call_add(ep, "setfarg", _embryo_args_setarg);
+ embryo_program_native_call_add(ep, "getsarg", _embryo_args_getsarg);
+}
--- /dev/null
+/* Float arithmetic for the Small AMX engine
+ *
+ * Copyright (c) Artran, Inc. 1999
+ * Written by Greg Garner (gmg@artran.com)
+ * Portions Copyright (c) Carsten Haitzler, 2004 <raster@rasterman.com>
+ *
+ * This software is provided "as-is", without any express or implied warranty.
+ * In no event will the authors be held liable for any damages arising from
+ * the use of this software.
+ *
+ * Permission is granted to anyone to use this software for any purpose,
+ * including commercial applications, and to alter it and redistribute it
+ * freely, subject to the following restrictions:
+ *
+ * 1. The origin of this software must not be misrepresented; you must not
+ * claim that you wrote the original software. If you use this software in
+ * a product, an acknowledgment in the product documentation would be
+ * appreciated but is not required.
+ * 2. Altered source versions must be plainly marked as such, and must not be
+ * misrepresented as being the original software.
+ * 3. This notice may not be removed or altered from any source distribution.
+ */
+
+/* CHANGES -
+ * 2002-08-27: Basic conversion of source from C++ to C by Adam D. Moss
+ * <adam@gimp.org> <aspirin@icculus.org>
+ * 2003-08-29: Removal of the dynamic memory allocation and replacing two
+ * type conversion functions by macros, by Thiadmer Riemersma
+ * 2003-09-22: Moved the type conversion macros to AMX.H, and simplifications
+ * of some routines, by Thiadmer Riemersma
+ * 2003-11-24: A few more native functions (geometry), plus minor modifications,
+ * mostly to be compatible with dynamically loadable extension
+ * modules, by Thiadmer Riemersma
+ * 2004-03-20: Cleaned up and reduced size for Embryo, Modified to conform to
+ * E coding style. Added extra parameter checks.
+ * Carsten Haitzler, <raster@rasterman.com>
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <math.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define PI 3.1415926535897932384626433832795f
+#ifndef MAXFLOAT
+#define MAXFLOAT 3.40282347e+38f
+#endif
+
+/* internally useful calls */
+
+static float
+_embryo_fp_degrees_to_radians(float angle, int radix)
+{
+ switch (radix)
+ {
+ case 1: /* degrees, sexagesimal system (technically: degrees/minutes/seconds) */
+ return (angle * PI / 180.0f);
+ case 2: /* grades, centesimal system */
+ return (angle * PI / 200.0f);
+ default: /* assume already radian */
+ break;
+ }
+ return angle;
+}
+
+/* exported float api */
+
+static Embryo_Cell
+_embryo_fp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = long value to convert to a float */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = (float)params[1];
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_str(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = virtual string address to convert to a float */
+ char buf[64];
+ Embryo_Cell *str;
+ float f;
+ int len;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ str = embryo_data_address_get(ep, params[1]);
+ len = embryo_data_string_length_get(ep, str);
+ if ((len == 0) || (len >= (int)sizeof(buf))) return 0;
+ embryo_data_string_get(ep, str, buf);
+ f = (float)atof(buf);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_mul(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) * EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_div(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float dividend (top) */
+ /* params[2] = float divisor (bottom) */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if (ff == 0.0)
+ {
+ if (f == 0.0)
+ return EMBRYO_FLOAT_TO_CELL(0.0f);
+ else if (f < 0.0)
+ return EMBRYO_FLOAT_TO_CELL(-MAXFLOAT);
+ else
+ return EMBRYO_FLOAT_TO_CELL(MAXFLOAT);
+ }
+ f = f / ff;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_add(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) + EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sub(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]) - EMBRYO_CELL_TO_FLOAT(params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return fractional part of float */
+static Embryo_Cell
+_embryo_fp_fract(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f -= (floorf(f));
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return integer part of float, rounded */
+static Embryo_Cell
+_embryo_fp_round(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ /* params[2] = Type of rounding (cell) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ switch (params[2])
+ {
+ case 1: /* round downwards (truncate) */
+ f = (floorf(f));
+ break;
+ case 2: /* round upwards */
+ f = (ceilf(f));
+ break;
+ case 3: /* round towards zero */
+ if (f >= 0.0) f = (floorf(f));
+ else f = (ceilf(f));
+ break;
+ default: /* standard, round to nearest */
+ f = (floorf(f + 0.5));
+ break;
+ }
+ return (Embryo_Cell)f;
+}
+
+static Embryo_Cell
+_embryo_fp_cmp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if (f == ff) return 0;
+ else if (f > ff) return 1;
+ return -1;
+}
+
+static Embryo_Cell
+_embryo_fp_sqroot(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = sqrtf(f);
+ if (f < 0)
+ {
+ embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+ return 0;
+ }
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_power(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 */
+ /* params[2] = float operand 2 */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = powf(f, ff);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log(Embryo_Program *ep, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (value) */
+ /* params[2] = float operand 2 (base) */
+ float f, ff, tf;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ if ((f <= 0.0) || (ff <= 0.0))
+ {
+ embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+ return 0;
+ }
+ if (ff == 10.0) f = log10f(f);
+ else if (ff == 2.0) f = log2f(f);
+ else
+ {
+ tf = logf(ff);
+ if (tf == 0.0) f = 0.0;
+ else f = (logf(f) / tf);
+ }
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = sinf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = cosf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_tan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ f = tanf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_abs(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = (f >= 0) ? f : -f;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_asin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = sinf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_acos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = cosf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (angle) */
+ /* params[2] = float operand 2 (radix) */
+ float f;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = tanf(f);
+ f = _embryo_fp_degrees_to_radians(f, params[2]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand 1 (y) */
+ /* params[2] = float operand 2 (x) */
+ /* params[3] = float operand 3 (radix) */
+ float f, ff;
+
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = atan2f(f, ff);
+ f = _embryo_fp_degrees_to_radians(f, params[3]);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log1p(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = log1pf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cbrt(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = cbrtf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = expf(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f;
+
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ f = exp2f(f);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_hypot(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+ /* params[1] = float operand */
+ float f, ff;
+
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ f = EMBRYO_CELL_TO_FLOAT(params[1]);
+ ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+ f = hypotf(f, ff);
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_fp_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "float", _embryo_fp);
+ embryo_program_native_call_add(ep, "atof", _embryo_fp_str);
+ embryo_program_native_call_add(ep, "float_mul", _embryo_fp_mul);
+ embryo_program_native_call_add(ep, "float_div", _embryo_fp_div);
+ embryo_program_native_call_add(ep, "float_add", _embryo_fp_add);
+ embryo_program_native_call_add(ep, "float_sub", _embryo_fp_sub);
+ embryo_program_native_call_add(ep, "fract", _embryo_fp_fract);
+ embryo_program_native_call_add(ep, "round", _embryo_fp_round);
+ embryo_program_native_call_add(ep, "float_cmp", _embryo_fp_cmp);
+ embryo_program_native_call_add(ep, "sqrt", _embryo_fp_sqroot);
+ embryo_program_native_call_add(ep, "pow", _embryo_fp_power);
+ embryo_program_native_call_add(ep, "log", _embryo_fp_log);
+ embryo_program_native_call_add(ep, "sin", _embryo_fp_sin);
+ embryo_program_native_call_add(ep, "cos", _embryo_fp_cos);
+ embryo_program_native_call_add(ep, "tan", _embryo_fp_tan);
+ embryo_program_native_call_add(ep, "abs", _embryo_fp_abs);
+ /* Added in embryo 1.2 */
+ embryo_program_native_call_add(ep, "asin", _embryo_fp_asin);
+ embryo_program_native_call_add(ep, "acos", _embryo_fp_acos);
+ embryo_program_native_call_add(ep, "atan", _embryo_fp_atan);
+ embryo_program_native_call_add(ep, "atan2", _embryo_fp_atan2);
+ embryo_program_native_call_add(ep, "log1p", _embryo_fp_log1p);
+ embryo_program_native_call_add(ep, "cbrt", _embryo_fp_cbrt);
+ embryo_program_native_call_add(ep, "exp", _embryo_fp_exp);
+ embryo_program_native_call_add(ep, "exp2", _embryo_fp_exp2);
+ embryo_program_native_call_add(ep, "hypot", _embryo_fp_hypot);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+static Embryo_Version _version = { VMAJ, VMIN, VMIC, VREV };
+EAPI Embryo_Version *embryo_version = &_version;
+
+static int _embryo_init_count = 0;
+
+/*** EXPORTED CALLS ***/
+
+EAPI int
+embryo_init(void)
+{
+ if (++_embryo_init_count != 1)
+ return _embryo_init_count;
+
+ srand(time(NULL));
+
+ return _embryo_init_count;
+}
+
+EAPI int
+embryo_shutdown(void)
+{
+ if (_embryo_init_count <= 0)
+ {
+ printf("%s:%i Init count not greater than 0 in shutdown.", __FUNCTION__, __LINE__);
+ return 0;
+ }
+ if (--_embryo_init_count != 0)
+ return _embryo_init_count;
+
+ return _embryo_init_count;
+}
--- /dev/null
+#ifndef _EMBRYO_PRIVATE_H
+#define _EMBRYO_PRIVATE_H
+
+
+#ifdef __GNUC__
+# if __GNUC__ >= 4
+// BROKEN in gcc 4 on amd64
+//# pragma GCC visibility push(hidden)
+# endif
+#endif
+
+typedef enum _Embryo_Opcode Embryo_Opcode;
+
+enum _Embryo_Opcode
+{
+ EMBRYO_OP_NONE,
+ EMBRYO_OP_LOAD_PRI,
+ EMBRYO_OP_LOAD_ALT,
+ EMBRYO_OP_LOAD_S_PRI,
+ EMBRYO_OP_LOAD_S_ALT,
+ EMBRYO_OP_LREF_PRI,
+ EMBRYO_OP_LREF_ALT,
+ EMBRYO_OP_LREF_S_PRI,
+ EMBRYO_OP_LREF_S_ALT,
+ EMBRYO_OP_LOAD_I,
+ EMBRYO_OP_LODB_I,
+ EMBRYO_OP_CONST_PRI,
+ EMBRYO_OP_CONST_ALT,
+ EMBRYO_OP_ADDR_PRI,
+ EMBRYO_OP_ADDR_ALT,
+ EMBRYO_OP_STOR_PRI,
+ EMBRYO_OP_STOR_ALT,
+ EMBRYO_OP_STOR_S_PRI,
+ EMBRYO_OP_STOR_S_ALT,
+ EMBRYO_OP_SREF_PRI,
+ EMBRYO_OP_SREF_ALT,
+ EMBRYO_OP_SREF_S_PRI,
+ EMBRYO_OP_SREF_S_ALT,
+ EMBRYO_OP_STOR_I,
+ EMBRYO_OP_STRB_I,
+ EMBRYO_OP_LIDX,
+ EMBRYO_OP_LIDX_B,
+ EMBRYO_OP_IDXADDR,
+ EMBRYO_OP_IDXADDR_B,
+ EMBRYO_OP_ALIGN_PRI,
+ EMBRYO_OP_ALIGN_ALT,
+ EMBRYO_OP_LCTRL,
+ EMBRYO_OP_SCTRL,
+ EMBRYO_OP_MOVE_PRI,
+ EMBRYO_OP_MOVE_ALT,
+ EMBRYO_OP_XCHG,
+ EMBRYO_OP_PUSH_PRI,
+ EMBRYO_OP_PUSH_ALT,
+ EMBRYO_OP_PUSH_R,
+ EMBRYO_OP_PUSH_C,
+ EMBRYO_OP_PUSH,
+ EMBRYO_OP_PUSH_S,
+ EMBRYO_OP_POP_PRI,
+ EMBRYO_OP_POP_ALT,
+ EMBRYO_OP_STACK,
+ EMBRYO_OP_HEAP,
+ EMBRYO_OP_PROC,
+ EMBRYO_OP_RET,
+ EMBRYO_OP_RETN,
+ EMBRYO_OP_CALL,
+ EMBRYO_OP_CALL_PRI,
+ EMBRYO_OP_JUMP,
+ EMBRYO_OP_JREL,
+ EMBRYO_OP_JZER,
+ EMBRYO_OP_JNZ,
+ EMBRYO_OP_JEQ,
+ EMBRYO_OP_JNEQ,
+ EMBRYO_OP_JLESS,
+ EMBRYO_OP_JLEQ,
+ EMBRYO_OP_JGRTR,
+ EMBRYO_OP_JGEQ,
+ EMBRYO_OP_JSLESS,
+ EMBRYO_OP_JSLEQ,
+ EMBRYO_OP_JSGRTR,
+ EMBRYO_OP_JSGEQ,
+ EMBRYO_OP_SHL,
+ EMBRYO_OP_SHR,
+ EMBRYO_OP_SSHR,
+ EMBRYO_OP_SHL_C_PRI,
+ EMBRYO_OP_SHL_C_ALT,
+ EMBRYO_OP_SHR_C_PRI,
+ EMBRYO_OP_SHR_C_ALT,
+ EMBRYO_OP_SMUL,
+ EMBRYO_OP_SDIV,
+ EMBRYO_OP_SDIV_ALT,
+ EMBRYO_OP_UMUL,
+ EMBRYO_OP_UDIV,
+ EMBRYO_OP_UDIV_ALT,
+ EMBRYO_OP_ADD,
+ EMBRYO_OP_SUB,
+ EMBRYO_OP_SUB_ALT,
+ EMBRYO_OP_AND,
+ EMBRYO_OP_OR,
+ EMBRYO_OP_XOR,
+ EMBRYO_OP_NOT,
+ EMBRYO_OP_NEG,
+ EMBRYO_OP_INVERT,
+ EMBRYO_OP_ADD_C,
+ EMBRYO_OP_SMUL_C,
+ EMBRYO_OP_ZERO_PRI,
+ EMBRYO_OP_ZERO_ALT,
+ EMBRYO_OP_ZERO,
+ EMBRYO_OP_ZERO_S,
+ EMBRYO_OP_SIGN_PRI,
+ EMBRYO_OP_SIGN_ALT,
+ EMBRYO_OP_EQ,
+ EMBRYO_OP_NEQ,
+ EMBRYO_OP_LESS,
+ EMBRYO_OP_LEQ,
+ EMBRYO_OP_GRTR,
+ EMBRYO_OP_GEQ,
+ EMBRYO_OP_SLESS,
+ EMBRYO_OP_SLEQ,
+ EMBRYO_OP_SGRTR,
+ EMBRYO_OP_SGEQ,
+ EMBRYO_OP_EQ_C_PRI,
+ EMBRYO_OP_EQ_C_ALT,
+ EMBRYO_OP_INC_PRI,
+ EMBRYO_OP_INC_ALT,
+ EMBRYO_OP_INC,
+ EMBRYO_OP_INC_S,
+ EMBRYO_OP_INC_I,
+ EMBRYO_OP_DEC_PRI,
+ EMBRYO_OP_DEC_ALT,
+ EMBRYO_OP_DEC,
+ EMBRYO_OP_DEC_S,
+ EMBRYO_OP_DEC_I,
+ EMBRYO_OP_MOVS,
+ EMBRYO_OP_CMPS,
+ EMBRYO_OP_FILL,
+ EMBRYO_OP_HALT,
+ EMBRYO_OP_BOUNDS,
+ EMBRYO_OP_SYSREQ_PRI,
+ EMBRYO_OP_SYSREQ_C,
+ EMBRYO_OP_FILE,
+ EMBRYO_OP_LINE,
+ EMBRYO_OP_SYMBOL,
+ EMBRYO_OP_SRANGE,
+ EMBRYO_OP_JUMP_PRI,
+ EMBRYO_OP_SWITCH,
+ EMBRYO_OP_CASETBL,
+ EMBRYO_OP_SWAP_PRI,
+ EMBRYO_OP_SWAP_ALT,
+ EMBRYO_OP_PUSHADDR,
+ EMBRYO_OP_NOP,
+ EMBRYO_OP_SYSREQ_D,
+ EMBRYO_OP_SYMTAG,
+ /* ----- */
+ EMBRYO_OP_NUM_OPCODES
+};
+
+#define NUMENTRIES(hdr, field, nextfield) \
+(int)(((hdr)->nextfield - (hdr)->field) / (hdr)->defsize)
+#define GETENTRY(hdr, table, index) \
+(Embryo_Func_Stub *)((unsigned char*)(hdr) + \
+(int)(hdr)->table + index * (hdr)->defsize)
+#ifdef WORDS_BIGENDIAN
+static int __inline __entryswap32(int v)
+{int vv; vv = v; embryo_swap_32((unsigned int *)&vv); return vv;}
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + \
+__entryswap32(*((unsigned int *)(entry) + 1))) \
+: (entry)->name)
+#else
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + *((unsigned int *)(entry) + 1)) \
+: (entry)->name)
+#endif
+
+#define CUR_FILE_VERSION 7 /* current file version; also the current Embryo_Program version */
+#define MIN_FILE_VERSION 7 /* lowest supported file format version for the current Embryo_Program version */
+#define MIN_AMX_VERSION 7 /* minimum Embryo_Program version needed to support the current file format */
+#define sEXPMAX 19 /* maximum name length for file version <= 6 */
+#define sNAMEMAX 31 /* maximum name length of symbol name */
+#define EMBRYO_MAGIC 0xf1e0 /* magic byte pattern */
+#define EMBRYO_FLAG_COMPACT 0x04 /* compact encoding */
+#define EMBRYO_FLAG_RELOC 0x8000 /* jump/call addresses relocated */
+#define GETPARAM(v) (v = *(Embryo_Cell *)cip++)
+#define PUSH(v) (stk -= sizeof(Embryo_Cell), *(Embryo_Cell *)(data + (int)stk) = v)
+#define POP(v) (v = *(Embryo_Cell *)(data + (int)stk), stk += sizeof(Embryo_Cell))
+#define ABORT(ep,v) {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_FAIL;}
+#define OK(ep,v) {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_OK;}
+#define TOOLONG(ep) {(ep)->pri = pri; (ep)->cip = (Embryo_Cell)((unsigned char *)cip - code); (ep)->alt = alt; (ep)->frm = frm; (ep)->stk = stk; (ep)->hea = hea; (ep)->reset_stk = reset_stk; (ep)->reset_hea = reset_hea; (ep)->run_count--; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_TOOLONG;}
+#define STKMARGIN ((Embryo_Cell)(16 * sizeof(Embryo_Cell)))
+#define CHKMARGIN() if ((hea + STKMARGIN) > stk) {ep->error = EMBRYO_ERROR_STACKERR; return 0;}
+#define CHKSTACK() if (stk > ep->stp) {ep->run_count--; ep->error = EMBRYO_ERROR_STACKLOW; return 0;}
+#define CHKHEAP() if (hea < ep->hlw) {ep->run_count--; ep->error = EMBRYO_ERROR_HEAPLOW; return 0;}
+#define CHKMEM(x) if ((((x) >= hea) && ((x) < stk)) || ((Embryo_UCell)(x) >= (Embryo_UCell)ep->stp)) ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+
+typedef struct _Embryo_Param Embryo_Param;
+typedef struct _Embryo_Header Embryo_Header;
+typedef struct _Embryo_Func_Stub Embryo_Func_Stub;
+
+typedef Embryo_Cell (*Embryo_Native)(Embryo_Program *ep, Embryo_Cell *params);
+
+struct _Embryo_Param
+{
+ char *string;
+ Embryo_Cell *cell_array;
+ int cell_array_size;
+ Embryo_Cell cell;
+};
+
+struct _Embryo_Program
+{
+ unsigned char *base; /* points to the Embryo_Program header ("ephdr") plus the code, optionally also the data */
+ int pushes; /* number of pushes - pops */
+ /* for external functions a few registers must be accessible from the outside */
+ Embryo_Cell cip; /* instruction pointer: relative to base + ephdr->cod */
+ Embryo_Cell frm; /* stack frame base: relative to base + ephdr->dat */
+ Embryo_Cell hea; /* top of the heap: relative to base + ephdr->dat */
+ Embryo_Cell hlw; /* bottom of the heap: relative to base + ephdr->dat */
+ Embryo_Cell stk; /* stack pointer: relative to base + ephdr->dat */
+ Embryo_Cell stp; /* top of the stack: relative to base + ephdr->dat */
+ int flags; /* current status */
+ /* native functions can raise an error */
+ int error;
+ /* the sleep opcode needs to store the full Embryo_Program status */
+ Embryo_Cell pri;
+ Embryo_Cell alt;
+ Embryo_Cell reset_stk;
+ Embryo_Cell reset_hea;
+ Embryo_Cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
+
+ /* extended stuff */
+ Embryo_Native *native_calls;
+ int native_calls_size;
+ int native_calls_alloc;
+
+ unsigned char *code;
+ unsigned char dont_free_code : 1;
+ Embryo_Cell retval;
+
+ Embryo_Param *params;
+ int params_size;
+ int params_alloc;
+
+ int run_count;
+
+ int max_run_cycles;
+
+ void *data;
+};
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+struct _Embryo_Func_Stub
+{
+ int address;
+ char name[sEXPMAX+1];
+} EMBRYO_STRUCT_PACKED;
+
+struct _Embryo_Header
+{
+ unsigned int size; /* size of the "file" */
+ unsigned short magic; /* signature */
+ char file_version; /* file format version */
+ char ep_version; /* required version of the Embryo_Program */
+ short flags;
+ short defsize; /* size of a definition record */
+ int cod; /* initial value of COD - code block */
+ int dat; /* initial value of DAT - data block */
+ int hea; /* initial value of HEA - start of the heap */
+ int stp; /* initial value of STP - stack top */
+ int cip; /* initial value of CIP - the instruction pointer */
+ int publics; /* offset to the "public functions" table */
+ int natives; /* offset to the "native functions" table */
+ int libraries; /* offset to the table of libraries */
+ int pubvars; /* the "public variables" table */
+ int tags; /* the "public tagnames" table */
+ int nametable; /* name table, file version 7 only */
+} EMBRYO_STRUCT_PACKED;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+void _embryo_args_init(Embryo_Program *ep);
+void _embryo_fp_init(Embryo_Program *ep);
+void _embryo_rand_init(Embryo_Program *ep);
+void _embryo_str_init(Embryo_Program *ep);
+void _embryo_time_init(Embryo_Program *ep);
+
+#endif
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported random number api */
+
+static Embryo_Cell
+_embryo_rand_rand(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ return (Embryo_Cell)(rand() & 0xffff);
+}
+
+static Embryo_Cell
+_embryo_rand_randf(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ double r;
+ float f;
+
+ r = (double)(rand() & 0xffff) / 65535.0;
+ f = (float)r;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_rand_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "rand", _embryo_rand_rand);
+ embryo_program_native_call_add(ep, "randf", _embryo_rand_randf);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif !defined alloca
+# ifdef __GNUC__
+# define alloca __builtin_alloca
+# elif defined _AIX
+# define alloca __alloca
+# elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+# elif !defined HAVE_ALLOCA
+# ifdef __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+# endif
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <fnmatch.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRGET(ep, str, par) { \
+ Embryo_Cell *___cptr; \
+ str = NULL; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ int ___l; \
+ ___l = embryo_data_string_length_get(ep, ___cptr); \
+ (str) = alloca(___l + 1); \
+ if (str) embryo_data_string_get(ep, ___cptr, str); \
+ } }
+#define STRSET(ep, par, str) { \
+ Embryo_Cell *___cptr; \
+ if ((___cptr = embryo_data_address_get(ep, par))) { \
+ embryo_data_string_set(ep, str, ___cptr); \
+ } }
+
+/* exported string api */
+
+static Embryo_Cell
+_embryo_str_atoi(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = str */
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ if (!s1) return 0;
+ return (Embryo_Cell)atoi(s1);
+}
+
+static Embryo_Cell
+_embryo_str_fnmatch(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = glob */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)fnmatch(s1, s2, 0);
+}
+
+static Embryo_Cell
+_embryo_str_strcmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = str1 */
+ /* params[2] = str2 */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return -1;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)strcmp(s1, s2);
+}
+
+static Embryo_Cell
+_embryo_str_strncmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+
+ /* params[1] = str1 */
+ /* params[2] = str2 */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ return (Embryo_Cell)strncmp(s1, s2, (size_t)params[3]);
+}
+
+static Embryo_Cell
+_embryo_str_strcpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ STRSET(ep, params[1], s1);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+ int l;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ l = strlen(s1);
+ if (l > params[3]) s1[params[3]] = 0;
+ STRSET(ep, params[1], s1);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strlen(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1;
+
+ /* params[1] = str */
+ if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ if (!s1) return 0;
+ return (Embryo_Cell)strlen(s1);
+}
+
+static Embryo_Cell
+_embryo_str_strcat(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+
+ /* params[1] = dsr */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ s3 = alloca(strlen(s1) + strlen(s2) + 1);
+ if (!s3) return 0;
+ strcpy(s3, s1);
+ strcat(s3, s2);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncat(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+ int l1, l2;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ l1 = strlen(s1);
+ l2 = strlen(s2);
+ s3 = alloca(l1 + l2 + 1);
+ if (!s3) return 0;
+ strcpy(s3, s1);
+ strncat(s3, s2, params[3]);
+ if (l2 >= params[3]) s3[l1 + params[3]] = 0;
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ s3 = alloca(strlen(s1) + strlen(s2) + 1);
+ if (!s3) return 0;
+ strcpy(s3, s2);
+ strcat(s3, s1);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strnprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *s3;
+ int l1, l2;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return 0;
+ l1 = strlen(s1);
+ l2 = strlen(s2);
+ s3 = alloca(l1 + l2 + 1);
+ if (!s3) return 0;
+ strncpy(s3, s2, params[3]);
+ if (params[3] <= l2) s3[params[3]] = 0;
+ strcat(s3, s1);
+ STRSET(ep, params[1], s3);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strcut(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+ int l1;
+
+ /* params[1] = dst */
+ /* params[2] = str */
+ /* params[3] = n */
+ /* params[4] = n2 */
+ if (params[0] != (4 * sizeof(Embryo_Cell))) return 0;
+ if (params[3] < 0) params[3] = 0;
+ if (params[4] < params[3]) params[4] = params[3];
+ STRGET(ep, s1, params[2]);
+ if (!s1) return 0;
+ l1 = strlen(s1);
+ if (params[3] >= l1) params[3] = l1;
+ if (params[4] >= l1) params[4] = l1;
+ if (params[4] == params[3])
+ {
+ STRSET(ep, params[1], "");
+ return 0;
+ }
+ s2 = alloca(params[4] - params[3] + 1);
+ strncpy(s2, s1 + params[3], params[4] - params[3]);
+ s2[params[4] - params[3]] = 0;
+ STRSET(ep, params[1], s2);
+ return 0;
+}
+
+static Embryo_Cell
+_embryo_str_snprintf(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2;
+ int i, o;
+ int inesc = 0;
+ int insub = 0;
+ int p, pnum;
+
+ /* params[1] = buf */
+ /* params[2] = bufsize */
+ /* params[3] = format_string */
+ /* params[4] = first arg ... */
+ if (params[0] < (Embryo_Cell)(3 * sizeof(Embryo_Cell))) return 0;
+ if (params[2] <= 0) return 0;
+ STRGET(ep, s1, params[3]);
+ if (!s1) return -1;
+ s2 = alloca(params[2] + 1);
+ if (!s2) return -1;
+ s2[0] = 0;
+ pnum = (params[0] / sizeof(Embryo_Cell)) - 3;
+ for (p = 0, o = 0, i = 0; (s1[i]) && (o < (params[2] - 1)) && (p < (pnum + 1)); i++)
+ {
+ if ((!inesc) && (!insub))
+ {
+ if (s1[i] == '\\') inesc = 1;
+ else if (s1[i] == '%') insub = 1;
+ if ((!inesc) && (!insub))
+ {
+ s2[o] = s1[i];
+ o++;
+ }
+ }
+ else
+ {
+ Embryo_Cell *cptr;
+
+ if (inesc)
+ {
+ switch (s1[i])
+ {
+ case 't':
+ s2[o] = '\t';
+ o++;
+ break;
+ case 'n':
+ s2[o] = '\n';
+ o++;
+ break;
+ default:
+ s2[o] = s1[i];
+ o++;
+ break;
+ }
+ inesc = 0;
+ }
+ if ((insub) && (s1[i] == '%')) pnum++;
+ if ((insub) && (p < pnum))
+ {
+ switch (s1[i])
+ {
+ case '%':
+ s2[o] = '%';
+ o++;
+ break;
+ case 'c':
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) s2[o] = (char)(*cptr);
+ p++;
+ o++;
+ break;
+ case 'i':
+ case 'd':
+ case 'x':
+ case 'X':
+ {
+ char fmt[10] = "";
+ char tmp[256] = "";
+ int l;
+
+ if (s1[i] == 'i') strcpy(fmt, "%i");
+ else if (s1[i] == 'd') strcpy(fmt, "%d");
+ else if (s1[i] == 'x') strcpy(fmt, "%x");
+ else if (s1[i] == 'X') strcpy(fmt, "%08x");
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) snprintf(tmp, sizeof(tmp), fmt, (int)(*cptr));
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ case 'f':
+ {
+ char tmp[256] = "";
+ int l;
+
+ cptr = embryo_data_address_get(ep, params[4 + p]);
+ if (cptr) snprintf(tmp, sizeof(tmp), "%f", (double)EMBRYO_CELL_TO_FLOAT(*cptr));
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ case 's':
+ {
+ char *tmp;
+ int l;
+
+ STRGET(ep, tmp, params[4 + p]);
+ l = strlen(tmp);
+ if ((o + l) > (params[2] - 1))
+ {
+ l = params[2] - 1 - o;
+ if (l < 0) l = 0;
+ tmp[l] = 0;
+ }
+ strcpy(s2 + o, tmp);
+ o += l;
+ p++;
+ }
+ break;
+ default:
+ break;
+ }
+ insub = 0;
+ }
+ else if (insub)
+ insub = 0;
+ }
+ }
+ s2[o] = 0;
+
+ STRSET(ep, params[1], s2);
+ return o;
+}
+
+static Embryo_Cell
+_embryo_str_strstr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ndl */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strstr(s1, s2);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ch */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strchr(s1, s2[0]);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strrchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+ char *s1, *s2, *p;
+
+ /* params[1] = str */
+ /* params[2] = ch */
+ if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+ STRGET(ep, s1, params[1]);
+ STRGET(ep, s2, params[2]);
+ if ((!s1) || (!s2)) return -1;
+ p = strrchr(s1, s2[0]);
+ if (!p) return -1;
+ return (Embryo_Cell)(p - s1);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_str_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "atoi", _embryo_str_atoi);
+ embryo_program_native_call_add(ep, "fnmatch", _embryo_str_fnmatch);
+ embryo_program_native_call_add(ep, "strcmp", _embryo_str_strcmp);
+ embryo_program_native_call_add(ep, "strncmp", _embryo_str_strncmp);
+ embryo_program_native_call_add(ep, "strcpy", _embryo_str_strcpy);
+ embryo_program_native_call_add(ep, "strncpy", _embryo_str_strncpy);
+ embryo_program_native_call_add(ep, "strlen", _embryo_str_strlen);
+ embryo_program_native_call_add(ep, "strcat", _embryo_str_strcat);
+ embryo_program_native_call_add(ep, "strncat", _embryo_str_strncat);
+ embryo_program_native_call_add(ep, "strprep", _embryo_str_strprep);
+ embryo_program_native_call_add(ep, "strnprep", _embryo_str_strnprep);
+ embryo_program_native_call_add(ep, "strcut", _embryo_str_strcut);
+ embryo_program_native_call_add(ep, "snprintf", _embryo_str_snprintf);
+ embryo_program_native_call_add(ep, "strstr", _embryo_str_strstr);
+ embryo_program_native_call_add(ep, "strchr", _embryo_str_strchr);
+ embryo_program_native_call_add(ep, "strrchr", _embryo_str_strrchr);
+}
--- /dev/null
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifndef EFL_HAVE_GETTIMEOFDAY
+# error "Your platform isn't supported yet"
+#endif
+
+#include <sys/time.h>
+#include <time.h>
+
+#ifdef _MSC_VER
+# include <winsock2.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported time api */
+
+static Embryo_Cell
+_embryo_time_seconds(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+ struct timeval timev;
+ double t;
+ float f;
+
+ gettimeofday(&timev, NULL);
+ t = (double)(timev.tv_sec - ((timev.tv_sec / (60 * 60 * 24)) * (60 * 60 * 24)))
+ + (((double)timev.tv_usec) / 1000000);
+ f = (float)t;
+ return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_time_date(Embryo_Program *ep, Embryo_Cell *params)
+{
+ static time_t last_tzset = 0;
+ struct timeval timev;
+ struct tm *tm;
+ time_t tt;
+
+ if (params[0] != (8 * sizeof(Embryo_Cell))) return 0;
+ gettimeofday(&timev, NULL);
+ tt = (time_t)(timev.tv_sec);
+ if ((tt > (last_tzset + 1)) ||
+ (tt < (last_tzset - 1)))
+ {
+ last_tzset = tt;
+ tzset();
+ }
+ tm = localtime(&tt);
+ if (tm)
+ {
+ Embryo_Cell *cptr;
+ double t;
+ float f;
+
+ cptr = embryo_data_address_get(ep, params[1]);
+ if (cptr) *cptr = tm->tm_year + 1900;
+ cptr = embryo_data_address_get(ep, params[2]);
+ if (cptr) *cptr = tm->tm_mon + 1;
+ cptr = embryo_data_address_get(ep, params[3]);
+ if (cptr) *cptr = tm->tm_mday;
+ cptr = embryo_data_address_get(ep, params[4]);
+ if (cptr) *cptr = tm->tm_yday;
+ cptr = embryo_data_address_get(ep, params[5]);
+ if (cptr) *cptr = (tm->tm_wday + 6) % 7;
+ cptr = embryo_data_address_get(ep, params[6]);
+ if (cptr) *cptr = tm->tm_hour;
+ cptr = embryo_data_address_get(ep, params[7]);
+ if (cptr) *cptr = tm->tm_min;
+ cptr = embryo_data_address_get(ep, params[8]);
+ t = (double)tm->tm_sec + (((double)timev.tv_usec) / 1000000);
+ f = (float)t;
+ if (cptr) *cptr = EMBRYO_FLOAT_TO_CELL(f);
+
+ }
+ return 0;
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_time_init(Embryo_Program *ep)
+{
+ embryo_program_native_call_add(ep, "seconds", _embryo_time_seconds);
+ embryo_program_native_call_add(ep, "date", _embryo_time_date);
+}
projects / framework / uifw / embryo.git / commitdiff
