diff options
| author | raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33> | 2012-08-30 09:54:57 +0000 |
|---|---|---|
| committer | raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33> | 2012-08-30 09:54:57 +0000 |
| commit | 124ac58c553c1435bf6a33f6ca77e7363bfa4d1d (patch) | |
| tree | b3beb0fb39eb8693de0c4288454887d51432ec98 | |
| download | embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.gz embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.bz2 embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.zip | |
EFL 1.7 svn doobies
git-svn-id: svn+ssh://svn.enlightenment.org/var/svn/e/branches/embryo-1.7@75862 7cbeb6ba-43b4-40fd-8cce-4c39aea84d33
67 files changed, 23538 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fbe3b34 --- /dev/null +++ b/.gitignore @@ -0,0 +1,39 @@ +*~ +*.o +*.lo +*.lo +*.la +.deps +.libs +/ABOUT-NLS +Makefile +Makefile.in +/README +/aclocal.m4 +autom4te.cache/ +/compile +/config.cache +/config.cache-env +/config.guess +/config.h +/config.h.in +/config.log +/config.status +/config.sub +/configure +/depcomp +doc/embryo.dox +/embryo.pc +/embryo.spec +/install-sh +/libtool +/ltmain.sh +m4/libtool.m4 +m4/ltoptions.m4 +m4/ltsugar.m4 +m4/ltversion.m4 +m4/lt~obsolete.m4 +/missing +/src/bin/embryo_cc +/stamp-h1 +/doc/Doxyfile @@ -0,0 +1,2 @@ +The Rasterman (Carsten Haitzler) <raster@rasterman.com> +Jérôme Pinot <ngc891@gmail.com> @@ -0,0 +1,47 @@ +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. diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..97da875 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,43 @@ +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). + @@ -0,0 +1,236 @@ +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. + diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..5c70db3 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,44 @@ +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 @@ -0,0 +1,46 @@ +Embryo 1.7.0 + +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 + @@ -0,0 +1,90 @@ +Embryo 1.7.0 + +****************************************************************************** + + 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 diff --git a/autogen.sh b/autogen.sh new file mode 100755 index 0000000..72e1033 --- /dev/null +++ b/autogen.sh @@ -0,0 +1,38 @@ +#!/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 diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..243748a --- /dev/null +++ b/configure.ac @@ -0,0 +1,222 @@ +##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--## +##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--##--## +m4_define([v_maj], [1]) +m4_define([v_min], [7]) +m4_define([v_mic], [0]) +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 +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 diff --git a/doc/Doxyfile.in b/doc/Doxyfile.in new file mode 100644 index 0000000..5476347 --- /dev/null +++ b/doc/Doxyfile.in @@ -0,0 +1,137 @@ +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 diff --git a/doc/Makefile.am b/doc/Makefile.am new file mode 100644 index 0000000..91c79f3 --- /dev/null +++ b/doc/Makefile.am @@ -0,0 +1,33 @@ + +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 diff --git a/doc/e.css b/doc/e.css new file mode 100644 index 0000000..07ebd1e --- /dev/null +++ b/doc/e.css @@ -0,0 +1,436 @@ +/* + 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%; +} + diff --git a/doc/embryo.css b/doc/embryo.css new file mode 100644 index 0000000..6117b39 --- /dev/null +++ b/doc/embryo.css @@ -0,0 +1,178 @@ +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; +} diff --git a/doc/embryo.dox.in b/doc/embryo.dox.in new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/doc/embryo.dox.in diff --git a/doc/foot.html b/doc/foot.html new file mode 100644 index 0000000..78ef911 --- /dev/null +++ b/doc/foot.html @@ -0,0 +1,19 @@ + + <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> diff --git a/doc/head.html b/doc/head.html new file mode 100644 index 0000000..48032d9 --- /dev/null +++ b/doc/head.html @@ -0,0 +1,66 @@ +<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"> diff --git a/doc/img/e.png b/doc/img/e.png Binary files differnew file mode 100755 index 0000000..b3884a5 --- /dev/null +++ b/doc/img/e.png diff --git a/doc/img/e_big.png b/doc/img/e_big.png Binary files differnew file mode 100755 index 0000000..d42aeb4 --- /dev/null +++ b/doc/img/e_big.png diff --git a/doc/img/edoxy.css b/doc/img/edoxy.css new file mode 100755 index 0000000..616a0c5 --- /dev/null +++ b/doc/img/edoxy.css @@ -0,0 +1,966 @@ +/* + * 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%; +} + diff --git a/doc/img/foot_bg.png b/doc/img/foot_bg.png Binary files differnew file mode 100755 index 0000000..b24f3a4 --- /dev/null +++ b/doc/img/foot_bg.png diff --git a/doc/img/head_bg.png b/doc/img/head_bg.png Binary files differnew file mode 100755 index 0000000..081dc13 --- /dev/null +++ b/doc/img/head_bg.png diff --git a/doc/img/hilite.png b/doc/img/hilite.png Binary files differnew file mode 100644 index 0000000..88a4381 --- /dev/null +++ b/doc/img/hilite.png diff --git a/doc/img/menu_bg.png b/doc/img/menu_bg.png Binary files differnew file mode 100755 index 0000000..e978743 --- /dev/null +++ b/doc/img/menu_bg.png diff --git a/doc/img/menu_bg_current.png b/doc/img/menu_bg_current.png Binary files differnew file mode 100755 index 0000000..de97c92 --- /dev/null +++ b/doc/img/menu_bg_current.png diff --git a/doc/img/menu_bg_hover.png b/doc/img/menu_bg_hover.png Binary files differnew file mode 100755 index 0000000..3fd851d --- /dev/null +++ b/doc/img/menu_bg_hover.png diff --git a/doc/img/menu_bg_last.png b/doc/img/menu_bg_last.png Binary files differnew file mode 100755 index 0000000..88c116c --- /dev/null +++ b/doc/img/menu_bg_last.png diff --git a/doc/img/menu_bg_unsel.png b/doc/img/menu_bg_unsel.png Binary files differnew file mode 100755 index 0000000..50e5fd8 --- /dev/null +++ b/doc/img/menu_bg_unsel.png diff --git a/embryo.pc.in b/embryo.pc.in new file mode 100644 index 0000000..540f27c --- /dev/null +++ b/embryo.pc.in @@ -0,0 +1,15 @@ +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@ diff --git a/embryo.spec.in b/embryo.spec.in new file mode 100644 index 0000000..4c37ede --- /dev/null +++ b/embryo.spec.in @@ -0,0 +1,77 @@ +%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 diff --git a/include/Makefile.am b/include/Makefile.am new file mode 100644 index 0000000..006ee14 --- /dev/null +++ b/include/Makefile.am @@ -0,0 +1,7 @@ +MAINTAINERCLEANFILES = Makefile.in + +filesdir = $(datadir)/embryo/include +files_DATA = \ +default.inc + +EXTRA_DIST = $(files_DATA) diff --git a/include/default.inc b/include/default.inc new file mode 100644 index 0000000..b82ff14 --- /dev/null +++ b/include/default.inc @@ -0,0 +1,231 @@ +/* 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); diff --git a/m4/ac_attribute.m4 b/m4/ac_attribute.m4 new file mode 100644 index 0000000..23479a9 --- /dev/null +++ b/m4/ac_attribute.m4 @@ -0,0 +1,47 @@ +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 diff --git a/m4/efl_binary.m4 b/m4/efl_binary.m4 new file mode 100644 index 0000000..93d6934 --- /dev/null +++ b/m4/efl_binary.m4 @@ -0,0 +1,44 @@ +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]) + +]) diff --git a/m4/efl_doxygen.m4 b/m4/efl_doxygen.m4 new file mode 100644 index 0000000..d83ed68 --- /dev/null +++ b/m4/efl_doxygen.m4 @@ -0,0 +1,97 @@ +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 diff --git a/m4/efl_fnmatch.m4 b/m4/efl_fnmatch.m4 new file mode 100644 index 0000000..c857046 --- /dev/null +++ b/m4/efl_fnmatch.m4 @@ -0,0 +1,31 @@ +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]) + +]) diff --git a/m4/efl_gettimeofday.m4 b/m4/efl_gettimeofday.m4 new file mode 100644 index 0000000..9b767e5 --- /dev/null +++ b/m4/efl_gettimeofday.m4 @@ -0,0 +1,48 @@ +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]) +]) diff --git a/m4/efl_path_max.m4 b/m4/efl_path_max.m4 new file mode 100644 index 0000000..f57bfd2 --- /dev/null +++ b/m4/efl_path_max.m4 @@ -0,0 +1,36 @@ +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 diff --git a/src/Makefile.am b/src/Makefile.am new file mode 100644 index 0000000..a8590b2 --- /dev/null +++ b/src/Makefile.am @@ -0,0 +1,3 @@ +MAINTAINERCLEANFILES = Makefile.in + +SUBDIRS = lib bin diff --git a/src/bin/Makefile.am b/src/bin/Makefile.am new file mode 100644 index 0000000..09f6ffd --- /dev/null +++ b/src/bin/Makefile.am @@ -0,0 +1,40 @@ + +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 diff --git a/src/bin/embryo_cc_amx.h b/src/bin/embryo_cc_amx.h new file mode 100644 index 0000000..0118e2d --- /dev/null +++ b/src/bin/embryo_cc_amx.h @@ -0,0 +1,226 @@ +/* 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 */ diff --git a/src/bin/embryo_cc_osdefs.h b/src/bin/embryo_cc_osdefs.h new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/src/bin/embryo_cc_osdefs.h diff --git a/src/bin/embryo_cc_prefix.c b/src/bin/embryo_cc_prefix.c new file mode 100644 index 0000000..9b57704 --- /dev/null +++ b/src/bin/embryo_cc_prefix.c @@ -0,0 +1,61 @@ +#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); +} diff --git a/src/bin/embryo_cc_prefix.h b/src/bin/embryo_cc_prefix.h new file mode 100644 index 0000000..d6dc7b2 --- /dev/null +++ b/src/bin/embryo_cc_prefix.h @@ -0,0 +1,6 @@ +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); diff --git a/src/bin/embryo_cc_sc.h b/src/bin/embryo_cc_sc.h new file mode 100644 index 0000000..bedd59e --- /dev/null +++ b/src/bin/embryo_cc_sc.h @@ -0,0 +1,667 @@ +/* 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 */ + +#endif diff --git a/src/bin/embryo_cc_sc1.c b/src/bin/embryo_cc_sc1.c new file mode 100644 index 0000000..3a5b3d9 --- /dev/null +++ b/src/bin/embryo_cc_sc1.c @@ -0,0 +1,4081 @@ +/* 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 (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 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; !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 (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 */ +} diff --git a/src/bin/embryo_cc_sc2.c b/src/bin/embryo_cc_sc2.c new file mode 100644 index 0000000..04cb537 --- /dev/null +++ b/src/bin/embryo_cc_sc2.c @@ -0,0 +1,2779 @@ +/* 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 (!isdigit(*ptr)) /* should start with digit */ + return 0; + while (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 == '.' && 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 (!isdigit(*ptr)) /* should start with digit */ + return 0; + if (*ptr == '0' && *(ptr + 1) == 'x') + { /* C style hexadecimal notation */ + ptr += 2; + while (isxdigit(*ptr) || *ptr == '_') + { + if (*ptr != '_') + { + assert(isxdigit(*ptr)); + *val = *val << 4; + if (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 (!isdigit(*ptr)) /* should start with digit */ + return 0; + while (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 (!isdigit(*ptr)) /* there must be at least one digit after the dot */ + return 0; + ffrac = 0.0; + fmult = 1.0; + ignore = FALSE; + while (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 (!isdigit(*ptr)) /* 'e' should be followed by a digit */ + return 0; + exp = 0; + while (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))) && + (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 && (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 (!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 && 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; + isalpha(*start) || 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; isalpha(*s) || 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 (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 == '%' && 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 == '%' && 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 (!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 (isalpha(*end) || 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 (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 (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) || 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 && !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; +} diff --git a/src/bin/embryo_cc_sc3.c b/src/bin/embryo_cc_sc3.c new file mode 100644 index 0000000..1206857 --- /dev/null +++ b/src/bin/embryo_cc_sc3.c @@ -0,0 +1,2438 @@ +/* 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 */ +} diff --git a/src/bin/embryo_cc_sc4.c b/src/bin/embryo_cc_sc4.c new file mode 100644 index 0000000..258d714 --- /dev/null +++ b/src/bin/embryo_cc_sc4.c @@ -0,0 +1,1308 @@ +/* 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"); +} diff --git a/src/bin/embryo_cc_sc5.c b/src/bin/embryo_cc_sc5.c new file mode 100644 index 0000000..a8af498 --- /dev/null +++ b/src/bin/embryo_cc_sc5.c @@ -0,0 +1,154 @@ +/* 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; + } +} diff --git a/src/bin/embryo_cc_sc5.scp b/src/bin/embryo_cc_sc5.scp new file mode 100644 index 0000000..bf0a606 --- /dev/null +++ b/src/bin/embryo_cc_sc5.scp @@ -0,0 +1,317 @@ +/* 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 +}; diff --git a/src/bin/embryo_cc_sc6.c b/src/bin/embryo_cc_sc6.c new file mode 100644 index 0000000..417a8a1 --- /dev/null +++ b/src/bin/embryo_cc_sc6.c @@ -0,0 +1,1077 @@ +/* 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 (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 (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; !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 (isspace(*params)) + params++; + len = strlen(params); + while (len > 0 && 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; !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' && !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' && !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 */ +} diff --git a/src/bin/embryo_cc_sc7.c b/src/bin/embryo_cc_sc7.c new file mode 100644 index 0000000..910c522 --- /dev/null +++ b/src/bin/embryo_cc_sc7.c @@ -0,0 +1,688 @@ +/* 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(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(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(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 diff --git a/src/bin/embryo_cc_sc7.scp b/src/bin/embryo_cc_sc7.scp new file mode 100644 index 0000000..38f784d --- /dev/null +++ b/src/bin/embryo_cc_sc7.scp @@ -0,0 +1,1473 @@ +/* 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} +}; diff --git a/src/bin/embryo_cc_scexpand.c b/src/bin/embryo_cc_scexpand.c new file mode 100644 index 0000000..6ab34a1 --- /dev/null +++ b/src/bin/embryo_cc_scexpand.c @@ -0,0 +1,53 @@ +/* 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; +} diff --git a/src/bin/embryo_cc_sclist.c b/src/bin/embryo_cc_sclist.c new file mode 100644 index 0000000..e908248 --- /dev/null +++ b/src/bin/embryo_cc_sclist.c @@ -0,0 +1,293 @@ +/* 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; +} diff --git a/src/bin/embryo_cc_scvars.c b/src/bin/embryo_cc_scvars.c new file mode 100644 index 0000000..f369b9b --- /dev/null +++ b/src/bin/embryo_cc_scvars.c @@ -0,0 +1,88 @@ +/* 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; diff --git a/src/lib/Embryo.h b/src/lib/Embryo.h new file mode 100644 index 0000000..e184ce2 --- /dev/null +++ b/src/lib/Embryo.h @@ -0,0 +1,901 @@ +/** +@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 7 + + 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 diff --git a/src/lib/Makefile.am b/src/lib/Makefile.am new file mode 100644 index 0000000..d2ccb55 --- /dev/null +++ b/src/lib/Makefile.am @@ -0,0 +1,36 @@ + +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 diff --git a/src/lib/embryo_amx.c b/src/lib/embryo_amx.c new file mode 100644 index 0000000..55423b4 --- /dev/null +++ b/src/lib/embryo_amx.c @@ -0,0 +1,1995 @@ +/* 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; +} diff --git a/src/lib/embryo_args.c b/src/lib/embryo_args.c new file mode 100644 index 0000000..0c0089e --- /dev/null +++ b/src/lib/embryo_args.c @@ -0,0 +1,128 @@ +#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); +} diff --git a/src/lib/embryo_float.c b/src/lib/embryo_float.c new file mode 100644 index 0000000..ffaa87d --- /dev/null +++ b/src/lib/embryo_float.c @@ -0,0 +1,480 @@ +/* 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); +} diff --git a/src/lib/embryo_main.c b/src/lib/embryo_main.c new file mode 100644 index 0000000..3c57ec7 --- /dev/null +++ b/src/lib/embryo_main.c @@ -0,0 +1,42 @@ +#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; +} diff --git a/src/lib/embryo_private.h b/src/lib/embryo_private.h new file mode 100644 index 0000000..a4205e1 --- /dev/null +++ b/src/lib/embryo_private.h @@ -0,0 +1,298 @@ +#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 diff --git a/src/lib/embryo_rand.c b/src/lib/embryo_rand.c new file mode 100644 index 0000000..627f7ed --- /dev/null +++ b/src/lib/embryo_rand.c @@ -0,0 +1,36 @@ +#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); +} diff --git a/src/lib/embryo_str.c b/src/lib/embryo_str.c new file mode 100644 index 0000000..0c2faa2 --- /dev/null +++ b/src/lib/embryo_str.c @@ -0,0 +1,498 @@ +#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); +} diff --git a/src/lib/embryo_time.c b/src/lib/embryo_time.c new file mode 100644 index 0000000..90c14cf --- /dev/null +++ b/src/lib/embryo_time.c @@ -0,0 +1,97 @@ +#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); +} |
