diff --git a/legacy/embryo/AUTHORS b/legacy/embryo/AUTHORS new file mode 100644 index 0000000000..7bf31c1234 --- /dev/null +++ b/legacy/embryo/AUTHORS @@ -0,0 +1,2 @@ +The Rasterman (Carsten Haitzler) + diff --git a/legacy/embryo/COPYING b/legacy/embryo/COPYING new file mode 100644 index 0000000000..474fcc5faa --- /dev/null +++ b/legacy/embryo/COPYING @@ -0,0 +1,28 @@ +Copyright (C) 2000 Carsten Haitzler and various contributors (see AUTHORS) + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to +deal in the Software without restriction, including without limitation the +rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +sell copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies of the Software and its Copyright notices. In addition publicly +documented acknowledgment must be given that this software has been used if no +source code of this software is made available publicly. This includes +acknowledgments in either Copyright notices, Manuals, Publicity and Marketing +documents or any documentation provided with any product containing this +software. This License does not apply to any software that links to the +libraries provided by this software (statically or dynamically), but only to +the software provided. + +Please see the COPYING.PLAIN for a plain-english explanation of this notice +and it's intent. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/legacy/embryo/COPYING-PLAIN b/legacy/embryo/COPYING-PLAIN new file mode 100644 index 0000000000..376875e868 --- /dev/null +++ b/legacy/embryo/COPYING-PLAIN @@ -0,0 +1,33 @@ +Plain English Copyright Notice + +This file is not intended to be the actual License. The reason this file +exists is that we here are programmers and engineers. We aren't lawyers. We +provide licenses that we THINK say the right things, but we have our own +intentions at heart. This is a plain-english explanation of what those +intentions are, and if you follow them you will be within the "spirit" of +the license. + +The intent is for us to enjoy writing software that is useful to us (the +AUTHORS) and allow others to use it freely and also benefit from the work we +put into making it. We don't want to restrict others using it. They should +not *HAVE* to make the source code of the applications they write that +simply link to these libraries (be that statically or dynamically), or for +them to be limited as to what license they choose to use (be it open, closed +or anything else). But we would like to know you are using these libraries. +We simply would like to know that it has been useful to someone. This is why +we ask for acknowledgement of some sort. + +You can do what you want with the source of this software - it doesn't +matter. We still have it here for ourselves and it is open and free to use +and download and play with. It can't be taken away. We don't really mind what +you do with the source to your software. We would simply like to know that +you are using it - especially if it makes it to a commerical product. If you +simply e-mail all the AUTHORS (see COPYING and AUTHORS files) telling us, and +then make sure you include a paragraph or page in the manual for the product +with the copyright notice and state that you used this software, we will be +very happy. If you want to contribute back modifications and fixes you may have +made we will welcome those too with open arms (generally). If you want help +with changes needed, ports needed or features to be added, arrangements can +be easily made with some dialogue. + +Carsten Haitzler diff --git a/legacy/embryo/ChangeLog b/legacy/embryo/ChangeLog new file mode 100644 index 0000000000..e69de29bb2 diff --git a/legacy/embryo/Doxyfile b/legacy/embryo/Doxyfile new file mode 100644 index 0000000000..ba040ec825 --- /dev/null +++ b/legacy/embryo/Doxyfile @@ -0,0 +1,145 @@ +PROJECT_NAME = Embryo +PROJECT_NUMBER = +OUTPUT_DIRECTORY = doc +INPUT = embryo.c +IMAGE_PATH = doc/img +OUTPUT_LANGUAGE = English +GENERATE_HTML = YES +HTML_OUTPUT = html +HTML_FILE_EXTENSION = .html +HTML_HEADER = doc/head.html +HTML_FOOTER = doc/foot.html +HTML_STYLESHEET = doc/embryo.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 = NO +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 +DETAILS_AT_TOP = 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 = NO +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 = +MAX_DOT_GRAPH_WIDTH = 512 +MAX_DOT_GRAPH_HEIGHT = 512 +GENERATE_LEGEND = YES +DOT_CLEANUP = YES +SEARCHENGINE = NO +CGI_NAME = search.cgi +CGI_URL = +DOC_URL = +DOC_ABSPATH = +BIN_ABSPATH = /usr/bin/ +EXT_DOC_PATHS = diff --git a/legacy/embryo/INSTALL b/legacy/embryo/INSTALL new file mode 100644 index 0000000000..348d00976c --- /dev/null +++ b/legacy/embryo/INSTALL @@ -0,0 +1,14 @@ +COMPILING and INSTALLING: + +If you got a official release tar archive do: + ./configure + +( otherwise if you got this from enlightenment cvs do: ./autogen.sh ) + +Then to compile: + make + +To install (run this as root, or the user who handles installs): + make install + +NOTE: You MUST make install Embryo for it to run properly. diff --git a/legacy/embryo/Makefile.am b/legacy/embryo/Makefile.am new file mode 100644 index 0000000000..5d1b062c46 --- /dev/null +++ b/legacy/embryo/Makefile.am @@ -0,0 +1,24 @@ +## Process this file with automake to produce Makefile.in + +SUBDIRS = src + +MAINTAINERCLEANFILES = Makefile.in aclocal.m4 config.guess \ + config.h.in config.sub configure install-sh \ + ltconfig ltmain.sh missing mkinstalldirs \ + stamp-h.in embryo_docs.tar embryo_docs.tar.gz embryo.c + +dist-hook: + ./gendoc; \ + tar cvf embryo_docs.tar doc/html doc/latex doc/man; \ + rm -f embryo_docs.tar.gz; \ + gzip -9 embryo_docs.tar; + +bin_SCRIPTS = embryo-config + +EXTRA_DIST = README AUTHORS COPYING COPYING-PLAIN embryo.spec embryo.c.in \ + gendoc Doxyfile embryo_docs.tar.gz embryo.pc.in \ + make_cross_compile_arm.sh + +pkgconfigdir = $(libdir)/pkgconfig +pkgconfig_DATA = embryo.pc + diff --git a/legacy/embryo/NEWS b/legacy/embryo/NEWS new file mode 100644 index 0000000000..e69de29bb2 diff --git a/legacy/embryo/README b/legacy/embryo/README new file mode 100644 index 0000000000..b212e2e1a7 --- /dev/null +++ b/legacy/embryo/README @@ -0,0 +1 @@ +Embryo 0.0.1 diff --git a/legacy/embryo/autogen.sh b/legacy/embryo/autogen.sh new file mode 100755 index 0000000000..9226176c74 --- /dev/null +++ b/legacy/embryo/autogen.sh @@ -0,0 +1,137 @@ +#!/bin/sh +# Run this to generate all the initial makefiles, etc. + +srcdir=`dirname $0` +PKG_NAME="the package." + +DIE=0 + +(autoconf --version) < /dev/null > /dev/null 2>&1 || { + echo + echo "**Error**: You must have \`autoconf' installed to." + echo "Download the appropriate package for your distribution," + echo "or get the source tarball at ftp://ftp.gnu.org/pub/gnu/" + DIE=1 +} + +(grep "^AM_PROG_LIBTOOL" $srcdir/configure.in >/dev/null) && { + (libtool --version) < /dev/null > /dev/null 2>&1 || { + echo + echo "**Error**: You must have \`libtool' installed." + echo "Get ftp://ftp.gnu.org/pub/gnu/libtool-1.2d.tar.gz" + echo "(or a newer version if it is available)" + DIE=1 + } +} + +grep "^AM_GNU_GETTEXT" $srcdir/configure.in >/dev/null && { + grep "sed.*POTFILES" $srcdir/configure.in >/dev/null || \ + (gettext --version) < /dev/null > /dev/null 2>&1 || { + echo + echo "**Error**: You must have \`gettext' installed." + echo "Get ftp://alpha.gnu.org/gnu/gettext-0.10.35.tar.gz" + echo "(or a newer version if it is available)" + DIE=1 + } +} + +(automake --version) < /dev/null > /dev/null 2>&1 || { + echo + echo "**Error**: You must have \`automake' installed." + echo "Get ftp://ftp.gnu.org/pub/gnu/automake-1.3.tar.gz" + echo "(or a newer version if it is available)" + DIE=1 + NO_AUTOMAKE=yes +} + + +# if no automake, don't bother testing for aclocal +test -n "$NO_AUTOMAKE" || (aclocal --version) < /dev/null > /dev/null 2>&1 || { + echo + echo "**Error**: Missing \`aclocal'. The version of \`automake'" + echo "installed doesn't appear recent enough." + echo "Get ftp://ftp.gnu.org/pub/gnu/automake-1.3.tar.gz" + echo "(or a newer version if it is available)" + DIE=1 +} + +if test "$DIE" -eq 1; then + exit 1 +fi + +if test -z "$*"; then + echo "**Warning**: I am going to run \`configure' with no arguments." + echo "If you wish to pass any to it, please specify them on the" + echo \`$0\'" command line." + echo +fi + +case $CC in +xlc ) + am_opt=--include-deps;; +esac + +for coin in `find $srcdir -name configure.in -print` +do + dr=`dirname $coin` + if test -f $dr/NO-AUTO-GEN; then + echo skipping $dr -- flagged as no auto-gen + else + echo processing $dr + macrodirs=`sed -n -e 's,AM_ACLOCAL_INCLUDE(\(.*\)),\1,gp' < $coin` + ( cd $dr + aclocalinclude="$ACLOCAL_FLAGS" + for k in $macrodirs; do + if test -d $k; then + aclocalinclude="$aclocalinclude -I $k" + ##else + ## echo "**Warning**: No such directory \`$k'. Ignored." + fi + done + if grep "^AM_GNU_GETTEXT" configure.in >/dev/null; then + if grep "sed.*POTFILES" configure.in >/dev/null; then + : do nothing -- we still have an old unmodified configure.in + else + echo "Creating $dr/aclocal.m4 ..." + test -r $dr/aclocal.m4 || touch $dr/aclocal.m4 + echo "Running gettextize... Ignore non-fatal messages." + echo "no" | gettextize --force --copy + echo "Making $dr/aclocal.m4 writable ..." + test -r $dr/aclocal.m4 && chmod u+w $dr/aclocal.m4 + fi + fi + if grep "^AM_GNOME_GETTEXT" configure.in >/dev/null; then + echo "Creating $dr/aclocal.m4 ..." + test -r $dr/aclocal.m4 || touch $dr/aclocal.m4 + echo "Running gettextize... Ignore non-fatal messages." + echo "no" | gettextize --force --copy + echo "Making $dr/aclocal.m4 writable ..." + test -r $dr/aclocal.m4 && chmod u+w $dr/aclocal.m4 + fi + if grep "^AM_PROG_LIBTOOL" configure.in >/dev/null; then + echo "Running libtoolize..." + libtoolize --force --copy + fi + echo "Running aclocal $aclocalinclude ..." + aclocal $aclocalinclude + if grep "^AM_CONFIG_HEADER" configure.in >/dev/null; then + echo "Running autoheader..." + autoheader + fi + echo "Running automake --gnu $am_opt ..." + automake --add-missing --gnu $am_opt + echo "Running autoconf ..." + autoconf + ) + fi +done + +#conf_flags="--enable-maintainer-mode --enable-compile-warnings" #--enable-iso-c + +if test x$NOCONFIGURE = x; then + echo Running $srcdir/configure $conf_flags "$@" ... + $srcdir/configure $conf_flags "$@" \ + && echo Now type \`make\' to compile $PKG_NAME +else + echo Skipping configure process. +fi diff --git a/legacy/embryo/configure.in b/legacy/embryo/configure.in new file mode 100644 index 0000000000..b7559471c4 --- /dev/null +++ b/legacy/embryo/configure.in @@ -0,0 +1,85 @@ +dnl Process this file with autoconf to produce a configure script. + +# get rid of that stupid cache mechanism +rm -f config.cache + +AC_INIT(configure.in) +AC_CANONICAL_BUILD +AC_CANONICAL_HOST +AC_CANONICAL_TARGET +AC_ISC_POSIX +AM_INIT_AUTOMAKE(embryo, 0.0.1) +AM_CONFIG_HEADER(config.h) + +AC_PROG_CC +AM_PROG_CC_STDC +AC_HEADER_STDC +AC_C_CONST +AM_ENABLE_SHARED +AM_PROG_LIBTOOL + +if test "x${exec_prefix}" = "xNONE"; then + if test "x${prefix}" = "xNONE"; then + bindir="${ac_default_prefix}/bin"; + else + bindir="${prefix}/bin"; + fi +else + if test "x${prefix}" = "xNONE"; then + bindir="${ac_default_prefix}/bin"; + else + bindir="${prefix}/bin"; + fi +fi + +if test "x${exec_prefix}" = "xNONE"; then + if test "x${prefix}" = "xNONE"; then + libdir="${ac_default_prefix}/lib"; + else + libdir="${prefix}/lib"; + fi +else + if test "x${prefix}" = "xNONE"; then + libdir="${ac_default_prefix}/lib"; + else + libdir="${prefix}/lib"; + fi +fi + +dnl Set PACKAGE_BIN_DIR in config.h. +if test "x${bindir}" = 'xNONE'; then + if test "x${prefix}" = "xNONE"; then + AC_DEFINE_UNQUOTED(PACKAGE_BIN_DIR, "${ac_default_prefix}/bin", [Installation directory for user executables]) + else + AC_DEFINE_UNQUOTED(PACKAGE_BIN_DIR, "${prefix}/bin", [Installation directory for user executables]) + fi +else + AC_DEFINE_UNQUOTED(PACKAGE_BIN_DIR, "${bindir}", [Installation directory for user executables]) +fi + +dnl Set PACKAGE_LIB_DIR in config.h. +if test "x${libdir}" = 'xNONE'; then + if test "x${prefix}" = "xNONE"; then + AC_DEFINE_UNQUOTED(PACKAGE_LIB_DIR, "${ac_default_prefix}/lib", [Installation directory for libraries] ) + else + AC_DEFINE_UNQUOTED(PACKAGE_LIB_DIR, "${prefix}/lib", [Installation directory for libraries]) + fi +else + AC_DEFINE_UNQUOTED(PACKAGE_LIB_DIR, "${libdir}", [Installation directory for libraries]) +fi + +dnl Set PACKAGE_SOURCE_DIR in config.h. +packagesrcdir=`cd $srcdir && pwd` +AC_DEFINE_UNQUOTED(PACKAGE_SOURCE_DIR, "${packagesrcdir}", [Source code directory]) + +AC_OUTPUT([ +Makefile +embryo.pc +src/Makefile +src/lib/Makefile +src/bin/Makefile +embryo-config +],[ +chmod +x embryo-config +touch embryo_docs.tar.gz +]) diff --git a/legacy/embryo/doc/embryo.css b/legacy/embryo/doc/embryo.css new file mode 100644 index 0000000000..6117b397ba --- /dev/null +++ b/legacy/embryo/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/legacy/embryo/doc/foot.html b/legacy/embryo/doc/foot.html new file mode 100644 index 0000000000..308b1d01b6 --- /dev/null +++ b/legacy/embryo/doc/foot.html @@ -0,0 +1,2 @@ + + diff --git a/legacy/embryo/doc/head.html b/legacy/embryo/doc/head.html new file mode 100644 index 0000000000..cb873ae9d2 --- /dev/null +++ b/legacy/embryo/doc/head.html @@ -0,0 +1,19 @@ + + + + +$title + + + + + +
+ + + + +
E +E : M : B : R : Y : O +E
+
diff --git a/legacy/embryo/doc/img/embryo.png b/legacy/embryo/doc/img/embryo.png new file mode 100644 index 0000000000..47597a8d44 Binary files /dev/null and b/legacy/embryo/doc/img/embryo.png differ diff --git a/legacy/embryo/doc/img/embryo_big.png b/legacy/embryo/doc/img/embryo_big.png new file mode 100644 index 0000000000..cd818f75b1 Binary files /dev/null and b/legacy/embryo/doc/img/embryo_big.png differ diff --git a/legacy/embryo/doc/img/embryo_mini.png b/legacy/embryo/doc/img/embryo_mini.png new file mode 100644 index 0000000000..f4f99f0fa3 Binary files /dev/null and b/legacy/embryo/doc/img/embryo_mini.png differ diff --git a/legacy/embryo/doc/img/embryo_small.png b/legacy/embryo/doc/img/embryo_small.png new file mode 100644 index 0000000000..8bea36784e Binary files /dev/null and b/legacy/embryo/doc/img/embryo_small.png differ diff --git a/legacy/embryo/doc/img/hilite.png b/legacy/embryo/doc/img/hilite.png new file mode 100644 index 0000000000..88a43816ea Binary files /dev/null and b/legacy/embryo/doc/img/hilite.png differ diff --git a/legacy/embryo/embryo-config.in b/legacy/embryo/embryo-config.in new file mode 100644 index 0000000000..0cb4e231b4 --- /dev/null +++ b/legacy/embryo/embryo-config.in @@ -0,0 +1,59 @@ +#!/bin/sh + +prefix=@prefix@ +exec_prefix=@exec_prefix@ +exec_prefix_set=no + +usage="\ +Usage: embryo-config [--prefix[=DIR]] [--exec-prefix[=DIR]] [--version] [--libs] [--cflags]" + +if test $# -eq 0; then + echo "${usage}" 1>&2 + exit 1 +fi + +while test $# -gt 0; do + case "$1" in + -*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) optarg= ;; + esac + + case $1 in + --prefix=*) + prefix=$optarg + if test $exec_prefix_set = no ; then + exec_prefix=$optarg + fi + ;; + --prefix) + echo $prefix + ;; + --exec-prefix=*) + exec_prefix=$optarg + exec_prefix_set=yes + ;; + --exec-prefix) + echo $exec_prefix + ;; + --version) + echo @VERSION@ + ;; + --cflags) + if test @includedir@ != /usr/include ; then + includes=-I@includedir@ + fi + echo $includes + ;; + --libs) + libdirs=-L@libdir@ + echo $libdirs -lembryo -lm + ;; + *) + echo "${usage}" 1>&2 + exit 1 + ;; + esac + shift +done + +exit 0 diff --git a/legacy/embryo/embryo.c.in b/legacy/embryo/embryo.c.in new file mode 100644 index 0000000000..75457078cc --- /dev/null +++ b/legacy/embryo/embryo.c.in @@ -0,0 +1,30 @@ +/** +@file +@brief Embryo virtual machine library & compiler + +These routines are used for Embryo library interaction +*/ + +/** + +@mainpage Embryo Library Documentation +@image html embryo.png +@version 0.0.1 +@author Carsten Haitzler +@date 2004 + + + + + +@section intro What is Embryo? + +It is a tiny library designed interpret limited small programs compiled by the +included scmall compiler. This is mostly cleaning up and reduction in size of +the original small abstract machine. the compiler itself has been left alone +almost completely. + +@todo Document it all +@todo Clean up compiler code. + +*/ diff --git a/legacy/embryo/embryo.pc.in b/legacy/embryo/embryo.pc.in new file mode 100644 index 0000000000..57a0ec8840 --- /dev/null +++ b/legacy/embryo/embryo.pc.in @@ -0,0 +1,11 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ + +Name: embryo +Description: embryo +Version: @VERSION@ +Libs: -L${libdir} -lembryo -lm +Cflags: -I${includedir} + diff --git a/legacy/embryo/embryo.spec b/legacy/embryo/embryo.spec new file mode 100644 index 0000000000..fb1e82bd1c --- /dev/null +++ b/legacy/embryo/embryo.spec @@ -0,0 +1,80 @@ +# Note that this is NOT a relocatable package +%define ver 0.0.1 +%define rel 1 +%define prefix /usr + +Summary: embryo +Name: embryo +Version: %ver +Release: %rel +Copyright: BSD +Group: System Environment/Libraries +Source: ftp://ftp.enlightenment.org/pub/embryo/embryo-%{ver}.tar.gz +BuildRoot: /var/tmp/embryo-root +Packager: The Rasterman +URL: http://www.enlightenment.org/ + +Docdir: %{prefix}/doc + +%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 + +%prep +rm -rf $RPM_BUILD_ROOT + +%setup -q + +%build +./configure --prefix=%prefix + +if [ "$SMP" != "" ]; then + (make "MAKE=make -k -j $SMP"; exit 0) + make +else + make +fi +########################################################################### + +%install +make DESTDIR=$RPM_BUILD_ROOT install + +%clean +rm -rf $RPM_BUILD_ROOT + +%post +/sbin/ldconfig + +%postun +/sbin/ldconfig + +%files +%defattr(-,root,root) +%attr(755,root,root) %{prefix}/lib/libembryo.so.* +%{prefix}/lib/libembryo.la +%attr(755,root,root) %{prefix}/bin/embryo_cc +%attr(755,root,root) %{prefix}/bin/embryo + +%files devel +%attr(755,root,root) %{prefix}/lib/libembryo.so +%attr(755,root,root) %{prefix}/lib/libembryo.a +%attr(755,root,root) %{prefix}/bin/embryo-config +%{prefix}/lib/pkgconfig/embryo.pc +%{prefix}/include/Embryo* +%doc AUTHORS +%doc COPYING +%doc README +%doc embryo_docs.tar.gz + +%changelog +* Sat Jun 23 2001 The Rasterman +- Created spec file diff --git a/legacy/embryo/gendoc b/legacy/embryo/gendoc new file mode 100755 index 0000000000..d1bef2dbe4 --- /dev/null +++ b/legacy/embryo/gendoc @@ -0,0 +1,12 @@ +#!/bin/sh +cp ./embryo.c.in ./embryo.c +for I in `find ./src/lib -name "*.c" -print`; do + cat $I >> ./embryo.c +done +rm -rf ./doc/html ./doc/latex ./doc/man +doxygen +cp doc/img/*.png doc/html/ +rm -f embryo_docs.tar embryo_docs.tar.gz +tar -cvf embryo_docs.tar doc/html doc/man doc/latex +gzip -9 embryo_docs.tar +exit 0 diff --git a/legacy/embryo/make_cross_compile_arm.sh b/legacy/embryo/make_cross_compile_arm.sh new file mode 100755 index 0000000000..e7dbfe961e --- /dev/null +++ b/legacy/embryo/make_cross_compile_arm.sh @@ -0,0 +1,75 @@ +#!/bin/sh + +PROJ="embryo" + +SKIFF="/skiff/local" +HOSTARCH="i686-pc-linux-gnu" +TARGETCPU="arm" +TARGETARCH=$TARGETCPU"-pc-linux-gnu" + +make clean distclean +export CC=$SKIFF"/bin/"$TARGETCPU"-linux-gcc" +export CFLAGS=-O9 +./configure \ +--host=$HOSTARCH \ +--build=$TARGETARCH \ +--target=$TARGETARCH + +INST="/tmp/"$PROJ"-instroot" +sudo rm -rf $INST + +make + +for I in find . -name "*.la" -print; do + sed s:"/usr/local":$INST:g < $I > "/tmp/.sed.tmp" + sudo cp "/tmp/.sed.tmp" $I + rm -f "/tmp/.sed.tmp" +done + +sudo \ +make \ +prefix=$INST \ +exec_prefix=$INST \ +bindir=$INST"/bin" \ +sbindir=$INST"/sbin" \ +sysconfdir=$INST"/etc" \ +datadir=$INST"/share" \ +includedir=$INST"/include" \ +libdir=$INST"/lib" \ +libexecdir=$INST"/libexec" \ +localstatedir=$INST"/var/run" \ +mandir=$INST"/share/man" \ +infodir=$INST"/share/info" \ +install + +## FIXUPS +for I in $INST"/bin/"* $INST"/sbin/"* $INST"/libexec/"*; do + J=`echo $I | sed s:$TARGETARCH"-"::g` + sudo mv $I $J +done + +CF=$INST"/bin/"$PROJ"-config" +sed s:"/usr/local":$SKIFF"/"$TARGETCPU"-linux":g < $CF > "/tmp/.sed.tmp" +sudo cp "/tmp/.sed.tmp" $CF +rm -f "/tmp/.sed.tmp" + +for I in $INST"/lib/"*.la; do + sed s:"/usr/local":$SKIFF"/"$TARGETCPU"-linux":g < $I > "/tmp/.sed.tmp" + sudo cp "/tmp/.sed.tmp" $I + rm -f "/tmp/.sed.tmp" +done + +## package it all up +PACK=$PROJ"-"$TARGETCPU"-inst.tar.gz" + +DIR=$PWD +cd $INST +sudo tar zcvf $DIR"/"$PACK * +sudo chown $USER $DIR"/"$PACK +cd $DIR +sudo rm -rf $INST + +## install it in our skiff tree +cd $SKIFF"/"$TARGETCPU"-linux" +sudo tar zxvf $DIR"/"$PACK + diff --git a/legacy/embryo/src/Makefile.am b/legacy/embryo/src/Makefile.am new file mode 100644 index 0000000000..7b45af65b2 --- /dev/null +++ b/legacy/embryo/src/Makefile.am @@ -0,0 +1,3 @@ +## Process this file with automake to produce Makefile.in + +SUBDIRS = lib bin diff --git a/legacy/embryo/src/bin/Makefile.am b/legacy/embryo/src/bin/Makefile.am new file mode 100644 index 0000000000..0112254d76 --- /dev/null +++ b/legacy/embryo/src/bin/Makefile.am @@ -0,0 +1,34 @@ +## Process this file with automake to produce Makefile.in + +INCLUDES = -DLINUX -I$(top_srcdir)/src/lib + +bin_PROGRAMS = embryo embryo_cc + +embryo_SOURCES = \ +embryo_main.c + +embryo_LDADD = $(top_builddir)/src/lib/libembryo.la +embryo_DEPENDENCIES = $(top_builddir)/src/lib/libembryo.la + +embryo_cc_SOURCES = \ +embryo_cc_amx.h \ +embryo_cc_osdefs.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_sclinux.h \ +embryo_cc_sclist.c \ +embryo_cc_scvars.c + +embryo_cc_LDADD = +embryo_cc_DEPENDENCIES = + +EXTRA_DIST = \ +embryo_cc_sc5.scp \ +embryo_cc_sc7.scp diff --git a/legacy/embryo/src/bin/embryo_cc_amx.h b/legacy/embryo/src/bin/embryo_cc_amx.h new file mode 100644 index 0000000000..37b2ace394 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_amx.h @@ -0,0 +1,349 @@ +/* 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$ + */ + +#if defined LINUX + #include +#endif + +#ifndef __AMX_H +#define __AMX_H + +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L + /* The ISO C99 defines the int16_t and int_32t types. If the compiler got + * here, these types are probably undefined. + */ + #if defined __LCC__ || defined LINUX + #include + #else + typedef short int int16_t; + typedef unsigned short int uint16_t; + #if defined SN_TARGET_PS2 + typedef int int32_t; + typedef unsigned int uint32_t; + #else + typedef long int int32_t; + typedef unsigned long int uint32_t; + #endif + #endif +#endif + +#if defined __WIN32__ || defined _WIN32 || defined WIN32 || defined __MSDOS__ + #if !defined alloca + #define alloca(n) _alloca(n) + #endif +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* calling convention for native functions */ +#if !defined AMX_NATIVE_CALL + #define AMX_NATIVE_CALL +#endif +/* calling convention for all interface functions and callback functions */ +#if !defined AMXAPI + #if defined STDECL + #define AMXAPI __stdcall + #elif defined CDECL + #define AMXAPI __cdecl + #else + #define AMXAPI + #endif +#endif +#if !defined AMXEXPORT + #define AMXEXPORT +#endif + +/* 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 + #if defined(BIT16) + typedef uint16_t ucell; /* only for type casting */ + typedef int16_t cell; + #else + typedef uint32_t ucell; + typedef int32_t cell; + #endif +#endif + +struct tagAMX; +typedef cell (AMX_NATIVE_CALL *AMX_NATIVE)(struct tagAMX *amx, cell *params); +typedef int (AMXAPI *AMX_CALLBACK)(struct tagAMX *amx, cell index, + cell *result, cell *params); +typedef int (AMXAPI *AMX_DEBUG)(struct tagAMX *amx); +#if !defined _FAR + #define _FAR +#endif + +#if defined _MSC_VER + #pragma warning(disable:4103) /* disable warning message 4103 that complains + * about pragma pack in a header file */ + #pragma warning(disable:4100) /* "'%$S' : unreferenced formal parameter" */ +#endif + +/* Some compilers do not support the #pragma align, which should be fine. Some + * compilers give a warning on unknown #pragmas, which is not so fine... + */ +#if defined SN_TARGET_PS2 || defined __GNUC__ + #define AMX_NO_ALIGN +#endif + +#if defined __GNUC__ + #define PACKED __attribute__((packed)) +#else + #define PACKED +#endif + +#if !defined AMX_NO_ALIGN + #if defined LINUX + #pragma pack(1) /* structures must be packed (byte-aligned) */ + #else + #pragma pack(push) + #pragma pack(1) /* structures must be packed (byte-aligned) */ + #if defined __TURBOC__ + #pragma option -a- /* "pack" pragma for older Borland compilers */ + #endif + #endif +#endif + +typedef struct { + char _FAR *name PACKED; + AMX_NATIVE func PACKED; +} AMX_NATIVE_INFO PACKED; + +#define AMX_USERNUM 4 +#define sEXPMAX 19 /* maximum name length for file version <= 6 */ +#define sNAMEMAX 31 /* maximum name length of symbol name */ + +typedef struct tagAMX_FUNCSTUB { + uint32_t address PACKED; + char name[sEXPMAX+1] PACKED; +} AMX_FUNCSTUB PACKED; + +/* 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 _FAR *base PACKED; /* points to the AMX header ("amxhdr") plus the code, optionally also the data */ + unsigned char _FAR *data PACKED; /* points to separate data+stack+heap, may be NULL */ + AMX_CALLBACK callback PACKED; + AMX_DEBUG debug PACKED; /* debug callback */ + /* for external functions a few registers must be accessible from the outside */ + cell cip PACKED; /* instruction pointer: relative to base + amxhdr->cod */ + cell frm PACKED; /* stack frame base: relative to base + amxhdr->dat */ + cell hea PACKED; /* top of the heap: relative to base + amxhdr->dat */ + cell hlw PACKED; /* bottom of the heap: relative to base + amxhdr->dat */ + cell stk PACKED; /* stack pointer: relative to base + amxhdr->dat */ + cell stp PACKED; /* top of the stack: relative to base + amxhdr->dat */ + int flags PACKED; /* current status, see amx_Flags() */ + /* for assertions and debug hook */ + cell curline PACKED; + cell curfile PACKED; + int dbgcode PACKED; + cell dbgaddr PACKED; + cell dbgparam PACKED; + char _FAR *dbgname PACKED; + /* user data */ + long usertags[AMX_USERNUM] PACKED; + void _FAR *userdata[AMX_USERNUM] PACKED; + /* native functions can raise an error */ + int error PACKED; + /* the sleep opcode needs to store the full AMX status */ + cell pri PACKED; + cell alt PACKED; + cell reset_stk PACKED; + cell reset_hea PACKED; + cell _FAR *syscall_d PACKED; /* relocated value/address for the SYSCALL.D opcode */ + #if defined JIT + /* support variables for the JIT */ + int reloc_size PACKED; /* required temporary buffer for relocations */ + long code_size PACKED; /* estimated memory footprint of the native code */ + #endif +} AMX PACKED; + +/* The AMX_HEADER structure is both the memory format as the file format. The + * structure is used internaly. + */ +typedef struct tagAMX_HEADER { + int32_t size PACKED; /* size of the "file" */ + uint16_t magic PACKED; /* signature */ + char file_version PACKED; /* file format version */ + char amx_version PACKED; /* required version of the AMX */ + int16_t flags PACKED; + int16_t defsize PACKED; /* size of a definition record */ + int32_t cod PACKED; /* initial value of COD - code block */ + int32_t dat PACKED; /* initial value of DAT - data block */ + int32_t hea PACKED; /* initial value of HEA - start of the heap */ + int32_t stp PACKED; /* initial value of STP - stack top */ + int32_t cip PACKED; /* initial value of CIP - the instruction pointer */ + int32_t publics PACKED; /* offset to the "public functions" table */ + int32_t natives PACKED; /* offset to the "native functions" table */ + int32_t libraries PACKED; /* offset to the table of libraries */ + int32_t pubvars PACKED; /* the "public variables" table */ + int32_t tags PACKED; /* the "public tagnames" table */ + int32_t nametable PACKED; /* name table, file version 7 only */ +} AMX_HEADER PACKED; +#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)) != NULL) \ + amx_GetString((result), amx_cstr_); \ + else (result) = NULL; \ +} + +uint16_t * AMXAPI amx_Align16(uint16_t *v); +uint32_t * AMXAPI amx_Align32(uint32_t *v); +int AMXAPI amx_Allot(AMX *amx, int cells, cell *amx_addr, cell **phys_addr); +int AMXAPI amx_Callback(AMX *amx, cell index, cell *result, cell *params); +int AMXAPI amx_Cleanup(AMX *amx); +int AMXAPI amx_Clone(AMX *amxClone, AMX *amxSource, void *data); +int AMXAPI amx_Debug(AMX *amx); /* default debug procedure, does nothing */ +int AMXAPI amx_Exec(AMX *amx, cell *retval, int index, int numparams, ...); +int AMXAPI amx_Execv(AMX *amx, cell *retval, int index, int numparams, cell params[]); +int AMXAPI amx_FindNative(AMX *amx, char *name, int *index); +int AMXAPI amx_FindPublic(AMX *amx, char *funcname, int *index); +int AMXAPI amx_FindPubVar(AMX *amx, char *varname, cell *amx_addr); +int AMXAPI amx_FindTagId(AMX *amx, cell tag_id, char *tagname); +int AMXAPI amx_Flags(AMX *amx,uint16_t *flags); +int AMXAPI amx_GetAddr(AMX *amx,cell amx_addr,cell **phys_addr); +int AMXAPI amx_GetNative(AMX *amx, int index, char *funcname); +int AMXAPI amx_GetPublic(AMX *amx, int index, char *funcname); +int AMXAPI amx_GetPubVar(AMX *amx, int index, char *varname, cell *amx_addr); +int AMXAPI amx_GetString(char *dest,cell *source); +int AMXAPI amx_GetTag(AMX *amx, int index, char *tagname, cell *tag_id); +int AMXAPI amx_GetUserData(AMX *amx, long tag, void **ptr); +int AMXAPI amx_Init(AMX *amx, void *program); +int AMXAPI amx_InitJIT(AMX *amx, void *reloc_table, void *native_code); +int AMXAPI amx_MemInfo(AMX *amx, long *codesize, long *datasize, long *stackheap); +int AMXAPI amx_NameLength(AMX *amx, int *length); +AMX_NATIVE_INFO * AMXAPI amx_NativeInfo(char *name,AMX_NATIVE func); +int AMXAPI amx_NumNatives(AMX *amx, int *number); +int AMXAPI amx_NumPublics(AMX *amx, int *number); +int AMXAPI amx_NumPubVars(AMX *amx, int *number); +int AMXAPI amx_NumTags(AMX *amx, int *number); +int AMXAPI amx_RaiseError(AMX *amx, int error); +int AMXAPI amx_Register(AMX *amx, AMX_NATIVE_INFO *nativelist, int number); +int AMXAPI amx_Release(AMX *amx, cell amx_addr); +int AMXAPI amx_SetCallback(AMX *amx, AMX_CALLBACK callback); +int AMXAPI amx_SetDebugHook(AMX *amx, AMX_DEBUG debug); +int AMXAPI amx_SetString(cell *dest, char *source, int pack); +int AMXAPI amx_SetUserData(AMX *amx, long tag, void *ptr); +char * AMXAPI amx_StrError(int errnum); +int AMXAPI amx_StrLen(cell *cstring, int *length); + + +#if !defined AMX_NO_ALIGN + #if defined LINUX + #pragma pack() /* reset default packing */ + #else + #pragma pack(pop) /* reset previous packing */ + #endif +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* __AMX_H */ diff --git a/legacy/embryo/src/bin/embryo_cc_osdefs.h b/legacy/embryo/src/bin/embryo_cc_osdefs.h new file mode 100644 index 0000000000..8eb99f8cac --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_osdefs.h @@ -0,0 +1,84 @@ +/* __MSDOS__ set when compiling for DOS (not Windows) + * _Windows set when compiling for any version of Microsoft Windows + * __WIN32__ set when compiling for Windows95 or WindowsNT (32 bit mode) + * __32BIT__ set when compiling in 32-bit "flat" mode (DOS or Windows) + * + * Copyright 1998-2003, ITB CompuPhase, The Netherlands. + * info@compuphase.com. + */ + +#ifndef _OSDEFS_H +#define _OSDEFS_H + +/* Every compiler uses different "default" macros to indicate the mode + * it is in. Throughout the source, we use the Borland C++ macros, so + * the macros of Watcom C/C++ and Microsoft Visual C/C++ are mapped to + * those of Borland C++. + */ +#if defined(__WATCOMC__) +# if defined(__WINDOWS__) || defined(__NT__) +# define _Windows 1 +# endif +# ifdef __386__ +# define __32BIT__ 1 +# endif +# if defined(_Windows) && defined(__32BIT__) +# define __WIN32__ 1 +# endif +#elif defined(_MSC_VER) +# if defined(_WINDOWS) || defined(_WIN32) +# define _Windows 1 +# endif +# ifdef _WIN32 +# define __WIN32__ 1 +# define __32BIT__ 1 +# endif +#endif + +#if defined LINUX + #include +#endif + +/* Linux NOW has these */ +#if !defined BIG_ENDIAN + #define BIG_ENDIAN 4321 +#endif +#if !defined LITTLE_ENDIAN + #define LITTLE_ENDIAN 1234 +#endif + +/* educated guess, BYTE_ORDER is undefined, i386 is common => little endian */ +#if !defined BYTE_ORDER + #if defined UCLINUX + #define BYTE_ORDER BIG_ENDIAN + #else + #define BYTE_ORDER LITTLE_ENDIAN + #endif +#endif + +/* _MAX_PATH is sometimes called differently and it may be in limits.h instead + * stdio.h. + */ +#if !defined _MAX_PATH + /* not defined, perhaps stdio.h was not included */ + #include + #if !defined _MAX_PATH + /* still undefined, try a common alternative name */ + #if defined MAX_PATH + #define _MAX_PATH MAX_PATH + #else + /* no _MAX_PATH and no MAX_PATH, perhaps it is in limits.h */ + #include + #if defined PATH_MAX + #define _MAX_PATH PATH_MAX + #elif defined _POSIX_PATH_MAX + #define _MAX_PATH _POSIX_PATH_MAX + #else + /* everything failed, actually we have a problem here... */ + #define _MAX_PATH 1024 + #endif + #endif + #endif +#endif + +#endif /* _OSDEFS_H */ diff --git a/legacy/embryo/src/bin/embryo_cc_sc.h b/legacy/embryo/src/bin/embryo_cc_sc.h new file mode 100644 index 0000000000..492df261d7 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc.h @@ -0,0 +1,687 @@ +/* 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 __SC_H +#define __SC_H +#include +#include +#include +#if defined __BORLANDC__ && defined _Windows && !(defined __32BIT__ || defined __WIN32__) + /* setjmp() and longjmp() not well supported in 16-bit windows */ + #include + typedef int jmp_buf[9]; + #define setjmp(b) Catch(b) + #define longjmp(b,e) Throw(b,e) +#else + #include +#endif +#include "embryo_cc_osdefs.h" +#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 */ + +#if defined __MSDOS__ || defined __WIN32__ || defined _Windows + #define DIRSEP_CHAR '\\' +#elif defined macintosh + #define DIRSEP_CHAR ':' +#else + #define DIRSEP_CHAR '/' /* directory separator character */ +#endif + +#define sDIMEN_MAX 2 /* maximum number of array dimensions */ +#define sDEF_LITMAX 500 /* initial size of the literal pool, in "cells" */ +#define sLINEMAX 511 /* 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 void *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]; + uint32_t 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) + + +/* interface functions */ +#if defined __cplusplus + extern "C" { +#endif + +/* + * 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(char *filename); /* read/write */ +void sc_closeasm(void *handle,int deletefile); +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 */ + +#if defined __cplusplus + } +#endif + + +/* by default, functions and variables used in throughout the compiler + * files are "external" + */ +#if !defined SC_FUNC + #define SC_FUNC +#endif +#if !defined SC_VDECL + #define SC_VDECL extern +#endif +#if !defined SC_VDEFINE + #define SC_VDEFINE +#endif + +/* function prototypes in SC1.C */ +SC_FUNC void set_extension(char *filename,char *extension,int force); +SC_FUNC symbol *fetchfunc(char *name,int tag); +SC_FUNC char *operator_symname(char *symname,char *opername,int tag1,int tag2,int numtags,int resulttag); +SC_FUNC char *funcdisplayname(char *dest,char *funcname); +SC_FUNC int constexpr(cell *val,int *tag); +SC_FUNC constvalue *append_constval(constvalue *table,char *name,cell val,short index); +SC_FUNC constvalue *find_constval(constvalue *table,char *name,short index); +SC_FUNC void delete_consttable(constvalue *table); +SC_FUNC void add_constant(char *name,cell val,int vclass,int tag); +SC_FUNC void exporttag(int tag); + +/* function prototypes in SC2.C */ +SC_FUNC void pushstk(stkitem val); +SC_FUNC stkitem popstk(void); +SC_FUNC int plungequalifiedfile(char *name); /* explicit path included */ +SC_FUNC int plungefile(char *name,int try_currentpath,int try_includepaths); /* search through "include" paths */ +SC_FUNC void preprocess(void); +SC_FUNC void lexinit(void); +SC_FUNC int lex(cell *lexvalue,char **lexsym); +SC_FUNC void lexpush(void); +SC_FUNC void lexclr(int clreol); +SC_FUNC int matchtoken(int token); +SC_FUNC int tokeninfo(cell *val,char **str); +SC_FUNC int needtoken(int token); +SC_FUNC void stowlit(cell value); +SC_FUNC int alphanum(char c); +SC_FUNC int ishex(char c); +SC_FUNC void delete_symbol(symbol *root,symbol *sym); +SC_FUNC void delete_symbols(symbol *root,int level,int del_labels,int delete_functions); +SC_FUNC int refer_symbol(symbol *entry,symbol *bywhom); +SC_FUNC void markusage(symbol *sym,int usage); +SC_FUNC uint32_t namehash(char *name); +SC_FUNC symbol *findglb(char *name); +SC_FUNC symbol *findloc(char *name); +SC_FUNC symbol *findconst(char *name); +SC_FUNC symbol *finddepend(symbol *parent); +SC_FUNC symbol *addsym(char *name,cell addr,int ident,int vclass,int tag, + int usage); +SC_FUNC symbol *addvariable(char *name,cell addr,int ident,int vclass,int tag, + int dim[],int numdim,int idxtag[]); +SC_FUNC int getlabel(void); +SC_FUNC char *itoh(ucell val); + +/* function prototypes in SC3.C */ +SC_FUNC int check_userop(void (*oper)(void),int tag1,int tag2,int numparam, + value *lval,int *resulttag); +SC_FUNC int matchtag(int formaltag,int actualtag,int allowcoerce); +SC_FUNC int expression(int *constant,cell *val,int *tag,int chkfuncresult); +SC_FUNC int hier14(value *lval1); /* the highest expression level */ + +/* function prototypes in SC4.C */ +SC_FUNC void writeleader(void); +SC_FUNC void writetrailer(void); +SC_FUNC void begcseg(void); +SC_FUNC void begdseg(void); +SC_FUNC void setactivefile(int fnumber); +SC_FUNC cell nameincells(char *name); +SC_FUNC void setfile(char *name,int fileno); +SC_FUNC void setline(int line,int fileno); +SC_FUNC void setfiledirect(char *name); +SC_FUNC void setlinedirect(int line); +SC_FUNC void setlabel(int index); +SC_FUNC void endexpr(int fullexpr); +SC_FUNC void startfunc(char *fname); +SC_FUNC void endfunc(void); +SC_FUNC void alignframe(int numbytes); +SC_FUNC void defsymbol(char *name,int ident,int vclass,cell offset,int tag); +SC_FUNC void symbolrange(int level,cell size); +SC_FUNC void rvalue(value *lval); +SC_FUNC void address(symbol *ptr); +SC_FUNC void store(value *lval); +SC_FUNC void memcopy(cell size); +SC_FUNC void copyarray(symbol *sym,cell size); +SC_FUNC void fillarray(symbol *sym,cell size,cell value); +SC_FUNC void const1(cell val); +SC_FUNC void const2(cell val); +SC_FUNC void moveto1(void); +SC_FUNC void push1(void); +SC_FUNC void push2(void); +SC_FUNC void pushval(cell val); +SC_FUNC void pop1(void); +SC_FUNC void pop2(void); +SC_FUNC void swap1(void); +SC_FUNC void ffswitch(int label); +SC_FUNC void ffcase(cell value,char *labelname,int newtable); +SC_FUNC void ffcall(symbol *sym,int numargs); +SC_FUNC void ffret(void); +SC_FUNC void ffabort(int reason); +SC_FUNC void ffbounds(cell size); +SC_FUNC void jumplabel(int number); +SC_FUNC void defstorage(void); +SC_FUNC void modstk(int delta); +SC_FUNC void setstk(cell value); +SC_FUNC void modheap(int delta); +SC_FUNC void setheap_pri(void); +SC_FUNC void setheap(cell value); +SC_FUNC void cell2addr(void); +SC_FUNC void cell2addr_alt(void); +SC_FUNC void addr2cell(void); +SC_FUNC void char2addr(void); +SC_FUNC void charalign(void); +SC_FUNC 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 + */ +SC_FUNC void os_mult(void); /* multiplication (signed) */ +SC_FUNC void os_div(void); /* division (signed) */ +SC_FUNC void os_mod(void); /* modulus (signed) */ +SC_FUNC void ob_add(void); /* addition */ +SC_FUNC void ob_sub(void); /* subtraction */ +SC_FUNC void ob_sal(void); /* shift left (arithmetic) */ +SC_FUNC void os_sar(void); /* shift right (arithmetic, signed) */ +SC_FUNC void ou_sar(void); /* shift right (logical, unsigned) */ +SC_FUNC void ob_or(void); /* bitwise or */ +SC_FUNC void ob_xor(void); /* bitwise xor */ +SC_FUNC void ob_and(void); /* bitwise and */ +SC_FUNC void ob_eq(void); /* equality */ +SC_FUNC void ob_ne(void); /* inequality */ +SC_FUNC void relop_prefix(void); +SC_FUNC void relop_suffix(void); +SC_FUNC void os_le(void); /* less or equal (signed) */ +SC_FUNC void os_ge(void); /* greater or equal (signed) */ +SC_FUNC void os_lt(void); /* less (signed) */ +SC_FUNC void os_gt(void); /* greater (signed) */ + +SC_FUNC void lneg(void); +SC_FUNC void neg(void); +SC_FUNC void invert(void); +SC_FUNC void nooperation(void); +SC_FUNC void inc(value *lval); +SC_FUNC void dec(value *lval); +SC_FUNC void jmp_ne0(int number); +SC_FUNC void jmp_eq0(int number); +SC_FUNC void outval(cell val,int newline); + +/* function prototypes in SC5.C */ +SC_FUNC int error(int number,...); +SC_FUNC void errorset(int code); + +/* function prototypes in SC6.C */ +SC_FUNC void assemble(FILE *fout,FILE *fin); + +/* function prototypes in SC7.C */ +SC_FUNC void stgbuffer_cleanup(void); +SC_FUNC void stgmark(char mark); +SC_FUNC void stgwrite(char *st); +SC_FUNC void stgout(int index); +SC_FUNC void stgdel(int index,cell code_index); +SC_FUNC int stgget(int *index,cell *code_index); +SC_FUNC void stgset(int onoff); +SC_FUNC int phopt_init(void); +SC_FUNC int phopt_cleanup(void); + +/* function prototypes in SCLIST.C */ +SC_FUNC char* duplicatestring(const char* sourcestring); +SC_FUNC stringpair *insert_alias(char *name,char *alias); +SC_FUNC stringpair *find_alias(char *name); +SC_FUNC int lookup_alias(char *target,char *name); +SC_FUNC void delete_aliastable(void); +SC_FUNC stringlist *insert_path(char *path); +SC_FUNC char *get_path(int index); +SC_FUNC void delete_pathtable(void); +SC_FUNC stringpair *insert_subst(char *pattern,char *substitution,int prefixlen); +SC_FUNC int get_subst(int index,char **pattern,char **substitution); +SC_FUNC stringpair *find_subst(char *name,int length); +SC_FUNC int delete_subst(char *name,int length); +SC_FUNC void delete_substtable(void); + +/* external variables (defined in scvars.c) */ +#if !defined SC_SKIP_VDECL +SC_VDECL symbol loctab; /* local symbol table */ +SC_VDECL symbol glbtab; /* global symbol table */ +SC_VDECL cell *litq; /* the literal queue */ +SC_VDECL char pline[]; /* the line read from the input file */ +SC_VDECL char *lptr; /* points to the current position in "pline" */ +SC_VDECL constvalue tagname_tab;/* tagname table */ +SC_VDECL constvalue libname_tab;/* library table (#pragma library "..." syntax) */ //??? use "stringlist" type +SC_VDECL constvalue *curlibrary;/* current library */ +SC_VDECL symbol *curfunc; /* pointer to current function */ +SC_VDECL char *inpfname; /* name of the file currently read from */ +SC_VDECL char outfname[]; /* output file name */ +SC_VDECL char errfname[]; /* error file name */ +SC_VDECL char sc_ctrlchar; /* the control character (or escape character) */ +SC_VDECL int litidx; /* index to literal table */ +SC_VDECL int litmax; /* current size of the literal table */ +SC_VDECL int stgidx; /* index to the staging buffer */ +SC_VDECL int labnum; /* number of (internal) labels */ +SC_VDECL int staging; /* true if staging output */ +SC_VDECL cell declared; /* number of local cells declared */ +SC_VDECL cell glb_declared; /* number of global cells declared */ +SC_VDECL cell code_idx; /* number of bytes with generated code */ +SC_VDECL int ntv_funcid; /* incremental number of native function */ +SC_VDECL int errnum; /* number of errors */ +SC_VDECL int warnnum; /* number of warnings */ +SC_VDECL int sc_debug; /* debug/optimization options (bit field) */ +SC_VDECL int charbits; /* number of bits for a character */ +SC_VDECL int sc_packstr; /* strings are packed by default? */ +SC_VDECL int sc_asmfile; /* create .ASM file? */ +SC_VDECL int sc_listing; /* create .LST file? */ +SC_VDECL int sc_compress; /* compress bytecode? */ +SC_VDECL int sc_needsemicolon;/* semicolon required to terminate expressions? */ +SC_VDECL int sc_dataalign; /* data alignment value */ +SC_VDECL int sc_alignnext; /* must frame of the next function be aligned? */ +SC_VDECL int curseg; /* 1 if currently parsing CODE, 2 if parsing DATA */ +SC_VDECL cell sc_stksize; /* stack size */ +SC_VDECL int freading; /* is there an input file ready for reading? */ +SC_VDECL int fline; /* the line number in the current file */ +SC_VDECL int fnumber; /* number of files in the file table (debugging) */ +SC_VDECL int fcurrent; /* current file being processed (debugging) */ +SC_VDECL int intest; /* true if inside a test */ +SC_VDECL int sideeffect; /* true if an expression causes a side-effect */ +SC_VDECL int stmtindent; /* current indent of the statement */ +SC_VDECL int indent_nowarn; /* skip warning "217 loose indentation" */ +SC_VDECL int sc_tabsize; /* number of spaces that a TAB represents */ +SC_VDECL int sc_allowtags; /* allow/detect tagnames in lex() */ +SC_VDECL int sc_status; /* read/write status */ +SC_VDECL int sc_rationaltag; /* tag for rational numbers */ +SC_VDECL int rational_digits; /* number of fractional digits */ + +SC_VDECL FILE *inpf; /* file read from (source or include) */ +SC_VDECL FILE *inpf_org; /* main source file */ +SC_VDECL FILE *outf; /* file written to */ + +SC_VDECL jmp_buf errbuf; /* target of longjmp() on a fatal error */ + +#if !defined SC_LIGHT + SC_VDECL int sc_makereport; /* generate a cross-reference report */ +#endif + +#endif /* SC_SKIP_VDECL */ + +#endif /* __SC_H */ diff --git a/legacy/embryo/src/bin/embryo_cc_sc1.c b/legacy/embryo/src/bin/embryo_cc_sc1.c new file mode 100644 index 0000000000..a1838f1048 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc1.c @@ -0,0 +1,3979 @@ +/* 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$ + */ +#include +#include +#include +#include +#include +#include +#include + +#if defined __WIN32__ || defined _WIN32 || defined __MSDOS__ + #include + #include +#endif + +#if defined LINUX + #include + #include +#endif + +#if defined FORTIFY + #include "fortify.h" +#endif + +#if defined __BORLANDC__ || defined __WATCOMC__ + #include + static unsigned total_drives; /* dummy variable */ + #define dos_setdrive(i) _dos_setdrive(i,&total_drives) +#elif defined _MSC_VER && defined _WIN32 + #include /* for _chdrive() */ + #define dos_setdrive(i) _chdrive(i) +#endif +#if defined __BORLANDC__ + #include /* for chdir() */ +#elif defined __WATCOMC__ + #include /* for chdir() */ +#endif +#if defined __WIN32__ || defined _WIN32 || defined _Windows + #include +#endif + +#include "embryo_cc_sc.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 *ename,char *pname,char *rname); +static void setconfig(char *root); +static void setcaption(void); +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 dump_referrers(symbol *root,FILE *log,char *sourcefile); +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[_MAX_PATH];/* binary file name */ +#if defined __WIN32__ || defined _WIN32 || defined _Windows + static HWND hwndFinish = 0; +#endif + +#if !defined NO_MAIN + +#if defined __TURBOC__ && !defined __32BIT__ + extern unsigned int _stklen = 0x2000; +#endif + +#if defined __BORLANDC__ || defined __WATCOMC__ + #pragma argsused +#endif + +int main(int argc, char *argv[], char *env[]) +{ + #if defined LINUX + char argv0[_MAX_PATH]; + int i; + + strcpy(argv0,argv[0]); + /* Linux stores the name of the program in argv[0], but not the path. + * To adjust this, I store a string with the path in argv[0]. To do + * so, I try to get the current path with getcwd(), and if that fails + * I search for the PWD= setting in the environment. + */ + if ( NULL != getcwd(argv0, _MAX_PATH) ) { + i=strlen(argv0); + snprintf(argv0+i,_MAX_PATH-i,"/%s",argv[0]); + } else { + char *pwd = getenv("PWD"); + if (pwd!=NULL) + snprintf(argv0,_MAX_PATH,"%s/%s",pwd,argv[0]); + } /* if */ + argv[0]=argv0; /* set location to new first parameter */ + #endif + + return sc_compile(argc,argv); +} + +int sc_printf(const char *message,...) +{ + int ret; + va_list argptr; + + va_start(argptr,message); + ret=vprintf(message,argptr); + va_end(argptr); + + return ret; +} + +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,"rt"); +} + +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(char *filename) +{ + return fopen(filename,"w+t"); +} + +void sc_closeasm(void *handle, int deletefile) +{ + if (handle!=NULL) + fclose((FILE*)handle); + if (deletefile) + unlink(outfname); +} + +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); +} + +#endif /* !defined NO_MAIN */ + + +/* "main" of the compiler + */ +#if defined __cplusplus + extern "C" +#endif +int sc_compile(int argc, char *argv[]) +{ + int entry,i,jmpcode; + int retcode; + char incfname[_MAX_PATH]; + char reportname[_MAX_PATH]; + FILE *binf; + void *inpfmark; + char lcl_ctrlchar; + int lcl_packstr,lcl_needsemicolon,lcl_tabsize; + + /* 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(_MAX_PATH); + litq=(cell *)malloc(litmax*sizeof(cell)); + if (litq==NULL) + error(103); /* insufficient memory */ + if (!phopt_init()) + error(103); /* insufficient memory */ + + setopt(argc,argv,inpfname,outfname,errfname,incfname,reportname); + /* set output names that depend on the input name */ + if (sc_listing) + set_extension(outfname,".lst",TRUE); + else + set_extension(outfname,".asm",TRUE); + strcpy(binfname,outfname); + set_extension(binfname,".amx",TRUE); + if (strlen(errfname)!=0) + unlink(errfname); /* delete file on startup */ + else + setcaption(); + 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==NULL) + error(100,inpfname); + freading=TRUE; + outf=(FILE*)sc_openasm(outfname); /* first write to assembler file (may be temporary) */ + if (outf==NULL) + error(101,outfname); + /* immediately open the binary file, for other programs to check */ + if (sc_asmfile || sc_listing) { + binf=NULL; + } else { + binf=(FILE*)sc_openbin(binfname); + if (binf==NULL) + error(101,binfname); + } /* if */ + setconstants(); /* set predefined constants and tagnames */ + for (i=0; i0) { + 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 */ + /* write a report, if requested */ + #if !defined SC_LIGHT + if (sc_makereport) { + FILE *frep=stdout; + if (strlen(reportname)>0) + frep=fopen(reportname,"wb"); /* avoid translation of \n to \r\n in DOS/Windows */ + if (frep!=NULL) { + dump_referrers(&glbtab,frep,inpfname); + if (strlen(reportname)>0) + fclose(frep); + } /* if */ + } /* if */ + #endif + if (sc_listing) + goto cleanup; + + /* ??? 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 (strlen(incfname)>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!=NULL) /* main source file is not closed, do it now */ + sc_closesrc(inpf); + /* write the binary file (the file is already open) */ + if (!(sc_asmfile || sc_listing) && 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!=NULL) + sc_closeasm(outf,!(sc_asmfile || sc_listing)); + if (binf!=NULL) + sc_closebin(binf,errnum!=0); + + if (inpfname!=NULL) + free(inpfname); + if (litq!=NULL) + 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){ + if (strlen(errfname)==0) + sc_printf("\n%d Error%s.\n",errnum,(errnum>1) ? "s" : ""); + retcode=2; + } else if (warnnum!=0){ + if (strlen(errfname)==0) + sc_printf("\n%d Warning%s.\n",warnnum,(warnnum>1) ? "s" : ""); + retcode=1; + } else { + retcode=jmpcode; + } /* if */ + #if defined __WIN32__ || defined _WIN32 || defined _Windows + if (IsWindow(hwndFinish)) + PostMessage(hwndFinish,RegisterWindowMessage("SCNotify"),retcode,0L); + #endif + #if defined FORTIFY + Fortify_ListAllMemory(); + #endif + return retcode; +} + +#if defined __cplusplus + extern "C" +#endif +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; +} + +#if defined __cplusplus + extern "C" +#endif +int sc_addtag(char *name) +{ + cell val; + constvalue *ptr; + int last,tag; + + if (name==NULL) { + /* no tagname was given, check for one */ + if (lex(&val,&name)!=tLABEL) { + lexpush(); + return 0; /* untagged */ + } /* if */ + } /* if */ + + assert(strchr(name,':')==NULL); /* colon should already have been stripped */ + last=0; + ptr=tagname_tab.next; + while (ptr!=NULL) { + 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=FALSE; /* do not skip warning "217 loose indentation" */ + sc_allowtags=TRUE; /* allow/detect tagnames */ + sc_status=statIDLE; +} + +static void initglobals(void) +{ + resetglobals(); + + sc_asmfile=FALSE; /* do not create .ASM file */ + sc_listing=FALSE; /* do not create .LST file */ + 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 */ + charbits=8; /* a "char" is 8 bits */ + sc_packstr=FALSE; /* strings are unpacked by default */ + sc_compress=TRUE; /* compress output bytecodes */ + sc_needsemicolon=FALSE;/* semicolon required to terminate expressions? */ + sc_dataalign=sizeof(cell); + 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 */ + errfname[0]='\0'; /* error 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 */ + +#if !defined SC_LIGHT + sc_makereport=FALSE; /* do not generate a cross-reference report */ +#endif +} + +/* set_extension + * Set the default extension, or force an extension. To erase the + * extension of a filename, set "extension" to an empty string. + */ +SC_FUNC void set_extension(char *filename,char *extension,int force) +{ + char *ptr; + + assert(extension!=NULL && (*extension=='\0' || *extension=='.')); + assert(filename!=NULL); + ptr=strrchr(filename,'.'); + if (ptr!=NULL) { + /* ignore extension on a directory or at the start of the filename */ + if (strchr(ptr,DIRSEP_CHAR)!=NULL || ptr==filename || *(ptr-1)==DIRSEP_CHAR) + ptr=NULL; + } /* if */ + if (force && ptr!=NULL) + *ptr='\0'; /* set zero terminator at the position of the period */ + if (force || ptr==NULL) + strcat(filename,extension); +} + +static int toggle_option(char *optptr, int option) +{ + switch (*(optptr+1)) { + case '\0': + option=!option; + break; + case '-': + option=FALSE; + break; + case '+': + option=TRUE; + break; + default: + about(); + } /* switch */ + return option; +} + +/* Parsing command line options is indirectly recursive: parseoptions() + * calls parserespf() to handle options in a a response file and + * parserespf() calls parseoptions() at its turn after having created + * an "option list" from the contents of the file. + */ +static void parserespf(char *filename,char *iname,char *oname, + char *ename,char *pname,char *rname); + +static void parseoptions(int argc,char **argv,char *iname,char *oname, + char *ename,char *pname,char *rname) +{ + char str[_MAX_PATH],*ptr; + int arg,i,isoption; + + for (arg=1; arg0) { + if (str[i-1]!=DIRSEP_CHAR) { + str[i]=DIRSEP_CHAR; + str[i+1]='\0'; + } /* if */ + insert_path(str); + } /* if */ + break; + case 'l': + if (*(ptr+1)!='\0') + about(); + sc_listing=TRUE; /* skip second pass & code generation */ + break; + case 'o': + strcpy(oname,ptr+1); /* set name of (binary) output file */ + break; + case 'P': + sc_packstr=toggle_option(ptr,sc_packstr); + break; + case 'p': + strcpy(pname,ptr+1); /* set name of implicit include file */ + break; +#if !defined SC_LIGHT + case 'r': + strcpy(rname,ptr+1); /* set name of report file */ + sc_makereport=TRUE; + if (strlen(rname)>0) { + set_extension(rname,".xml",FALSE); + } else if (strlen(iname)>0) { + assert(strlen(rname)==0); + if ((ptr=strrchr(iname,DIRSEP_CHAR))!=NULL) + ptr++; /* strip path */ + else + ptr=iname; + strcpy(rname,ptr); + set_extension(rname,".xml",TRUE); + } /* if */ + break; +#endif + case 'S': + i=atoi(ptr+1); + if (i>64) + sc_stksize=(cell)i; /* stack size has minimum size */ + else + about(); + break; + case 's': + skipinput=atoi(ptr+1); + break; + case 't': + sc_tabsize=atoi(ptr+1); + break; + case '\\': /* use \ instead for escape characters */ + sc_ctrlchar='\\'; + break; + case '^': /* use ^ instead for escape characters */ + sc_ctrlchar='^'; + break; + case ';': + sc_needsemicolon=toggle_option(ptr,sc_needsemicolon); + break; + default: /* wrong option */ + about(); + } /* switch */ + } else if (argv[arg][0]=='@') { + #if !defined SC_LIGHT + parserespf(&argv[arg][1],iname,oname,ename,pname,rname); + #endif + } else if ((ptr=strchr(argv[arg],'='))!=NULL) { + i=(int)(ptr-argv[arg]); + if (i>sNAMEMAX) { + i=sNAMEMAX; + error(200,argv[arg],sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */ + } /* if */ + strncpy(str,argv[arg],i); + str[i]='\0'; /* str holds symbol name */ + i=atoi(ptr+1); + add_constant(str,i,sGLOBAL,0); + } else if (strlen(iname)>0) { + about(); + } else { + strcpy(iname,argv[arg]); + set_extension(iname,".sma",FALSE); + /* The output name is the input name with a different extension, + * but it is stored in a different directory + */ + if (strlen(oname)==0) { + if ((ptr=strrchr(iname,DIRSEP_CHAR))!=NULL) + ptr++; /* strip path */ + else + ptr=iname; + strcpy(oname,ptr); + } /* if */ + set_extension(oname,".asm",TRUE); +#if !defined SC_LIGHT + if (sc_makereport && strlen(rname)==0) { + if ((ptr=strrchr(iname,DIRSEP_CHAR))!=NULL) + ptr++; /* strip path */ + else + ptr=iname; + strcpy(rname,ptr); + set_extension(rname,".xml",TRUE); + } /* if */ +#endif + } /* if */ + } /* for */ +} + +#if !defined SC_LIGHT +static void parserespf(char *filename,char *iname,char *oname, + char *ename,char *pname,char *rname) +{ +#define MAX_OPTIONS 100 + FILE *fp; + char *string, *ptr, **argv; + int argc; + long size; + + if ((fp=fopen(filename,"rt"))==NULL) + error(100,filename); /* error reading input file */ + /* load the complete file into memory */ + fseek(fp,0L,SEEK_END); + size=ftell(fp); + fseek(fp,0L,SEEK_SET); + assert(size0 && ch!=' ' && ch!='\x1b'); + sc_printf("\n\n"); + return ch==' '; + #else + return TRUE; + #endif +} + +static void setcaption(void) +{ + sc_printf("Small compiler " VERSION_STR "\t\tCopyright (c) 1997-2003, ITB CompuPhase\n\n"); +} + +static void about(void) +{ + if (strlen(errfname)==0) { + setcaption(); + sc_printf("Usage: sc [options]\n\n"); + sc_printf("Options:\n"); + sc_printf(" -A alignment in bytes of the data segment and the stack\n"); + sc_printf(" -a output assembler code (skip code generation pass)\n"); + sc_printf(" -C[+/-] compact encoding for output file (default=%c)\n", sc_compress ? '+' : '-'); + sc_printf(" -c8 [default] a character is 8-bits (ASCII/ISO Latin-1)\n"); + sc_printf(" -c16 a character is 16-bits (Unicode)\n"); +#if defined dos_setdrive + sc_printf(" -Dpath active directory path\n"); +#endif + sc_printf(" -d0 no symbolic information, no run-time checks\n"); + sc_printf(" -d1 [default] run-time checks, no symbolic information\n"); + sc_printf(" -d2 full debug information and dynamic checking\n"); + sc_printf(" -d3 full debug information, dynamic checking, no optimization\n"); + sc_printf(" -e set name of error file (quiet compile)\n"); +#if defined __WIN32__ || defined _WIN32 || defined _Windows + sc_printf(" -H window handle to send a notification message on finish\n"); +#endif + sc_printf(" -i path for include files\n"); + sc_printf(" -l create list file (preprocess only)\n"); + sc_printf(" -o set base name of output file\n"); + sc_printf(" -P[+/-] strings are \"packed\" by default (default=%c)\n", sc_packstr ? '+' : '-'); + sc_printf(" -p set name of \"prefix\" file\n"); + if (!waitkey()) + longjmp(errbuf,3); +#if !defined SC_LIGHT + sc_printf(" -r[name] write cross reference report to console or to specified file\n"); +#endif + sc_printf(" -S stack/heap size in cells (default=%d)\n",(int)sc_stksize); + sc_printf(" -s skip lines from the input file\n"); + sc_printf(" -t TAB indent size (in character positions)\n"); + sc_printf(" -\\ use '\\' for escape characters\n"); + sc_printf(" -^ use '^' for escape characters\n"); + sc_printf(" -;[+/-] require a semicolon to end each statement (default=%c)\n", sc_needsemicolon ? '+' : '-'); + sc_printf(" sym=val define constant \"sym\" with value \"val\"\n"); + sc_printf(" sym= define constant \"sym\" with value 0\n"); + } /* if */ + 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' */ + #if defined(BIT16) + add_constant("cellbits",16,sGLOBAL,0); + add_constant("cellmax",SHRT_MAX,sGLOBAL,0); + add_constant("cellmin",SHRT_MIN,sGLOBAL,0); + #else + add_constant("cellbits",32,sGLOBAL,0); + add_constant("cellmax",LONG_MAX,sGLOBAL,0); + add_constant("cellmin",LONG_MIN,sGLOBAL,0); + #endif + 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 paranthesis 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) + 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) +{ + assert(numbytes % sizeof(cell) == 0); /* alignment must be a multiple of + * the cell size */ + assert(numbytes!=0); + + 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 + + assert(!fpublic || !stock); /* may not both be set */ + 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!=NULL) { + 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==NULL) + sym=findconst(name); + if (sym!=NULL && (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!=NULL && (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 */ + assert(litidx==0); /* literal queue should be empty (again) */ + initials(ident,tag,&size,dim,numdim);/* stores values in the literal queue */ + assert(size>=litidx); + if (numdim==1) + dim[0]=(int)size; + dumplits(); /* dump the literal queue */ + dumpzero((int)size-litidx); + litidx=0; + if (sym==NULL) { /* 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; levelcompound==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))!=NULL && sym->compound!=nestlevel || findglb(name)!=NULL) + 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 (litidxcompound=nestlevel; /* for multiple declaration/shadowing check */ + if (fconst) + sym->usage|=uCONST; + if (ident==iARRAY) + for (level=0; level0) { + 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 (strlen(enumname)>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. + */ +SC_FUNC 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))!=0) { /* 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); + assert(sym!=NULL); /* fatal error 103 must be given on error */ + /* 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!=NULL) { + 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!=NULL) { + 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; + + assert(sym!=NULL && sym->ident==iFUNCTN && sym->dim.arglist!=NULL); + /* 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(strlen(opername)>0); + operator_symname(tmpname,opername,tags[0],tags[1],count,resulttag); + if ((oldsym=findglb(tmpname))!=NULL) { + 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; inumrefers; i++) + if (oldsym->refer[i]!=NULL) + 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 && strlen(opername)>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; +} + +SC_FUNC 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; +} + +SC_FUNC 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]); + assert(tagsym[0]!=NULL); + /* 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 */ + assert(loctab.next==NULL); /* local symbol table should be empty */ + + 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==NULL) + 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 */ + delete_symbols(&loctab,0,TRUE,TRUE);/* clear local variables queue */ +} + +/* 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; + + assert(litidx==0); /* literal queue should be empty */ + litidx=0; /* clear the literal pool ??? */ + opertok=0; + lastst=0; /* no statement yet */ + cidx=0; /* just to avoid compiler warnings */ + glbdecl=0; + assert(loctab.next==NULL); /* local symbol table should be empty */ + filenum=fcurrent; /* save file number at the start of the declaration */ + + if (firstname!=NULL) { + 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==NULL) + 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; inumtags && 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 && levelnumdim; 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=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==0) + 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==0) + 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==NULL) + 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) { + error(17,ptr); /* undefined symbol */ + } else { + assert(arglist[idx].defvalue.size.symname!=NULL); + /* 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 */ + /* check the type of the argument whose size to take; for a iVARIABLE + * or a iREFERENCE, this is always 1 (so the code is redundant) + */ + assert(arglist[altidx].ident!=iVARARGS); + 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(litidx==0); /* at the start of a function, this is reset */ + 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!=NULL) { + 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; + /* calulate size to reserve on the heap */ + arg->defvalue.array.arraysize=1; + for (i=0; inumdim; 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=duplicatestring(name)) == NULL) + 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==NULL) + error(103); /* insufficient memory */ + memcpy(arg->tags,tags,numtags*sizeof tags[0]); + argsym=findloc(name); + if (argsym!=NULL) { + error(21,name); /* symbol already defined */ + } else { + if ((argsym=findglb(name))!=NULL && 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; inumrefers; i++) + if (entry->refer[i]!=NULL) + count++; + return count; +} + +#if !defined SC_LIGHT +static void dump_referrers(symbol *root,FILE *log,char *sourcefile) +{ + char symname[2*sNAMEMAX+16]; + int i; + symbol *sym,*ref; + + /* the XML header */ + fprintf(log,"\n"); + fprintf(log,"\n",sourcefile); + + /* use multiple passes to print constants variables and functions in + * separate sections + */ + + fprintf(log,"\t\n"); + for (sym=root->next; sym!=NULL; sym=sym->next) { + if (sym->parent!=NULL) + continue; /* hierarchical data type */ + assert(sym->ident==iCONSTEXPR || sym->ident==iVARIABLE + || sym->ident==iARRAY || sym->ident==iFUNCTN); + if (sym->ident!=iCONSTEXPR) + continue; + if ((sym->usage & uREAD)==0) + continue; + fprintf(log,"\t\t\n",funcdisplayname(symname,sym->name)); + assert(sym->refer!=NULL); + for (i=0; inumrefers; i++) { + if ((ref=sym->refer[i])!=NULL) + fprintf(log,"\t\t\t%s\n",funcdisplayname(symname,ref->name)); + } /* for */ + fprintf(log,"\t\t\n"); + } /* for */ + fprintf(log,"\t\n\n"); + + fprintf(log,"\t\n"); + for (sym=root->next; sym!=NULL; sym=sym->next) { + if (sym->parent!=NULL) + continue; /* hierarchical data type */ + if (sym->ident!=iVARIABLE && sym->ident!=iARRAY) + continue; + fprintf(log,"\t\t\n",funcdisplayname(symname,sym->name)); + assert(sym->refer!=NULL); + if ((sym->usage & uPUBLIC)!=0) + fprintf(log,"\t\t\t\n"); + for (i=0; inumrefers; i++) { + if ((ref=sym->refer[i])!=NULL) + fprintf(log,"\t\t\t%s\n",funcdisplayname(symname,ref->name)); + } /* for */ + fprintf(log,"\t\t\n"); + } /* for */ + fprintf(log,"\t\n\n"); + + fprintf(log,"\t\n"); + for (sym=root->next; sym!=NULL; sym=sym->next) { + if (sym->parent!=NULL) + continue; /* hierarchical data type */ + if (sym->ident!=iFUNCTN) + continue; + if ((sym->usage & (uREAD | uNATIVE))==uNATIVE) + continue; /* unused native function */ + fprintf(log,"\t\t\n",funcdisplayname(symname,sym->name)); + assert(sym->refer!=NULL); + /* check whether this function is called from the outside */ + if ((sym->usage & uNATIVE)!=0) + fprintf(log,"\t\t\t\n"); + if ((sym->usage & uPUBLIC)!=0) + fprintf(log,"\t\t\t\n"); + if (strcmp(sym->name,uMAINFUNC)==0) + fprintf(log,"\t\t\t\n"); + for (i=0; inumrefers; i++) { + if ((ref=sym->refer[i])!=NULL) + fprintf(log,"\t\t\t%s\n",funcdisplayname(symname,ref->name)); + } /* for */ + fprintf(log,"\t\t\n"); + } /* for */ + fprintf(log,"\t\n\n"); + + fprintf(log,"\n"); +} +#endif + +/* 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!=NULL; sym=sym->next) { + if (sym->parent!=NULL) + 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!=NULL; ref=ref->next) { + if (ref->parent!=NULL) + continue; /* hierarchical data type */ + assert(ref->refer!=NULL); + for (i=0; inumrefers && ref->refer[i]!=sym; i++) + /* nothing */; + if (inumrefers) { + 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==NULL + && 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!=NULL && 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 (strlen(symname)>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!=NULL) + 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!=NULL) + *offset=length*(*offset+sizeof(cell)); + if (sublength>0) + length*=length*sublength; + else + length=0; + } else { + if (offset!=NULL) + *offset=0; + } /* if */ + return length; +} + +static void destructsymbols(symbol *root,int level) +{ + cell offset=0; + int savepri=FALSE; + symbol *sym=root->next; + while (sym!=NULL && 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))!=NULL) { + /* save PRI, in case of a return statment */ + 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 */ + assert(opsym->ident==iFUNCTN); + 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!=NULL) + 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 index) +{ + constvalue *cur; + + if ((cur=(constvalue*)malloc(sizeof(constvalue)))==NULL) + error(103); /* insufficient memory (fatal error) */ + memset(cur,0,sizeof(constvalue)); + strcpy(cur->name,name); + cur->value=val; + cur->index=index; + cur->next=next; + prev->next=cur; + return cur; +} + +SC_FUNC constvalue *append_constval(constvalue *table,char *name,cell val,short index) +{ + constvalue *cur,*prev; + + /* find the end of the constant table */ + for (prev=table, cur=table->next; cur!=NULL; prev=cur, cur=cur->next) + /* nothing */; + return insert_constval(prev,NULL,name,val,index); +} + +SC_FUNC constvalue *find_constval(constvalue *table,char *name,short index) +{ + constvalue *ptr = table->next; + + while (ptr!=NULL) { + if (strcmp(name,ptr->name)==0 && ptr->index==index) + return ptr; + ptr=ptr->next; + } /* while */ + return NULL; +} + +static constvalue *find_constval_byval(constvalue *table,cell val) +{ + constvalue *ptr = table->next; + + while (ptr!=NULL) { + 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 + +SC_FUNC void delete_consttable(constvalue *table) +{ + constvalue *cur=table->next, *next; + + while (cur!=NULL) { + next=cur->next; + free(cur); + cur=next; + } /* while */ + memset(table,0,sizeof(constvalue)); +} + +/* add_constant + * + * Adds a symbol to the #define symbol table. + */ +SC_FUNC 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); + assert(sym!=NULL); /* fatal error 103 must be given on error */ + 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!=NULL && tok!=tLABEL) { + if (*lastindent>=0 && *lastindent!=stmtindent && !indent_nowarn && sc_tabsize>0) + error(217); /* loose indentation */ + *lastindent=stmtindent; + indent_nowarn=FALSE; /* 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) + modstk((int)(declared-save_decl)*sizeof(cell)); /* delete local variable space */ + 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,index,ident; + int localstaging=FALSE; + cell val; + + if (!staging) { + stgset(TRUE); /* start stage-buffering */ + localstaging=TRUE; + assert(stgidx==0); + } /* if */ + index=stgidx; + errorset(sEXPRMARK); + do { + /* on second round through, mark the end of the previous expression */ + if (index!=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(index); + stgset(FALSE); /* stop staging */ + } /* if */ +} + +/* constexpr + */ +SC_FUNC int constexpr(cell *val,int *tag) +{ + int constant,index; + cell cidx; + + stgset(TRUE); /* start stage-buffering */ + stgget(&index,&cidx); /* mark position in code generator */ + errorset(sEXPRMARK); + expression(&constant,val,tag,FALSE); + stgdel(index,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 index,tok; + cell cidx; + value lval = {0}; + int localstaging=FALSE; + + if (!staging) { + stgset(TRUE); /* start staging */ + localstaging=TRUE; + #if !defined NDEBUG + stgget(&index,&cidx); /* should start at zero if started locally */ + assert(index==0); + #endif + } /* if */ + + pushstk((stkitem)intest); + intest=1; + if (parens) + needtoken('('); + do { + stgget(&index,&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!=NULL) ? 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(index,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 (stmtindent0) + error(217); /* loose indentation */ + 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,index; + 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); + index=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(index); + 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 + * with a label. Then, you can search for: + * * the first semicolon (marks the end of a statement) + * * 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!=NULL && cse->valuenext) + /* nothing */; + if (cse!=NULL && 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 + assert(csp!=NULL); + assert(csp->next==cse); + 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!=NULL && cse->valuenext) + /* nothing */; + if (cse!=NULL && cse->value==val) + error(40,val); /* duplicate "case" label */ + assert(csp!=NULL); + assert(csp->next==cse); + 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 (unfortunatly, 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!=NULL && cse->next!=NULL; cse=cse->next) + assert(cse->value <= cse->next->value); + #endif + /* generate the table here, before lbl_exit (general jump target) */ + setlabel(lbl_table); + assert(swdefault==FALSE || swdefault==TRUE); + 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!=NULL; 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,index; + cell cidx; + value lval = {0}; + + 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(&index,&cidx); /* mark position in code generator */ + do { + if (hier14(&lval)) + rvalue(&lval); + stgdel(index,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)!=NULL) + 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); + assert(sym!=NULL); /* fatal error 103 must be given on error */ + 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==NULL) + 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==NULL) + return; + destructsymbols(&loctab,nestlevel); + modstk(((int)declared-ptr[wqCONT])*sizeof(cell)); + jumplabel(ptr[wqLOOP]); +} + +SC_FUNC 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!=NULL && tag!=(int)(ptr->value & TAGMASK); ptr=ptr->next) + /* nothing */; + if (ptr!=NULL) + 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 (kwq) + wqptr-=wqSIZE; +} + +static int *readwhile(void) +{ + if (wqptr<=wq){ + error(24); /* out of context */ + return NULL; + } else { + return (wqptr-wqSIZE); + } /* if */ +} + diff --git a/legacy/embryo/src/bin/embryo_cc_sc2.c b/legacy/embryo/src/bin/embryo_cc_sc2.c new file mode 100644 index 0000000000..f0da7495c3 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc2.c @@ -0,0 +1,2332 @@ +/* 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$ + */ +#include +#include +#include +#include +#include +#include +#include "embryo_cc_sc.h" +#if defined LINUX + #include +#endif + +#if defined FORTIFY + #include "fortify.h" +#endif + +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; +SC_FUNC void pushstk(stkitem val) +{ + if (stkidx>=sSTKMAX) + error(102,"parser stack"); /* stack overflow (recursive include?) */ + stack[stkidx]=val; + stkidx+=1; +} + +SC_FUNC stkitem popstk(void) +{ + if (stkidx==0) + return (stkitem) -1; /* stack is empty */ + stkidx-=1; + return stack[stkidx]; +} + +SC_FUNC 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==NULL) { + /* try to append an extension */ + strcpy(ext,extensions[ext_idx]); + fp=(FILE*)sc_opensrc(name); + if (fp==NULL) + *ext='\0'; /* on failure, restore filename */ + } /* if */ + ext_idx++; + } while (fp==NULL && ext_idx<(sizeof extensions / sizeof extensions[0])); + if (fp==NULL) { + *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=duplicatestring(name);/* set name of include file */ + if (inpfname==NULL) + 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); + setfiledirect(inpfname); + listline=-1; /* force a #line directive when changing the file */ + setactivefile(fcurrent); + return TRUE; +} + +SC_FUNC 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))!=NULL; i++) { + char path[_MAX_PATH]; + 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[_MAX_PATH],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' && i0 && name[i-1]<=' ') + i--; /* strip trailing whitespace */ + assert(i>=0 && i 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==NULL || sc_eofsrc(inpf)) { + if (cont) + error(49); /* invalid line continuation */ + if (inpf!=NULL && 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); + setfiledirect(inpfname); + listline=-1; /* force a #line directive when changing the file */ + elsedone=0; + } /* if */ + + if (sc_readsrc(inpf,line,num)==NULL) { + *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')==NULL && !sc_eofsrc(inpf)) + error(75); /* line too long */ + /* check if the next line must be concatenated to this line */ + if ((ptr=strchr(line,'\n'))!=NULL && 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')!=NULL) + 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 (ishex(*ptr) || *ptr=='_') { + if (*ptr!='_') { + assert(ishex(*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; i0 && !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) { + /* floating point */ + float value=(float)fnum; + *val=*((cell *)&value); + #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; + assert(*(long*)&test1==0x00000000L && *(long*)&test2==0x42480000L); + } + #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 index; + 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(&index,&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)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(&index,&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[_MAX_PATH]; + lptr=getstring(pathname,sizeof pathname,lptr); + if (strlen(pathname)>0) { + free(inpfname); + inpfname=duplicatestring(pathname); + if (inpfname==NULL) + 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; + } /* 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,lptr); + } else { + int i; + for (i=0; isEXPMAX) + 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)==NULL) + 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; i9) { + 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; iusage |= 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==NULL) + sym=findglb(str); + if (sym==NULL || 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==NULL) + error(103); /* insufficient memory */ + lptr=start; + count=0; + while (lptr!=end) { + assert(lptr=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==NULL) + end=lptr; + } else { + end=NULL; + } /* if */ + count++; + lptr++; + } /* while */ + if (end==NULL) + end=lptr; + /* store matched substitution */ + substitution=malloc(count+1); /* +1 for '\0' */ + if (substitution==NULL) + error(103); /* insufficient memory */ + lptr=start; + count=0; + while (lptr!=end) { + assert(lptr0); + if ((def=find_subst(pattern,prefixlen))!=NULL) { + 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(strlen(pattern)>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)!=NULL) /* 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]!=NULL) + free(args[arg]); + len=(int)(e-s); + args[arg]=malloc(len+1); + if (args[arg]==NULL) + 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]!=NULL) + 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]!=NULL) { + 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]!=NULL) + 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!=NULL) { + /* 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) + */ +SC_FUNC 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 + if (sc_status==statFIRST && sc_listing && freading + && (iscommand==CMD_NONE || iscommand==CMD_EMPTYLINE || iscommand==CMD_DIRECTIVE)) + { + listline++; + if (fline!=listline) { + listline=fline; + setlinedirect(fline); + } /* if */ + if (iscommand==CMD_EMPTYLINE) + fputs("\n",outf); + else + fputs(pline,outf); + } /* if */ + } while (iscommand!=CMD_NONE && iscommand!=CMD_TERM && freading); /* enddo */ +} + +static char *unpackedstring(char *lptr,int rawstring) +{ + while (*lptr!='\"' && *lptr!='\0') { + 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!='\"' && *lptr!='\0') { + 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; + +SC_FUNC 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-" + }; + +SC_FUNC 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=litmax) { + cell *p; + + litmax+=sDEF_LITMAX; + p=(cell *)realloc(litq,litmax*sizeof(cell)); + if (p==NULL) + error(102,"literal table"); /* literal table overflow (fatal error) */ + litq=p; + } /* if */ + assert(litidx='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 "@") + */ +SC_FUNC int alphanum(char c) +{ + return (alpha(c) || isdigit(c)); +} + +/* ishex + * + * Test if character "c" is a hexadecimal digit ("0".."9" or "a".."f"). + */ +SC_FUNC int ishex(char c) +{ + return (c>='0' && c<='9') || (c>='a' && c<='f') || (c>='A' && c<='F'); +} + +/* 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!=NULL && strcmp(entry->name,root->next->name)>0) + root=root->next; + + if ((newsym=(symbol *)malloc(sizeof(symbol)))==NULL) { + 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); +} + +SC_FUNC 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); +} + +SC_FUNC 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!=NULL) { + sym=root->next; + if (sym->compoundident!=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. + */ +SC_FUNC uint32_t 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!=NULL) { + if (hash==ptr->hash && strcmp(name,ptr->name)==0 && ptr->parent==NULL + && (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!=NULL) { + 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. + */ +SC_FUNC 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; countnumrefers && entry->refer[count]!=bywhom; count++) + /* nothing */; + if (countnumrefers) { + assert(entry->refer[count]==bywhom); + return TRUE; + } /* if */ + + /* see if there is an empty spot in the referrer list */ + for (count=0; countnumrefers && entry->refer[count]!=NULL; 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==NULL) + return FALSE; /* insufficient memory */ + /* initialize the new entries */ + entry->refer=refer; + for (count=entry->numrefers; countrefer[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; +} + +SC_FUNC 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!=NULL) + refer_symbol(sym,curfunc); + } /* if */ + } /* if */ +} + + +/* findglb + * + * Returns a pointer to the global symbol (if found) or NULL (if not found) + */ +SC_FUNC 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. + */ +SC_FUNC symbol *findloc(char *name) +{ + return find_symbol(&loctab,name,-1); +} + +SC_FUNC symbol *findconst(char *name) +{ + symbol *sym; + + sym=find_symbol(&loctab,name,-1); /* try local symbols first */ + if (sym==NULL || sym->ident!=iCONSTEXPR) /* not found, or not a constant */ + sym=find_symbol(&glbtab,name,fcurrent); + if (sym==NULL || sym->ident!=iCONSTEXPR) + return NULL; + assert(sym->parent==NULL); /* constants have no hierarchy */ + return sym; +} + +SC_FUNC symbol *finddepend(symbol *parent) +{ + symbol *sym; + + sym=find_symbol_child(&loctab,parent); /* try local symbols first */ + if (sym==NULL) /* 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). + */ +SC_FUNC 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*)))==NULL) { + 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); +} + +SC_FUNC 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; leveldim.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. + */ +SC_FUNC int getlabel(void) +{ + return labnum++; +} + +/* itoh + * + * Converts a number to a hexadecimal string and returns a pointer to that + * string. + */ +SC_FUNC 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>=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/legacy/embryo/src/bin/embryo_cc_sc3.c b/legacy/embryo/src/bin/embryo_cc_sc3.c new file mode 100644 index 0000000000..cbf0d64830 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc3.c @@ -0,0 +1,2063 @@ +/* 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$ + */ +#include +#include +#include /* for _MAX_PATH */ +#include +#if defined FORTIFY + #include "fortify.h" +#endif +#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 */ +} + +SC_FUNC 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==NULL) { + /* assignment operator: a special case */ + strcpy(opername,"="); + if (lval!=NULL && (lval->ident==iARRAYCELL || lval->ident==iARRAYCHAR)) + savealt=TRUE; + } else { + assert( (sizeof binoperstr / sizeof binoperstr[0]) == (sizeof op1 / sizeof op1[0]) ); + for (i=0; iusage & uDEFINE)==0*/) { /* ??? should not check uDEFINE; first pass clears these bits */ + /* check for commutative operators */ + if (tag1==tag2 || oper==NULL || !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==NULL /*|| (sym->usage & uDEFINE)==0*/) + return FALSE; + } /* if */ + + /* check existance 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 accross 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==NULL) ? 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!=NULL) + 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; +} + +SC_FUNC 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==NULL || (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 " */ + } /* 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 = {0}; + + 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!=NULL) + 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 = {0}; /* intialize, to avoid a compiler warning */ + 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<constval<ident==iCONSTEXPR) { /* constant on right side */ + if (commutative(oper)) { /* test for commutative operators */ + value lvaltmp = {0}; + stgdel(index,cidx); /* scratch push1() and constant fetch (then + * fetch the constant again */ + const2(lval2->constval<constval<ident==iARRAY || lval1->ident==iREFARRAY) { + char *ptr=(lval1->sym!=NULL) ? lval1->sym->name : "-unknown-"; + error(33,ptr); /* array must be indexed */ + } else if (lval2->ident==iARRAY || lval2->ident==iREFARRAY) { + char *ptr=(lval2->sym!=NULL) ? 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; +} + +SC_FUNC int expression(int *constant,cell *val,int *tag,int chkfuncresult) +{ + value lval = {0}; + + if (hier14(&lval)) + rvalue(&lval); + if (lval.ident==iCONSTEXPR) { /* constant expression */ + *constant=TRUE; + *val=lval.constval; + } else { + *constant=FALSE; + } /* if */ + if (tag!=NULL) + *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 (reffered to only) + */ +SC_FUNC int hier14(value *lval1) +{ + int lvalue; + value lval2 = {0},lval3 = {0}; + 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; iarrayidx; /* save current pointer, to reset later */ + if (lval1->arrayidx==NULL) + 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!=NULL && lval2.arrayidx!=NULL + && lval3.ident==lval2.ident && lval3.sym==lval2.sym) + { + int same=TRUE; + assert(lval3.arrayidx==arrayidx1); + assert(lval2.arrayidx==arrayidx2); + for (i=0; iname); /* 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!=NULL) { + 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.lengthdim.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; idim.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 = {0}; + 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!=NULL) ? lval->sym->name : "-unknown-"; + error(33,ptr); /* array must be indexed */ + } else if (!array1 && array2) { + char *ptr=(lval2.sym->name!=NULL) ? 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==NULL) + sym=findglb(st); + if (sym!=NULL && 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!=NULL); + if (!val && find_subst(st,strlen(st))!=NULL) + 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==NULL) + sym=findglb(st); + if (sym==NULL) + 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)==NULL) + 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==NULL) + sym=findglb(st); + if (sym==NULL) + 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 = {0}; + 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==NULL && 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==NULL) { /* 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!=NULL) { /* keep constant index, for checking */ + assert(sym->dim.array.level>=0 && sym->dim.array.levelarrayidx[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==NULL + || (sym->ident!=iFUNCTN && sym->ident!=iREFFUNC)) + { + if (sym==NULL && 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!=NULL) + 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!=NULL && 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)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))!=0) { + 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); + 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; idim.arglist; + assert(arg!=NULL); + stgmark(sSTARTREORDER); + for (argpos=0; argposusage & 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!=NULL) + markusage(lval.sym,uWRITTEN); + 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!=NULL && (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!=NULL) + 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!=NULL && (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==NULL || 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(leveldim.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(leveldim.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; level0); + 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!=NULL) { + 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==NULL) + sym=findglb(arg[argidx].defvalue.size.symname); + array_sz=(sym!=NULL) ? 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!=NULL) + 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))!=0){ + 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/legacy/embryo/src/bin/embryo_cc_sc4.c b/legacy/embryo/src/bin/embryo_cc_sc4.c new file mode 100644 index 0000000000..3dd1d50bf0 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc4.c @@ -0,0 +1,1195 @@ +/* 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$ + */ +#include +#include +#include +#include /* for _MAX_PATH */ +#include +#if defined FORTIFY + #include "fortify.h" +#endif +#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. + */ +SC_FUNC 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) + */ +SC_FUNC 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 + */ +SC_FUNC 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 + */ +SC_FUNC void begdseg(void) +{ + if (curseg!=sIN_DSEG) { + stgwrite("\n"); + stgwrite("DATA\t; "); + outval(glb_declared-litidx,TRUE); + curseg=sIN_DSEG; + } /* if */ +} + +SC_FUNC void setactivefile(int fnumber) +{ + stgwrite("curfile "); + outval(fnumber,TRUE); +} + +SC_FUNC cell nameincells(char *name) +{ + cell clen=(strlen(name)+sizeof(cell)) & ~(sizeof(cell)-1); + return clen; +} + +SC_FUNC 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 */ +} + +SC_FUNC 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 */ +} + +SC_FUNC void setfiledirect(char *name) +{ + if (sc_status==statFIRST && sc_listing) { + assert(name!=NULL); + fprintf(outf,"#file %s\n",name); + } /* if */ +} + +SC_FUNC void setlinedirect(int line) +{ + if (sc_status==statFIRST && sc_listing) + fprintf(outf,"#line %d\n",line); +} + +/* setlabel + * + * Post a code label (specified as a number), on a new line. + */ +SC_FUNC 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. + */ +SC_FUNC 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) + */ +SC_FUNC void startfunc(char *fname) +{ + stgwrite("\tproc"); + if (sc_asmfile) { + char symname[2*sNAMEMAX+16]; + funcdisplayname(symname,fname); + stgwrite("\t; "); + stgwrite(symname); + } /* if */ + stgwrite("\n"); + code_idx+=opcodes(1); +} + +/* endfunc + * + * Declare a CODE ending point (function end) + */ +SC_FUNC 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) + */ +SC_FUNC 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; isym; + 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). + */ +SC_FUNC 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). + */ +SC_FUNC 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. + */ +SC_FUNC 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). + */ +SC_FUNC 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); +} + +SC_FUNC void fillarray(symbol *sym,cell size,cell value) +{ + const1(value); /* load value 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 + */ +SC_FUNC 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 + */ +SC_FUNC 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 */ +SC_FUNC void moveto1(void) +{ + stgwrite("\tmove.pri\n"); + code_idx+=opcodes(1)+opargs(0); +} + +/* + * Push primary register onto the stack + */ +SC_FUNC void push1(void) +{ + stgwrite("\tpush.pri\n"); + code_idx+=opcodes(1); +} + +/* + * Push alternate register onto the stack + */ +SC_FUNC void push2(void) +{ + stgwrite("\tpush.alt\n"); + code_idx+=opcodes(1); +} + +/* + * Push a constant value onto the stack + */ +SC_FUNC void pushval(cell val) +{ + stgwrite("\tpush.c "); + outval(val, TRUE); + code_idx+=opcodes(1)+opargs(1); +} + +/* + * pop stack to the primary register + */ +SC_FUNC void pop1(void) +{ + stgwrite("\tpop.pri\n"); + code_idx+=opcodes(1); +} + +/* + * pop stack to the secondary register + */ +SC_FUNC void pop2(void) +{ + stgwrite("\tpop.alt\n"); + code_idx+=opcodes(1); +} + +/* + * swap the top-of-stack with the value in primary register + */ +SC_FUNC 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. + */ +SC_FUNC void ffswitch(int label) +{ + stgwrite("\tswitch "); + outval(label,TRUE); /* the label is the address of the case table */ + code_idx+=opcodes(1)+opargs(1); +} + +SC_FUNC void ffcase(cell value,char *labelname,int newtable) +{ + if (newtable) { + stgwrite("\tcasetbl\n"); + code_idx+=opcodes(1); + } /* if */ + stgwrite("\tcase "); + outval(value,FALSE); + stgwrite(" "); + stgwrite(labelname); + stgwrite("\n"); + code_idx+=opcodes(0)+opargs(2); +} + +/* + * Call specified function + */ +SC_FUNC void ffcall(symbol *sym,int numargs) +{ + char symname[2*sNAMEMAX+16]; + + assert(sym!=NULL); + assert(sym->ident==iFUNCTN); + if (sc_asmfile) + funcdisplayname(symname,sym->name); + 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); + if (sc_asmfile) { + stgwrite("\t; "); + stgwrite(symname); + } /* if */ + stgwrite("\n\tstack "); + outval((numargs+1)*sizeof(cell), TRUE); + code_idx+=opcodes(2)+opargs(2); + } else { + /* normal function */ + stgwrite("\tcall "); + stgwrite(sym->name); + if (sc_asmfile + && !isalpha(sym->name[0]) && sym->name[0]!='_' && sym->name[0]!=sc_ctrlchar) + { + stgwrite("\t; "); + stgwrite(symname); + } /* if */ + stgwrite("\n"); + code_idx+=opcodes(1)+opargs(1); + } /* if */ +} + +/* Return from function + * + * Global references: funcstatus (referred to only) + */ +SC_FUNC void ffret(void) +{ + stgwrite("\tretn\n"); + code_idx+=opcodes(1); +} + +SC_FUNC void ffabort(int reason) +{ + stgwrite("\thalt "); + outval(reason,TRUE); + code_idx+=opcodes(1)+opargs(1); +} + +SC_FUNC 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) + */ +SC_FUNC void jumplabel(int number) +{ + stgwrite("\tjump "); + outval(number,TRUE); + code_idx+=opcodes(1)+opargs(1); +} + +/* + * Define storage (global and static variables) + */ +SC_FUNC void defstorage(void) +{ + stgwrite("dump "); +} + +/* + * Inclrement/decrement stack pointer. Note that this routine does + * nothing if the delta is zero. + */ +SC_FUNC 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 */ +SC_FUNC void setstk(cell value) +{ + stgwrite("\tlctrl 5\n"); /* get FRM */ + assert(value<=0); /* STK should always become <= FRM */ + if (value<0) { + stgwrite("\tadd.c "); + outval(value, TRUE); /* add (negative) offset */ + code_idx+=opcodes(1)+opargs(1); + // ??? write zeros in the space between STK and the value in PRI (the new stk) + // get value 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); +} + +SC_FUNC void modheap(int delta) +{ + if (delta) { + stgwrite("\theap "); + outval(delta, TRUE); + code_idx+=opcodes(1)+opargs(1); + } /* if */ +} + +SC_FUNC 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); +} + +SC_FUNC void setheap(cell value) +{ + stgwrite("\tconst.pri "); /* load default value in PRI */ + outval(value, 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. + */ +SC_FUNC 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. + */ +SC_FUNC 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). + */ +SC_FUNC 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. + */ +SC_FUNC 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. + */ +SC_FUNC void charalign(void) +{ + stgwrite("\talign.pri "); + outval(charbits/8,TRUE); + code_idx+=opcodes(1)+opargs(1); +} + +/* + * Add a constant to the primary register. + */ +SC_FUNC void addconst(cell value) +{ + if (value!=0) { + stgwrite("\tadd.c "); + outval(value,TRUE); + code_idx+=opcodes(1)+opargs(1); + } /* if */ +} + +/* + * signed multiply of primary and secundairy registers (result in primary) + */ +SC_FUNC 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) + */ +SC_FUNC void os_div(void) +{ + stgwrite("\tsdiv.alt\n"); + code_idx+=opcodes(1); +} + +/* + * modulus of (alternate % primary), result in primary (signed) + */ +SC_FUNC 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). + */ +SC_FUNC void ob_add(void) +{ + stgwrite("\tadd\n"); + code_idx+=opcodes(1); +} + +/* + * subtract primary register from alternate register (result in primary) + */ +SC_FUNC 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. + */ +SC_FUNC 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). + */ +SC_FUNC 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). + */ +SC_FUNC void ou_sar(void) +{ + stgwrite("\txchg\n"); + stgwrite("\tshr\n"); + code_idx+=opcodes(2); +} + +/* + * inclusive "or" of primary and secondary registers (result in primary) + */ +SC_FUNC void ob_or(void) +{ + stgwrite("\tor\n"); + code_idx+=opcodes(1); +} + +/* + * "exclusive or" of primary and alternate registers (result in primary) + */ +SC_FUNC void ob_xor(void) +{ + stgwrite("\txor\n"); + code_idx+=opcodes(1); +} + +/* + * "and" of primary and secundairy registers (result in primary) + */ +SC_FUNC void ob_and(void) +{ + stgwrite("\tand\n"); + code_idx+=opcodes(1); +} + +/* + * test ALT==PRI; result in primary register (1 or 0). + */ +SC_FUNC void ob_eq(void) +{ + stgwrite("\teq\n"); + code_idx+=opcodes(1); +} + +/* + * test ALT!=PRI + */ +SC_FUNC 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. + */ +SC_FUNC void relop_prefix(void) +{ + stgwrite("\tpush.pri\n"); + stgwrite("\tmove.pri\n"); + code_idx+=opcodes(2); +} + +SC_FUNC void relop_suffix(void) +{ + stgwrite("\tswap.alt\n"); + stgwrite("\tand\n"); + stgwrite("\tpop.alt\n"); + code_idx+=opcodes(3); +} + +/* + * test ALTPRI (signed) + */ +SC_FUNC void os_gt(void) +{ + stgwrite("\txchg\n"); + stgwrite("\tsgrtr\n"); + code_idx+=opcodes(2); +} + +/* + * test ALT>=PRI (signed) + */ +SC_FUNC void os_ge(void) +{ + stgwrite("\txchg\n"); + stgwrite("\tsgeq\n"); + code_idx+=opcodes(2); +} + +/* + * logical negation of primary register + */ +SC_FUNC void lneg(void) +{ + stgwrite("\tnot\n"); + code_idx+=opcodes(1); +} + +/* + * two's complement primary register + */ +SC_FUNC void neg(void) +{ + stgwrite("\tneg\n"); + code_idx+=opcodes(1); +} + +/* + * one's complement of primary register + */ +SC_FUNC void invert(void) +{ + stgwrite("\tinvert\n"); + code_idx+=opcodes(1); +} + +/* + * nop + */ +SC_FUNC void nooperation(void) +{ + stgwrite("\tnop\n"); + code_idx+=opcodes(1); +} + + +/* increment symbol + */ +SC_FUNC 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. + */ +SC_FUNC 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 + */ +SC_FUNC void jmp_ne0(int number) +{ + stgwrite("\tjnz "); + outval(number,TRUE); + code_idx+=opcodes(1)+opargs(1); +} + +/* + * Jumps to "label" if PRI == 0 + */ +SC_FUNC 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 */ +SC_FUNC void outval(cell val,int newline) +{ + stgwrite(itoh(val)); + if (newline) + stgwrite("\n"); +} diff --git a/legacy/embryo/src/bin/embryo_cc_sc5.c b/legacy/embryo/src/bin/embryo_cc_sc5.c new file mode 100644 index 0000000000..611699d0c9 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc5.c @@ -0,0 +1,165 @@ +/* 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$ + */ +#include +#if defined __WIN32__ || defined _WIN32 || defined __MSDOS__ + #include +#endif +#if defined LINUX || defined __GNUC__ + #include +#endif +#include +#include +#include /* ANSI standardized variable argument list functions */ +#include +#if defined FORTIFY + #include "fortify.h" +#endif +#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_sc5.scp" + +#if defined _MSC_VER + #pragma warning(pop) +#endif + +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 (reffered to only) + * fline (reffered to only) + * fcurrent (reffered to only) + * errflag (altered) + */ +SC_FUNC int error(int number,...) +{ +static char *prefix[3]={ "error", "fatal error", "warning" }; +static int lastline,lastfile,errorcount; + char *msg,*pre; + va_list argptr; + char string[128]; + + /* 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]; + pre=prefix[0]; + errflag=TRUE; /* set errflag (skip rest of erroneous expression) */ + errnum++; + } else if (number<200){ + msg=fatalmsg[number-100]; + pre=prefix[1]; + errnum++; /* a fatal error also counts as an error */ + } else { + msg=warnmsg[number-200]; + pre=prefix[2]; + warnnum++; + } /* if */ + + strexpand(string,(unsigned char *)msg,sizeof string,SCPACK_TABLE); + + assert(errstart<=fline); + va_start(argptr,number); + if (strlen(errfname)==0) { + int start= (errstart==fline) ? -1 : errstart; + if (sc_error(number,string,inpfname,start,fline,argptr)) { + sc_closeasm(outf,TRUE); + outf=NULL; + longjmp(errbuf,3); /* user abort */ + } /* if */ + } else { + FILE *fp=fopen(errfname,"at"); + if (fp!=NULL) { + if (errstart>=0 && errstart!=fline) + fprintf(fp,"%s(%d -- %d) : %s %03d: ",inpfname,errstart,fline,pre,number); + else + fprintf(fp,"%s(%d) : %s %03d: ",inpfname,fline,pre,number); + vfprintf(fp,string,argptr); + fclose(fp); + } /* if */ + } /* if */ + va_end(argptr); + + if (number>=100 && number<200 || errnum>25){ + if (strlen(errfname)==0) { + va_start(argptr,number); + sc_error(0,"\nCompilation aborted.",NULL,0,0,argptr); + va_end(argptr); + } /* if */ + if (outf!=NULL) { + sc_closeasm(outf,TRUE); + 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) || lastlinefline || 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; +} + +SC_FUNC 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; + } /* switch */ +} + +#undef SCPACK_TABLE diff --git a/legacy/embryo/src/bin/embryo_cc_sc5.scp b/legacy/embryo/src/bin/embryo_cc_sc5.scp new file mode 100644 index 0000000000..a64513da3e --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc5.scp @@ -0,0 +1,283 @@ +/* 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$ + */ + +SC_FUNC 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 ;\"\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/legacy/embryo/src/bin/embryo_cc_sc6.c b/legacy/embryo/src/bin/embryo_cc_sc6.c new file mode 100644 index 0000000000..44381f45c1 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc6.c @@ -0,0 +1,967 @@ +/* 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$ + */ +#include +#include +#include /* for macro max() */ +#include +#include +#if defined LINUX + #include +#endif +#if defined FORTIFY + #include "fortify.h" +#endif +#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!=NULL) + *n=s; + if (negate) + result=(~result)+1; /* take two's complement of the result */ + return (ucell)result; +} + +#if BYTE_ORDER==BIG_ENDIAN +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!=NULL) { + *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,char *params,cell opcode) +{ + return 0; +} + +#if defined __BORLANDC__ || defined __WATCOMC__ + #pragma argsused +#endif +static cell parm0(FILE *fbin,char *params,cell opcode) +{ + if (fbin!=NULL) + 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!=NULL) { + 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!=NULL) { + 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) +{ + ucell p; + int num = 0; + + while (*params!='\0') { + p=hex2long(params,¶ms); + if (fbin!=NULL) + 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(iident==iFUNCTN || sym->ident==iREFFUNC); + assert(sym->vclass==sGLOBAL); + + p=sym->addr; + if (fbin!=NULL) { + 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 && i0 && 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!=NULL) { + 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=0 && i=0 && i=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 (low0) + low=mid+1; + else + high=mid; + } /* while */ + + assert(low==high); + if (stricmp(str,opcodelist[low].name)==0) + return low; /* found */ + return 0; /* not found, return special index */ +} + +SC_FUNC void assemble(FILE *fout,FILE *fin) +{ + typedef struct tagFUNCSTUB { + uint32_t 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; + int16_t count; + symbol *sym, **nativelist; + constvalue *constptr; + cell mainaddr; + + #if !defined NDEBUG + /* verify that the opcode list is sorted (skip entry 1; it is reserved + * for a non-existant opcode) + */ + assert(opcodelist[1].name!=NULL); + for (i=2; i<(sizeof opcodelist / sizeof opcodelist[0]); i++) { + assert(opcodelist[i].name!=NULL); + assert(stricmp(opcodelist[i].name,opcodelist[i-1].name)>0); + } /* for */ + #endif + + writeerror=FALSE; + nametablesize=sizeof(int16_t); + numpublics=0; + numnatives=0; + numpubvars=0; + mainaddr=-1; + /* count number of public and native functions and public variables */ + for (sym=glbtab.next; sym!=NULL; 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(strlen(alias)>0); + nametablesize+=strlen(alias)+1; + } /* if */ + } /* for */ + assert(numnatives==ntv_funcid); + + /* count number of libraries */ + numlibraries=0; + for (constptr=libname_tab.next; constptr!=NULL; constptr=constptr->next) { + if (constptr->value>0) { + assert(strlen(constptr->name)>0); + numlibraries++; + nametablesize+=strlen(constptr->name)+1; + } /* if */ + } /* for */ + + /* count number of public tags */ + numtags=0; + for (constptr=tagname_tab.next; constptr!=NULL; constptr=constptr->next) { + if ((constptr->value & PUBLICTAG)!=0) { + assert(strlen(constptr->name)>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; + #if BYTE_ORDER==BIG_ENDIAN + hdr.flags|=AMX_FLAG_BIGENDIAN; + #endif + hdr.defsize=sizeof(FUNCSTUB); + assert((hdr.defsize % sizeof(cell))==0); + hdr.publics=sizeof hdr; /* public table starts right after the header */ + hdr.natives=hdr.publics + numpublics*sizeof(FUNCSTUB); + hdr.libraries=hdr.natives + numnatives*sizeof(FUNCSTUB); + hdr.pubvars=hdr.libraries + numlibraries*sizeof(FUNCSTUB); + hdr.tags=hdr.pubvars + numpubvars*sizeof(FUNCSTUB); + hdr.nametable=hdr.tags + numtags*sizeof(FUNCSTUB); + 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 */ + #if BYTE_ORDER==BIG_ENDIAN + align32(&hdr.size); + align16(&hdr.magic); + align16(&hdr.flags); + align16(&hdr.defsize); + align32(&hdr.publics); + align32(&hdr.natives); + align32(&hdr.libraries); + align32(&hdr.pubvars); + align32(&hdr.tags); + align32(&hdr.nametable); + align32(&hdr.cod); + align32(&hdr.dat); + align32(&hdr.hea); + align32(&hdr.stp); + align32(&hdr.cip); + #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; nameofsnext) { + if (sym->ident==iFUNCTN + && (sym->usage & uPUBLIC)!=0 && (sym->usage & uDEFINE)!=0) + { + assert(sym->vclass==sGLOBAL); + func.address=sym->addr; + func.nameofs=nameofs; + #if BYTE_ORDER==BIG_ENDIAN + align32(&func.address); + align32(&func.nameofs); + #endif + fseek(fout,hdr.publics+count*sizeof(FUNCSTUB),SEEK_SET); + sc_writebin(fout,&func,sizeof func); + fseek(fout,func.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==NULL) + error(103); /* insufficient memory */ + #if !defined NDEBUG + memset(nativelist,0,numnatives*sizeof(symbol *)); /* for NULL checking */ + #endif + for (sym=glbtab.next; sym!=NULL; 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; iname)) { + assert(strlen(sym->name)<=sNAMEMAX); + strcpy(alias,sym->name); + } /* if */ + assert(sym->vclass==sGLOBAL); + func.address=0; + func.nameofs=nameofs; + #if BYTE_ORDER==BIG_ENDIAN + align32(&func.address); + align32(&func.nameofs); + #endif + fseek(fout,hdr.natives+count*sizeof(FUNCSTUB),SEEK_SET); + sc_writebin(fout,&func,sizeof func); + fseek(fout,func.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!=NULL; constptr=constptr->next) { + if (constptr->value>0) { + assert(strlen(constptr->name)>0); + func.address=0; + func.nameofs=nameofs; + #if BYTE_ORDER==BIG_ENDIAN + align32(&func.address); + align32(&func.nameofs); + #endif + fseek(fout,hdr.libraries+count*sizeof(FUNCSTUB),SEEK_SET); + sc_writebin(fout,&func,sizeof func); + fseek(fout,func.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!=NULL; 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; + #if BYTE_ORDER==BIG_ENDIAN + align32(&func.address); + align32(&func.nameofs); + #endif + fseek(fout,hdr.pubvars+count*sizeof(FUNCSTUB),SEEK_SET); + sc_writebin(fout,&func,sizeof func); + fseek(fout,func.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!=NULL; constptr=constptr->next) { + if ((constptr->value & PUBLICTAG)!=0) { + assert(strlen(constptr->name)>0); + func.address=constptr->value & TAGMASK; + func.nameofs=nameofs; + #if BYTE_ORDER==BIG_ENDIAN + align32(&func.address); + align32(&func.nameofs); + #endif + fseek(fout,hdr.tags+count*sizeof(FUNCSTUB),SEEK_SET); + sc_writebin(fout,&func,sizeof func); + fseek(fout,func.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==hdr.nametable+nametablesize); + fseek(fout,hdr.nametable,SEEK_SET); + count=sNAMEMAX; + #if BYTE_ORDER==BIG_ENDIAN + align16(&count); + #endif + sc_writebin(fout,&count,sizeof count); + fseek(fout,hdr.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==NULL) + error(103); /* insufficient memory */ + codeindex=0; + sc_resetasm(fin); + while (sc_readasm(fin,line,sizeof line)!=NULL) { + 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(lindexinstr); + i=findopcode(instr,(int)(params-instr)); + if (opcodelist[i].name==NULL) { + *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)!=NULL) { + 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!=NULL) { + 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); + #if BYTE_ORDER==BIG_ENDIAN + 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/legacy/embryo/src/bin/embryo_cc_sc7.c b/legacy/embryo/src/bin/embryo_cc_sc7.c new file mode 100644 index 0000000000..5f12ee6f22 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sc7.c @@ -0,0 +1,606 @@ +/* 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$ + */ +#include +#include +#include /* for atoi() */ +#include +#include +#if defined FORTIFY + #include "fortify.h" +#endif +#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==NULL; /* if previously none, empty buffer explicitly */ + + assert(stgmaxsSTG_MAX) + error(102,"staging buffer"); /* staging buffer overflow (fatal error) */ + stgmax=requiredsize+sSTG_GROW; + if (stgbuf!=NULL) + p=(char *)realloc(stgbuf,stgmax*sizeof(char)); + else + p=(char *)malloc(stgmax*sizeof(char)); + if (p==NULL) + error(102,"staging buffer"); /* staging buffer overflow (fatal error) */ + stgbuf=p; + if (clear) + *stgbuf='\0'; +} + +SC_FUNC void stgbuffer_cleanup(void) +{ + if (stgbuf!=NULL) { + 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) + */ +SC_FUNC 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) + */ +SC_FUNC 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) + */ +SC_FUNC 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 usefull + * '[...|...] 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=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 (ptr0) + 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; + +SC_FUNC int phopt_init(void) +{ + int number, i, len; + char str[160]; + + /* count number of sequences */ + for (number=0; sequences_cmp[number].find!=NULL; number++) + /* nothing */; + number++; /* include an item for the NULL terminator */ + + if ((sequences=(SEQUENCE*)malloc(number * sizeof(SEQUENCE)))==NULL) + return FALSE; + + /* pre-initialize all to NULL (in case of failure) */ + for (i=0; i=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=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))==NULL) + return (char*)error(103); + + /* 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=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 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/legacy/embryo/src/bin/embryo_cc_scexpand.c b/legacy/embryo/src/bin/embryo_cc_scexpand.c new file mode 100644 index 0000000000..034b794839 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_scexpand.c @@ -0,0 +1,67 @@ +/* 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 +#include +#include "embryo_cc_sc.h" + +#define STACKSIZE 16 + +SC_FUNC int strexpand(char *dest, unsigned char *source, int maxlen, unsigned char pairtable[128][2]) +{ + unsigned char stack[STACKSIZE]; + short c, top = 0; + int len; + + assert(maxlen > 0); + 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) { + assert(top+2 <= STACKSIZE); + stack[top++] = pairtable[c-128][1]; + stack[top++] = pairtable[c-128][0]; + } + else { + len++; + if (maxlen > 1) { /* reserve one byte for the '\0' */ + *dest++ = (char)c; + maxlen--; + } + } + } + *dest = '\0'; + return len; /* return number of bytes decoded */ +} + +#if 0 /*for testing*/ +#include "sc5.scp" + +int main (int argc, char **argv) +{ + int i; + char str[128]; + + for (i=0; i<58; i++) { + strexpand(str, errmsg[i], sizeof str, SCPACK_TABLE); + printf("%s", str); + } /* for */ + return 0; +} +#endif diff --git a/legacy/embryo/src/bin/embryo_cc_sclib.c b/legacy/embryo/src/bin/embryo_cc_sclib.c new file mode 100644 index 0000000000..760018e0af --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sclib.c @@ -0,0 +1,218 @@ +/* SCLIB.C + * + * This is an example file that shows how to embed the Small compiler into a + * program. This program contains the "default" implementation of all + * functions that the Small compiler calls for I/O. + * + * This program also contains a main(), so it compiles, again, to a + * stand-alone compiler. This is for illustration purposes only + * + * What this file does is (in sequence): + * 1. Declare the NO_MAIN macro, so that the function main() and all + * "callback" functions that are in SC1.C are not compiled. + * 2. Declare SC_FUNC and SC_VDEFINE as "static" so that all functions and + * global variables are "encapsulated" in the object file. This solves + * the global namespace polution problem. + * 3. Declare the SC_SKIP_VDECL macro which is needed to avoid variables to + * be doubly declared when the C files are *not* independently compiled. + * 4. And, the dirtiest trick of all, include the remaining C files. That is, + * the entire Small compiler compiles to a single object file (.OBJ in + * Windows). This is the only way to get rid of the global namespace + * polution. + * + * Note that the interface of the Small compiler is subject to change. + * + * Compilation: + * wcl386 /l=nt sclib.c + * + * Copyright (c) ITB CompuPhase, 2000-2003 + * This file may be freely used. No warranties of any kind. + */ +#include +#include +#include + +#define NO_MAIN +#define SC_FUNC static +#define SC_VDEFINE static +#define SC_SKIP_VDECL /* skip variable "forward declaration" */ +#include "sc.h" + +#include "scvars.c" +#include "sc1.c" +#include "sc2.c" +#include "sc3.c" +#include "sc4.c" +#include "sc5.c" +#include "sc6.c" +#include "sc7.c" +#include "sclist.c" +#include "scexpand.c" + +int main(int argc, char **argv) +{ + return sc_compile(argc,argv); +} + +/* sc_printf + * Called for general purpose "console" output. This function prints general + * purpose messages; errors go through sc_error(). The function is modelled + * after printf(). + */ +int sc_printf(const char *message,...) +{ + int ret; + va_list argptr; + + va_start(argptr,message); + ret=vprintf(message,argptr); + va_end(argptr); + + return ret; +} + +/* sc_error + * Called for producing error output. + * number the error number (as documented in the manual) + * message a string describing the error with embedded %d and %s tokens + * filename the name of the file currently being parsed + * firstline the line number at which the expression started on which + * the error was found, or -1 if there is no "starting line" + * lastline the line number at which the error was detected + * argptr a pointer to the first of a series of arguments (for macro + * "va_arg") + * Return: + * If the function returns 0, the parser attempts to continue compilation. + * On a non-zero return value, the parser aborts. + */ +int sc_error(int number,char *message,char *filename,int firstline,int lastline,va_list argptr) +{ +static char *prefix[3]={ "Error", "Fatal", "Warning" }; + + if (number!=0) { + char *pre; + + pre=prefix[number/100]; + if (firstline>=0) + printf("%s(%d -- %d) %s [%03d]: ",filename,firstline,lastline,pre,number); + else + printf("%s(%d) %s [%03d]: ",filename,lastline,pre,number); + } /* if */ + vprintf(message,argptr); + fflush(stdout); + return 0; +} + +/* sc_opensrc + * Opens a source file (or include file) for reading. The "file" does not have + * to be a physical file, one might compile from memory. + * filename the name of the "file" to read from + * Return: + * The function must return a pointer, which is used as a "magic cookie" to + * all I/O functions. When failing to open the file for reading, the + * function must return NULL. + */ +void *sc_opensrc(char *filename) +{ + return fopen(filename,"rt"); +} + +/* sc_closesrc + * Closes a source file (or include file). The "handle" parameter has the + * value that sc_opensrc() returned in an earlier call. + */ +void sc_closesrc(void *handle) +{ + assert(handle!=NULL); + fclose((FILE*)handle); +} + +/* sc_resetsrc + * "position" may only hold a pointer that was previously obtained from + * sc_getpossrc() */ +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; + + fgetpos((FILE*)handle,&lastpos); + return &lastpos; +} + +int sc_eofsrc(void *handle) +{ + return feof((FILE*)handle); +} + +/* should return a pointer, which is used as a "magic cookie" to all I/O + * functions; return NULL for failure + */ +void *sc_openasm(char *filename) +{ + return fopen(filename,"w+t"); +} + +void sc_closeasm(void *handle, int deletefile) +{ + fclose((FILE*)handle); + if (deletefile) + unlink(outfname); +} + +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); +} + +/* Should return a pointer, which is used as a "magic cookie" to all I/O + * functions; return NULL for failure. + */ +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 fwrite(buffer,1,size,(FILE*)handle) == size; +} + +long sc_lengthbin(void *handle) +{ + return ftell((FILE*)handle); +} + diff --git a/legacy/embryo/src/bin/embryo_cc_sclinux.h b/legacy/embryo/src/bin/embryo_cc_sclinux.h new file mode 100644 index 0000000000..aeed6b9687 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sclinux.h @@ -0,0 +1,47 @@ +/* + * Things needed to compile under linux. + * + * Should be reworked totally to use GNU's 'configure' + */ + +/* + * Getchar is not a 'cool' replacement for MSDOS getch: Linux/unix depends on the features activated or not about the + * controlling terminal's tty. This means that ioctl(2) calls must be performed, for instance to have the controlling terminal tty's + * in 'raw' mode, if we want to be able to fetch a single character. This also means that everything must be put back + * correctly when the program ends. + * + * For interactive use of SRUN/SDBG if would be much better to use GNU's readline package: the user would be able to have + * a complete emacs/vi like line editing system. + * + * So we stick to getchar at the moment... (one needs to key ctrl-d to terminate input if getch is called with a controlling + * terminal driven by a tty having -raw) + */ +#define getch getchar +#define stricmp(a,b) strcasecmp(a,b) +#define strnicmp(a,b,c) strncasecmp(a,b,c) + +/* + * WinWorld wants '\'. Unices do not. + */ +#define DIRECTORY_SEP_CHAR '/' +#define DIRECTORY_SEP_STR "/" + +/* + * SC assumes that a computer is Little Endian unless told otherwise. It uses + * (and defines) the macros BYTE_ORDER and BIG_ENDIAN. + * For Linux, we must overrule these settings with those defined in glibc. + */ +#if !defined __BYTE_ORDER +# include +#endif + +#if defined __OpenBSD__ +# define __BYTE_ORDER BYTE_ORDER +# define __LITTLE_ENDIAN LITTLE_ENDIAN +# define __BIG_ENDIAN BIG_ENDIAN +#endif + +#if !defined __BYTE_ORDER +# error "Can't figure computer byte order (__BYTE_ORDER macro not found)" +#endif + diff --git a/legacy/embryo/src/bin/embryo_cc_sclist.c b/legacy/embryo/src/bin/embryo_cc_sclist.c new file mode 100644 index 0000000000..3dcad35324 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_sclist.c @@ -0,0 +1,279 @@ +/* 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$ + */ +#include +#include +#include +#include "embryo_cc_sc.h" + +#if defined FORTIFY + #include "fortify.h" +#endif + +/* a "private" implementation of strdup(), so that porting + * to other memory allocators becomes easier. + * By Søren Hannibal. + */ +SC_FUNC char* duplicatestring(const char* sourcestring) +{ + char* result=malloc(strlen(sourcestring)+1); + strcpy(result,sourcestring); + return result; +} + + +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)))==NULL) + return NULL; + cur->first=duplicatestring(first); + cur->second=duplicatestring(second); + cur->matchlength=matchlength; + if (cur->first==NULL || cur->second==NULL) { + if (cur->first!=NULL) + free(cur->first); + if (cur->second!=NULL) + free(cur->second); + free(cur); + return NULL; + } /* if */ + /* link the node to the tree, find the position */ + for (pred=root; pred->next!=NULL && 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!=NULL) { + 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!=NULL && 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!=NULL) { + 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}; /* alias table */ + +SC_FUNC 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)))==NULL) + error(103); /* insufficient memory (fatal error) */ + return cur; +} + +SC_FUNC stringpair *find_alias(char *name) +{ + return find_stringpair(alias_tab.next,name,strlen(name)); +} + +SC_FUNC int lookup_alias(char *target,char *name) +{ + stringpair *cur=find_stringpair(alias_tab.next,name,strlen(name)); + if (cur!=NULL) { + assert(strlen(cur->second)<=sEXPMAX); + strcpy(target,cur->second); + } /* if */ + return cur!=NULL; +} + +SC_FUNC void delete_aliastable(void) +{ + delete_stringpairtable(&alias_tab); +} + +/* ----- include paths list -------------------------------------- */ +static stringlist includepaths = {NULL, NULL}; /* directory list for include files */ + +SC_FUNC stringlist *insert_path(char *path) +{ + stringlist *cur; + + assert(path!=NULL); + if ((cur=(stringlist*)malloc(sizeof(stringlist)))==NULL) + error(103); /* insufficient memory (fatal error) */ + if ((cur->line=duplicatestring(path))==NULL) + error(103); /* insufficient memory (fatal error) */ + cur->next=includepaths.next; + includepaths.next=cur; + return cur; +} + +SC_FUNC char *get_path(int index) +{ + stringlist *cur = includepaths.next; + + while (cur!=NULL && index-->0) + cur=cur->next; + if (cur!=NULL) { + assert(cur->line!=NULL); + return cur->line; + } /* if */ + return NULL; +} + +SC_FUNC void delete_pathtable(void) +{ + stringlist *cur=includepaths.next, *next; + + while (cur!=NULL) { + next=cur->next; + assert(cur->line!=NULL); + free(cur->line); + free(cur); + cur=next; + } /* while */ + memset(&includepaths,0,sizeof(stringlist)); +} + + +/* ----- text substitution patterns ------------------------------ */ +#if !defined NO_DEFINE + +static stringpair substpair = { NULL, NULL, NULL}; /* 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!=NULL && cur->first[0]!=c; cur=cur->next) + /* nothing */; + substindex[(int)c-'A']=cur; +} + +SC_FUNC 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))==NULL) + error(103); /* insufficient memory (fatal error) */ + adjustindex(*pattern); + return cur; +} + +SC_FUNC 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!=NULL) + item=find_stringpair(item,name,length); + return item; +} + +SC_FUNC 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!=NULL) + item=find_stringpair(item,name,length); + if (item==NULL) + return FALSE; + delete_stringpair(&substpair,item); + adjustindex(*name); + return TRUE; +} + +SC_FUNC void delete_substtable(void) +{ + int i; + delete_stringpairtable(&substpair); + for (i=0; i +#include +#include +#include +#include + +#if UINT_MAX > 0xFFFFU + #define MAXSIZE 1024*1024L +#else + #define MAXSIZE UINT_MAX /* Input file buffer size */ +#endif +#define HASHSIZE 8192 /* Hash table size, power of 2 */ +#define THRESHOLD 3 /* Increase for speed, min 3 */ + +#define START_TOKEN "#ifdef SCPACK" /* start reading the buffer here */ +#define NAME_TOKEN "#define SCPACK_TABLE" +#define SEP_TOKEN "#define SCPACK_SEPARATOR" +#define TERM_TOKEN "#define SCPACK_TERMINATOR" +#define TEMPFILE "~SCPACK.TMP" +static char tablename[32+1] = "scpack_table"; +static char separator[16]=","; +static char terminator[16]=""; + +int compress(unsigned char *buffer, unsigned buffersize, unsigned char pairtable[128][2]) +{ + unsigned char *left, *right, *count; + unsigned char a, b, bestcount; + unsigned i, j, index, bestindex, code=128; + + /* Dynamically allocate buffers and check for errors */ + left = (unsigned char *)malloc(HASHSIZE); + right = (unsigned char *)malloc(HASHSIZE); + count = (unsigned char *)malloc(HASHSIZE); + if (left==NULL || right==NULL || count==NULL) { + printf("Error allocating memory\n"); + exit(1); + } + + /* Check for errors */ + for (i=0; i 127) { + printf("This program works only on text files (7-bit ASCII)\n"); + exit(1); + } + + memset(pairtable, 0, 128*2*sizeof(char)); + + do { /* Replace frequent pairs with bytes 128..255 */ + + /* Enter counts of all byte pairs into hash table */ + memset(count,0,HASHSIZE); + for (i=0; i bestcount) { + bestcount = count[i]; + bestindex = i; + } + } + + /* Compress if enough occurrences of pair */ + if (bestcount >= THRESHOLD) { + + /* Add pair to table using code as index */ + a = pairtable[code-128][0] = left[bestindex]; + b = pairtable[code-128][1] = right[bestindex]; + + /* Replace all pair occurrences with unused byte */ + for (i=0, j=0; i= 128 || *bufptr == '"' || *bufptr == '\\') + fprintf(output, "\\%03o", *bufptr); + else + fprintf(output, "%c", *bufptr); + bufptr++; + } /* while */ + fprintf(output, "\""); + needseparator = 1; + bufptr++; /* skip '\0' */ + } /* while */ + fprintf(output, "%s\n",terminator); + bufptr++; + + /* skip the input file until the #endif section */ + while (fgets(str,sizeof str,input)!=NULL) { + if (strmatch(str,"#endif",NULL)) { + fprintf(output,"%s",str); + break; /* done */ + } /* if */ + } /* while */ + } /* while - !feof(input) */ +} + +static void usage(void) +{ + printf("Usage: scpack [output file]\n"); + exit(1); +} + +int main(int argc, char **argv) +{ + FILE *in, *out; + unsigned char *buffer; + unsigned buffersize, orgbuffersize; + unsigned char pairtable[128][2]; + + if (argc < 2 || argc > 3) + usage(); + if ((in=fopen(argv[1],"rt"))==NULL) { + printf("SCPACK: error opening input %s\n",argv[1]); + usage(); + } /* if */ + if (argc == 2) { + if ((out=fopen(TEMPFILE,"wt"))==NULL) { + printf("SCPACK: error opening temporary file %s\n",TEMPFILE); + usage(); + } /* if */ + } else { + if ((out=fopen(argv[2],"wt"))==NULL) { + printf("SCPACK: error opening output file %s\n",argv[2]); + usage(); + } /* if */ + } /* if */ + + buffer = (unsigned char *)malloc(MAXSIZE); + if (buffer == NULL) { + printf("SCPACK: error allocating memory\n"); + return 1; + } /* if */ + /* 1. read the buffer + * 2. compress the buffer + * 3. copy the file, insert the compressed buffer + */ + buffersize = readbuffer(in, buffer); + orgbuffersize = buffersize; + if (buffersize > 0) { + buffersize = compress(buffer, buffersize, pairtable); + writefile(in, out, buffer, buffersize, pairtable); + printf("SCPACK: compression ratio: %ld%% (%d -> %d)\n", + 100L-(100L*buffersize)/orgbuffersize, orgbuffersize, buffersize); + } else { + printf("SCPACK: no SCPACK section found, nothing to do\n"); + } /* if */ + fclose(out); + fclose(in); + /* let the new file replace the old file */ + if (buffersize == 0) { + if (argc == 2) + unlink(TEMPFILE); + else + unlink(argv[2]); + } else if (argc == 2) { + unlink(argv[1]); + rename(TEMPFILE,argv[1]); + } /* if */ + return 0; +} diff --git a/legacy/embryo/src/bin/embryo_cc_scstub.c b/legacy/embryo/src/bin/embryo_cc_scstub.c new file mode 100644 index 0000000000..4937d50830 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_scstub.c @@ -0,0 +1,29 @@ +#include +#include +#include + +static char filename[] = "scdos.exe"; + +int main(int argc, char *argv[]) +{ + int result; + + /* build a command line to pass on to the "DOS" program */ + char path[80], *ptr; + strcpy(path,argv[0]); + ptr=strrchr(path,'\\'); + if (ptr==NULL) + ptr=strchr(path,':'); + if (ptr==NULL) { + strcpy(path,filename); + } else { + strcpy(ptr+1,filename); + } /* if */ + + /* launch the DOS version of the tool */ + result=execv(path,argv); + if (result==-1) + printf("Error launching '%s'\n",path); + return result; +} + diff --git a/legacy/embryo/src/bin/embryo_cc_scvars.c b/legacy/embryo/src/bin/embryo_cc_scvars.c new file mode 100644 index 0000000000..a1b9d466f8 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_cc_scvars.c @@ -0,0 +1,99 @@ +/* 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$ + */ +#include +#include /* for _MAX_PATH */ +#include "embryo_cc_sc.h" + +/* global variables + * + * All global variables that are shared amongst the compiler files are + * declared here. + */ +SC_VDEFINE symbol loctab; /* local symbol table */ +SC_VDEFINE symbol glbtab; /* global symbol table */ +SC_VDEFINE cell *litq; /* the literal queue */ +SC_VDEFINE char pline[sLINEMAX+1]; /* the line read from the input file */ +SC_VDEFINE char *lptr; /* points to the current position in "pline" */ +SC_VDEFINE constvalue tagname_tab = { NULL, "", 0, 0}; /* tagname table */ +SC_VDEFINE constvalue libname_tab = { NULL, "", 0, 0}; /* library table (#pragma library "..." syntax) */ +SC_VDEFINE constvalue *curlibrary = NULL;/* current library */ +SC_VDEFINE symbol *curfunc; /* pointer to current function */ +SC_VDEFINE char *inpfname; /* pointer to name of the file currently read from */ +SC_VDEFINE char outfname[_MAX_PATH]; /* output file name */ +SC_VDEFINE char errfname[_MAX_PATH]; /* error file name */ +SC_VDEFINE char sc_ctrlchar = CTRL_CHAR;/* the control character (or escape character)*/ +SC_VDEFINE int litidx = 0; /* index to literal table */ +SC_VDEFINE int litmax = sDEF_LITMAX;/* current size of the literal table */ +SC_VDEFINE int stgidx = 0; /* index to the staging buffer */ +SC_VDEFINE int labnum = 0; /* number of (internal) labels */ +SC_VDEFINE int staging = 0; /* true if staging output */ +SC_VDEFINE cell declared = 0; /* number of local cells declared */ +SC_VDEFINE cell glb_declared=0; /* number of global cells declared */ +SC_VDEFINE cell code_idx = 0; /* number of bytes with generated code */ +SC_VDEFINE int ntv_funcid= 0; /* incremental number of native function */ +SC_VDEFINE int errnum = 0; /* number of errors */ +SC_VDEFINE int warnnum = 0; /* number of warnings */ +SC_VDEFINE int sc_debug = sCHKBOUNDS; /* by default: bounds checking+assertions */ +SC_VDEFINE int charbits = 8; /* a "char" is 8 bits */ +SC_VDEFINE int sc_packstr= FALSE; /* strings are packed by default? */ +SC_VDEFINE int sc_asmfile= FALSE; /* create .ASM file? */ +SC_VDEFINE int sc_listing= FALSE; /* create .LST file? */ +SC_VDEFINE int sc_compress=TRUE; /* compress bytecode? */ +SC_VDEFINE int sc_needsemicolon=TRUE;/* semicolon required to terminate expressions? */ +SC_VDEFINE int sc_dataalign=sizeof(cell);/* data alignment value */ +SC_VDEFINE int sc_alignnext=FALSE; /* must frame of the next function be aligned? */ +SC_VDEFINE int curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */ +SC_VDEFINE cell sc_stksize=sDEF_AMXSTACK;/* default stack size */ +SC_VDEFINE int freading = FALSE; /* Is there an input file ready for reading? */ +SC_VDEFINE int fline = 0; /* the line number in the current file */ +SC_VDEFINE int fnumber = 0; /* the file number in the file table (debugging) */ +SC_VDEFINE int fcurrent = 0; /* current file being processed (debugging) */ +SC_VDEFINE int intest = 0; /* true if inside a test */ +SC_VDEFINE int sideeffect= 0; /* true if an expression causes a side-effect */ +SC_VDEFINE int stmtindent= 0; /* current indent of the statement */ +SC_VDEFINE int indent_nowarn=FALSE;/* skip warning "217 loose indentation" */ +SC_VDEFINE int sc_tabsize=8; /* number of spaces that a TAB represents */ +SC_VDEFINE int sc_allowtags=TRUE; /* allow/detect tagnames in lex() */ +SC_VDEFINE int sc_status; /* read/write status */ +SC_VDEFINE int sc_rationaltag=0; /* tag for rational numbers */ +SC_VDEFINE int rational_digits=0; /* number of fractional digits */ + +SC_VDEFINE FILE *inpf = NULL; /* file read from (source or include) */ +SC_VDEFINE FILE *inpf_org= NULL; /* main source file */ +SC_VDEFINE FILE *outf = NULL; /* file written to */ + +SC_VDEFINE jmp_buf errbuf; + +#if !defined SC_LIGHT + SC_VDEFINE int sc_makereport=FALSE; /* generate a cross-reference report */ +#endif + +#if defined __WATCOMC__ && !defined NDEBUG + /* Watcom's CVPACK dislikes .OBJ files without functions */ + static int dummyfunc(void) + { + return 0; + } +#endif diff --git a/legacy/embryo/src/bin/embryo_main.c b/legacy/embryo/src/bin/embryo_main.c new file mode 100644 index 0000000000..190333be65 --- /dev/null +++ b/legacy/embryo/src/bin/embryo_main.c @@ -0,0 +1,235 @@ +#include "Embryo.h" + +#include +#include +#include +#include +#include +#include +#include + +/* debugging native calls */ +static int dochar(Embryo_Program *ep, char ch, Embryo_Cell param); +static int doesc(Embryo_Program *ep, char ch, Embryo_Cell param); +static int printstring(Embryo_Program *ep, Embryo_Cell *cstr, Embryo_Cell *params, int num); + +static int +dochar(Embryo_Program * ep, char ch, Embryo_Cell param) +{ + Embryo_Cell *cptr; + + switch (ch) + { + case '%': + putchar(ch); + return 0; + case 'c': + cptr = embryo_data_address_get(ep, param); + if (cptr) + putchar((int) *cptr); + return 1; + case 'i': + case 'd': + cptr = embryo_data_address_get(ep, param); + if (cptr) + printf("%i", (int) *cptr); + return 1; + case 'x': + cptr = embryo_data_address_get(ep, param); + if (cptr) + printf("%x", (unsigned int) *cptr); + return 1; + case 'f': + cptr = embryo_data_address_get(ep, param); + if (cptr) + printf("%f", (float)(*(float *)cptr)); + return 1; + case 'X': + cptr = embryo_data_address_get(ep, param); + if (cptr) + printf("%08x", (unsigned int) *cptr); + return 1; + case 's': + cptr = embryo_data_address_get(ep, param); + if (cptr) + printstring(ep, cptr, NULL, 0); + return 1; + } + putchar(ch); + return 0; +} + +static int +doesc(Embryo_Program * ep, char ch, Embryo_Cell param) +{ + Embryo_Cell *cptr; + + switch (ch) + { + case 'n': + putchar('\n'); + return 1; + case 't': + putchar('\t'); + return 1; + } + putchar(ch); + return 0; +} + +static int +printstring(Embryo_Program * ep, Embryo_Cell *cstr, Embryo_Cell *params, int num) +{ + int i; + int informat = 0, paramidx = 0, inesc = 0, len = 0; + int j = sizeof(Embryo_Cell) - sizeof(char); + char c; + char *str; + + /* the string is packed */ + i = 0; + len = embryo_data_string_length_get(ep, cstr); + str = alloca(len + 1); + embryo_data_string_get(ep, cstr, str); + for (i = 0;; i++) { + c = (char) (str[i]); + if (c == 0) + break; + if (informat) { + paramidx += dochar(ep, c, params[paramidx]); + informat = 0; + } else if (inesc) { + doesc(ep, c, params[paramidx]); + inesc = 0; + } else if (params != NULL && c == '%') { + informat = 1; + } else if (params != NULL && c == '\\') { + inesc = 1; + } else { + putchar(c); + } /* if */ + } /* for */ + return EMBRYO_ERROR_NONE; +} + +static Embryo_Cell +exported_printf(Embryo_Program *ep, Embryo_Cell *params) +{ + Embryo_Cell *cptr; + + // params[0] = number of bytes params passed + cptr = embryo_data_address_get(ep, params[1]); + printstring(ep, cptr, params + 2, (int) (params[0] / sizeof(Embryo_Cell)) - 1); + fflush(stdout); + return EMBRYO_ERROR_NONE; +} + +static Embryo_Cell +exported_call(Embryo_Program *ep, Embryo_Cell *params) +{ + Embryo_Cell *cptr; + + // params[0] = number of bytes of params passed + cptr = embryo_data_address_get(ep, params[1]); + if (cptr) + { + char buf[4096]; + + buf[0] = 0; + printf(".."); + embryo_data_string_get(ep, cptr, buf); + printf("OUT: \"%s\"", buf); + } + cptr = embryo_data_address_get(ep, params[3]); + if (cptr) + { + char buf[4096]; + + buf[0] = 0; + embryo_data_string_get(ep, cptr, buf); + printf(" \"%s\"", buf); + } + { + int v; + + v = params[3]; + printf(" %i", v); + } + printf("\n"); + return 10; +} + +void +exit_error(Embryo_Program *ep, int errorcode) +{ + printf("Run time error %d: \"%s\"\n", + errorcode, + embryo_error_string_get(errorcode)); + exit(-1); +} + +void PrintUsage(char *program) +{ + printf("Usage: %s \n", program); + exit(1); +} + +int +main(int argc,char *argv[]) +{ + Embryo_Program *ep; + Embryo_Cell val; + Embryo_Function fn; + int r; + int err; + + if (argc != 2) + { + printf("Usage: %s \n", argv[0]); + exit(-1); + } + ep = embryo_program_load(argv[1]); + if (!ep) + { + printf("Cannot load %s\n", argv[1]); + exit(-1); + } + embryo_program_native_call_add(ep, "call", exported_call); + embryo_program_native_call_add(ep, "printf", exported_printf); + + embryo_program_vm_push(ep); + val = embryo_program_variable_find(ep, "global1"); + if (val != EMBRYO_CELL_NONE) + { + Embryo_Cell *addr; + + addr = embryo_data_address_get(ep, val); + if (addr) printf("Global variable value = %i\n", (int)*addr); + } + else + printf("Cannot find variable\n"); + + fn = embryo_program_function_find(ep, "testfn"); + if (fn != EMBRYO_FUNCTION_NONE) + { + printf("Found testfn()\n"); + embryo_parameter_cell_push(ep, 9876); + embryo_parameter_string_push(ep, "K is a dirty fish"); + embryo_parameter_cell_push(ep, 127); + while ((r = embryo_program_run(ep, fn)) == EMBRYO_PROGRAM_SLEEP); + if (r == EMBRYO_PROGRAM_FAIL) printf("Run failed!\n"); + } + else + { + printf("Runing main()\n"); + while ((r = embryo_program_run(ep, EMBRYO_FUNCTION_MAIN)) == EMBRYO_PROGRAM_SLEEP); + if (r == EMBRYO_PROGRAM_FAIL) printf("Run failed!\n"); + } + embryo_program_vm_pop(ep); + + err = embryo_program_error_get(ep); + if (err != EMBRYO_ERROR_NONE) exit_error(ep, err); + printf("Program %s returns %i\n", argv[1], embryo_program_return_value_get(ep)); + embryo_program_free(ep); + return 0; +} diff --git a/legacy/embryo/src/lib/Embryo.h b/legacy/embryo/src/lib/Embryo.h new file mode 100644 index 0000000000..90278986b2 --- /dev/null +++ b/legacy/embryo/src/lib/Embryo.h @@ -0,0 +1,98 @@ +#ifndef _EMBRYO_H +#define _EMBRYO_H +/* + * FIXME: + * handle the case where: + * [C] -> [vm] -> [native call] -> [same or other func in same vm] + */ + +#ifdef __cplusplus +extern "C" { +#endif + + /* potentioal error values */ + enum + { + 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 */ + }; + + /* possible function type values that are enumerated */ +#define EMBRYO_FUNCTION_NONE 0x7fffffff /* an invalid/non existant function */ +#define EMBRYO_FUNCTION_MAIN -1 /* start at program entry point */ +#define EMBRYO_FUNCTION_CONT -2 /* continue from last address */ + /* an invalid cell reference */ +#define EMBRYO_CELL_NONE 0x7fffffff /* an invalid cell reference */ + /* program run return values */ +#define EMBRYO_PROGRAM_OK 1 +#define EMBRYO_PROGRAM_SLEEP 2 +#define EMBRYO_PROGRAM_BUSY 3 +#define EMBRYO_PROGRAM_FAIL 0 + +#define EMBRYO_FLOAT_TO_CELL(f) ( *((Embryo_Cell*)&f)) /* float to Embryo_Cell */ +#define EMBRYO_CELL_TO_FLOAT(c) ( *((float*)&c)) /* Embryo_Cell to float */ + + typedef unsigned int Embryo_UCell; + typedef int Embryo_Cell; + typedef struct _Embryo_Program Embryo_Program; + typedef int Embryo_Function; + + int embryo_init(void); + int embryo_shutdown(void); + + Embryo_Program *embryo_program_new(void *data, int size); + Embryo_Program *embryo_program_const_new(void *data, int size); + Embryo_Program *embryo_program_load(char *file); + void embryo_program_free(Embryo_Program *ep); + void embryo_program_native_call_add(Embryo_Program *ep, char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params)); + void embryo_program_vm_reset(Embryo_Program *ep); + void embryo_program_vm_push(Embryo_Program *ep); + void embryo_program_vm_pop(Embryo_Program *ep); + void embryo_swap_16(unsigned short *v); + void embryo_swap_32(unsigned int *v); + Embryo_Function embryo_program_function_find(Embryo_Program *ep, char *name); + Embryo_Cell embryo_program_variable_find(Embryo_Program *ep, char *name); + void embryo_program_error_set(Embryo_Program *ep, int error); + int embryo_program_error_get(Embryo_Program *ep); + const char *embryo_error_string_get(int error); + int embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell); + void embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst); + void embryo_data_string_set(Embryo_Program *ep, char *src, Embryo_Cell *str_cell); + Embryo_Cell *embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr); + Embryo_Cell embryo_data_heap_push(Embryo_Program *ep, int cells); + void embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to); + int embryo_program_run(Embryo_Program *ep, Embryo_Function func); + Embryo_Cell embryo_program_return_value_get(Embryo_Program *ep); + int embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell); + int embryo_parameter_string_push(Embryo_Program *ep, char *str); + int embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/legacy/embryo/src/lib/Makefile.am b/legacy/embryo/src/lib/Makefile.am new file mode 100644 index 0000000000..cc0140f1ff --- /dev/null +++ b/legacy/embryo/src/lib/Makefile.am @@ -0,0 +1,24 @@ +## Process this file with automake to produce Makefile.in + +AUTOMAKE_OPTIONS = 1.4 foreign + +# A list of all the files in the current directory which can be regenerated +MAINTAINERCLEANFILES = Makefile.in + +LDFLAGS = +INCLUDES = -I. \ + -I$(top_srcdir)/src/lib \ + -I$(top_srcdir)/src/lib/include + + +lib_LTLIBRARIES = libembryo.la +include_HEADERS = Embryo.h +libembryo_la_SOURCES = \ +embryo_amx.c \ +embryo_float.c \ +embryo_main.c \ +embryo_private.h + +libembryo_la_LIBADD = $(LDFLAGS) -lm +libembryo_la_DEPENDENCIES = $(top_builddir)/config.h +libembryo_la_LDFLAGS = -version-info 1:0:0 diff --git a/legacy/embryo/src/lib/embryo_amx.c b/legacy/embryo/src/lib/embryo_amx.c new file mode 100644 index 0000000000..bb5e3e52d5 --- /dev/null +++ b/legacy/embryo/src/lib/embryo_amx.c @@ -0,0 +1,1611 @@ +/* Abstract Machine for the Small compiler + * + * Copyright (c) ITB CompuPhase, 1997-2003 + * Portions Copyright (c) Carsten Haitzler, 2004 + * + * 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. + */ +#include "embryo_private.h" + +#define JUMPABS(base, ip) ((Embryo_Cell *)(code + (*ip))) + +static void _embryo_byte_swap_16 (unsigned short *v); +static void _embryo_byte_swap_32 (unsigned int *v); +static int _embryo_native_call (Embryo_Program *ep, Embryo_Cell index, Embryo_Cell *result, Embryo_Cell *params); +static int _embryo_func_get (Embryo_Program *ep, int index, char *funcname); +static int _embryo_var_get (Embryo_Program *ep, int index, char *varname, Embryo_Cell *ep_addr); +static int _embryo_program_init (Embryo_Program *ep, void *code); + +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; +} + +static int +_embryo_native_call(Embryo_Program *ep, Embryo_Cell index, 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, index); + 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 index, char *funcname) +{ + Embryo_Header *hdr; + Embryo_Func_Stub *func; + + hdr = (Embryo_Header *)ep->code; + if (index >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives)) + return EMBRYO_ERROR_INDEX; + + func = GETENTRY(hdr, publics, index); + strcpy(funcname, GETENTRYNAME(hdr, func)); + return EMBRYO_ERROR_NONE; +} + +static int +_embryo_var_get(Embryo_Program *ep, int index, char *varname, Embryo_Cell *ep_addr) +{ + + Embryo_Header *hdr; + Embryo_Func_Stub *var; + + hdr=(Embryo_Header *)ep->base; + if (index >= (Embryo_Cell)NUMENTRIES(hdr, pubvars, tags)) + return EMBRYO_ERROR_INDEX; + + var = GETENTRY(hdr, pubvars, index); + 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; + Embryo_Func_Stub *fs; + int i, num; + + 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); +#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); + if (*len > sNAMEMAX) return 0; + } + if (hdr->stp <= 0) return 0; + if ((hdr->flags & EMBRYO_FLAG_COMPACT)) return 0; + + /* 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); + } + ep->flags = EMBRYO_FLAG_RELOC; + + /* init native api for handling floating point - default in embryo */ + _embryo_fp_init(ep); + return 1; +} + +/*** EXPORTED CALLS ***/ + +Embryo_Program * +embryo_program_new(void *data, int size) +{ + Embryo_Program *ep; + void *code_data; + + if (size < 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; +} + +Embryo_Program * +embryo_program_const_new(void *data, int size) +{ + Embryo_Program *ep; + + if (size < 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; +} + +Embryo_Program * +embryo_program_load(char *file) +{ + Embryo_Program *ep; + 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); + rewind(f); + if (program_size < sizeof(Embryo_Header)) + { + fclose(f); + return NULL; + } + 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; +} + +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); +} + +void +embryo_program_native_call_add(Embryo_Program *ep, char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params)) +{ + Embryo_Func_Stub *func_entry; + Embryo_Header *hdr; + int i, num; + + if ((ep == NULL ) || (name == NULL) || (func == NULL)) return; + if (strlen(name) > sEXPMAX) 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 += 16; + calls = realloc(ep->native_calls, + ep->native_calls_alloc * sizeof(Embryo_Native)); + if (!calls) + { + ep->native_calls_size--; + ep->native_calls_alloc -= 16; + 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; + return; + } + } + func_entry = + (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize); + } +} + +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; +} + +void +embryo_program_vm_push(Embryo_Program *ep) +{ + Embryo_Header *hdr; + + if ((!ep) || (ep->base)) return; + hdr = (Embryo_Header *)ep->code; + ep->base = malloc(hdr->stp); + if (!ep->base) return; + embryo_program_vm_reset(ep); +} + +void +embryo_program_vm_pop(Embryo_Program *ep) +{ + if ((!ep) || (!ep->base)) return; + free(ep->base); + ep->base = NULL; +} + +void +embryo_swap_16(unsigned short *v) +{ +#ifdef WORDS_BIGENDIAN + _embryo_byte_swap_16(v); +#endif +} + +void +embryo_swap_32(unsigned int *v) +{ +#ifdef WORDS_BIGENDIAN + _embryo_byte_swap_32(v); +#endif +} + +Embryo_Function +embryo_program_function_find(Embryo_Program *ep, 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 + result = -1; + if (result > 0) last = mid - 1; + else if (result < 0) first = mid + 1; + else return mid; + } + return EMBRYO_FUNCTION_NONE; +} + +Embryo_Cell +embryo_program_variable_find(Embryo_Program *ep, 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 + result = -1; + if (result > 0) last = mid - 1; + else if (result < 0) first = mid + 1; + return paddr; + } + return EMBRYO_CELL_NONE; +} + +void +embryo_program_error_set(Embryo_Program *ep, int error) +{ + if (!ep) return; + ep->error = error; +} + +int +embryo_program_error_get(Embryo_Program *ep) +{ + if (!ep) return EMBRYO_ERROR_NONE; + return ep->error; +} + +const char * +embryo_error_string_get(int 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 ((error < 0) || (error >= (sizeof(messages) / sizeof(messages[0])))) + return (const char *)"(unknown)"; + return messages[error]; +} + +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; +} + +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++) dst[i] = str_cell[i]; + dst[i] = 0; +} + +void +embryo_data_string_set(Embryo_Program *ep, 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; + } + str_cell[i] = src[i]; + } + str_cell[i] = 0; +} + +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); +} + +Embryo_Cell +embryo_data_heap_push(Embryo_Program *ep, int cells) +{ + Embryo_Header *hdr; + unsigned char *data; + Embryo_Cell addr; + + if ((!ep) || (!ep->base)) return EMBRYO_CELL_NONE; + hdr = (Embryo_Header *)ep->base; + data = ep->base + (int)hdr->dat; + 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; +} + +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; +} + +int +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; + Embryo_Cell reset_stk, reset_hea, *cip; + Embryo_UCell codesize; + int i; + Embryo_Opcode op; + Embryo_Cell offs; + int num; + + if (!ep) return EMBRYO_PROGRAM_FAIL; + if (ep->run_count > 0) return EMBRYO_PROGRAM_BUSY; + 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; + } + + /* 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 = 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 = 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) + 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(); + + ep->run_count++; + + /* start running */ + for (;;) + { + 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: + /* verify address */ + if (pri>=hea && pri=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + pri= * (Embryo_Cell *)(data+(int)pri); + break; + case EMBRYO_OP_LODB_I: + GETPARAM(offs); + /* verify address */ + if (pri>=hea && pri=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + 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: + /* verify address */ + if (alt>=hea && alt=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + *(Embryo_Cell *)(data+(int)alt)=pri; + break; + case EMBRYO_OP_STRB_I: + GETPARAM(offs); + /* verify address */ + if (alt>=hea && alt=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + 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; + } /* switch */ + break; + case EMBRYO_OP_LIDX: + offs=pri*sizeof(Embryo_Cell)+alt; + /* verify address */ + if (offs>=hea && offs=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + pri= * (Embryo_Cell *)(data+(int)offs); + break; + case EMBRYO_OP_LIDX_B: + GETPARAM(offs); + offs=(pri << (int)offs)+alt; + /* verify address */ + if (offs>=hea && offs=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + 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)offscod; + 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); + /* verify the return address */ + 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); + /* verify the return address */ + 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 (prialt) + 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= prialt ? 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); + /* verify top & bottom memory addresses, for both source and destination + * addresses + */ + if (pri>=hea && pri=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if ((pri+offs)>hea && (pri+offs)(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if (alt>=hea && alt=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if ((alt+offs)>hea && (alt+offs)(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + memcpy(data+(int)alt, data+(int)pri, (int)offs); + break; + case EMBRYO_OP_CMPS: + GETPARAM(offs); + /* verify top & bottom memory addresses, for both source and destination + * addresses + */ + if (pri>=hea && pri=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if ((pri+offs)>hea && (pri+offs)(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if (alt>=hea && alt=(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + if ((alt+offs)>hea && (alt+offs)(Embryo_UCell)ep->stp) + ABORT(ep,EMBRYO_ERROR_MEMACCESS); + pri=memcmp(data+(int)alt, data+(int)pri, (int)offs); + break; + case EMBRYO_OP_FILL: + GETPARAM(offs); + /* verify top & bottom memory addresses (destination only) */ + if (((alt >= hea) && (alt < stk)) || + ((Embryo_UCell)alt >= (Embryo_UCell)ep->stp)) + ABORT(ep, EMBRYO_ERROR_MEMACCESS); + if ((((alt + offs) > hea) && ((alt + offs) < stk)) || + ((Embryo_UCell)(alt + offs) > (Embryo_UCell)ep->stp)) + ABORT(ep, EMBRYO_ERROR_MEMACCESS); + 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; + } + 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; + pri = ((Embryo_Native)offs)(ep, (Embryo_Cell *)(data + (int)stk)); + if (ep->error != EMBRYO_ERROR_NONE) + { + if (ep->error == 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; + + cptr = (Embryo_Cell *)*cip + 1; /* +1, to skip the "casetbl" opcode */ + cip = (Embryo_Cell *)*(cptr + 1); /* preset to "none-matched" case */ + num = (int)*cptr; /* number of records in the case table */ + for (cptr += 2; (num > 0) && (*cptr != pri); num--, cptr += 2); + if (num > 0) cip = (Embryo_Cell *)*(cptr + 1); /* case found */ + } + 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; + default: + ABORT(ep, EMBRYO_ERROR_INVINSTR); + } + } + ep->run_count--; + return EMBRYO_PROGRAM_OK; +} + +Embryo_Cell +embryo_program_return_value_get(Embryo_Program *ep) +{ + if (!ep) return 0; + return ep->retval; +} + +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; +} + +int +embryo_parameter_string_push(Embryo_Program *ep, 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; +} + +int +embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num) +{ + Embryo_Param *pr; + Embryo_Cell *cell_array; + + pr->cell_array = malloc(num * sizeof(Embryo_Cell)); + if ((!cells) || (num <= 0)) + return embryo_parameter_cell_push(ep, 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(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/legacy/embryo/src/lib/embryo_float.c b/legacy/embryo/src/lib/embryo_float.c new file mode 100644 index 0000000000..2b58e41581 --- /dev/null +++ b/legacy/embryo/src/lib/embryo_float.c @@ -0,0 +1,306 @@ +/* Float arithmetic for the Small AMX engine + * + * Copyright (c) Artran, Inc. 1999 + * Written by Greg Garner (gmg@artran.com) + * This file may be freely used. No warranties of any kind. + * Portions Copyright (c) Carsten Haitzler, 2004 + * + * CHANGES - + * 2002-08-27: Basic conversion of source from C++ to C by Adam D. Moss + * + * 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, + */ +#include +#include "embryo_private.h" + +#define PI 3.1415926535897932384626433832795 + +/* 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 (float)(angle * PI / 180.0); + case 2: /* grades, centesimal system */ + return (float)(angle * PI / 200.0); + default: /* assume already radian */ + break; + } + return angle; +} + +/* exported float api */ + +static Embryo_Cell +_embryo_fp(Embryo_Program *ep, 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 >= 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, 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, Embryo_Cell *params) +{ + /* params[1] = float dividend (top) */ + /* params[2] = float divisor (bottom) */ + 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_add(Embryo_Program *ep, 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, 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, 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 -= (float)(floor((double)f)); + return EMBRYO_FLOAT_TO_CELL(f); +} + +/* Return integer part of float, rounded */ +static Embryo_Cell +_embryo_fp_round(Embryo_Program *ep, 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 = (float)(floor((double)f)); + break; + case 2: /* round upwards */ + f = (float)(ceil((double)f)); + break; + case 3: /* round towards zero */ + if (f >= 0.0) f = (float)(floor((double)f)); + else f = (float)(ceil((double)f)); + break; + default: /* standard, round to nearest */ + f = (float)(floor((double)f + 0.5)); + break; + } + return (Embryo_Cell)f; +} + +static Embryo_Cell +_embryo_fp_cmp(Embryo_Program *ep, 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 = (float)sqrt(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, 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 = (float)pow(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; + + 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 = (float)log10(f); + else f = (float)(log(f) / log(ff)); + return EMBRYO_FLOAT_TO_CELL(f); +} + +static Embryo_Cell +_embryo_fp_sin(Embryo_Program *ep, 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 = sin(f); + return EMBRYO_FLOAT_TO_CELL(f); +} + +static Embryo_Cell +_embryo_fp_cos(Embryo_Program *ep, 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 = cos(f); + return EMBRYO_FLOAT_TO_CELL(f); +} + +static Embryo_Cell +_embryo_fp_tan(Embryo_Program *ep, 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 = tan(f); + return EMBRYO_FLOAT_TO_CELL(f); +} + +static Embryo_Cell +_embryo_fp_abs(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 = (f >= 0) ? f : -f; + 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); +} diff --git a/legacy/embryo/src/lib/embryo_main.c b/legacy/embryo/src/lib/embryo_main.c new file mode 100644 index 0000000000..e229df91eb --- /dev/null +++ b/legacy/embryo/src/lib/embryo_main.c @@ -0,0 +1,23 @@ +#include "embryo_private.h" + +static int _embryo_init_count = 0; + +/*** EXPORTED CALLS ***/ + +int +embryo_init(void) +{ + _embryo_init_count++; + if (_embryo_init_count > 1) return _embryo_init_count; + + return _embryo_init_count; +} + +int +embryo_shutdown(void) +{ + _embryo_init_count--; + if (_embryo_init_count > 0) return _embryo_init_count; + + return _embryo_init_count; +} diff --git a/legacy/embryo/src/lib/embryo_private.h b/legacy/embryo/src/lib/embryo_private.h new file mode 100644 index 0000000000..f6bf9610d5 --- /dev/null +++ b/legacy/embryo/src/lib/embryo_private.h @@ -0,0 +1,266 @@ +#ifndef _EMBRYO_PRIVATE_H +#define _EMBRYO_PRIVATE_H + +#include "Embryo.h" + +#include +#include +#include +#include +#include +#include +#include + +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) +#define GETENTRYNAME(hdr,entry) \ + (((hdr)->defsize == 2 * sizeof(unsigned int)) \ + ? (char *)((unsigned char*)(hdr) + *((unsigned int *)(entry) + 1)) \ + : (entry)->name) +#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; return 0;} +#define OK(ep,v) {(ep)->stk = reset_stk; (ep)->hea = reset_hea; ep->run_count--; ep->error = v; return 1;} +#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;} + +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 */ + /* 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; +}; + +#pragma pack(push, 1) +struct _Embryo_Func_Stub +{ + int address; + char name[sEXPMAX+1]; +}; + +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 */ +}; + +void _embryo_fp_init(Embryo_Program *ep); + +#endif