EFL 1.7 svn doobies

git-svn-id: svn+ssh://svn.enlightenment.org/var/svn/e/branches/embryo-1.7@75862 7cbeb6ba-43b4-40fd-8cce-4c39aea84d33
author: raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33> 2012-08-30 09:54:57 +0000
committer: raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33> 2012-08-30 09:54:57 +0000
commit: 124ac58c553c1435bf6a33f6ca77e7363bfa4d1d (patch)
tree: b3beb0fb39eb8693de0c4288454887d51432ec98 /src
download: embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.gz
embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.bz2
embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.zip
29 files changed, 20263 insertions, 0 deletions
diff --git a/src/Makefile.am b/src/Makefile.am
new file mode 100644
index 0000000..a8590b2
--- /dev/null
+++ b/src/Makefile.am
@@ -0,0 +1,3 @@
+MAINTAINERCLEANFILES = Makefile.in
+
+SUBDIRS = lib bin
diff --git a/src/bin/Makefile.am b/src/bin/Makefile.am
new file mode 100644
index 0000000..09f6ffd
--- /dev/null
+++ b/src/bin/Makefile.am
@@ -0,0 +1,40 @@
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir) \
+-I$(top_builddir) \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EINA_CFLAGS@ \
+@EVIL_CFLAGS@
+
+bin_PROGRAMS = @EMBRYO_CC_PRG@
+EXTRA_PROGRAMS = embryo_cc
+
+embryo_cc_SOURCES = \
+embryo_cc_amx.h \
+embryo_cc_sc.h \
+embryo_cc_sc1.c \
+embryo_cc_sc2.c \
+embryo_cc_sc3.c \
+embryo_cc_sc4.c \
+embryo_cc_sc5.c \
+embryo_cc_sc6.c \
+embryo_cc_sc7.c \
+embryo_cc_scexpand.c \
+embryo_cc_sclist.c \
+embryo_cc_scvars.c \
+embryo_cc_prefix.c \
+embryo_cc_prefix.h
+
+embryo_cc_CFLAGS = @EMBRYO_CFLAGS@
+embryo_cc_LDADD = $(top_builddir)/src/lib/libembryo.la @EVIL_LIBS@ @EINA_LIBS@ -lm
+embryo_cc_LDFLAGS = @lt_enable_auto_import@
+
+EXTRA_DIST = \
+embryo_cc_sc5.scp \
+embryo_cc_sc7.scp
diff --git a/src/bin/embryo_cc_amx.h b/src/bin/embryo_cc_amx.h
new file mode 100644
index 0000000..0118e2d
--- /dev/null
+++ b/src/bin/embryo_cc_amx.h
@@ -0,0 +1,226 @@
+/*  Abstract Machine for the Small compiler
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+#ifndef EMBRYO_CC_AMX_H
+#define EMBRYO_CC_AMX_H
+
+#include <sys/types.h>
+
+/* calling convention for all interface functions and callback functions */
+
+/* File format version                          Required AMX version
+ *   0 (original version)                       0
+ *   1 (opcodes JUMP.pri, SWITCH and CASETBL)   1
+ *   2 (compressed files)                       2
+ *   3 (public variables)                       2
+ *   4 (opcodes SWAP.pri/alt and PUSHADDR)      4
+ *   5 (tagnames table)                         4
+ *   6 (reformatted header)                     6
+ *   7 (name table, opcodes SYMTAG & SYSREQ.D)  7
+ */
+#define CUR_FILE_VERSION  7	/* current file version; also the current AMX version */
+#define MIN_FILE_VERSION  6	/* lowest supported file format version for the current AMX version */
+#define MIN_AMX_VERSION   7	/* minimum AMX version needed to support the current file format */
+
+#if !defined CELL_TYPE
+#define CELL_TYPE
+   typedef unsigned int    ucell;
+   typedef int     cell;
+#endif
+
+   struct tagAMX;
+   typedef             cell(*AMX_NATIVE) (struct tagAMX * amx,
+							   cell * params);
+   typedef int         (* AMX_CALLBACK) (struct tagAMX * amx, cell index,
+						cell * result, cell * params);
+   typedef int         (* AMX_DEBUG) (struct tagAMX * amx);
+
+   typedef struct
+   {
+      char          *name;
+      AMX_NATIVE func    ;
+   } AMX_NATIVE_INFO  ;
+
+#define AMX_USERNUM     4
+#define sEXPMAX         19	/* maximum name length for file version <= 6 */
+#define sNAMEMAX        31	/* maximum name length of symbol name */
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+   typedef struct tagAMX_FUNCSTUB
+   {
+      unsigned int        address;
+      char                name[sEXPMAX + 1];
+   } EMBRYO_STRUCT_PACKED AMX_FUNCSTUB;
+
+/* The AMX structure is the internal structure for many functions. Not all
+ * fields are valid at all times; many fields are cached in local variables.
+ */
+   typedef struct tagAMX
+   {
+      unsigned char *base;	/* points to the AMX header ("amxhdr") plus the code, optionally also the data */
+      unsigned char *data;	/* points to separate data+stack+heap, may be NULL */
+      AMX_CALLBACK callback;
+      AMX_DEBUG debug    ;	/* debug callback */
+      /* for external functions a few registers must be accessible from the outside */
+      cell cip           ;	/* instruction pointer: relative to base + amxhdr->cod */
+      cell frm           ;	/* stack frame base: relative to base + amxhdr->dat */
+      cell hea           ;	/* top of the heap: relative to base + amxhdr->dat */
+      cell hlw           ;	/* bottom of the heap: relative to base + amxhdr->dat */
+      cell stk           ;	/* stack pointer: relative to base + amxhdr->dat */
+      cell stp           ;	/* top of the stack: relative to base + amxhdr->dat */
+      int flags          ;	/* current status, see amx_Flags() */
+      /* for assertions and debug hook */
+      cell curline       ;
+      cell curfile       ;
+      int dbgcode        ;
+      cell dbgaddr       ;
+      cell dbgparam      ;
+      char          *dbgname;
+      /* user data */
+      long                usertags[AMX_USERNUM];
+      void          *userdata[AMX_USERNUM];
+      /* native functions can raise an error */
+      int error          ;
+      /* the sleep opcode needs to store the full AMX status */
+      cell pri           ;
+      cell alt           ;
+      cell reset_stk     ;
+      cell reset_hea     ;
+      cell          *syscall_d;	/* relocated value/address for the SYSCALL.D opcode */
+   } EMBRYO_STRUCT_PACKED AMX;
+
+/* The AMX_HEADER structure is both the memory format as the file format. The
+ * structure is used internaly.
+ */
+   typedef struct tagAMX_HEADER
+   {
+      int size       ;	/* size of the "file" */
+      unsigned short magic     ;	/* signature */
+      char file_version  ;	/* file format version */
+      char amx_version   ;	/* required version of the AMX */
+      unsigned short flags      ;
+      unsigned short defsize    ;	/* size of a definition record */
+      int cod        ;	/* initial value of COD - code block */
+      int dat        ;	/* initial value of DAT - data block */
+      int hea        ;	/* initial value of HEA - start of the heap */
+      int stp        ;	/* initial value of STP - stack top */
+      int cip        ;	/* initial value of CIP - the instruction pointer */
+      int publics    ;	/* offset to the "public functions" table */
+      int natives    ;	/* offset to the "native functions" table */
+      int libraries  ;	/* offset to the table of libraries */
+      int pubvars    ;	/* the "public variables" table */
+      int tags       ;	/* the "public tagnames" table */
+      int nametable  ;	/* name table, file version 7 only */
+   } EMBRYO_STRUCT_PACKED AMX_HEADER;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+#define AMX_MAGIC       0xf1e0
+
+   enum
+   {
+      AMX_ERR_NONE,
+      /* reserve the first 15 error codes for exit codes of the abstract machine */
+      AMX_ERR_EXIT,		/* forced exit */
+      AMX_ERR_ASSERT,		/* assertion failed */
+      AMX_ERR_STACKERR,		/* stack/heap collision */
+      AMX_ERR_BOUNDS,		/* index out of bounds */
+      AMX_ERR_MEMACCESS,	/* invalid memory access */
+      AMX_ERR_INVINSTR,		/* invalid instruction */
+      AMX_ERR_STACKLOW,		/* stack underflow */
+      AMX_ERR_HEAPLOW,		/* heap underflow */
+      AMX_ERR_CALLBACK,		/* no callback, or invalid callback */
+      AMX_ERR_NATIVE,		/* native function failed */
+      AMX_ERR_DIVIDE,		/* divide by zero */
+      AMX_ERR_SLEEP,		/* go into sleepmode - code can be restarted */
+
+      AMX_ERR_MEMORY = 16,	/* out of memory */
+      AMX_ERR_FORMAT,		/* invalid file format */
+      AMX_ERR_VERSION,		/* file is for a newer version of the AMX */
+      AMX_ERR_NOTFOUND,		/* function not found */
+      AMX_ERR_INDEX,		/* invalid index parameter (bad entry point) */
+      AMX_ERR_DEBUG,		/* debugger cannot run */
+      AMX_ERR_INIT,		/* AMX not initialized (or doubly initialized) */
+      AMX_ERR_USERDATA,		/* unable to set user data field (table full) */
+      AMX_ERR_INIT_JIT,		/* cannot initialize the JIT */
+      AMX_ERR_PARAMS,		/* parameter error */
+      AMX_ERR_DOMAIN,		/* domain error, expression result does not fit in range */
+   };
+
+   enum
+   {
+      DBG_INIT,			/* query/initialize */
+      DBG_FILE,			/* file number in curfile, filename in name */
+      DBG_LINE,			/* line number in curline, file number in curfile */
+      DBG_SYMBOL,		/* address in dbgaddr, class/type in dbgparam */
+      DBG_CLRSYM,		/* stack address below which locals should be removed. stack address in stk */
+      DBG_CALL,			/* function call, address jumped to in dbgaddr */
+      DBG_RETURN,		/* function returns */
+      DBG_TERMINATE,		/* program ends, code address in dbgaddr, reason in dbgparam */
+      DBG_SRANGE,		/* symbol size and dimensions (arrays); level in dbgaddr (!); length in dbgparam */
+      DBG_SYMTAG,		/* tag of the most recent symbol (if non-zero), tag in dbgparam */
+   };
+
+#define AMX_FLAG_CHAR16   0x01	/* characters are 16-bit */
+#define AMX_FLAG_DEBUG    0x02	/* symbolic info. available */
+#define AMX_FLAG_COMPACT  0x04	/* compact encoding */
+#define AMX_FLAG_BIGENDIAN 0x08	/* big endian encoding */
+#define AMX_FLAG_NOCHECKS  0x10	/* no array bounds checking */
+#define AMX_FLAG_BROWSE 0x4000	/* browsing/relocating or executing */
+#define AMX_FLAG_RELOC  0x8000	/* jump/call addresses relocated */
+
+#define AMX_EXEC_MAIN   -1	/* start at program entry point */
+#define AMX_EXEC_CONT   -2	/* continue from last address */
+
+#define AMX_USERTAG(a,b,c,d)    ((a) | ((b)<<8) | ((long)(c)<<16) | ((long)(d)<<24))
+
+#define AMX_EXPANDMARGIN  64
+
+/* for native functions that use floating point parameters, the following
+ * two macros are convenient for casting a "cell" into a "float" type _without_
+ * changing the bit pattern
+ */
+#define amx_ftoc(f)     ( * ((cell*)&f) )	/* float to cell */
+#define amx_ctof(c)     ( * ((float*)&c) )	/* cell to float */
+
+#define amx_StrParam(amx,param,result) {                             \
+            cell *amx_cstr_; int amx_length_;                        \
+            amx_GetAddr((amx), (param), &amx_cstr_);                 \
+            amx_StrLen(amx_cstr_, &amx_length_);                     \
+            if (amx_length_ > 0 &&                                   \
+                ((result) = (char *)alloca(amx_length_ + 1))) \
+              amx_GetString((result), amx_cstr_);                    \
+            else (result) = NULL;                                    \
+}
+
+#endif				/* __AMX_H */
diff --git a/src/bin/embryo_cc_osdefs.h b/src/bin/embryo_cc_osdefs.h
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/src/bin/embryo_cc_osdefs.h
diff --git a/src/bin/embryo_cc_prefix.c b/src/bin/embryo_cc_prefix.c
new file mode 100644
index 0000000..9b57704
--- /dev/null
+++ b/src/bin/embryo_cc_prefix.c
@@ -0,0 +1,61 @@
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <Eina.h>
+
+#include "embryo_cc_prefix.h"
+
+/* local subsystem functions */
+
+/* local subsystem globals */
+
+static Eina_Prefix *pfx = NULL;
+
+/* externally accessible functions */
+int
+e_prefix_determine(char *argv0)
+{
+   if (pfx) return 1;
+   eina_init();
+   pfx = eina_prefix_new(argv0, e_prefix_determine,
+                         "EMBRYO", "embryo", "include/default.inc",
+                         PACKAGE_BIN_DIR,
+                         PACKAGE_LIB_DIR,
+                         PACKAGE_DATA_DIR,
+                         PACKAGE_DATA_DIR);
+   if (!pfx) return 0;
+   return 1;
+}
+
+void
+e_prefix_shutdown(void)
+{
+   eina_prefix_free(pfx);
+   pfx = NULL;
+   eina_shutdown();
+}
+
+const char *
+e_prefix_get(void)
+{
+   return eina_prefix_get(pfx);
+}
+
+const char *
+e_prefix_bin_get(void)
+{
+   return eina_prefix_bin_get(pfx);
+}
+
+const char *
+e_prefix_data_get(void)
+{
+   return eina_prefix_data_get(pfx);
+}
+
+const char *
+e_prefix_lib_get(void)
+{
+   return eina_prefix_lib_get(pfx);
+}
diff --git a/src/bin/embryo_cc_prefix.h b/src/bin/embryo_cc_prefix.h
new file mode 100644
index 0000000..d6dc7b2
--- /dev/null
+++ b/src/bin/embryo_cc_prefix.h
@@ -0,0 +1,6 @@
+int         e_prefix_determine(char *argv0);
+void        e_prefix_shutdown(void);
+const char *e_prefix_get(void);
+const char *e_prefix_bin_get(void);
+const char *e_prefix_data_get(void);
+const char *e_prefix_lib_get(void);
diff --git a/src/bin/embryo_cc_sc.h b/src/bin/embryo_cc_sc.h
new file mode 100644
index 0000000..bedd59e
--- /dev/null
+++ b/src/bin/embryo_cc_sc.h
@@ -0,0 +1,667 @@
+/*  Small compiler
+ *
+ *  Drafted after the Small-C compiler Version 2.01, originally created
+ *  by Ron Cain, july 1980, and enhanced by James E. Hendrix.
+ *
+ *  This version comes close to a complete rewrite.
+ *
+ *  Copyright R. Cain, 1980
+ *  Copyright J.E. Hendrix, 1982, 1983
+ *  Copyright T. Riemersma, 1997-2003
+ *
+ *  Version: $Id$
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ */
+
+#ifndef EMBRYO_CC_SC_H
+#define EMBRYO_CC_SC_H
+
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <setjmp.h>
+
+#ifndef _MSC_VER
+# include <stdint.h>
+#else
+# include <stddef.h>
+# include <Evil.h>
+#endif
+
+#include "embryo_cc_amx.h"
+
+/* Note: the "cell" and "ucell" types are defined in AMX.H */
+
+#define PUBLIC_CHAR '@'		/* character that defines a function "public" */
+#define CTRL_CHAR   '\\'	/* default control character */
+
+#define DIRSEP_CHAR '/'		/* directory separator character */
+
+#define sDIMEN_MAX     2	/* maximum number of array dimensions */
+#define sDEF_LITMAX  500	/* initial size of the literal pool, in "cells" */
+#define sLINEMAX (640 * 1024)	/* input line length (in characters) */
+#define sDEF_AMXSTACK 4096	/* default stack size for AMX files */
+#define sSTKMAX       80	/* stack for nested #includes and other uses */
+#define PREPROC_TERM  '\x7f'	/* termination character for preprocessor expressions (the "DEL" code) */
+#define sDEF_PREFIX   "default.inc"	/* default prefix filename */
+
+typedef intptr_t stkitem;	/* type of items stored on the stack */
+
+typedef struct __s_arginfo
+{				/* function argument info */
+   char                name[sNAMEMAX + 1];
+   char                ident;	/* iVARIABLE, iREFERENCE, iREFARRAY or iVARARGS */
+   char                usage;	/* uCONST */
+   int                *tags;	/* argument tag id. list */
+   int                 numtags;	/* number of tags in the tag list */
+   int                 dim[sDIMEN_MAX];
+   int                 numdim;	/* number of dimensions */
+   unsigned char       hasdefault;	/* bit0: is there a default value? bit6: "tagof"; bit7: "sizeof" */
+   union
+   {
+      cell                val;	/* default value */
+      struct
+      {
+	 char               *symname;	/* name of another symbol */
+	 short               level;	/* indirection level for that symbol */
+      } size;			/* used for "sizeof" default value */
+      struct
+      {
+	 cell               *data;	/* values of default array */
+	 int                 size;	/* complete length of default array */
+	 int                 arraysize;	/* size to reserve on the heap */
+	 cell                addr;	/* address of the default array in the data segment */
+      } array;
+   } defvalue;			/* default value, or pointer to default array */
+   int                 defvalue_tag;	/* tag of the default value */
+} arginfo;
+
+/*  Equate table, tagname table, library table */
+typedef struct __s_constvalue
+{
+   struct __s_constvalue *next;
+   char                name[sNAMEMAX + 1];
+   cell                value;
+   short               index;
+} constvalue;
+
+/*  Symbol table format
+ *
+ *  The symbol name read from the input file is stored in "name", the
+ *  value of "addr" is written to the output file. The address in "addr"
+ *  depends on the class of the symbol:
+ *      global          offset into the data segment
+ *      local           offset relative to the stack frame
+ *      label           generated hexadecimal number
+ *      function        offset into code segment
+ */
+typedef struct __s_symbol
+{
+   struct __s_symbol  *next;
+   struct __s_symbol  *parent;	/* hierarchical types (multi-dimensional arrays) */
+   char                name[sNAMEMAX + 1];
+   unsigned int        hash;	/* value derived from name, for quicker searching */
+   cell                addr;	/* address or offset (or value for constant, index for native function) */
+   char                vclass;	/* sLOCAL if "addr" refers to a local symbol */
+   char                ident;	/* see below for possible values */
+   char                usage;	/* see below for possible values */
+   int                 compound;	/* compound level (braces nesting level) */
+   int                 tag;	/* tagname id */
+   union
+   {
+      int                 declared;	/* label: how many local variables are declared */
+      int                 idxtag;	/* array: tag of array indices */
+      constvalue         *lib;	/* native function: library it is part of *///??? use "stringlist"
+   } x;				/* 'x' for 'extra' */
+   union
+   {
+      arginfo            *arglist;	/* types of all parameters for functions */
+      struct
+      {
+	 cell                length;	/* arrays: length (size) */
+	 short               level;	/* number of dimensions below this level */
+      } array;
+   } dim;			/* for 'dimension', both functions and arrays */
+   int                 fnumber;	/* static global variables: file number in which the declaration is visible */
+   struct __s_symbol **refer;	/* referrer list, functions that "use" this symbol */
+   int                 numrefers;	/* number of entries in the referrer list */
+} symbol;
+
+/*  Possible entries for "ident". These are used in the "symbol", "value"
+ *  and arginfo structures. Not every constant is valid for every use.
+ *  In an argument list, the list is terminated with a "zero" ident; labels
+ *  cannot be passed as function arguments, so the value 0 is overloaded.
+ */
+#define iLABEL      0
+#define iVARIABLE   1		/* cell that has an address and that can be fetched directly (lvalue) */
+#define iREFERENCE  2		/* iVARIABLE, but must be dereferenced */
+#define iARRAY      3
+#define iREFARRAY   4		/* an array passed by reference (i.e. a pointer) */
+#define iARRAYCELL  5		/* array element, cell that must be fetched indirectly */
+#define iARRAYCHAR  6		/* array element, character from cell from array */
+#define iEXPRESSION 7		/* expression result, has no address (rvalue) */
+#define iCONSTEXPR  8		/* constant expression (or constant symbol) */
+#define iFUNCTN     9
+#define iREFFUNC    10		/* function passed as a parameter */
+#define iVARARGS    11		/* function specified ... as argument(s) */
+
+/*  Possible entries for "usage"
+ *
+ *  This byte is used as a serie of bits, the syntax is different for
+ *  functions and other symbols:
+ *
+ *  VARIABLE
+ *  bits: 0     (uDEFINE) the variable is defined in the source file
+ *        1     (uREAD) the variable is "read" (accessed) in the source file
+ *        2     (uWRITTEN) the variable is altered (assigned a value)
+ *        3     (uCONST) the variable is constant (may not be assigned to)
+ *        4     (uPUBLIC) the variable is public
+ *        6     (uSTOCK) the variable is discardable (without warning)
+ *
+ *  FUNCTION
+ *  bits: 0     (uDEFINE) the function is defined ("implemented") in the source file
+ *        1     (uREAD) the function is invoked in the source file
+ *        2     (uRETVALUE) the function returns a value (or should return a value)
+ *        3     (uPROTOTYPED) the function was prototyped
+ *        4     (uPUBLIC) the function is public
+ *        5     (uNATIVE) the function is native
+ *        6     (uSTOCK) the function is discardable (without warning)
+ *        7     (uMISSING) the function is not implemented in this source file
+ *
+ *  CONSTANT
+ *  bits: 0     (uDEFINE) the symbol is defined in the source file
+ *        1     (uREAD) the constant is "read" (accessed) in the source file
+ *        3     (uPREDEF) the constant is pre-defined and should be kept between passes
+ */
+#define uDEFINE   0x01
+#define uREAD     0x02
+#define uWRITTEN  0x04
+#define uRETVALUE 0x04		/* function returns (or should return) a value */
+#define uCONST    0x08
+#define uPROTOTYPED 0x08
+#define uPREDEF   0x08		/* constant is pre-defined */
+#define uPUBLIC   0x10
+#define uNATIVE   0x20
+#define uSTOCK    0x40
+#define uMISSING  0x80
+/* uRETNONE is not stored in the "usage" field of a symbol. It is
+ * used during parsing a function, to detect a mix of "return;" and
+ * "return value;" in a few special cases.
+ */
+#define uRETNONE  0x10
+
+#define uTAGOF    0x40		/* set in the "hasdefault" field of the arginfo struct */
+#define uSIZEOF   0x80		/* set in the "hasdefault" field of the arginfo struct */
+
+#define uMAINFUNC "main"
+
+#define sGLOBAL   0		/* global/local variable/constant class */
+#define sLOCAL    1
+#define sSTATIC   2		/* global life, local scope */
+
+typedef struct
+{
+   symbol             *sym;	/* symbol in symbol table, NULL for (constant) expression */
+   cell                constval;	/* value of the constant expression (if ident==iCONSTEXPR)
+					 * also used for the size of a literal array */
+   int                 tag;	/* tagname id (of the expression) */
+   char                ident;	/* iCONSTEXPR, iVARIABLE, iARRAY, iARRAYCELL,
+				 * iEXPRESSION or iREFERENCE */
+   char                boolresult;	/* boolean result for relational operators */
+   cell               *arrayidx;	/* last used array indices, for checking self assignment */
+} value;
+
+/*  "while" statement queue (also used for "for" and "do - while" loops) */
+enum
+{
+   wqBRK,			/* used to restore stack for "break" */
+   wqCONT,			/* used to restore stack for "continue" */
+   wqLOOP,			/* loop start label number */
+   wqEXIT,			/* loop exit label number (jump if false) */
+   /* --- */
+   wqSIZE			/* "while queue" size */
+};
+
+#define wqTABSZ (24*wqSIZE)	/* 24 nested loop statements */
+
+enum
+{
+   statIDLE,			/* not compiling yet */
+   statFIRST,			/* first pass */
+   statWRITE,			/* writing output */
+   statSKIP,			/* skipping output */
+};
+
+typedef struct __s_stringlist
+{
+   struct __s_stringlist *next;
+   char               *line;
+} stringlist;
+
+typedef struct __s_stringpair
+{
+   struct __s_stringpair *next;
+   char               *first;
+   char               *second;
+   int                 matchlength;
+} stringpair;
+
+/* macros for code generation */
+#define opcodes(n)      ((n)*sizeof(cell))	/* opcode size */
+#define opargs(n)       ((n)*sizeof(cell))	/* size of typical argument */
+
+/*  Tokens recognized by lex()
+ *  Some of these constants are assigned as well to the variable "lastst"
+ */
+#define tFIRST   256		/* value of first multi-character operator */
+#define tMIDDLE  279		/* value of last multi-character operator */
+#define tLAST    320		/* value of last multi-character match-able token */
+/* multi-character operators */
+#define taMULT   256		/* *= */
+#define taDIV    257		/* /= */
+#define taMOD    258		/* %= */
+#define taADD    259		/* += */
+#define taSUB    260		/* -= */
+#define taSHL    261		/* <<= */
+#define taSHRU   262		/* >>>= */
+#define taSHR    263		/* >>= */
+#define taAND    264		/* &= */
+#define taXOR    265		/* ^= */
+#define taOR     266		/* |= */
+#define tlOR     267		/* || */
+#define tlAND    268		/* && */
+#define tlEQ     269		/* == */
+#define tlNE     270		/* != */
+#define tlLE     271		/* <= */
+#define tlGE     272		/* >= */
+#define tSHL     273		/* << */
+#define tSHRU    274		/* >>> */
+#define tSHR     275		/* >> */
+#define tINC     276		/* ++ */
+#define tDEC     277		/* -- */
+#define tELLIPS  278		/* ... */
+#define tDBLDOT  279		/* .. */
+/* reserved words (statements) */
+#define tASSERT  280
+#define tBREAK   281
+#define tCASE    282
+#define tCHAR    283
+#define tCONST   284
+#define tCONTINUE 285
+#define tDEFAULT 286
+#define tDEFINED 287
+#define tDO      288
+#define tELSE    289
+#define tENUM    290
+#define tEXIT    291
+#define tFOR     292
+#define tFORWARD 293
+#define tGOTO    294
+#define tIF      295
+#define tNATIVE  296
+#define tNEW     297
+#define tOPERATOR 298
+#define tPUBLIC  299
+#define tRETURN  300
+#define tSIZEOF  301
+#define tSLEEP   302
+#define tSTATIC  303
+#define tSTOCK   304
+#define tSWITCH  305
+#define tTAGOF   306
+#define tWHILE   307
+/* compiler directives */
+#define tpASSERT 308		/* #assert */
+#define tpDEFINE 309
+#define tpELSE   310		/* #else */
+#define tpEMIT   311
+#define tpENDIF  312
+#define tpENDINPUT 313
+#define tpENDSCRPT 314
+#define tpFILE   315
+#define tpIF     316		/* #if */
+#define tINCLUDE 317
+#define tpLINE   318
+#define tpPRAGMA 319
+#define tpUNDEF  320
+/* semicolon is a special case, because it can be optional */
+#define tTERM    321		/* semicolon or newline */
+#define tENDEXPR 322		/* forced end of expression */
+/* other recognized tokens */
+#define tNUMBER  323		/* integer number */
+#define tRATIONAL 324		/* rational number */
+#define tSYMBOL  325
+#define tLABEL   326
+#define tSTRING  327
+#define tEXPR    328		/* for assigment to "lastst" only */
+
+/* (reversed) evaluation of staging buffer */
+#define sSTARTREORDER 1
+#define sENDREORDER   2
+#define sEXPRSTART    0xc0	/* top 2 bits set, rest is free */
+#define sMAXARGS      64	/* relates to the bit pattern of sEXPRSTART */
+
+/* codes for ffabort() */
+#define xEXIT           1	/* exit code in PRI */
+#define xASSERTION      2	/* abort caused by failing assertion */
+#define xSTACKERROR     3	/* stack/heap overflow */
+#define xBOUNDSERROR    4	/* array index out of bounds */
+#define xMEMACCESS      5	/* data access error */
+#define xINVINSTR       6	/* invalid instruction */
+#define xSTACKUNDERFLOW 7	/* stack underflow */
+#define xHEAPUNDERFLOW  8	/* heap underflow */
+#define xCALLBACKERR    9	/* no, or invalid, callback */
+#define xSLEEP         12	/* sleep, exit code in PRI, tag in ALT */
+
+/* Miscellaneous  */
+#if !defined TRUE
+#define FALSE         0
+#define TRUE          1
+#endif
+#define sIN_CSEG        1	/* if parsing CODE */
+#define sIN_DSEG        2	/* if parsing DATA */
+#define sCHKBOUNDS      1	/* bit position in "debug" variable: check bounds */
+#define sSYMBOLIC       2	/* bit position in "debug" variable: symbolic info */
+#define sNOOPTIMIZE     4	/* bit position in "debug" variable: no optimization */
+#define sRESET          0	/* reset error flag */
+#define sFORCESET       1	/* force error flag on */
+#define sEXPRMARK       2	/* mark start of expression */
+#define sEXPRRELEASE    3	/* mark end of expression */
+
+#if INT_MAX<0x8000u
+#define PUBLICTAG   0x8000u
+#define FIXEDTAG    0x4000u
+#else
+#define PUBLICTAG   0x80000000Lu
+#define FIXEDTAG    0x40000000Lu
+#endif
+#define TAGMASK       (~PUBLICTAG)
+
+
+/*
+ * Functions you call from the "driver" program
+ */
+   int                 sc_compile(int argc, char **argv);
+   int                 sc_addconstant(char *name, cell value, int tag);
+   int                 sc_addtag(char *name);
+
+/*
+ * Functions called from the compiler (to be implemented by you)
+ */
+
+/* general console output */
+   int                 sc_printf(const char *message, ...);
+
+/* error report function */
+   int                 sc_error(int number, char *message, char *filename,
+				int firstline, int lastline, va_list argptr);
+
+/* input from source file */
+   void               *sc_opensrc(char *filename);	/* reading only */
+   void                sc_closesrc(void *handle);	/* never delete */
+   void                sc_resetsrc(void *handle, void *position);	/* reset to a position marked earlier */
+   char               *sc_readsrc(void *handle, char *target, int maxchars);
+   void               *sc_getpossrc(void *handle);	/* mark the current position */
+   int                 sc_eofsrc(void *handle);
+
+/* output to intermediate (.ASM) file */
+   void               *sc_openasm(int fd);	/* read/write */
+   void                sc_closeasm(void *handle);
+   void                sc_resetasm(void *handle);
+   int                 sc_writeasm(void *handle, char *str);
+   char               *sc_readasm(void *handle, char *target, int maxchars);
+
+/* output to binary (.AMX) file */
+   void               *sc_openbin(char *filename);
+   void                sc_closebin(void *handle, int deletefile);
+   void                sc_resetbin(void *handle);
+   int                 sc_writebin(void *handle, void *buffer, int size);
+   long                sc_lengthbin(void *handle);	/* return the length of the file */
+
+/* function prototypes in SC1.C */
+symbol     *fetchfunc(char *name, int tag);
+char       *operator_symname(char *symname, char *opername, int tag1,
+				     int tag2, int numtags, int resulttag);
+char       *funcdisplayname(char *dest, char *funcname);
+int         constexpr(cell * val, int *tag);
+constvalue *append_constval(constvalue * table, char *name, cell val,
+				    short index);
+constvalue *find_constval(constvalue * table, char *name, short index);
+void        delete_consttable(constvalue * table);
+void        add_constant(char *name, cell val, int vclass, int tag);
+void        exporttag(int tag);
+
+/* function prototypes in SC2.C */
+void        pushstk(stkitem val);
+stkitem     popstk(void);
+int         plungequalifiedfile(char *name);	/* explicit path included */
+int         plungefile(char *name, int try_currentpath, int try_includepaths);	/* search through "include" paths */
+void        preprocess(void);
+void        lexinit(void);
+int         lex(cell * lexvalue, char **lexsym);
+void        lexpush(void);
+void        lexclr(int clreol);
+int         matchtoken(int token);
+int         tokeninfo(cell * val, char **str);
+int         needtoken(int token);
+void        stowlit(cell value);
+int         alphanum(char c);
+void        delete_symbol(symbol * root, symbol * sym);
+void        delete_symbols(symbol * root, int level, int del_labels,
+				   int delete_functions);
+int         refer_symbol(symbol * entry, symbol * bywhom);
+void        markusage(symbol * sym, int usage);
+unsigned int namehash(char *name);
+symbol     *findglb(char *name);
+symbol     *findloc(char *name);
+symbol     *findconst(char *name);
+symbol     *finddepend(symbol * parent);
+symbol     *addsym(char *name, cell addr, int ident, int vclass,
+			   int tag, int usage);
+symbol     *addvariable(char *name, cell addr, int ident, int vclass,
+				int tag, int dim[], int numdim, int idxtag[]);
+int         getlabel(void);
+char       *itoh(ucell val);
+
+/* function prototypes in SC3.C */
+int         check_userop(void (*oper) (void), int tag1, int tag2,
+				 int numparam, value * lval, int *resulttag);
+int         matchtag(int formaltag, int actualtag, int allowcoerce);
+int         expression(int *constant, cell * val, int *tag,
+			       int chkfuncresult);
+int         hier14(value * lval1);	/* the highest expression level */
+
+/* function prototypes in SC4.C */
+void        writeleader(void);
+void        writetrailer(void);
+void        begcseg(void);
+void        begdseg(void);
+void        setactivefile(int fnumber);
+cell        nameincells(char *name);
+void        setfile(char *name, int fileno);
+void        setline(int line, int fileno);
+void        setlabel(int index);
+void        endexpr(int fullexpr);
+void        startfunc(char *fname);
+void        endfunc(void);
+void        alignframe(int numbytes);
+void        defsymbol(char *name, int ident, int vclass, cell offset,
+			      int tag);
+void        symbolrange(int level, cell size);
+void        rvalue(value * lval);
+void        address(symbol * ptr);
+void        store(value * lval);
+void        memcopy(cell size);
+void        copyarray(symbol * sym, cell size);
+void        fillarray(symbol * sym, cell size, cell value);
+void        const1(cell val);
+void        const2(cell val);
+void        moveto1(void);
+void        push1(void);
+void        push2(void);
+void        pushval(cell val);
+void        pop1(void);
+void        pop2(void);
+void        swap1(void);
+void        ffswitch(int label);
+void        ffcase(cell value, char *labelname, int newtable);
+void        ffcall(symbol * sym, int numargs);
+void        ffret(void);
+void        ffabort(int reason);
+void        ffbounds(cell size);
+void        jumplabel(int number);
+void        defstorage(void);
+void        modstk(int delta);
+void        setstk(cell value);
+void        modheap(int delta);
+void        setheap_pri(void);
+void        setheap(cell value);
+void        cell2addr(void);
+void        cell2addr_alt(void);
+void        addr2cell(void);
+void        char2addr(void);
+void        charalign(void);
+void        addconst(cell value);
+
+/*  Code generation functions for arithmetic operators.
+ *
+ *  Syntax: o[u|s|b]_name
+ *          |   |   | +--- name of operator
+ *          |   |   +----- underscore
+ *          |   +--------- "u"nsigned operator, "s"igned operator or "b"oth
+ *          +------------- "o"perator
+ */
+void        os_mult(void);	/* multiplication (signed) */
+void        os_div(void);	/* division (signed) */
+void        os_mod(void);	/* modulus (signed) */
+void        ob_add(void);	/* addition */
+void        ob_sub(void);	/* subtraction */
+void        ob_sal(void);	/* shift left (arithmetic) */
+void        os_sar(void);	/* shift right (arithmetic, signed) */
+void        ou_sar(void);	/* shift right (logical, unsigned) */
+void        ob_or(void);	/* bitwise or */
+void        ob_xor(void);	/* bitwise xor */
+void        ob_and(void);	/* bitwise and */
+void        ob_eq(void);	/* equality */
+void        ob_ne(void);	/* inequality */
+void        relop_prefix(void);
+void        relop_suffix(void);
+void        os_le(void);	/* less or equal (signed) */
+void        os_ge(void);	/* greater or equal (signed) */
+void        os_lt(void);	/* less (signed) */
+void        os_gt(void);	/* greater (signed) */
+
+void        lneg(void);
+void        neg(void);
+void        invert(void);
+void        nooperation(void);
+void        inc(value * lval);
+void        dec(value * lval);
+void        jmp_ne0(int number);
+void        jmp_eq0(int number);
+void        outval(cell val, int newline);
+
+/* function prototypes in SC5.C */
+int         error(int number, ...);
+void        errorset(int code);
+
+/* function prototypes in SC6.C */
+void        assemble(FILE * fout, FILE * fin);
+
+/* function prototypes in SC7.C */
+void        stgbuffer_cleanup(void);
+void        stgmark(char mark);
+void        stgwrite(char *st);
+void        stgout(int index);
+void        stgdel(int index, cell code_index);
+int         stgget(int *index, cell * code_index);
+void        stgset(int onoff);
+int         phopt_init(void);
+int         phopt_cleanup(void);
+
+/* function prototypes in SCLIST.C */
+stringpair *insert_alias(char *name, char *alias);
+stringpair *find_alias(char *name);
+int         lookup_alias(char *target, char *name);
+void        delete_aliastable(void);
+stringlist *insert_path(char *path);
+char       *get_path(int index);
+void        delete_pathtable(void);
+stringpair *insert_subst(char *pattern, char *substitution,
+				 int prefixlen);
+int         get_subst(int index, char **pattern, char **substitution);
+stringpair *find_subst(char *name, int length);
+int         delete_subst(char *name, int length);
+void        delete_substtable(void);
+
+/* external variables (defined in scvars.c) */
+extern symbol     loctab;	/* local symbol table */
+extern symbol     glbtab;	/* global symbol table */
+extern cell      *litq;	/* the literal queue */
+extern char       pline[];	/* the line read from the input file */
+extern char      *lptr;	/* points to the current position in "pline" */
+extern constvalue tagname_tab;	/* tagname table */
+extern constvalue libname_tab;	/* library table (#pragma library "..." syntax) *///??? use "stringlist" type
+extern constvalue *curlibrary;	/* current library */
+extern symbol    *curfunc;	/* pointer to current function */
+extern char      *inpfname;	/* name of the file currently read from */
+extern char       outfname[];	/* output file name */
+extern char       sc_ctrlchar;	/* the control character (or escape character) */
+extern int        litidx;	/* index to literal table */
+extern int        litmax;	/* current size of the literal table */
+extern int        stgidx;	/* index to the staging buffer */
+extern int        labnum;	/* number of (internal) labels */
+extern int        staging;	/* true if staging output */
+extern cell       declared;	/* number of local cells declared */
+extern cell       glb_declared;	/* number of global cells declared */
+extern cell       code_idx;	/* number of bytes with generated code */
+extern int        ntv_funcid;	/* incremental number of native function */
+extern int        errnum;	/* number of errors */
+extern int        warnnum;	/* number of warnings */
+extern int        sc_debug;	/* debug/optimization options (bit field) */
+extern int        charbits;	/* number of bits for a character */
+extern int        sc_packstr;	/* strings are packed by default? */
+extern int        sc_asmfile;	/* create .ASM file? */
+extern int        sc_listing;	/* create .LST file? */
+extern int        sc_compress;	/* compress bytecode? */
+extern int        sc_needsemicolon;	/* semicolon required to terminate expressions? */
+extern int        sc_dataalign;	/* data alignment value */
+extern int        sc_alignnext;	/* must frame of the next function be aligned? */
+extern int        curseg;	/* 1 if currently parsing CODE, 2 if parsing DATA */
+extern cell       sc_stksize;	/* stack size */
+extern int        freading;	/* is there an input file ready for reading? */
+extern int        fline;	/* the line number in the current file */
+extern int        fnumber;	/* number of files in the file table (debugging) */
+extern int        fcurrent;	/* current file being processed (debugging) */
+extern int        intest;	/* true if inside a test */
+extern int        sideeffect;	/* true if an expression causes a side-effect */
+extern int        stmtindent;	/* current indent of the statement */
+extern int        indent_nowarn;	/* skip warning "217 loose indentation" */
+extern int        sc_tabsize;	/* number of spaces that a TAB represents */
+extern int        sc_allowtags;	/* allow/detect tagnames in lex() */
+extern int        sc_status;	/* read/write status */
+extern int        sc_rationaltag;	/* tag for rational numbers */
+extern int        rational_digits;	/* number of fractional digits */
+
+extern FILE      *inpf;	/* file read from (source or include) */
+extern FILE      *inpf_org;	/* main source file */
+extern FILE      *outf;	/* file written to */
+
+extern jmp_buf    errbuf;	/* target of longjmp() on a fatal error */
+
+#endif
diff --git a/src/bin/embryo_cc_sc1.c b/src/bin/embryo_cc_sc1.c
new file mode 100644
index 0000000..3a5b3d9
--- /dev/null
+++ b/src/bin/embryo_cc_sc1.c
@@ -0,0 +1,4081 @@
+/*  Small compiler
+ *  Function and variable definition and declaration, statement parser.
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ * This software is provided "as-is", without any express or implied
+ * warranty.  In no event will the authors be held liable for any
+ * damages arising from the use of this software. Permission is granted
+ * to anyone to use this software for any purpose, including commercial
+ * applications, and to alter it and redistribute it freely, subject to
+ * the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented;
+ *  you must not claim that you wrote the original software.
+ *  If you use this software in a product, an acknowledgment in the
+ *  product documentation would be appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and
+ *  must not be misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source
+ *  distribution.
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif /* HAVE_EVIL */
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_prefix.h"
+
+#define VERSION_STR "2.4"
+#define VERSION_INT 240
+
+static void         resetglobals(void);
+static void         initglobals(void);
+static void         setopt(int argc, char **argv,
+                           char *iname, char *oname,
+                           char *pname, char *rname);
+static void         setconfig(char *root);
+static void         about(void);
+static void         setconstants(void);
+static void         parse(void);
+static void         dumplits(void);
+static void         dumpzero(int count);
+static void         declfuncvar(int tok, char *symname,
+				int tag, int fpublic,
+				int fstatic, int fstock, int fconst);
+static void         declglb(char *firstname, int firsttag,
+			    int fpublic, int fstatic, int stock, int fconst);
+static int          declloc(int fstatic);
+static void         decl_const(int table);
+static void         decl_enum(int table);
+static cell         needsub(int *tag);
+static void         initials(int ident, int tag,
+			     cell * size, int dim[], int numdim);
+static cell         initvector(int ident, int tag, cell size, int fillzero);
+static cell         init(int ident, int *tag);
+static void         funcstub(int native);
+static int          newfunc(char *firstname, int firsttag,
+			    int fpublic, int fstatic, int stock);
+static int          declargs(symbol * sym);
+static void         doarg(char *name, int ident, int offset,
+			  int tags[], int numtags,
+			  int fpublic, int fconst, arginfo * arg);
+static void         reduce_referrers(symbol * root);
+static int          testsymbols(symbol * root, int level,
+				int testlabs, int testconst);
+static void         destructsymbols(symbol * root, int level);
+static constvalue  *find_constval_byval(constvalue * table, cell val);
+static void         statement(int *lastindent, int allow_decl);
+static void         compound(void);
+static void         doexpr(int comma, int chkeffect,
+			   int allowarray, int mark_endexpr,
+			   int *tag, int chkfuncresult);
+static void         doassert(void);
+static void         doexit(void);
+static void         test(int label, int parens, int invert);
+static void         doif(void);
+static void         dowhile(void);
+static void         dodo(void);
+static void         dofor(void);
+static void         doswitch(void);
+static void         dogoto(void);
+static void         dolabel(void);
+static symbol      *fetchlab(char *name);
+static void         doreturn(void);
+static void         dobreak(void);
+static void         docont(void);
+static void         dosleep(void);
+static void         addwhile(int *ptr);
+static void         delwhile(void);
+static int         *readwhile(void);
+
+static int          lastst = 0;	/* last executed statement type */
+static int          nestlevel = 0;	/* number of active (open) compound statements */
+static int          rettype = 0;	/* the type that a "return" expression should have */
+static int          skipinput = 0;	/* number of lines to skip from the first input file */
+static int          wq[wqTABSZ];	/* "while queue", internal stack for nested loops */
+static int         *wqptr;	/* pointer to next entry */
+static char         binfname[PATH_MAX];	/* binary file name */
+
+int
+main(int argc, char *argv[], char *env[] __UNUSED__)
+{
+   e_prefix_determine(argv[0]);
+   return sc_compile(argc, argv);
+}
+
+int
+sc_error(int number, char *message, char *filename, int firstline,
+	 int lastline, va_list argptr)
+{
+   static char        *prefix[3] = { "error", "fatal error", "warning" };
+
+   if (number != 0)
+     {
+	char               *pre;
+
+	pre = prefix[number / 100];
+	if (firstline >= 0)
+	   fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
+		   lastline, pre, number);
+	else
+	   fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
+		   number);
+     }				/* if */
+   vfprintf(stderr, message, argptr);
+   fflush(stderr);
+   return 0;
+}
+
+void               *
+sc_opensrc(char *filename)
+{
+   return fopen(filename, "rb");
+}
+
+void
+sc_closesrc(void *handle)
+{
+   assert(handle != NULL);
+   fclose((FILE *) handle);
+}
+
+void
+sc_resetsrc(void *handle, void *position)
+{
+   assert(handle != NULL);
+   fsetpos((FILE *) handle, (fpos_t *) position);
+}
+
+char               *
+sc_readsrc(void *handle, char *target, int maxchars)
+{
+   return fgets(target, maxchars, (FILE *) handle);
+}
+
+void               *
+sc_getpossrc(void *handle)
+{
+   static fpos_t       lastpos;	/* may need to have a LIFO stack of
+				 * such positions */
+
+   fgetpos((FILE *) handle, &lastpos);
+   return &lastpos;
+}
+
+int
+sc_eofsrc(void *handle)
+{
+   return feof((FILE *) handle);
+}
+
+void               *
+sc_openasm(int fd)
+{
+   return fdopen(fd, "w+");
+}
+
+void
+sc_closeasm(void *handle)
+{
+   if (handle)
+      fclose((FILE *) handle);
+}
+
+void
+sc_resetasm(void *handle)
+{
+   fflush((FILE *) handle);
+   fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writeasm(void *handle, char *st)
+{
+   return fputs(st, (FILE *) handle) >= 0;
+}
+
+char               *
+sc_readasm(void *handle, char *target, int maxchars)
+{
+   return fgets(target, maxchars, (FILE *) handle);
+}
+
+void               *
+sc_openbin(char *filename)
+{
+   return fopen(filename, "wb");
+}
+
+void
+sc_closebin(void *handle, int deletefile)
+{
+   fclose((FILE *) handle);
+   if (deletefile)
+      unlink(binfname);
+}
+
+void
+sc_resetbin(void *handle)
+{
+   fflush((FILE *) handle);
+   fseek((FILE *) handle, 0, SEEK_SET);
+}
+
+int
+sc_writebin(void *handle, void *buffer, int size)
+{
+   return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
+}
+
+long
+sc_lengthbin(void *handle)
+{
+   return ftell((FILE *) handle);
+}
+
+/*  "main" of the compiler
+ */
+int
+sc_compile(int argc, char *argv[])
+{
+   int                 entry, i, jmpcode, fd_out;
+   int                 retcode;
+   char                incfname[PATH_MAX];
+   char                reportname[PATH_MAX];
+   FILE               *binf;
+   void               *inpfmark;
+   char                lcl_ctrlchar;
+   int                 lcl_packstr, lcl_needsemicolon, lcl_tabsize;
+   char               *tmpdir;
+
+   /* set global variables to their initial value */
+   binf = NULL;
+   initglobals();
+   errorset(sRESET);
+   errorset(sEXPRRELEASE);
+   lexinit();
+
+   /* make sure that we clean up on a fatal error; do this before the
+    * first call to error(). */
+   if ((jmpcode = setjmp(errbuf)) != 0)
+      goto cleanup;
+
+   /* allocate memory for fixed tables */
+   inpfname = (char *)malloc(PATH_MAX);
+   litq = (cell *) malloc(litmax * sizeof(cell));
+   if (!litq)
+      error(103);		/* insufficient memory */
+   if (!phopt_init())
+      error(103);		/* insufficient memory */
+
+   setopt(argc, argv, inpfname, binfname, incfname, reportname);
+
+   /* open the output file */
+
+#ifndef HAVE_EVIL
+   tmpdir = getenv("TMPDIR");
+   if (!tmpdir) tmpdir = "/tmp";
+#else
+   tmpdir = (char *)evil_tmpdir_get();
+#endif /* ! HAVE_EVIL */
+
+   snprintf(outfname, PATH_MAX, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
+   fd_out = mkstemp(outfname);
+   if (fd_out < 0)
+     error(101, outfname);
+
+   setconfig(argv[0]);		/* the path to the include files */
+   lcl_ctrlchar = sc_ctrlchar;
+   lcl_packstr = sc_packstr;
+   lcl_needsemicolon = sc_needsemicolon;
+   lcl_tabsize = sc_tabsize;
+   inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
+   if (!inpf)
+      error(100, inpfname);
+   freading = TRUE;
+   outf = (FILE *) sc_openasm(fd_out);	/* first write to assembler
+						 * file (may be temporary) */
+   if (!outf)
+      error(101, outfname);
+   /* immediately open the binary file, for other programs to check */
+   binf = (FILE *) sc_openbin(binfname);
+   if (!binf)
+     error(101, binfname);
+   setconstants();		/* set predefined constants and tagnames */
+   for (i = 0; i < skipinput; i++)	/* skip lines in the input file */
+      if (sc_readsrc(inpf, pline, sLINEMAX))
+	 fline++;		/* keep line number up to date */
+   skipinput = fline;
+   sc_status = statFIRST;
+   /* do the first pass through the file */
+   inpfmark = sc_getpossrc(inpf);
+   if (incfname[0] != '\0')
+     {
+	if (strcmp(incfname, sDEF_PREFIX) == 0)
+	  {
+	     plungefile(incfname, FALSE, TRUE);	/* parse "default.inc" */
+	  }
+	else
+	  {
+	     if (!plungequalifiedfile(incfname))	/* parse "prefix" include
+							 * file */
+		error(100, incfname);	/* cannot read from ... (fatal error) */
+	  }			/* if */
+     }				/* if */
+   preprocess();		/* fetch first line */
+   parse();			/* process all input */
+
+   /* second pass */
+   sc_status = statWRITE;	/* set, to enable warnings */
+
+   /* ??? for re-parsing the listing file instead of the original source
+    * file (and doing preprocessing twice):
+    * - close input file, close listing file
+    * - re-open listing file for reading (inpf)
+    * - open assembler file (outf)
+    */
+
+   /* reset "defined" flag of all functions and global variables */
+   reduce_referrers(&glbtab);
+   delete_symbols(&glbtab, 0, TRUE, FALSE);
+#if !defined NO_DEFINE
+   delete_substtable();
+#endif
+   resetglobals();
+   sc_ctrlchar = lcl_ctrlchar;
+   sc_packstr = lcl_packstr;
+   sc_needsemicolon = lcl_needsemicolon;
+   sc_tabsize = lcl_tabsize;
+   errorset(sRESET);
+   /* reset the source file */
+   inpf = inpf_org;
+   freading = TRUE;
+   sc_resetsrc(inpf, inpfmark);	/* reset file position */
+   fline = skipinput;		/* reset line number */
+   lexinit();			/* clear internal flags of lex() */
+   sc_status = statWRITE;	/* allow to write --this variable was reset
+				 * by resetglobals() */
+   writeleader();
+   setfile(inpfname, fnumber);
+   if (incfname[0] != '\0')
+     {
+	if (strcmp(incfname, sDEF_PREFIX) == 0)
+	   plungefile(incfname, FALSE, TRUE);	/* parse "default.inc" (again) */
+	else
+	   plungequalifiedfile(incfname);	/* parse implicit include
+						 * file (again) */
+     }				/* if */
+   preprocess();		/* fetch first line */
+   parse();			/* process all input */
+   /* inpf is already closed when readline() attempts to pop of a file */
+   writetrailer();		/* write remaining stuff */
+
+   entry = testsymbols(&glbtab, 0, TRUE, FALSE);	/* test for unused
+							 * or undefined functions and variables */
+   if (!entry)
+      error(13);		/* no entry point (no public functions) */
+
+ cleanup:
+   if (inpf)		/* main source file is not closed, do it now */
+      sc_closesrc(inpf);
+   /* write the binary file (the file is already open) */
+   if (errnum == 0 && jmpcode == 0)
+     {
+	assert(binf != NULL);
+	sc_resetasm(outf);	/* flush and loop back, for reading */
+	assemble(binf, outf);	/* assembler file is now input */
+     }				/* if */
+   if (outf)
+      sc_closeasm(outf);
+   unlink (outfname);
+   if (binf)
+      sc_closebin(binf, errnum != 0);
+
+   if (inpfname)
+      free(inpfname);
+   if (litq)
+      free(litq);
+   phopt_cleanup();
+   stgbuffer_cleanup();
+   assert(jmpcode != 0 || loctab.next == NULL);	/* on normal flow,
+						 * local symbols
+						 * should already have been deleted */
+   delete_symbols(&loctab, 0, TRUE, TRUE);	/* delete local variables
+						 * if not yet  done (i.e.
+						 * on a fatal error) */
+   delete_symbols(&glbtab, 0, TRUE, TRUE);
+   delete_consttable(&tagname_tab);
+   delete_consttable(&libname_tab);
+   delete_aliastable();
+   delete_pathtable();
+#if !defined NO_DEFINE
+   delete_substtable();
+#endif
+   if (errnum != 0)
+     {
+	printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
+	retcode = 2;
+     }
+   else if (warnnum != 0)
+     {
+	printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
+	retcode = 1;
+     }
+   else
+     {
+	retcode = jmpcode;
+     }				/* if */
+   return retcode;
+}
+
+int
+sc_addconstant(char *name, cell value, int tag)
+{
+   errorset(sFORCESET);		/* make sure error engine is silenced */
+   sc_status = statIDLE;
+   add_constant(name, value, sGLOBAL, tag);
+   return 1;
+}
+
+int
+sc_addtag(char *name)
+{
+   cell                val;
+   constvalue         *ptr;
+   int                 last, tag;
+
+   if (!name)
+     {
+	/* no tagname was given, check for one */
+	if (lex(&val, &name) != tLABEL)
+	  {
+	     lexpush();
+	     return 0;		/* untagged */
+	  }			/* if */
+     }				/* if */
+
+   last = 0;
+   ptr = tagname_tab.next;
+   while (ptr)
+     {
+	tag = (int)(ptr->value & TAGMASK);
+	if (strcmp(name, ptr->name) == 0)
+	   return tag;		/* tagname is known, return its sequence number */
+	tag &= (int)~FIXEDTAG;
+	if (tag > last)
+	   last = tag;
+	ptr = ptr->next;
+     }				/* while */
+
+   /* tagname currently unknown, add it */
+   tag = last + 1;		/* guaranteed not to exist already */
+   if (isupper(*name))
+      tag |= (int)FIXEDTAG;
+   append_constval(&tagname_tab, name, (cell) tag, 0);
+   return tag;
+}
+
+static void
+resetglobals(void)
+{
+   /* reset the subset of global variables that is modified by the
+    * first pass */
+   curfunc = NULL;		/* pointer to current function */
+   lastst = 0;			/* last executed statement type */
+   nestlevel = 0;		/* number of active (open) compound statements */
+   rettype = 0;			/* the type that a "return" expression should have */
+   litidx = 0;			/* index to literal table */
+   stgidx = 0;			/* index to the staging buffer */
+   labnum = 0;			/* number of (internal) labels */
+   staging = 0;			/* true if staging output */
+   declared = 0;		/* number of local cells declared */
+   glb_declared = 0;		/* number of global cells declared */
+   code_idx = 0;		/* number of bytes with generated code */
+   ntv_funcid = 0;		/* incremental number of native function */
+   curseg = 0;			/* 1 if currently parsing CODE, 2 if parsing DATA */
+   freading = FALSE;		/* no input file ready yet */
+   fline = 0;			/* the line number in the current file */
+   fnumber = 0;			/* the file number in the file table (debugging) */
+   fcurrent = 0;		/* current file being processed (debugging) */
+   intest = 0;			/* true if inside a test */
+   sideeffect = 0;		/* true if an expression causes a side-effect */
+   stmtindent = 0;		/* current indent of the statement */
+   indent_nowarn = TRUE;	/* do not skip warning "217 loose indentation" */
+   sc_allowtags = TRUE;		/* allow/detect tagnames */
+   sc_status = statIDLE;
+}
+
+static void
+initglobals(void)
+{
+   resetglobals();
+
+   skipinput = 0;		/* number of lines to skip from the first
+				 * input file */
+   sc_ctrlchar = CTRL_CHAR;	/* the escape character */
+   litmax = sDEF_LITMAX;	/* current size of the literal table */
+   errnum = 0;			/* number of errors */
+   warnnum = 0;			/* number of warnings */
+/* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
+   sc_debug = 0;		/* by default: no debug */
+   charbits = 8;		/* a "char" is 8 bits */
+   sc_packstr = FALSE;		/* strings are unpacked by default */
+/* sc_compress=TRUE;     compress output bytecodes */
+   sc_compress = FALSE;		/* compress output bytecodes */
+   sc_needsemicolon = FALSE;	/* semicolon required to terminate
+				 * expressions? */
+   sc_dataalign = 4;
+   sc_stksize = sDEF_AMXSTACK;	/* default stack size */
+   sc_tabsize = 8;		/* assume a TAB is 8 spaces */
+   sc_rationaltag = 0;		/* assume no support for rational numbers */
+   rational_digits = 0;		/* number of fractional digits */
+
+   outfname[0] = '\0';		/* output file name */
+   inpf = NULL;			/* file read from */
+   inpfname = NULL;		/* pointer to name of the file currently
+				 * read from */
+   outf = NULL;			/* file written to */
+   litq = NULL;			/* the literal queue */
+   glbtab.next = NULL;		/* clear global variables/constants table */
+   loctab.next = NULL;		/*   "   local      "    /    "       "   */
+   tagname_tab.next = NULL;	/* tagname table */
+   libname_tab.next = NULL;	/* library table (#pragma library "..."
+				 * syntax) */
+
+   pline[0] = '\0';		/* the line read from the input file */
+   lptr = NULL;			/* points to the current position in "pline" */
+   curlibrary = NULL;		/* current library */
+   inpf_org = NULL;		/* main source file */
+
+   wqptr = wq;			/* initialize while queue pointer */
+
+}
+
+static void
+parseoptions(int argc, char **argv, char *iname, char *oname,
+             char *pname __UNUSED__, char *rname __UNUSED__)
+{
+   char str[PATH_MAX];
+   int i, stack_size;
+   size_t len;
+
+   /* use embryo include dir always */
+   snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
+   insert_path(str);
+   insert_path("./");
+
+   for (i = 1; i < argc; i++)
+   {
+      if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
+      {
+	 /* include directory */
+	 i++;
+	 strncpy(str, argv[i], sizeof(str));
+
+	 len = strlen(str);
+	 if (str[len - 1] != DIRSEP_CHAR)
+	 {
+	    str[len] = DIRSEP_CHAR;
+	    str[len + 1] = '\0';
+	 }
+
+	 insert_path(str);
+      }
+      else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
+      {
+	 /* output file */
+	 i++;
+	 strcpy(oname, argv[i]); /* FIXME */
+      }
+      else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
+      {
+	 /* stack size */
+	 i++;
+	 stack_size = atoi(argv[i]);
+
+	 if (stack_size > 64)
+	    sc_stksize = (cell) stack_size;
+	 else
+	    about();
+      }
+      else if (!*iname)
+      {
+	 /* input file */
+	 strcpy(iname, argv[i]); /* FIXME */
+      }
+      else
+      {
+	 /* only allow one input filename */
+	 about();
+      }
+   }
+}
+
+static void
+setopt(int argc, char **argv, char *iname, char *oname,
+       char *pname, char *rname)
+{
+   *iname = '\0';
+   *oname = '\0';
+   *pname = '\0';
+   *rname = '\0';
+   strcpy(pname, sDEF_PREFIX);
+
+   parseoptions(argc, argv, iname, oname, pname, rname);
+   if (iname[0] == '\0')
+      about();
+}
+
+static void
+setconfig(char *root)
+{
+   char                path[PATH_MAX];
+   char               *ptr;
+   int                 len;
+
+   path[sizeof(path) - 1] = 0;
+
+   /* add the default "include" directory */
+   if (root)
+     {
+	/* path + filename (hopefully) */
+	strncpy(path, root, sizeof(path) - 1);
+	path[sizeof(path) - 1] = 0;
+     }
+/* terminate just behind last \ or : */
+   if ((ptr = strrchr(path, DIRSEP_CHAR))
+       || (ptr = strchr(path, ':')))
+     {
+	/* If there was no terminating "\" or ":",
+	 * the filename probably does not
+	 * contain the path; so we just don't add it
+	 * to the list in that case
+	 */
+	*(ptr + 1) = '\0';
+	if (strlen(path) < (sizeof(path) - 1 - 7))
+	  {
+	     strcat(path, "include");
+	  }
+	len = strlen(path);
+	path[len] = DIRSEP_CHAR;
+	path[len + 1] = '\0';
+	insert_path(path);
+     }				/* if */
+}
+
+static void
+about(void)
+{
+   printf("Usage:   embryo_cc <filename> [options]\n\n");
+   printf("Options:\n");
+#if 0
+	printf
+	   ("         -A<num>  alignment in bytes of the data segment and the\
+     stack\n");
+
+	printf
+	   ("         -a       output assembler code (skip code generation\
+    pass)\n");
+
+	printf
+	   ("         -C[+/-]  compact encoding for output file (default=%c)\n",
+	    sc_compress ? '+' : '-');
+	printf("         -c8      [default] a character is 8-bits\
+     (ASCII/ISO Latin-1)\n");
+
+	printf("         -c16     a character is 16-bits (Unicode)\n");
+#if defined dos_setdrive
+	printf("         -Dpath   active directory path\n");
+#endif
+	printf
+	   ("         -d0      no symbolic information, no run-time checks\n");
+	printf("         -d1      [default] run-time checks, no symbolic\
+     information\n");
+	printf
+	   ("         -d2      full debug information and dynamic checking\n");
+	printf("         -d3      full debug information, dynamic checking,\
+     no optimization\n");
+#endif
+	printf("         -i <name> path for include files\n");
+#if 0
+	printf("         -l       create list file (preprocess only)\n");
+#endif
+	printf("         -o <name> set base name of output file\n");
+#if 0
+	printf
+	   ("         -P[+/-]  strings are \"packed\" by default (default=%c)\n",
+	    sc_packstr ? '+' : '-');
+	printf("         -p<name> set name of \"prefix\" file\n");
+	if (!waitkey())
+	   longjmp(errbuf, 3);
+#endif
+	printf
+	   ("         -S <num>  stack/heap size in cells (default=%d, min=65)\n",
+	    (int)sc_stksize);
+#if 0
+	printf("         -s<num>  skip lines from the input file\n");
+	printf
+	   ("         -t<num>  TAB indent size (in character positions)\n");
+	printf("         -\\       use '\\' for escape characters\n");
+	printf("         -^       use '^' for escape characters\n");
+	printf("         -;[+/-]  require a semicolon to end each statement\
+     (default=%c)\n", sc_needsemicolon ? '+' : '-');
+
+	printf
+	   ("         sym=val  define constant \"sym\" with value \"val\"\n");
+	printf("         sym=     define constant \"sym\" with value 0\n");
+#endif
+	longjmp(errbuf, 3);		/* user abort */
+}
+
+static void
+setconstants(void)
+{
+   int                 debug;
+
+   assert(sc_status == statIDLE);
+   append_constval(&tagname_tab, "_", 0, 0);	/* "untagged" */
+   append_constval(&tagname_tab, "bool", 1, 0);
+
+   add_constant("true", 1, sGLOBAL, 1);	/* boolean flags */
+   add_constant("false", 0, sGLOBAL, 1);
+   add_constant("EOS", 0, sGLOBAL, 0);	/* End Of String, or '\0' */
+   add_constant("cellbits", 32, sGLOBAL, 0);
+   add_constant("cellmax", INT_MAX, sGLOBAL, 0);
+   add_constant("cellmin", INT_MIN, sGLOBAL, 0);
+   add_constant("charbits", charbits, sGLOBAL, 0);
+   add_constant("charmin", 0, sGLOBAL, 0);
+   add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
+
+   add_constant("__Small", VERSION_INT, sGLOBAL, 0);
+
+   debug = 0;
+   if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
+      debug = 2;
+   else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
+      debug = 1;
+   add_constant("debug", debug, sGLOBAL, 0);
+}
+
+/*  parse       - process all input text
+ *
+ *  At this level, only static declarations and function definitions
+ *  are legal.
+ */
+static void
+parse(void)
+{
+   int                 tok, tag, fconst, fstock, fstatic;
+   cell                val;
+   char               *str;
+
+   while (freading)
+     {
+	/* first try whether a declaration possibly is native or public */
+	tok = lex(&val, &str);	/* read in (new) token */
+	switch (tok)
+	  {
+	  case 0:
+	     /* ignore zero's */
+	     break;
+	  case tNEW:
+	     fconst = matchtoken(tCONST);
+	     declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
+	     break;
+	  case tSTATIC:
+	     /* This can be a static function or a static global variable;
+	      * we know which of the two as soon as we have parsed up to the
+	      * point where an opening parenthesis of a function would be
+	      * expected. To back out after deciding it was a declaration of
+	      * a static variable after all, we have to store the symbol name
+	      * and tag.
+	      */
+	     fstock = matchtoken(tSTOCK);
+	     fconst = matchtoken(tCONST);
+	     tag = sc_addtag(NULL);
+	     tok = lex(&val, &str);
+	     if (tok == tNATIVE || tok == tPUBLIC)
+	       {
+		  error(42);	/* invalid combination of class specifiers */
+		  break;
+	       }		/* if */
+	     declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
+	     break;
+	  case tCONST:
+	     decl_const(sGLOBAL);
+	     break;
+	  case tENUM:
+	     decl_enum(sGLOBAL);
+	     break;
+	  case tPUBLIC:
+	     /* This can be a public function or a public variable;
+	      * see the comment above (for static functions/variables)
+	      * for details.
+	      */
+	     fconst = matchtoken(tCONST);
+	     tag = sc_addtag(NULL);
+	     tok = lex(&val, &str);
+	     if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
+	       {
+		  error(42);	/* invalid combination of class specifiers */
+		  break;
+	       }		/* if */
+	     declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
+	     break;
+	  case tSTOCK:
+	     /* This can be a stock function or a stock *global) variable;
+	      * see the comment above (for static functions/variables) for
+	      * details.
+	      */
+	     fstatic = matchtoken(tSTATIC);
+	     fconst = matchtoken(tCONST);
+	     tag = sc_addtag(NULL);
+	     tok = lex(&val, &str);
+	     if (tok == tNATIVE || tok == tPUBLIC)
+	       {
+		  error(42);	/* invalid combination of class specifiers */
+		  break;
+	       }		/* if */
+	     declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
+	     break;
+	  case tLABEL:
+	  case tSYMBOL:
+	  case tOPERATOR:
+	     lexpush();
+	     if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
+	       {
+		  error(10);	/* illegal function or declaration */
+		  lexclr(TRUE);	/* drop the rest of the line */
+	       }		/* if */
+	     break;
+	  case tNATIVE:
+	     funcstub(TRUE);	/* create a dummy function */
+	     break;
+	  case tFORWARD:
+	     funcstub(FALSE);
+	     break;
+	  case '}':
+	     error(54);		/* unmatched closing brace */
+	     break;
+	  case '{':
+	     error(55);		/* start of function body without function header */
+	     break;
+	  default:
+	     if (freading)
+	       {
+		  error(10);	/* illegal function or declaration */
+		  lexclr(TRUE);	/* drop the rest of the line */
+	       }		/* if */
+	  }			/* switch */
+     }				/* while */
+}
+
+/*  dumplits
+ *
+ *  Dump the literal pool (strings etc.)
+ *
+ *  Global references: litidx (referred to only)
+ */
+static void
+dumplits(void)
+{
+   int                 j, k;
+
+   k = 0;
+   while (k < litidx)
+     {
+	/* should be in the data segment */
+	assert(curseg == 2);
+	defstorage();
+	j = 16;			/* 16 values per line */
+	while (j && k < litidx)
+	  {
+	     outval(litq[k], FALSE);
+	     stgwrite(" ");
+	     k++;
+	     j--;
+	     if (j == 0 || k >= litidx)
+		stgwrite("\n");	/* force a newline after 10 dumps */
+	     /* Note: stgwrite() buffers a line until it is complete. It recognizes
+	      * the end of line as a sequence of "\n\0", so something like "\n\t"
+	      * so should not be passed to stgwrite().
+	      */
+	  }			/* while */
+     }				/* while */
+}
+
+/*  dumpzero
+ *
+ *  Dump zero's for default initial values
+ */
+static void
+dumpzero(int count)
+{
+   int                 i;
+
+   if (count <= 0)
+      return;
+   assert(curseg == 2);
+   defstorage();
+   i = 0;
+   while (count-- > 0)
+     {
+	outval(0, FALSE);
+	i = (i + 1) % 16;
+	stgwrite((i == 0 || count == 0) ? "\n" : " ");
+	if (i == 0 && count > 0)
+	   defstorage();
+     }				/* while */
+}
+
+static void
+aligndata(int numbytes)
+{
+   if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+     {
+	while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
+	   stowlit(0);
+     }				/* if */
+
+}
+
+static void
+declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
+	    int fstock, int fconst)
+{
+   char                name[sNAMEMAX + 1];
+
+   if (tok != tSYMBOL && tok != tOPERATOR)
+     {
+	if (freading)
+	   error(20, symname);	/* invalid symbol name */
+	return;
+     }				/* if */
+   if (tok == tOPERATOR)
+     {
+	lexpush();
+	if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
+	   error(10);		/* illegal function or declaration */
+     }
+   else
+     {
+	assert(strlen(symname) <= sNAMEMAX);
+	strcpy(name, symname);
+	if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
+	   declglb(name, tag, fpublic, fstatic, fstock, fconst);
+	/* if not a static function, try a static variable */
+     }				/* if */
+}
+
+/*  declglb     - declare global symbols
+ *
+ *  Declare a static (global) variable. Global variables are stored in
+ *  the DATA segment.
+ *
+ *  global references: glb_declared     (altered)
+ */
+static void
+declglb(char *firstname, int firsttag, int fpublic, int fstatic,
+	int stock, int fconst)
+{
+   int                 ident, tag, ispublic;
+   int                 idxtag[sDIMEN_MAX];
+   char                name[sNAMEMAX + 1];
+   cell                val, size, cidx;
+   char               *str;
+   int                 dim[sDIMEN_MAX];
+   int                 numdim, level;
+   int                 filenum;
+   symbol             *sym;
+
+#if !defined NDEBUG
+   cell                glbdecl = 0;
+#endif
+
+   filenum = fcurrent;		/* save file number at the start of the
+				 * declaration */
+   do
+     {
+	size = 1;		/* single size (no array) */
+	numdim = 0;		/* no dimensions */
+	ident = iVARIABLE;
+	if (firstname)
+	  {
+	     assert(strlen(firstname) <= sNAMEMAX);
+	     strcpy(name, firstname);	/* save symbol name */
+	     tag = firsttag;
+	     firstname = NULL;
+	  }
+	else
+	  {
+	     tag = sc_addtag(NULL);
+	     if (lex(&val, &str) != tSYMBOL)	/* read in (new) token */
+		error(20, str);	/* invalid symbol name */
+	     assert(strlen(str) <= sNAMEMAX);
+	     strcpy(name, str);	/* save symbol name */
+	  }			/* if */
+	sym = findglb(name);
+	if (!sym)
+	   sym = findconst(name);
+	if (sym && (sym->usage & uDEFINE) != 0)
+	   error(21, name);	/* symbol already defined */
+	ispublic = fpublic;
+	if (name[0] == PUBLIC_CHAR)
+	  {
+	     ispublic = TRUE;	/* implicitly public variable */
+	     if (stock || fstatic)
+		error(42);	/* invalid combination of class specifiers */
+	  }			/* if */
+	while (matchtoken('['))
+	  {
+	     ident = iARRAY;
+	     if (numdim == sDIMEN_MAX)
+	       {
+		  error(53);	/* exceeding maximum number of dimensions */
+		  return;
+	       }		/* if */
+	     if (numdim > 0 && dim[numdim - 1] == 0)
+		error(52);	/* only last dimension may be variable length */
+	     size = needsub(&idxtag[numdim]);	/* get size; size==0 for
+						 * "var[]" */
+#if INT_MAX < LONG_MAX
+	     if (size > INT_MAX)
+		error(105);	/* overflow, exceeding capacity */
+#endif
+	     if (ispublic)
+		error(56, name);	/* arrays cannot be public */
+	     dim[numdim++] = (int)size;
+	  }			/* while */
+	/* if this variable is never used (which can be detected only in
+	 * the second stage), shut off code generation; make an exception
+	 * for public variables
+	 */
+	cidx = 0;		/* only to avoid a compiler warning */
+	if (sc_status == statWRITE && sym
+	    && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
+	  {
+	     sc_status = statSKIP;
+	     cidx = code_idx;
+#if !defined NDEBUG
+	     glbdecl = glb_declared;
+#endif
+	  }			/* if */
+	defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
+	begdseg();		/* real (initialized) data in data segment */
+	assert(litidx == 0);	/* literal queue should be empty */
+	if (sc_alignnext)
+	  {
+	     litidx = 0;
+	     aligndata(sc_dataalign);
+	     dumplits();	/* dump the literal queue */
+	     sc_alignnext = FALSE;
+	     litidx = 0;	/* global initial data is dumped, so restart at zero */
+	  }			/* if */
+	initials(ident, tag, &size, dim, numdim);	/* stores values in
+							 * the literal queue */
+	if (numdim == 1)
+	   dim[0] = (int)size;
+	dumplits();		/* dump the literal queue */
+	dumpzero((int)size - litidx);
+	litidx = 0;
+	if (!sym)
+	  {			/* define only if not yet defined */
+	     sym =
+		addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
+			    tag, dim, numdim, idxtag);
+	  }
+	else
+	  {			/* if declared but not yet defined, adjust the
+				 * variable's address */
+	     sym->addr = sizeof(cell) * glb_declared;
+	     sym->usage |= uDEFINE;
+	  }			/* if */
+	if (ispublic)
+	   sym->usage |= uPUBLIC;
+	if (fconst)
+	   sym->usage |= uCONST;
+	if (stock)
+	   sym->usage |= uSTOCK;
+	if (fstatic)
+	   sym->fnumber = filenum;
+	if (ident == iARRAY)
+	   for (level = 0; level < numdim; level++)
+	      symbolrange(level, dim[level]);
+	if (sc_status == statSKIP)
+	  {
+	     sc_status = statWRITE;
+	     code_idx = cidx;
+	     assert(glb_declared == glbdecl);
+	  }
+	else
+	  {
+	     glb_declared += (int)size;	/* add total number of cells */
+	  }			/* if */
+     }
+   while (matchtoken(','));	/* enddo *//* more? */
+   needtoken(tTERM);		/* if not comma, must be semicolumn */
+}
+
+/*  declloc     - declare local symbols
+ *
+ *  Declare local (automatic) variables. Since these variables are
+ *  relative to the STACK, there is no switch to the DATA segment.
+ *  These variables cannot be initialized either.
+ *
+ *  global references: declared   (altered)
+ *                     funcstatus (referred to only)
+ */
+static int
+declloc(int fstatic)
+{
+   int                 ident, tag;
+   int                 idxtag[sDIMEN_MAX];
+   char                name[sNAMEMAX + 1];
+   symbol             *sym;
+   cell                val, size;
+   char               *str;
+   value               lval = { NULL, 0, 0, 0, 0, NULL };
+   int                 cur_lit = 0;
+   int                 dim[sDIMEN_MAX];
+   int                 numdim, level;
+   int                 fconst;
+
+   fconst = matchtoken(tCONST);
+   do
+     {
+	ident = iVARIABLE;
+	size = 1;
+	numdim = 0;		/* no dimensions */
+	tag = sc_addtag(NULL);
+	if (lex(&val, &str) != tSYMBOL)	/* read in (new) token */
+	   error(20, str);	/* invalid symbol name */
+	assert(strlen(str) <= sNAMEMAX);
+	strcpy(name, str);	/* save symbol name */
+	if (name[0] == PUBLIC_CHAR)
+	   error(56, name);	/* local variables cannot be public */
+	/* Note: block locals may be named identical to locals at higher
+	 * compound blocks (as with standard C); so we must check (and add)
+	 * the "nesting level" of local variables to verify the
+	 * multi-definition of symbols.
+	 */
+	if ((sym = findloc(name)) && sym->compound == nestlevel)
+	   error(21, name);	/* symbol already defined */
+	/* Although valid, a local variable whose name is equal to that
+	 * of a global variable or to that of a local variable at a lower
+	 * level might indicate a bug.
+	 */
+	if (((sym = findloc(name)) && sym->compound != nestlevel)
+	    || findglb(name))
+	   error(219, name);	/* variable shadows another symbol */
+	while (matchtoken('['))
+	  {
+	     ident = iARRAY;
+	     if (numdim == sDIMEN_MAX)
+	       {
+		  error(53);	/* exceeding maximum number of dimensions */
+		  return ident;
+	       }		/* if */
+	     if (numdim > 0 && dim[numdim - 1] == 0)
+		error(52);	/* only last dimension may be variable length */
+	     size = needsub(&idxtag[numdim]);	/* get size; size==0 for "var[]" */
+#if INT_MAX < LONG_MAX
+	     if (size > INT_MAX)
+		error(105);	/* overflow, exceeding capacity */
+#endif
+	     dim[numdim++] = (int)size;
+	  }			/* while */
+	if (ident == iARRAY || fstatic)
+	  {
+	     if (sc_alignnext)
+	       {
+		  aligndata(sc_dataalign);
+		  sc_alignnext = FALSE;
+	       }		/* if */
+	     cur_lit = litidx;	/* save current index in the literal table */
+	     initials(ident, tag, &size, dim, numdim);
+	     if (size == 0)
+		return ident;	/* error message already given */
+	     if (numdim == 1)
+		dim[0] = (int)size;
+	  }			/* if */
+	/* reserve memory (on the stack) for the variable */
+	if (fstatic)
+	  {
+	     /* write zeros for uninitialized fields */
+	     while (litidx < cur_lit + size)
+		stowlit(0);
+	     sym =
+		addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
+			    ident, sSTATIC, tag, dim, numdim, idxtag);
+	     defsymbol(name, ident, sSTATIC,
+		       (cur_lit + glb_declared) * sizeof(cell), tag);
+	  }
+	else
+	  {
+	     declared += (int)size;	/* variables are put on stack,
+					 * adjust "declared" */
+	     sym =
+		addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
+			    dim, numdim, idxtag);
+	     defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
+	     modstk(-(int)size * sizeof(cell));
+	  }			/* if */
+	/* now that we have reserved memory for the variable, we can
+	 * proceed to initialize it */
+	sym->compound = nestlevel;	/* for multiple declaration/shadowing */
+	if (fconst)
+	   sym->usage |= uCONST;
+	if (ident == iARRAY)
+	   for (level = 0; level < numdim; level++)
+	      symbolrange(level, dim[level]);
+	if (!fstatic)
+	  {			/* static variables already initialized */
+	     if (ident == iVARIABLE)
+	       {
+		  /* simple variable, also supports initialization */
+		  int                 ctag = tag;	/* set to "tag" by default */
+		  int                 explicit_init = FALSE;	/* is the variable explicitly
+								 * initialized? */
+		  if (matchtoken('='))
+		    {
+		       doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
+		       explicit_init = TRUE;
+		    }
+		  else
+		    {
+		       const1(0);	/* uninitialized variable, set to zero */
+		    }		/* if */
+		  /* now try to save the value (still in PRI) in the variable */
+		  lval.sym = sym;
+		  lval.ident = iVARIABLE;
+		  lval.constval = 0;
+		  lval.tag = tag;
+		  check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
+		  store(&lval);
+		  endexpr(TRUE);	/* full expression ends after the store */
+		  if (!matchtag(tag, ctag, TRUE))
+		     error(213);	/* tag mismatch */
+		  /* if the variable was not explicitly initialized, reset the
+		   * "uWRITTEN" flag that store() set */
+		  if (!explicit_init)
+		     sym->usage &= ~uWRITTEN;
+	       }
+	     else
+	       {
+		  /* an array */
+		  if (litidx - cur_lit < size)
+		     fillarray(sym, size * sizeof(cell), 0);
+		  if (cur_lit < litidx)
+		    {
+		       /* check whether the complete array is set to a single value;
+		        * if it is, more compact code can be generated */
+		       cell                first = litq[cur_lit];
+		       int                 i;
+
+		       for (i = cur_lit; i < litidx && litq[i] == first; i++)
+			  /* nothing */ ;
+		       if (i == litidx)
+			 {
+			    /* all values are the same */
+			    fillarray(sym, (litidx - cur_lit) * sizeof(cell),
+				      first);
+			    litidx = cur_lit;	/* reset literal table */
+			 }
+		       else
+			 {
+			    /* copy the literals to the array */
+			    const1((cur_lit + glb_declared) * sizeof(cell));
+			    copyarray(sym, (litidx - cur_lit) * sizeof(cell));
+			 }	/* if */
+		    }		/* if */
+	       }		/* if */
+	  }			/* if */
+     }
+   while (matchtoken(','));	/* enddo *//* more? */
+   needtoken(tTERM);		/* if not comma, must be semicolumn */
+   return ident;
+}
+
+static              cell
+calc_arraysize(int dim[], int numdim, int cur)
+{
+   if (cur == numdim)
+      return 0;
+   return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
+}
+
+/*  initials
+ *
+ *  Initialize global objects and local arrays.
+ *    size==array cells (count), if 0 on input, the routine counts
+ *    the number of elements
+ *    tag==required tagname id (not the returned tag)
+ *
+ *  Global references: litidx (altered)
+ */
+static void
+initials(int ident, int tag, cell * size, int dim[], int numdim)
+{
+   int                 ctag;
+   int                 curlit = litidx;
+   int                 d;
+
+   if (!matchtoken('='))
+     {
+	if (ident == iARRAY && dim[numdim - 1] == 0)
+	  {
+	     /* declared as "myvar[];" which is senseless (note: this *does* make
+	      * sense in the case of a iREFARRAY, which is a function parameter)
+	      */
+	     error(9);		/* array has zero length -> invalid size */
+	  }			/* if */
+	if (numdim > 1)
+	  {
+	     /* initialize the indirection tables */
+#if sDIMEN_MAX>2
+#error Array algorithms for more than 2 dimensions are not implemented
+#endif
+	     assert(numdim == 2);
+	     *size = calc_arraysize(dim, numdim, 0);
+	     for (d = 0; d < dim[0]; d++)
+		stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
+	  }			/* if */
+	return;
+     }				/* if */
+
+   if (ident == iVARIABLE)
+     {
+	assert(*size == 1);
+	init(ident, &ctag);
+	if (!matchtag(tag, ctag, TRUE))
+	   error(213);		/* tag mismatch */
+     }
+   else
+     {
+	assert(numdim > 0);
+	if (numdim == 1)
+	  {
+	     *size = initvector(ident, tag, dim[0], FALSE);
+	  }
+	else
+	  {
+	     cell                offs, dsize;
+
+	     /* The simple algorithm below only works for arrays with one or
+	      * two dimensions. This should be some recursive algorithm.
+	      */
+	     if (dim[numdim - 1] != 0)
+		/* set size to (known) full size */
+		*size = calc_arraysize(dim, numdim, 0);
+	     /* dump indirection tables */
+	     for (d = 0; d < dim[0]; d++)
+		stowlit(0);
+	     /* now dump individual vectors */
+	     needtoken('{');
+	     offs = dim[0];
+	     for (d = 0; d < dim[0]; d++)
+	       {
+		  litq[curlit + d] = offs * sizeof(cell);
+		  dsize = initvector(ident, tag, dim[1], TRUE);
+		  offs += dsize - 1;
+		  if (d + 1 < dim[0])
+		     needtoken(',');
+		  if (matchtoken('{') || matchtoken(tSTRING))
+		     /* expect a '{' or a string */
+		     lexpush();
+		  else
+		     break;
+	       }		/* for */
+	     matchtoken(',');
+	     needtoken('}');
+	  }			/* if */
+     }				/* if */
+
+   if (*size == 0)
+      *size = litidx - curlit;	/* number of elements defined */
+}
+
+/*  initvector
+ *  Initialize a single dimensional array
+ */
+static              cell
+initvector(int ident, int tag, cell size, int fillzero)
+{
+   cell                prev1 = 0, prev2 = 0;
+   int                 ctag;
+   int                 ellips = FALSE;
+   int                 curlit = litidx;
+
+   assert(ident == iARRAY || ident == iREFARRAY);
+   if (matchtoken('{'))
+     {
+	do
+	  {
+	     if (matchtoken('}'))
+	       {		/* to allow for trailing ',' after the initialization */
+		  lexpush();
+		  break;
+	       }		/* if */
+	     if ((ellips = matchtoken(tELLIPS)) != 0)
+		break;
+	     prev2 = prev1;
+	     prev1 = init(ident, &ctag);
+	     if (!matchtag(tag, ctag, TRUE))
+		error(213);	/* tag mismatch */
+	  }
+	while (matchtoken(','));	/* do */
+	needtoken('}');
+     }
+   else
+     {
+	init(ident, &ctag);
+	if (!matchtag(tag, ctag, TRUE))
+	   error(213);		/* tagname mismatch */
+     }				/* if */
+   /* fill up the literal queue with a series */
+   if (ellips)
+     {
+	cell                step =
+	   ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
+	if (size == 0 || (litidx - curlit) == 0)
+	   error(41);		/* invalid ellipsis, array size unknown */
+	else if ((litidx - curlit) == (int)size)
+	   error(18);		/* initialisation data exceeds declared size */
+	while ((litidx - curlit) < (int)size)
+	  {
+	     prev1 += step;
+	     stowlit(prev1);
+	  }			/* while */
+     }				/* if */
+   if (fillzero && size > 0)
+     {
+	while ((litidx - curlit) < (int)size)
+	   stowlit(0);
+     }				/* if */
+   if (size == 0)
+     {
+	size = litidx - curlit;	/* number of elements defined */
+     }
+   else if (litidx - curlit > (int)size)
+     {				/* e.g. "myvar[3]={1,2,3,4};" */
+	error(18);		/* initialisation data exceeds declared size */
+	litidx = (int)size + curlit;	/* avoid overflow in memory moves */
+     }				/* if */
+   return size;
+}
+
+/*  init
+ *
+ *  Evaluate one initializer.
+ */
+static              cell
+init(int ident, int *tag)
+{
+   cell                i = 0;
+
+   if (matchtoken(tSTRING))
+     {
+	/* lex() automatically stores strings in the literal table (and
+	 * increases "litidx") */
+	if (ident == iVARIABLE)
+	  {
+	     error(6);		/* must be assigned to an array */
+	     litidx = 1;	/* reset literal queue */
+	  }			/* if */
+	*tag = 0;
+     }
+   else if (constexpr(&i, tag))
+     {
+	stowlit(i);		/* store expression result in literal table */
+     }				/* if */
+   return i;
+}
+
+/*  needsub
+ *
+ *  Get required array size
+ */
+static              cell
+needsub(int *tag)
+{
+   cell                val;
+
+   *tag = 0;
+   if (matchtoken(']'))		/* we've already seen "[" */
+      return 0;			/* null size (like "char msg[]") */
+   constexpr(&val, tag);	/* get value (must be constant expression) */
+   if (val < 0)
+     {
+	error(9);		/* negative array size is invalid; assumed zero */
+	val = 0;
+     }				/* if */
+   needtoken(']');
+   return val;			/* return array size */
+}
+
+/*  decl_const  - declare a single constant
+ *
+ */
+static void
+decl_const(int vclass)
+{
+   char                constname[sNAMEMAX + 1];
+   cell                val;
+   char               *str;
+   int                 tag, exprtag;
+   int                 symbolline;
+
+   tag = sc_addtag(NULL);
+   if (lex(&val, &str) != tSYMBOL)	/* read in (new) token */
+      error(20, str);		/* invalid symbol name */
+   symbolline = fline;		/* save line where symbol was found */
+   strcpy(constname, str);	/* save symbol name */
+   needtoken('=');
+   constexpr(&val, &exprtag);	/* get value */
+   needtoken(tTERM);
+   /* add_constant() checks for duplicate definitions */
+   if (!matchtag(tag, exprtag, FALSE))
+     {
+	/* temporarily reset the line number to where the symbol was
+	 * defined */
+	int                 orgfline = fline;
+
+	fline = symbolline;
+	error(213);		/* tagname mismatch */
+	fline = orgfline;
+     }				/* if */
+   add_constant(constname, val, vclass, tag);
+}
+
+/*  decl_enum   - declare enumerated constants
+ *
+ */
+static void
+decl_enum(int vclass)
+{
+   char                enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
+   cell                val, value, size;
+   char               *str;
+   int                 tok, tag, explicittag;
+   cell                increment, multiplier;
+
+   /* get an explicit tag, if any (we need to remember whether an
+    * explicit tag was passed, even if that explicit tag was "_:", so we
+    * cannot call sc_addtag() here
+    */
+   if (lex(&val, &str) == tLABEL)
+     {
+	tag = sc_addtag(str);
+	explicittag = TRUE;
+     }
+   else
+     {
+	lexpush();
+	tag = 0;
+	explicittag = FALSE;
+     }				/* if */
+
+   /* get optional enum name (also serves as a tag if no explicit
+    * tag was set) */
+   if (lex(&val, &str) == tSYMBOL)
+     {				/* read in (new) token */
+	strcpy(enumname, str);	/* save enum name (last constant) */
+	if (!explicittag)
+	   tag = sc_addtag(enumname);
+     }
+   else
+     {
+	lexpush();		/* analyze again */
+	enumname[0] = '\0';
+     }				/* if */
+
+   /* get increment and multiplier */
+   increment = 1;
+   multiplier = 1;
+   if (matchtoken('('))
+     {
+	if (matchtoken(taADD))
+	  {
+	     constexpr(&increment, NULL);
+	  }
+	else if (matchtoken(taMULT))
+	  {
+	     constexpr(&multiplier, NULL);
+	  }
+	else if (matchtoken(taSHL))
+	  {
+	     constexpr(&val, NULL);
+	     while (val-- > 0)
+		multiplier *= 2;
+	  }			/* if */
+	needtoken(')');
+     }				/* if */
+
+   needtoken('{');
+   /* go through all constants */
+   value = 0;			/* default starting value */
+   do
+     {
+	if (matchtoken('}'))
+	  {			/* quick exit if '}' follows ',' */
+	     lexpush();
+	     break;
+	  }			/* if */
+	tok = lex(&val, &str);	/* read in (new) token */
+	if (tok != tSYMBOL && tok != tLABEL)
+	   error(20, str);	/* invalid symbol name */
+	strcpy(constname, str);	/* save symbol name */
+	size = increment;	/* default increment of 'val' */
+	if (tok == tLABEL || matchtoken(':'))
+	   constexpr(&size, NULL);	/* get size */
+	if (matchtoken('='))
+	   constexpr(&value, NULL);	/* get value */
+	/* add_constant() checks whether a variable (global or local) or
+	 * a constant with the same name already exists */
+	add_constant(constname, value, vclass, tag);
+	if (multiplier == 1)
+	   value += size;
+	else
+	   value *= size * multiplier;
+     }
+   while (matchtoken(','));
+   needtoken('}');		/* terminates the constant list */
+   matchtoken(';');		/* eat an optional ; */
+
+   /* set the enum name to the last value plus one */
+   if (enumname[0] != '\0')
+      add_constant(enumname, value, vclass, tag);
+}
+
+/*
+ *  Finds a function in the global symbol table or creates a new entry.
+ *  It does some basic processing and error checking.
+ */
+symbol     *
+fetchfunc(char *name, int tag)
+{
+   symbol             *sym;
+   cell                offset;
+
+   offset = code_idx;
+   if ((sc_debug & sSYMBOLIC) != 0)
+     {
+	offset += opcodes(1) + opargs(3) + nameincells(name);
+	/* ^^^ The address for the symbol is the code address. But the
+	 * "symbol" instruction itself generates code. Therefore the
+	 * offset is pre-adjusted to the value it will have after the
+	 * symbol instruction.
+	 */
+     }				/* if */
+   if ((sym = findglb(name)))
+     {				/* already in symbol table? */
+	if (sym->ident != iFUNCTN)
+	  {
+	     error(21, name);	/* yes, but not as a function */
+	     return NULL;	/* make sure the old symbol is not damaged */
+	  }
+	else if ((sym->usage & uDEFINE) != 0)
+	  {
+	     error(21, name);	/* yes, and it's already defined */
+	  }
+	else if ((sym->usage & uNATIVE) != 0)
+	  {
+	     error(21, name);	/* yes, and it is an native */
+	  }			/* if */
+	assert(sym->vclass == sGLOBAL);
+	if ((sym->usage & uDEFINE) == 0)
+	  {
+	     /* as long as the function stays undefined, update the address
+	      * and the tag */
+	     sym->addr = offset;
+	     sym->tag = tag;
+	  }			/* if */
+     }
+   else
+     {
+	/* don't set the "uDEFINE" flag; it may be a prototype */
+	sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
+	/* assume no arguments */
+	sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
+	sym->dim.arglist[0].ident = 0;
+	/* set library ID to NULL (only for native functions) */
+	sym->x.lib = NULL;
+     }				/* if */
+   return sym;
+}
+
+/* This routine adds symbolic information for each argument.
+ */
+static void
+define_args(void)
+{
+   symbol             *sym;
+
+   /* At this point, no local variables have been declared. All
+    * local symbols are function arguments.
+    */
+   sym = loctab.next;
+   while (sym)
+     {
+	assert(sym->ident != iLABEL);
+	assert(sym->vclass == sLOCAL);
+	defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
+	if (sym->ident == iREFARRAY)
+	  {
+	     symbol             *sub = sym;
+
+	     while (sub)
+	       {
+		  symbolrange(sub->dim.array.level, sub->dim.array.length);
+		  sub = finddepend(sub);
+	       }		/* while */
+	  }			/* if */
+	sym = sym->next;
+     }				/* while */
+}
+
+static int
+operatorname(char *name)
+{
+   int                 opertok;
+   char               *str;
+   cell                val;
+
+   assert(name != NULL);
+
+   /* check the operator */
+   opertok = lex(&val, &str);
+   switch (opertok)
+     {
+     case '+':
+     case '-':
+     case '*':
+     case '/':
+     case '%':
+     case '>':
+     case '<':
+     case '!':
+     case '~':
+     case '=':
+	name[0] = (char)opertok;
+	name[1] = '\0';
+	break;
+     case tINC:
+	strcpy(name, "++");
+	break;
+     case tDEC:
+	strcpy(name, "--");
+	break;
+     case tlEQ:
+	strcpy(name, "==");
+	break;
+     case tlNE:
+	strcpy(name, "!=");
+	break;
+     case tlLE:
+	strcpy(name, "<=");
+	break;
+     case tlGE:
+	strcpy(name, ">=");
+	break;
+     default:
+	name[0] = '\0';
+	error(61);		/* operator cannot be redefined
+				 * (or bad operator name) */
+	return 0;
+     }				/* switch */
+
+   return opertok;
+}
+
+static int
+operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
+{
+   int                 tags[2] = { 0, 0 };
+   int                 count = 0;
+   arginfo            *arg;
+   char                tmpname[sNAMEMAX + 1];
+   symbol             *oldsym;
+
+   if (opertok == 0)
+      return TRUE;
+
+   /* count arguments and save (first two) tags */
+   while (arg = &sym->dim.arglist[count], arg->ident != 0)
+     {
+	if (count < 2)
+	  {
+	     if (arg->numtags > 1)
+		error(65, count + 1);	/* function argument may only have
+					 * a single tag */
+	     else if (arg->numtags == 1)
+		tags[count] = arg->tags[0];
+	  }			/* if */
+	if (opertok == '~' && count == 0)
+	  {
+	     if (arg->ident != iREFARRAY)
+		error(73, arg->name);	/* must be an array argument */
+	  }
+	else
+	  {
+	     if (arg->ident != iVARIABLE)
+		error(66, arg->name);	/* must be non-reference argument */
+	  }			/* if */
+	if (arg->hasdefault)
+	   error(59, arg->name);	/* arguments of an operator may not
+					 * have a default value */
+	count++;
+     }				/* while */
+
+   /* for '!', '++' and '--', count must be 1
+    * for '-', count may be 1 or 2
+    * for '=', count must be 1, and the resulttag is also important
+    * for all other (binary) operators and the special '~'
+    * operator, count must be 2
+    */
+   switch (opertok)
+     {
+     case '!':
+     case '=':
+     case tINC:
+     case tDEC:
+	if (count != 1)
+	   error(62);		/* number or placement of the operands does
+				 * not fit the operator */
+	break;
+     case '-':
+	if (count != 1 && count != 2)
+	   error(62);		/* number or placement of the operands does
+				 * not fit the operator */
+	break;
+     default:
+	if (count != 2)
+	   error(62);		/* number or placement of the operands does
+				 * not fit the operator */
+     }				/* switch */
+
+   if (tags[0] == 0
+       && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
+      error(64);		/* cannot change predefined operators */
+
+   /* change the operator name */
+   assert(opername[0] != '\0');
+   operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
+   if ((oldsym = findglb(tmpname)))
+     {
+	int                 i;
+
+	if ((oldsym->usage & uDEFINE) != 0)
+	  {
+	     char                errname[2 * sNAMEMAX + 16];
+
+	     funcdisplayname(errname, tmpname);
+	     error(21, errname);	/* symbol already defined */
+	  }			/* if */
+	sym->usage |= oldsym->usage;	/* copy flags from the previous
+					 * definition */
+	for (i = 0; i < oldsym->numrefers; i++)
+	   if (oldsym->refer[i])
+	      refer_symbol(sym, oldsym->refer[i]);
+	delete_symbol(&glbtab, oldsym);
+     }				/* if */
+   if ((sc_debug & sSYMBOLIC) != 0)
+      sym->addr += nameincells(tmpname) - nameincells(sym->name);
+   strcpy(sym->name, tmpname);
+   sym->hash = namehash(sym->name);	/* calculate new hash */
+
+   /* operators should return a value, except the '~' operator */
+   if (opertok != '~')
+      sym->usage |= uRETVALUE;
+
+   return TRUE;
+}
+
+static int
+check_operatortag(int opertok, int resulttag, char *opername)
+{
+   assert(opername != NULL && opername[0] != '\0');
+   switch (opertok)
+     {
+     case '!':
+     case '<':
+     case '>':
+     case tlEQ:
+     case tlNE:
+     case tlLE:
+     case tlGE:
+	if (resulttag != sc_addtag("bool"))
+	  {
+	     error(63, opername, "bool:");	/* operator X requires
+						 * a "bool:" result tag */
+	     return FALSE;
+	  }			/* if */
+	break;
+     case '~':
+	if (resulttag != 0)
+	  {
+	     error(63, opername, "_:");	/* operator "~" requires
+					 * a "_:" result tag */
+	     return FALSE;
+	  }			/* if */
+	break;
+     }				/* switch */
+   return TRUE;
+}
+
+static char        *
+tag2str(char *dest, int tag)
+{
+   tag &= TAGMASK;
+   assert(tag >= 0);
+   sprintf(dest, "0%x", tag);
+   return isdigit(dest[1]) ? &dest[1] : dest;
+}
+
+char       *
+operator_symname(char *symname, char *opername, int tag1, int tag2,
+		 int numtags, int resulttag)
+{
+   char                tagstr1[10], tagstr2[10];
+   int                 opertok;
+
+   assert(numtags >= 1 && numtags <= 2);
+   opertok = (opername[1] == '\0') ? opername[0] : 0;
+   if (opertok == '=')
+      sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
+	      tag2str(tagstr2, tag1));
+   else if (numtags == 1 || opertok == '~')
+      sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
+   else
+      sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
+	      tag2str(tagstr2, tag2));
+   return symname;
+}
+
+static int
+parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
+{
+   char               *ptr, *name;
+   int                 unary;
+
+   /* tags are only positive, so if the function name starts with a '-',
+    * the operator is an unary '-' or '--' operator.
+    */
+   if (*fname == '-')
+     {
+	*tag1 = 0;
+	unary = TRUE;
+	ptr = fname;
+     }
+   else
+     {
+	*tag1 = (int)strtol(fname, &ptr, 16);
+	unary = ptr == fname;	/* unary operator if it doesn't start
+				 * with a tag name */
+     }				/* if */
+   assert(!unary || *tag1 == 0);
+   assert(*ptr != '\0');
+   for (name = opname; !isdigit(*ptr);)
+      *name++ = *ptr++;
+   *name = '\0';
+   *tag2 = (int)strtol(ptr, NULL, 16);
+   return unary;
+}
+
+char       *
+funcdisplayname(char *dest, char *funcname)
+{
+   int                 tags[2];
+   char                opname[10];
+   constvalue         *tagsym[2];
+   int                 unary;
+
+   if (isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
+       || *funcname == '\0')
+     {
+	if (dest != funcname)
+	   strcpy(dest, funcname);
+	return dest;
+     }				/* if */
+
+   unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
+   tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
+   assert(tagsym[1] != NULL);
+   if (unary)
+     {
+	sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
+     }
+   else
+     {
+	tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
+	/* special case: the assignment operator has the return value
+	 * as the 2nd tag */
+	if (opname[0] == '=' && opname[1] == '\0')
+	   sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
+		   tagsym[1]->name);
+	else
+	   sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
+		   tagsym[1]->name);
+     }				/* if */
+   return dest;
+}
+
+static void
+funcstub(int native)
+{
+   int                 tok, tag;
+   char               *str;
+   cell                val;
+   char                symbolname[sNAMEMAX + 1];
+   symbol             *sym;
+   int                 opertok;
+
+   opertok = 0;
+   lastst = 0;
+   litidx = 0;			/* clear the literal pool */
+
+   tag = sc_addtag(NULL);
+   tok = lex(&val, &str);
+   if (native)
+     {
+	if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
+	    (tok == tSYMBOL && *str == PUBLIC_CHAR))
+	   error(42);		/* invalid combination of class specifiers */
+     }
+   else
+     {
+	if (tok == tPUBLIC || tok == tSTATIC)
+	   tok = lex(&val, &str);
+     }				/* if */
+   if (tok == tOPERATOR)
+     {
+	opertok = operatorname(symbolname);
+	if (opertok == 0)
+	   return;		/* error message already given */
+	check_operatortag(opertok, tag, symbolname);
+     }
+   else
+     {
+	if (tok != tSYMBOL && freading)
+	  {
+	     error(10);		/* illegal function or declaration */
+	     return;
+	  }			/* if */
+	strcpy(symbolname, str);
+     }				/* if */
+   needtoken('(');		/* only functions may be native/forward */
+
+   sym = fetchfunc(symbolname, tag);	/* get a pointer to the
+					 * function entry */
+   if (!sym)
+      return;
+   if (native)
+     {
+	sym->usage = uNATIVE | uRETVALUE | uDEFINE;
+	sym->x.lib = curlibrary;
+     }				/* if */
+
+   declargs(sym);
+   /* "declargs()" found the ")" */
+   if (!operatoradjust(opertok, sym, symbolname, tag))
+      sym->usage &= ~uDEFINE;
+   /* for a native operator, also need to specify an "exported"
+    * function name; for a native function, this is optional
+    */
+   if (native)
+     {
+	if (opertok != 0)
+	  {
+	     needtoken('=');
+	     lexpush();		/* push back, for matchtoken() to retrieve again */
+	  }			/* if */
+	if (matchtoken('='))
+	  {
+	     /* allow number or symbol */
+	     if (matchtoken(tSYMBOL))
+	       {
+		  tokeninfo(&val, &str);
+		  if (strlen(str) > sEXPMAX)
+		    {
+		       error(220, str, sEXPMAX);
+		       str[sEXPMAX] = '\0';
+		    }		/* if */
+		  insert_alias(sym->name, str);
+	       }
+	     else
+	       {
+		  constexpr(&val, NULL);
+		  sym->addr = val;
+		  /*
+		   * ?? Must mark this address, so that it won't be generated again
+		   * and it won't be written to the output file. At the moment,
+		   * I have assumed that this syntax is only valid if val < 0.
+		   * To properly mix "normal" native functions and indexed native
+		   * functions, one should use negative indices anyway.
+		   * Special code for a negative index in sym->addr exists in
+		   * SC4.C (ffcall()) and in SC6.C (the loops for counting the
+		   * number of native variables and for writing them).
+		   */
+	       }		/* if */
+	  }			/* if */
+     }				/* if */
+   needtoken(tTERM);
+
+   litidx = 0;			/* clear the literal pool */
+   /* clear local variables queue */
+   delete_symbols(&loctab, 0, TRUE, TRUE);
+}
+
+/*  newfunc    - begin a function
+ *
+ *  This routine is called from "parse" and tries to make a function
+ *  out of the following text
+ *
+ *  Global references: funcstatus,lastst,litidx
+ *                     rettype  (altered)
+ *                     curfunc  (altered)
+ *                     declared (altered)
+ *                     glb_declared (altered)
+ *                     sc_alignnext (altered)
+ */
+static int
+newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
+{
+   symbol             *sym;
+   int                 argcnt, tok, tag, funcline;
+   int                 opertok, opererror;
+   char                symbolname[sNAMEMAX + 1];
+   char               *str;
+   cell                val, cidx, glbdecl;
+   int                 filenum;
+
+   litidx = 0;			/* clear the literal pool ??? */
+   opertok = 0;
+   lastst = 0;			/* no statement yet */
+   cidx = 0;			/* just to avoid compiler warnings */
+   glbdecl = 0;
+   filenum = fcurrent;		/* save file number at start of declaration */
+
+   if (firstname)
+     {
+	assert(strlen(firstname) <= sNAMEMAX);
+	strcpy(symbolname, firstname);	/* save symbol name */
+	tag = firsttag;
+     }
+   else
+     {
+	tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
+	tok = lex(&val, &str);
+	assert(!fpublic);
+	if (tok == tNATIVE || (tok == tPUBLIC && stock))
+	   error(42);		/* invalid combination of class specifiers */
+	if (tok == tOPERATOR)
+	  {
+	     opertok = operatorname(symbolname);
+	     if (opertok == 0)
+		return TRUE;	/* error message already given */
+	     check_operatortag(opertok, tag, symbolname);
+	  }
+	else
+	  {
+	     if (tok != tSYMBOL && freading)
+	       {
+		  error(20, str);	/* invalid symbol name */
+		  return FALSE;
+	       }		/* if */
+	     assert(strlen(str) <= sNAMEMAX);
+	     strcpy(symbolname, str);
+	  }			/* if */
+     }				/* if */
+   /* check whether this is a function or a variable declaration */
+   if (!matchtoken('('))
+      return FALSE;
+   /* so it is a function, proceed */
+   funcline = fline;		/* save line at which the function is defined */
+   if (symbolname[0] == PUBLIC_CHAR)
+     {
+	fpublic = TRUE;		/* implicitly public function */
+	if (stock)
+	   error(42);		/* invalid combination of class specifiers */
+     }				/* if */
+   sym = fetchfunc(symbolname, tag);	/* get a pointer to the
+					 * function entry */
+   if (!sym)
+      return TRUE;
+   if (fpublic)
+      sym->usage |= uPUBLIC;
+   if (fstatic)
+      sym->fnumber = filenum;
+   /* declare all arguments */
+   argcnt = declargs(sym);
+   opererror = !operatoradjust(opertok, sym, symbolname, tag);
+   if (strcmp(symbolname, uMAINFUNC) == 0)
+     {
+	if (argcnt > 0)
+	   error(5);		/* "main()" function may not have any arguments */
+	sym->usage |= uREAD;	/* "main()" is the program's entry point:
+				 * always used */
+     }				/* if */
+   /* "declargs()" found the ")"; if a ";" appears after this, it was a
+    * prototype */
+   if (matchtoken(';'))
+     {
+	if (!sc_needsemicolon)
+	   error(218);		/* old style prototypes used with optional
+				 * semicolumns */
+	delete_symbols(&loctab, 0, TRUE, TRUE);	/* prototype is done;
+						 * forget everything */
+	return TRUE;
+     }				/* if */
+   /* so it is not a prototype, proceed */
+   /* if this is a function that is not referred to (this can only be
+    * detected in the second stage), shut code generation off */
+   if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
+     {
+	sc_status = statSKIP;
+	cidx = code_idx;
+	glbdecl = glb_declared;
+     }				/* if */
+   begcseg();
+   sym->usage |= uDEFINE;	/* set the definition flag */
+   if (fpublic)
+      sym->usage |= uREAD;	/* public functions are always "used" */
+   if (stock)
+      sym->usage |= uSTOCK;
+   if (opertok != 0 && opererror)
+      sym->usage &= ~uDEFINE;
+   defsymbol(sym->name, iFUNCTN, sGLOBAL,
+	     code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
+   /* ^^^ The address for the symbol is the code address. But the
+    * "symbol" instruction itself generates code. Therefore the
+    * offset is pre-adjusted to the value it will have after the
+    * symbol instruction.
+    */
+   startfunc(sym->name);	/* creates stack frame */
+   if ((sc_debug & sSYMBOLIC) != 0)
+      setline(funcline, fcurrent);
+   if (sc_alignnext)
+     {
+	alignframe(sc_dataalign);
+	sc_alignnext = FALSE;
+     }				/* if */
+   declared = 0;		/* number of local cells */
+   rettype = (sym->usage & uRETVALUE);	/* set "return type" variable */
+   curfunc = sym;
+   define_args();		/* add the symbolic info for the function arguments */
+   statement(NULL, FALSE);
+   if ((rettype & uRETVALUE) != 0)
+      sym->usage |= uRETVALUE;
+   if (declared != 0)
+     {
+	/* This happens only in a very special (and useless) case, where a
+	 * function has only a single statement in its body (no compound
+	 * block) and that statement declares a new variable
+	 */
+	modstk((int)declared * sizeof(cell));	/* remove all local
+						 * variables */
+	declared = 0;
+     }				/* if */
+   if ((lastst != tRETURN) && (lastst != tGOTO))
+     {
+	const1(0);
+	ffret();
+	if ((sym->usage & uRETVALUE) != 0)
+	  {
+	     char                symname[2 * sNAMEMAX + 16];	/* allow space for user
+								 * defined operators */
+	     funcdisplayname(symname, sym->name);
+	     error(209, symname);	/* function should return a value */
+	  }			/* if */
+     }				/* if */
+   endfunc();
+   if (litidx)
+     {				/* if there are literals defined */
+	glb_declared += litidx;
+	begdseg();		/* flip to DATA segment */
+	dumplits();		/* dump literal strings */
+	litidx = 0;
+     }				/* if */
+   testsymbols(&loctab, 0, TRUE, TRUE);	/* test for unused arguments
+					 * and labels */
+   delete_symbols(&loctab, 0, TRUE, TRUE);	/* clear local variables
+						 * queue */
+   assert(loctab.next == NULL);
+   curfunc = NULL;
+   if (sc_status == statSKIP)
+     {
+	sc_status = statWRITE;
+	code_idx = cidx;
+	glb_declared = glbdecl;
+     }				/* if */
+   return TRUE;
+}
+
+static int
+argcompare(arginfo * a1, arginfo * a2)
+{
+   int                 result, level;
+
+   result = strcmp(a1->name, a2->name) == 0;
+   if (result)
+      result = a1->ident == a2->ident;
+   if (result)
+      result = a1->usage == a2->usage;
+   if (result)
+      result = a1->numtags == a2->numtags;
+   if (result)
+     {
+	int                 i;
+
+	for (i = 0; i < a1->numtags && result; i++)
+	   result = a1->tags[i] == a2->tags[i];
+     }				/* if */
+   if (result)
+      result = a1->hasdefault == a2->hasdefault;
+   if (a1->hasdefault)
+     {
+	if (a1->ident == iREFARRAY)
+	  {
+	     if (result)
+		result = a1->defvalue.array.size == a2->defvalue.array.size;
+	     if (result)
+		result =
+		   a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
+	     /* also check the dimensions of both arrays */
+	     if (result)
+		result = a1->numdim == a2->numdim;
+	     for (level = 0; result && level < a1->numdim; level++)
+		result = a1->dim[level] == a2->dim[level];
+	     /* ??? should also check contents of the default array
+	      * (these troubles go away in a 2-pass compiler that forbids
+	      * double declarations, but Small currently does not forbid them)
+	      */
+	  }
+	else
+	  {
+	     if (result)
+	       {
+		  if ((a1->hasdefault & uSIZEOF) != 0
+		      || (a1->hasdefault & uTAGOF) != 0)
+		     result = a1->hasdefault == a2->hasdefault
+			&& strcmp(a1->defvalue.size.symname,
+				  a2->defvalue.size.symname) == 0
+			&& a1->defvalue.size.level == a2->defvalue.size.level;
+		  else
+		     result = a1->defvalue.val == a2->defvalue.val;
+	       }		/* if */
+	  }			/* if */
+	if (result)
+	   result = a1->defvalue_tag == a2->defvalue_tag;
+     }				/* if */
+   return result;
+}
+
+/*  declargs()
+ *
+ *  This routine adds an entry in the local symbol table for each
+ *  argument found in the argument list.
+ *  It returns the number of arguments.
+ */
+static int
+declargs(symbol * sym)
+{
+#define MAXTAGS 16
+   char               *ptr;
+   int                 argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
+   cell                val;
+   arginfo             arg, *arglist;
+   char                name[sNAMEMAX + 1];
+   int                 ident, fpublic, fconst;
+   int                 idx;
+
+   /* if the function is already defined earlier, get the number of
+    * arguments of the existing definition
+    */
+   oldargcnt = 0;
+   if ((sym->usage & uPROTOTYPED) != 0)
+      while (sym->dim.arglist[oldargcnt].ident != 0)
+	 oldargcnt++;
+   argcnt = 0;			/* zero aruments up to now */
+   ident = iVARIABLE;
+   numtags = 0;
+   fconst = FALSE;
+   fpublic = (sym->usage & uPUBLIC) != 0;
+   /* the '(' parantheses has already been parsed */
+   if (!matchtoken(')'))
+     {
+	do
+	  {			/* there are arguments; process them */
+	     /* any legal name increases argument count (and stack offset) */
+	     tok = lex(&val, &ptr);
+	     switch (tok)
+	       {
+	       case 0:
+		  /* nothing */
+		  break;
+	       case '&':
+		  if (ident != iVARIABLE || numtags > 0)
+		     error(1, "-identifier-", "&");
+		  ident = iREFERENCE;
+		  break;
+	       case tCONST:
+		  if (ident != iVARIABLE || numtags > 0)
+		     error(1, "-identifier-", "const");
+		  fconst = TRUE;
+		  break;
+	       case tLABEL:
+		  if (numtags > 0)
+		     error(1, "-identifier-", "-tagname-");
+		  tags[0] = sc_addtag(ptr);
+		  numtags = 1;
+		  break;
+	       case '{':
+		  if (numtags > 0)
+		     error(1, "-identifier-", "-tagname-");
+		  numtags = 0;
+		  while (numtags < MAXTAGS)
+		    {
+		       if (!matchtoken('_') && !needtoken(tSYMBOL))
+			  break;
+		       tokeninfo(&val, &ptr);
+		       tags[numtags++] = sc_addtag(ptr);
+		       if (matchtoken('}'))
+			  break;
+		       needtoken(',');
+		    }		/* for */
+		  needtoken(':');
+		  tok = tLABEL;	/* for outer loop:
+				 * flag that we have seen a tagname */
+		  break;
+	       case tSYMBOL:
+		  if (argcnt >= sMAXARGS)
+		     error(45);	/* too many function arguments */
+		  strcpy(name, ptr);	/* save symbol name */
+		  if (name[0] == PUBLIC_CHAR)
+		     error(56, name);	/* function arguments cannot be public */
+		  if (numtags == 0)
+		     tags[numtags++] = 0;	/* default tag */
+		  /* Stack layout:
+		   *   base + 0*sizeof(cell)  == previous "base"
+		   *   base + 1*sizeof(cell)  == function return address
+		   *   base + 2*sizeof(cell)  == number of arguments
+		   *   base + 3*sizeof(cell)  == first argument of the function
+		   * So the offset of each argument is:
+		   * "(argcnt+3) * sizeof(cell)".
+		   */
+		  doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
+			fpublic, fconst, &arg);
+		  if (fpublic && arg.hasdefault)
+		     error(59, name);	/* arguments of a public function may not
+					 * have a default value */
+		  if ((sym->usage & uPROTOTYPED) == 0)
+		    {
+		       /* redimension the argument list, add the entry */
+		       sym->dim.arglist =
+			  (arginfo *) realloc(sym->dim.arglist,
+					      (argcnt + 2) * sizeof(arginfo));
+		       if (!sym->dim.arglist)
+			  error(103);	/* insufficient memory */
+		       sym->dim.arglist[argcnt] = arg;
+		       sym->dim.arglist[argcnt + 1].ident = 0;	/* keep the list
+								 * terminated */
+		    }
+		  else
+		    {
+		       /* check the argument with the earlier definition */
+		       if (argcnt > oldargcnt
+			   || !argcompare(&sym->dim.arglist[argcnt], &arg))
+			  error(25);	/* function definition does not match prototype */
+		       /* may need to free default array argument and the tag list */
+		       if (arg.ident == iREFARRAY && arg.hasdefault)
+			  free(arg.defvalue.array.data);
+		       else if (arg.ident == iVARIABLE
+				&& ((arg.hasdefault & uSIZEOF) != 0
+				    || (arg.hasdefault & uTAGOF) != 0))
+			  free(arg.defvalue.size.symname);
+		       free(arg.tags);
+		    }		/* if */
+		  argcnt++;
+		  ident = iVARIABLE;
+		  numtags = 0;
+		  fconst = FALSE;
+		  break;
+	       case tELLIPS:
+		  if (ident != iVARIABLE)
+		     error(10);	/* illegal function or declaration */
+		  if (numtags == 0)
+		     tags[numtags++] = 0;	/* default tag */
+		  if ((sym->usage & uPROTOTYPED) == 0)
+		    {
+		       /* redimension the argument list, add the entry iVARARGS */
+		       sym->dim.arglist =
+			  (arginfo *) realloc(sym->dim.arglist,
+					      (argcnt + 2) * sizeof(arginfo));
+		       if (!sym->dim.arglist)
+			  error(103);	/* insufficient memory */
+		       sym->dim.arglist[argcnt + 1].ident = 0;	/* keep the list
+								 * terminated */
+		       sym->dim.arglist[argcnt].ident = iVARARGS;
+		       sym->dim.arglist[argcnt].hasdefault = FALSE;
+		       sym->dim.arglist[argcnt].defvalue.val = 0;
+		       sym->dim.arglist[argcnt].defvalue_tag = 0;
+		       sym->dim.arglist[argcnt].numtags = numtags;
+		       sym->dim.arglist[argcnt].tags =
+			  (int *)malloc(numtags * sizeof tags[0]);
+		       if (!sym->dim.arglist[argcnt].tags)
+			  error(103);	/* insufficient memory */
+		       memcpy(sym->dim.arglist[argcnt].tags, tags,
+			      numtags * sizeof tags[0]);
+		    }
+		  else
+		    {
+		       if (argcnt > oldargcnt
+			   || sym->dim.arglist[argcnt].ident != iVARARGS)
+			  error(25);	/* function definition does not match prototype */
+		    }		/* if */
+		  argcnt++;
+		  break;
+	       default:
+		  error(10);	/* illegal function or declaration */
+	       }		/* switch */
+	  }
+	while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(',')));	/* more? */
+	/* if the next token is not ",", it should be ")" */
+	needtoken(')');
+     }				/* if */
+   /* resolve any "sizeof" arguments (now that all arguments are known) */
+   assert(sym->dim.arglist != NULL);
+   arglist = sym->dim.arglist;
+   for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
+     {
+	if ((arglist[idx].hasdefault & uSIZEOF) != 0
+	    || (arglist[idx].hasdefault & uTAGOF) != 0)
+	  {
+	     int                 altidx;
+
+	     /* Find the argument with the name mentioned after the "sizeof".
+	      * Note that we cannot use findloc here because we need the
+	      * arginfo struct, not the symbol.
+	      */
+	     ptr = arglist[idx].defvalue.size.symname;
+	     for (altidx = 0;
+		  altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
+		  altidx++)
+		/* nothing */ ;
+	     if (altidx >= argcnt)
+	       {
+		  error(17, ptr);	/* undefined symbol */
+	       }
+	     else
+	       {
+		  /* check the level against the number of dimensions */
+		  /* the level must be zero for "tagof" values */
+		  assert(arglist[idx].defvalue.size.level == 0
+			 || (arglist[idx].hasdefault & uSIZEOF) != 0);
+		  if (arglist[idx].defvalue.size.level > 0
+		      && arglist[idx].defvalue.size.level >=
+		      arglist[altidx].numdim)
+		     error(28);	/* invalid subscript */
+		  if (arglist[altidx].ident != iREFARRAY)
+		    {
+		       assert(arglist[altidx].ident == iVARIABLE
+			      || arglist[altidx].ident == iREFERENCE);
+		       error(223, ptr);	/* redundant sizeof */
+		    }		/* if */
+	       }		/* if */
+	  }			/* if */
+     }				/* for */
+
+   sym->usage |= uPROTOTYPED;
+   errorset(sRESET);		/* reset error flag (clear the "panic mode") */
+   return argcnt;
+}
+
+/*  doarg       - declare one argument type
+ *
+ * this routine is called from "declargs()" and adds an entry in the
+ * local  symbol table for one argument. "fpublic" indicates whether
+ * the function for this argument list is public.
+ * The arguments themselves are never public.
+ */
+static void
+doarg(char *name, int ident, int offset, int tags[], int numtags,
+      int fpublic, int fconst, arginfo * arg)
+{
+   symbol             *argsym;
+   cell                size;
+   int                 idxtag[sDIMEN_MAX];
+
+   strcpy(arg->name, name);
+   arg->hasdefault = FALSE;	/* preset (most common case) */
+   arg->defvalue.val = 0;	/* clear */
+   arg->defvalue_tag = 0;
+   arg->numdim = 0;
+   if (matchtoken('['))
+     {
+	if (ident == iREFERENCE)
+	   error(67, name);	/*illegal declaration ("&name[]" is unsupported) */
+	do
+	  {
+	     if (arg->numdim == sDIMEN_MAX)
+	       {
+		  error(53);	/* exceeding maximum number of dimensions */
+		  return;
+	       }		/* if */
+	     /* there is no check for non-zero major dimensions here, only if
+	      * the array parameter has a default value, we enforce that all
+	      * array dimensions, except the last, are non-zero
+	      */
+	     size = needsub(&idxtag[arg->numdim]);	/* may be zero here,
+							 *it is a pointer anyway */
+#if INT_MAX < LONG_MAX
+	     if (size > INT_MAX)
+		error(105);	/* overflow, exceeding capacity */
+#endif
+	     arg->dim[arg->numdim] = (int)size;
+	     arg->numdim += 1;
+	  }
+	while (matchtoken('['));
+	ident = iREFARRAY;	/* "reference to array" (is a pointer) */
+	if (matchtoken('='))
+	  {
+	     int                 level;
+
+	     lexpush();		/* initials() needs the "=" token again */
+	     assert(numtags > 0);
+	     /* for the moment, when a default value is given for the array,
+	      * all dimension sizes, except the last, must be non-zero
+	      * (function initials() requires to know the major dimensions)
+	      */
+	     for (level = 0; level < arg->numdim - 1; level++)
+		if (arg->dim[level] == 0)
+		   error(52);	/* only last dimension may be variable length */
+	     initials(ident, tags[0], &size, arg->dim, arg->numdim);
+	     assert(size >= litidx);
+	     /* allocate memory to hold the initial values */
+	     arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
+	     if (arg->defvalue.array.data)
+	       {
+		  int                 i;
+
+		  memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
+		  arg->hasdefault = TRUE;	/* argument has default value */
+		  arg->defvalue.array.size = litidx;
+		  arg->defvalue.array.addr = -1;
+		  /* calculate size to reserve on the heap */
+		  arg->defvalue.array.arraysize = 1;
+		  for (i = 0; i < arg->numdim; i++)
+		     arg->defvalue.array.arraysize *= arg->dim[i];
+		  if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
+		     arg->defvalue.array.arraysize = arg->defvalue.array.size;
+	       }		/* if */
+	     litidx = 0;	/* reset */
+	  }			/* if */
+     }
+   else
+     {
+	if (matchtoken('='))
+	  {
+	     unsigned char       size_tag_token;
+
+	     assert(ident == iVARIABLE || ident == iREFERENCE);
+	     arg->hasdefault = TRUE;	/* argument has a default value */
+	     size_tag_token =
+		(unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
+	     if (size_tag_token == 0)
+		size_tag_token =
+		   (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
+	     if (size_tag_token != 0)
+	       {
+		  int                 paranthese;
+
+		  if (ident == iREFERENCE)
+		     error(66, name);	/* argument may not be a reference */
+		  paranthese = 0;
+		  while (matchtoken('('))
+		     paranthese++;
+		  if (needtoken(tSYMBOL))
+		    {
+		       /* save the name of the argument whose size id to take */
+		       char               *name;
+		       cell                val;
+
+		       tokeninfo(&val, &name);
+		       if (!(arg->defvalue.size.symname = strdup(name)))
+			  error(103);	/* insufficient memory */
+		       arg->defvalue.size.level = 0;
+		       if (size_tag_token == uSIZEOF)
+			 {
+			    while (matchtoken('['))
+			      {
+				 arg->defvalue.size.level += (short)1;
+				 needtoken(']');
+			      }	/* while */
+			 }	/* if */
+		       if (ident == iVARIABLE)	/* make sure we set this only if
+						 * not a reference */
+			  arg->hasdefault |= size_tag_token;	/* uSIZEOF or uTAGOF */
+		    }		/* if */
+		  while (paranthese--)
+		     needtoken(')');
+	       }
+	     else
+	       {
+		  constexpr(&arg->defvalue.val, &arg->defvalue_tag);
+		  assert(numtags > 0);
+		  if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
+		     error(213);	/* tagname mismatch */
+	       }		/* if */
+	  }			/* if */
+     }				/* if */
+   arg->ident = (char)ident;
+   arg->usage = (char)(fconst ? uCONST : 0);
+   arg->numtags = numtags;
+   arg->tags = (int *)malloc(numtags * sizeof tags[0]);
+   if (!arg->tags)
+      error(103);		/* insufficient memory */
+   memcpy(arg->tags, tags, numtags * sizeof tags[0]);
+   argsym = findloc(name);
+   if (argsym)
+     {
+	error(21, name);	/* symbol already defined */
+     }
+   else
+     {
+	if ((argsym = findglb(name)) && argsym->ident != iFUNCTN)
+	   error(219, name);	/* variable shadows another symbol */
+	/* add details of type and address */
+	assert(numtags > 0);
+	argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
+			     arg->dim, arg->numdim, idxtag);
+	argsym->compound = 0;
+	if (ident == iREFERENCE)
+	   argsym->usage |= uREAD;	/* because references are passed back */
+	if (fpublic)
+	   argsym->usage |= uREAD;	/* arguments of public functions
+					 * are always "used" */
+	if (fconst)
+	   argsym->usage |= uCONST;
+     }				/* if */
+}
+
+static int
+count_referrers(symbol * entry)
+{
+   int                 i, count;
+
+   count = 0;
+   for (i = 0; i < entry->numrefers; i++)
+      if (entry->refer[i])
+	 count++;
+   return count;
+}
+
+/* Every symbol has a referrer list, that contains the functions that
+ * use the symbol. Now, if function "apple" is accessed by functions
+ * "banana" and "citron", but neither function "banana" nor "citron" are
+ * used by anyone else, then, by inference, function "apple" is not used
+ * either.  */
+static void
+reduce_referrers(symbol * root)
+{
+   int                 i, restart;
+   symbol             *sym, *ref;
+
+   do
+     {
+	restart = 0;
+	for (sym = root->next; sym; sym = sym->next)
+	  {
+	     if (sym->parent)
+		continue;	/* hierarchical data type */
+	     if (sym->ident == iFUNCTN
+		 && (sym->usage & uNATIVE) == 0
+		 && (sym->usage & uPUBLIC) == 0
+		 && strcmp(sym->name, uMAINFUNC) != 0
+		 && count_referrers(sym) == 0)
+	       {
+		  sym->usage &= ~(uREAD | uWRITTEN);	/* erase usage bits if
+							 * there is no referrer */
+		  /* find all symbols that are referred by this symbol */
+		  for (ref = root->next; ref; ref = ref->next)
+		    {
+		       if (ref->parent)
+			  continue;	/* hierarchical data type */
+		       assert(ref->refer != NULL);
+		       for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
+			    i++)
+			  /* nothing */ ;
+		       if (i < ref->numrefers)
+			 {
+			    assert(ref->refer[i] == sym);
+			    ref->refer[i] = NULL;
+			    restart++;
+			 }	/* if */
+		    }		/* for */
+	       }
+	     else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
+		      && (sym->usage & uPUBLIC) == 0
+		      && !sym->parent && count_referrers(sym) == 0)
+	       {
+		  sym->usage &= ~(uREAD | uWRITTEN);	/* erase usage bits if
+							 * there is no referrer */
+	       }		/* if */
+	  }			/* for */
+	/* after removing a symbol, check whether more can be removed */
+     }
+   while (restart > 0);
+}
+
+/*  testsymbols - test for unused local or global variables
+ *
+ *  "Public" functions are excluded from the check, since these
+ *  may be exported to other object modules.
+ *  Labels are excluded from the check if the argument 'testlabs'
+ *  is 0. Thus, labels are not tested until the end of the function.
+ *  Constants may also be excluded (convenient for global constants).
+ *
+ *  When the nesting level drops below "level", the check stops.
+ *
+ *  The function returns whether there is an "entry" point for the file.
+ *  This flag will only be 1 when browsing the global symbol table.
+ */
+static int
+testsymbols(symbol * root, int level, int testlabs, int testconst)
+{
+   char                symname[2 * sNAMEMAX + 16];
+   int                 entry = FALSE;
+
+   symbol             *sym = root->next;
+
+   while (sym && sym->compound >= level)
+     {
+	switch (sym->ident)
+	  {
+	  case iLABEL:
+	     if (testlabs)
+	       {
+		  if ((sym->usage & uDEFINE) == 0)
+		     error(19, sym->name);	/* not a label: ... */
+		  else if ((sym->usage & uREAD) == 0)
+		     error(203, sym->name);	/* symbol isn't used: ... */
+	       }		/* if */
+	     break;
+	  case iFUNCTN:
+	     if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
+	       {
+		  funcdisplayname(symname, sym->name);
+		  if (symname[0] != '\0')
+		     error(203, symname);	/* symbol isn't used ...
+						 * (and not native/stock) */
+	       }		/* if */
+	     if ((sym->usage & uPUBLIC) != 0
+		 || strcmp(sym->name, uMAINFUNC) == 0)
+		entry = TRUE;	/* there is an entry point */
+	     break;
+	  case iCONSTEXPR:
+	     if (testconst && (sym->usage & uREAD) == 0)
+		error(203, sym->name);	/* symbol isn't used: ... */
+	     break;
+	  default:
+	     /* a variable */
+	     if (sym->parent)
+		break;		/* hierarchical data type */
+	     if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
+		error(203, sym->name);	/* symbol isn't used (and not stock
+					 * or public) */
+	     else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
+		error(204, sym->name);	/* value assigned to symbol is
+					 * never used */
+#if 0				/*// ??? not sure whether it is a good idea to
+				 * force people use "const" */
+	     else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
+		      && sym->ident == iREFARRAY)
+		error(214, sym->name);	/* make array argument "const" */
+#endif
+	  }			/* if */
+	sym = sym->next;
+     }				/* while */
+
+   return entry;
+}
+
+static              cell
+calc_array_datasize(symbol * sym, cell * offset)
+{
+   cell                length;
+
+   assert(sym != NULL);
+   assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+   length = sym->dim.array.length;
+   if (sym->dim.array.level > 0)
+     {
+	cell                sublength =
+	   calc_array_datasize(finddepend(sym), offset);
+	if (offset)
+	   *offset = length * (*offset + sizeof(cell));
+	if (sublength > 0)
+	   length *= length * sublength;
+	else
+	   length = 0;
+     }
+   else
+     {
+	if (offset)
+	   *offset = 0;
+     }				/* if */
+   return length;
+}
+
+static void
+destructsymbols(symbol * root, int level)
+{
+   cell                offset = 0;
+   int                 savepri = FALSE;
+   symbol             *sym = root->next;
+
+   while (sym && sym->compound >= level)
+     {
+	if (sym->ident == iVARIABLE || sym->ident == iARRAY)
+	  {
+	     char                symbolname[16];
+	     symbol             *opsym;
+	     cell                elements;
+
+	     /* check that the '~' operator is defined for this tag */
+	     operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
+	     if ((opsym = findglb(symbolname)))
+	       {
+		  /* save PRI, in case of a return statement */
+		  if (!savepri)
+		    {
+		       push1();	/* right-hand operand is in PRI */
+		       savepri = TRUE;
+		    }		/* if */
+		  /* if the variable is an array, get the number of elements */
+		  if (sym->ident == iARRAY)
+		    {
+		       elements = calc_array_datasize(sym, &offset);
+		       /* "elements" can be zero when the variable is declared like
+		        *    new mytag: myvar[2][] = { {1, 2}, {3, 4} }
+		        * one should declare all dimensions!
+		        */
+		       if (elements == 0)
+			  error(46, sym->name);	/* array size is unknown */
+		    }
+		  else
+		    {
+		       elements = 1;
+		       offset = 0;
+		    }		/* if */
+		  pushval(elements);
+		  /* call the '~' operator */
+		  address(sym);
+		  addconst(offset);	/*add offset to array data to the address */
+		  push1();
+		  pushval(2 * sizeof(cell));	/* 2 parameters */
+		  ffcall(opsym, 1);
+		  if (sc_status != statSKIP)
+		     markusage(opsym, uREAD);	/* do not mark as "used" when this
+						 * call itself is skipped */
+		  if (opsym->x.lib)
+		     opsym->x.lib->value += 1;	/* increment "usage count"
+						 * of the library */
+	       }		/* if */
+	  }			/* if */
+	sym = sym->next;
+     }				/* while */
+   /* restore PRI, if it was saved */
+   if (savepri)
+      pop1();
+}
+
+static constvalue  *
+insert_constval(constvalue * prev, constvalue * next, char *name,
+		cell val, short idx)
+{
+   constvalue         *cur;
+
+   if (!(cur = (constvalue *)malloc(sizeof(constvalue))))
+      error(103);		/* insufficient memory (fatal error) */
+   memset(cur, 0, sizeof(constvalue));
+   strcpy(cur->name, name);
+   cur->value = val;
+   cur->index = idx;
+   cur->next = next;
+   prev->next = cur;
+   return cur;
+}
+
+constvalue *
+append_constval(constvalue * table, char *name, cell val, short idx)
+{
+   constvalue         *cur, *prev;
+
+   /* find the end of the constant table */
+   for (prev = table, cur = table->next; cur;
+	prev = cur, cur = cur->next)
+      /* nothing */ ;
+   return insert_constval(prev, NULL, name, val, idx);
+}
+
+constvalue *
+find_constval(constvalue * table, char *name, short idx)
+{
+   constvalue         *ptr = table->next;
+
+   while (ptr)
+     {
+	if (strcmp(name, ptr->name) == 0 && ptr->index == idx)
+	   return ptr;
+	ptr = ptr->next;
+     }				/* while */
+   return NULL;
+}
+
+static constvalue  *
+find_constval_byval(constvalue * table, cell val)
+{
+   constvalue         *ptr = table->next;
+
+   while (ptr)
+     {
+	if (ptr->value == val)
+	   return ptr;
+	ptr = ptr->next;
+     }				/* while */
+   return NULL;
+}
+
+#if 0				/* never used */
+static int
+delete_constval(constvalue * table, char *name)
+{
+   constvalue         *prev = table;
+   constvalue         *cur = prev->next;
+
+   while (cur != NULL)
+     {
+	if (strcmp(name, cur->name) == 0)
+	  {
+	     prev->next = cur->next;
+	     free(cur);
+	     return TRUE;
+	  }			/* if */
+	prev = cur;
+	cur = cur->next;
+     }				/* while */
+   return FALSE;
+}
+#endif
+
+void
+delete_consttable(constvalue * table)
+{
+   constvalue         *cur = table->next, *next;
+
+   while (cur)
+     {
+	next = cur->next;
+	free(cur);
+	cur = next;
+     }				/* while */
+   memset(table, 0, sizeof(constvalue));
+}
+
+/*  add_constant
+ *
+ *  Adds a symbol to the #define symbol table.
+ */
+void
+add_constant(char *name, cell val, int vclass, int tag)
+{
+   symbol             *sym;
+
+   /* Test whether a global or local symbol with the same name exists. Since
+    * constants are stored in the symbols table, this also finds previously
+    * defind constants. */
+   sym = findglb(name);
+   if (!sym)
+      sym = findloc(name);
+   if (sym)
+     {
+	/* silently ignore redefinitions of constants with the same value */
+	if (sym->ident == iCONSTEXPR)
+	  {
+	     if (sym->addr != val)
+		error(201, name);	/* redefinition of constant (different value) */
+	  }
+	else
+	  {
+	     error(21, name);	/* symbol already defined */
+	  }			/* if */
+	return;
+     }				/* if */
+
+   /* constant doesn't exist yet, an entry must be created */
+   sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
+   if (sc_status == statIDLE)
+      sym->usage |= uPREDEF;
+}
+
+/*  statement           - The Statement Parser
+ *
+ *  This routine is called whenever the parser needs to know what
+ *  statement it encounters (i.e. whenever program syntax requires a
+ *  statement).
+ */
+static void
+statement(int *lastindent, int allow_decl)
+{
+   int                 tok;
+   cell                val;
+   char               *st;
+
+   if (!freading)
+     {
+	error(36);		/* empty statement */
+	return;
+     }				/* if */
+   errorset(sRESET);
+
+   tok = lex(&val, &st);
+   if (tok != '{')
+      setline(fline, fcurrent);
+   /* lex() has set stmtindent */
+   if (lastindent && tok != tLABEL)
+     {
+#if 0
+	if (*lastindent >= 0 && *lastindent != stmtindent &&
+	    !indent_nowarn && sc_tabsize > 0)
+	   error(217);		/* loose indentation */
+#endif
+	*lastindent = stmtindent;
+	indent_nowarn = TRUE;	/* if warning was blocked, re-enable it */
+     }				/* if */
+   switch (tok)
+     {
+     case 0:
+	/* nothing */
+	break;
+     case tNEW:
+	if (allow_decl)
+	  {
+	     declloc(FALSE);
+	     lastst = tNEW;
+	  }
+	else
+	  {
+	     error(3);		/* declaration only valid in a block */
+	  }			/* if */
+	break;
+     case tSTATIC:
+	if (allow_decl)
+	  {
+	     declloc(TRUE);
+	     lastst = tNEW;
+	  }
+	else
+	  {
+	     error(3);		/* declaration only valid in a block */
+	  }			/* if */
+	break;
+     case '{':
+	if (!matchtoken('}'))	/* {} is the empty statement */
+	   compound();
+	/* lastst (for "last statement") does not change */
+	break;
+     case ';':
+	error(36);		/* empty statement */
+	break;
+     case tIF:
+	doif();
+	lastst = tIF;
+	break;
+     case tWHILE:
+	dowhile();
+	lastst = tWHILE;
+	break;
+     case tDO:
+	dodo();
+	lastst = tDO;
+	break;
+     case tFOR:
+	dofor();
+	lastst = tFOR;
+	break;
+     case tSWITCH:
+	doswitch();
+	lastst = tSWITCH;
+	break;
+     case tCASE:
+     case tDEFAULT:
+	error(14);		/* not in switch */
+	break;
+     case tGOTO:
+	dogoto();
+	lastst = tGOTO;
+	break;
+     case tLABEL:
+	dolabel();
+	lastst = tLABEL;
+	break;
+     case tRETURN:
+	doreturn();
+	lastst = tRETURN;
+	break;
+     case tBREAK:
+	dobreak();
+	lastst = tBREAK;
+	break;
+     case tCONTINUE:
+	docont();
+	lastst = tCONTINUE;
+	break;
+     case tEXIT:
+	doexit();
+	lastst = tEXIT;
+	break;
+     case tASSERT:
+	doassert();
+	lastst = tASSERT;
+	break;
+     case tSLEEP:
+	dosleep();
+	lastst = tSLEEP;
+	break;
+     case tCONST:
+	decl_const(sLOCAL);
+	break;
+     case tENUM:
+	decl_enum(sLOCAL);
+	break;
+     default:			/* non-empty expression */
+	lexpush();		/* analyze token later */
+	doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
+	needtoken(tTERM);
+	lastst = tEXPR;
+     }				/* switch */
+}
+
+static void
+compound(void)
+{
+   int                 indent = -1;
+   cell                save_decl = declared;
+   int                 count_stmt = 0;
+
+   nestlevel += 1;		/* increase compound statement level */
+   while (matchtoken('}') == 0)
+     {				/* repeat until compound statement is closed */
+	if (!freading)
+	  {
+	     needtoken('}');	/* gives error: "expected token }" */
+	     break;
+	  }
+	else
+	  {
+	     if (count_stmt > 0
+		 && (lastst == tRETURN || lastst == tBREAK
+		     || lastst == tCONTINUE))
+		error(225);	/* unreachable code */
+	     statement(&indent, TRUE);	/* do a statement */
+	     count_stmt++;
+	  }			/* if */
+     }				/* while */
+   if (lastst != tRETURN)
+      destructsymbols(&loctab, nestlevel);
+   if (lastst != tRETURN && lastst != tGOTO)
+      /* delete local variable space */
+      modstk((int)(declared - save_decl) * sizeof(cell));
+
+   testsymbols(&loctab, nestlevel, FALSE, TRUE);	/* look for unused
+							 * block locals */
+   declared = save_decl;
+   delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+   /* erase local symbols, but
+    * retain block local labels
+    * (within the function) */
+
+   nestlevel -= 1;		/* decrease compound statement level */
+}
+
+/*  doexpr
+ *
+ *  Global references: stgidx   (referred to only)
+ */
+static void
+doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
+       int *tag, int chkfuncresult)
+{
+   int                 constant, idx, ident;
+   int                 localstaging = FALSE;
+   cell                val;
+
+   if (!staging)
+     {
+	stgset(TRUE);		/* start stage-buffering */
+	localstaging = TRUE;
+	assert(stgidx == 0);
+     }				/* if */
+   idx = stgidx;
+   errorset(sEXPRMARK);
+   do
+     {
+	/* on second round through, mark the end of the previous expression */
+	if (idx != stgidx)
+	   endexpr(TRUE);
+	sideeffect = FALSE;
+	ident = expression(&constant, &val, tag, chkfuncresult);
+	if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
+	   error(33, "-unknown-");	/* array must be indexed */
+	if (chkeffect && !sideeffect)
+	   error(215);		/* expression has no effect */
+     }
+   while (comma && matchtoken(','));	/* more? */
+   if (mark_endexpr)
+      endexpr(TRUE);		/* optionally, mark the end of the expression */
+   errorset(sEXPRRELEASE);
+   if (localstaging)
+     {
+	stgout(idx);
+	stgset(FALSE);		/* stop staging */
+     }				/* if */
+}
+
+/*  constexpr
+ */
+int
+constexpr(cell * val, int *tag)
+{
+   int                 constant, idx;
+   cell                cidx;
+
+   stgset(TRUE);		/* start stage-buffering */
+   stgget(&idx, &cidx);	/* mark position in code generator */
+   errorset(sEXPRMARK);
+   expression(&constant, val, tag, FALSE);
+   stgdel(idx, cidx);		/* scratch generated code */
+   stgset(FALSE);		/* stop stage-buffering */
+   if (constant == 0)
+      error(8);			/* must be constant expression */
+   errorset(sEXPRRELEASE);
+   return constant;
+}
+
+/*  test
+ *
+ *  In the case a "simple assignment" operator ("=") is used within a
+ *  test, *  the warning "possibly unintended assignment" is displayed.
+ *  This routine sets the global variable "intest" to true, it is
+ *  restored upon termination. In the case the assignment was intended,
+ *  use parantheses around the expression to avoid the warning;
+ *  primary() sets "intest" to 0.
+ *
+ *  Global references: intest   (altered, but restored upon termination)
+ */
+static void
+test(int label, int parens, int invert)
+{
+   int                 idx, tok;
+   cell                cidx;
+   value               lval = { NULL, 0, 0, 0, 0, NULL };
+   int                 localstaging = FALSE;
+
+   if (!staging)
+     {
+	stgset(TRUE);		/* start staging */
+	localstaging = TRUE;
+#if !defined NDEBUG
+	stgget(&idx, &cidx);	/* should start at zero if started
+				 * locally */
+	assert(idx == 0);
+#endif
+     }				/* if */
+
+   pushstk((stkitem) intest);
+   intest = 1;
+   if (parens)
+      needtoken('(');
+   do
+     {
+	stgget(&idx, &cidx);	/* mark position (of last expression) in
+				 * code generator */
+	if (hier14(&lval))
+	   rvalue(&lval);
+	tok = matchtoken(',');
+	if (tok)
+	   endexpr(TRUE);
+     }
+   while (tok);			/* do */
+   if (parens)
+      needtoken(')');
+   if (lval.ident == iARRAY || lval.ident == iREFARRAY)
+     {
+	char               *ptr =
+	   (lval.sym->name) ? lval.sym->name : "-unknown-";
+	error(33, ptr);		/* array must be indexed */
+     }				/* if */
+   if (lval.ident == iCONSTEXPR)
+     {				/* constant expression */
+	intest = (int)(long)popstk();	/* restore stack */
+	stgdel(idx, cidx);
+	if (lval.constval)
+	  {			/* code always executed */
+	     error(206);	/* redundant test: always non-zero */
+	  }
+	else
+	  {
+	     error(205);	/* redundant code: never executed */
+	     jumplabel(label);
+	  }			/* if */
+	if (localstaging)
+	  {
+	     stgout(0);		/* write "jumplabel" code */
+	     stgset(FALSE);	/* stop staging */
+	  }			/* if */
+	return;
+     }				/* if */
+   if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
+      if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
+	 invert = !invert;	/* user-defined ! operator inverted result */
+   if (invert)
+      jmp_ne0(label);		/* jump to label if true (different from 0) */
+   else
+      jmp_eq0(label);		/* jump to label if false (equal to 0) */
+   endexpr(TRUE);		/* end expression (give optimizer a chance) */
+   intest = (int)(long)popstk();	/* double typecast to avoid warning
+					 * with Microsoft C */
+   if (localstaging)
+     {
+	stgout(0);		/* output queue from the very beginning (see
+				 * assert() when localstaging is set to TRUE) */
+	stgset(FALSE);		/* stop staging */
+     }				/* if */
+}
+
+static void
+doif(void)
+{
+   int                 flab1, flab2;
+   int                 ifindent;
+
+   ifindent = stmtindent;	/* save the indent of the "if" instruction */
+   flab1 = getlabel();		/* get label number for false branch */
+   test(flab1, TRUE, FALSE);	/*get expression, branch to flab1 if false */
+   statement(NULL, FALSE);	/* if true, do a statement */
+   if (matchtoken(tELSE) == 0)
+     {				/* if...else ? */
+	setlabel(flab1);	/* no, simple if..., print false label */
+     }
+   else
+     {
+	/* to avoid the "dangling else" error, we want a warning if the "else"
+	 * has a lower indent than the matching "if" */
+#if 0
+	if (stmtindent < ifindent && sc_tabsize > 0)
+	   error(217);		/* loose indentation */
+#endif
+	flab2 = getlabel();
+	if ((lastst != tRETURN) && (lastst != tGOTO))
+	   jumplabel(flab2);
+	setlabel(flab1);	/* print false label */
+	statement(NULL, FALSE);	/* do "else" clause */
+	setlabel(flab2);	/* print true label */
+     }				/* endif */
+}
+
+static void
+dowhile(void)
+{
+   int                 wq[wqSIZE];	/* allocate local queue */
+
+   addwhile(wq);		/* add entry to queue for "break" */
+   setlabel(wq[wqLOOP]);	/* loop label */
+   /* The debugger uses the "line" opcode to be able to "break" out of
+    * a loop. To make sure that each loop has a line opcode, even for the
+    * tiniest loop, set it below the top of the loop */
+   setline(fline, fcurrent);
+   test(wq[wqEXIT], TRUE, FALSE);	/* branch to wq[wqEXIT] if false */
+   statement(NULL, FALSE);	/* if so, do a statement */
+   jumplabel(wq[wqLOOP]);	/* and loop to "while" start */
+   setlabel(wq[wqEXIT]);	/* exit label */
+   delwhile();			/* delete queue entry */
+}
+
+/*
+ *  Note that "continue" will in this case not jump to the top of the
+ *  loop, but  to the end: just before the TRUE-or-FALSE testing code.
+ */
+static void
+dodo(void)
+{
+   int                 wq[wqSIZE], top;
+
+   addwhile(wq);		/* see "dowhile" for more info */
+   top = getlabel();		/* make a label first */
+   setlabel(top);		/* loop label */
+   statement(NULL, FALSE);
+   needtoken(tWHILE);
+   setlabel(wq[wqLOOP]);	/* "continue" always jumps to WQLOOP. */
+   setline(fline, fcurrent);
+   test(wq[wqEXIT], TRUE, FALSE);
+   jumplabel(top);
+   setlabel(wq[wqEXIT]);
+   delwhile();
+   needtoken(tTERM);
+}
+
+static void
+dofor(void)
+{
+   int                 wq[wqSIZE], skiplab;
+   cell                save_decl;
+   int                 save_nestlevel, idx;
+   int                *ptr;
+
+   save_decl = declared;
+   save_nestlevel = nestlevel;
+
+   addwhile(wq);
+   skiplab = getlabel();
+   needtoken('(');
+   if (matchtoken(';') == 0)
+     {
+	/* new variable declarations are allowed here */
+	if (matchtoken(tNEW))
+	  {
+	     /* The variable in expr1 of the for loop is at a
+	      * 'compound statement' level of it own.
+	      */
+	     nestlevel++;
+	     declloc(FALSE);	/* declare local variable */
+	  }
+	else
+	  {
+	     doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);	/* expression 1 */
+	     needtoken(';');
+	  }			/* if */
+     }				/* if */
+   /* Adjust the "declared" field in the "while queue", in case that
+    * local variables were declared in the first expression of the
+    * "for" loop. These are deleted in separately, so a "break" or a
+    * "continue" must ignore these fields.
+    */
+   ptr = readwhile();
+   assert(ptr != NULL);
+   ptr[wqBRK] = (int)declared;
+   ptr[wqCONT] = (int)declared;
+   jumplabel(skiplab);		/* skip expression 3 1st time */
+   setlabel(wq[wqLOOP]);	/* "continue" goes to this label: expr3 */
+   setline(fline, fcurrent);
+   /* Expressions 2 and 3 are reversed in the generated code:
+    * expression 3 precedes expression 2.
+    * When parsing, the code is buffered and marks for
+    * the start of each expression are insterted in the buffer.
+    */
+   assert(!staging);
+   stgset(TRUE);		/* start staging */
+   assert(stgidx == 0);
+   idx = stgidx;
+   stgmark(sSTARTREORDER);
+   stgmark((char)(sEXPRSTART + 0));	/* mark start of 2nd expression
+					 * in stage */
+   setlabel(skiplab);		/*jump to this point after 1st expression */
+   if (matchtoken(';') == 0)
+     {
+	test(wq[wqEXIT], FALSE, FALSE);	/* expression 2
+					 *(jump to wq[wqEXIT] if false) */
+	needtoken(';');
+     }				/* if */
+   stgmark((char)(sEXPRSTART + 1));	/* mark start of 3th expression
+					 * in stage */
+   if (matchtoken(')') == 0)
+     {
+	doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);	/* expression 3 */
+	needtoken(')');
+     }				/* if */
+   stgmark(sENDREORDER);	/* mark end of reversed evaluation */
+   stgout(idx);
+   stgset(FALSE);		/* stop staging */
+   statement(NULL, FALSE);
+   jumplabel(wq[wqLOOP]);
+   setlabel(wq[wqEXIT]);
+   delwhile();
+
+   assert(nestlevel >= save_nestlevel);
+   if (nestlevel > save_nestlevel)
+     {
+	/* Clean up the space and the symbol table for the local
+	 * variable in "expr1".
+	 */
+	destructsymbols(&loctab, nestlevel);
+	modstk((int)(declared - save_decl) * sizeof(cell));
+	declared = save_decl;
+	delete_symbols(&loctab, nestlevel, FALSE, TRUE);
+	nestlevel = save_nestlevel;	/* reset 'compound statement'
+					 * nesting level */
+     }				/* if */
+}
+
+/* The switch statement is incompatible with its C sibling:
+ * 1. the cases are not drop through
+ * 2. only one instruction may appear below each case, use a compound
+ *    instruction to execute multiple instructions
+ * 3. the "case" keyword accepts a comma separated list of values to
+ *    match, it also accepts a range using the syntax "1 .. 4"
+ *
+ * SWITCH param
+ *   PRI = expression result
+ *   param = table offset (code segment)
+ *
+ */
+static void
+doswitch(void)
+{
+   int                 lbl_table, lbl_exit, lbl_case;
+   int                 tok, swdefault, casecount;
+   cell                val;
+   char               *str;
+   constvalue          caselist = { NULL, "", 0, 0 };	/*case list starts empty */
+   constvalue         *cse, *csp;
+   char                labelname[sNAMEMAX + 1];
+
+   needtoken('(');
+   doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE);	/* evaluate
+							 * switch expression */
+   needtoken(')');
+   /* generate the code for the switch statement, the label is the
+    * address of the case table (to be generated later).
+    */
+   lbl_table = getlabel();
+   lbl_case = 0;		/* just to avoid a compiler warning */
+   ffswitch(lbl_table);
+
+   needtoken('{');
+   lbl_exit = getlabel();	/*get label number for jumping out of switch */
+   swdefault = FALSE;
+   casecount = 0;
+   do
+     {
+	tok = lex(&val, &str);	/* read in (new) token */
+	switch (tok)
+	  {
+	  case tCASE:
+	     if (swdefault != FALSE)
+		error(15);	/* "default" case must be last in switch
+				 * statement */
+	     lbl_case = getlabel();
+	     sc_allowtags = FALSE;	/* do not allow tagnames here */
+	     do
+	       {
+		  casecount++;
+
+		  /* ??? enforce/document that, in a switch, a statement cannot
+		   * start an opening brace (marks the start of a compound
+		   * statement) and search for the right-most colon before that
+		   * statement.
+		   * Now, by replacing the ':' by a special COLON token, you can
+		   * parse all expressions until that special token.
+		   */
+
+		  constexpr(&val, NULL);
+		  /* Search the insertion point (the table is kept in sorted
+		   * order, so that advanced abstract machines can sift the
+		   * case table with a binary search). Check for duplicate
+		   * case values at the same time.
+		   */
+		  for (csp = &caselist, cse = caselist.next;
+		       cse && cse->value < val;
+		       csp = cse, cse = cse->next)
+		     /* nothing */ ;
+		  if (cse && cse->value == val)
+		     error(40, val);	/* duplicate "case" label */
+		  /* Since the label is stored as a string in the
+		   * "constvalue", the size of an identifier must
+		   * be at least 8, as there are 8
+		   * hexadecimal digits in a 32-bit number.
+		   */
+#if sNAMEMAX < 8
+#error Length of identifier (sNAMEMAX) too small.
+#endif
+		  insert_constval(csp, cse, itoh(lbl_case), val, 0);
+		  if (matchtoken(tDBLDOT))
+		    {
+		       cell                end;
+
+		       constexpr(&end, NULL);
+		       if (end <= val)
+			  error(50);	/* invalid range */
+		       while (++val <= end)
+			 {
+			    casecount++;
+			    /* find the new insertion point */
+			    for (csp = &caselist, cse = caselist.next;
+				 cse && cse->value < val;
+				 csp = cse, cse = cse->next)
+			       /* nothing */ ;
+			    if (cse && cse->value == val)
+			       error(40, val);	/* duplicate "case" label */
+			    insert_constval(csp, cse, itoh(lbl_case), val, 0);
+			 }	/* if */
+		    }		/* if */
+	       }
+	     while (matchtoken(','));
+	     needtoken(':');	/* ':' ends the case */
+	     sc_allowtags = TRUE;	/* reset */
+	     setlabel(lbl_case);
+	     statement(NULL, FALSE);
+	     jumplabel(lbl_exit);
+	     break;
+	  case tDEFAULT:
+	     if (swdefault != FALSE)
+		error(16);	/* multiple defaults in switch */
+	     lbl_case = getlabel();
+	     setlabel(lbl_case);
+	     needtoken(':');
+	     swdefault = TRUE;
+	     statement(NULL, FALSE);
+	     /* Jump to lbl_exit, even thouh this is the last clause in the
+	      *switch, because the jump table is generated between the last
+	      * clause of the switch and the exit label.
+	      */
+	     jumplabel(lbl_exit);
+	     break;
+	  case '}':
+	     /* nothing, but avoid dropping into "default" */
+	     break;
+	  default:
+	     error(2);
+	     indent_nowarn = TRUE;	/* disable this check */
+	     tok = '}';		/* break out of the loop after an error */
+	  }			/* switch */
+     }
+   while (tok != '}');
+
+#if !defined NDEBUG
+   /* verify that the case table is sorted (unfortunately, duplicates can
+    * occur; there really shouldn't be duplicate cases, but the compiler
+    * may not crash or drop into an assertion for a user error). */
+   for (cse = caselist.next; cse && cse->next; cse = cse->next)
+     ; /* empty. no idea whether this is correct, but we MUST NOT do
+        * the setlabel(lbl_table) call in the loop body. doing so breaks
+        * switch statements that only have one case statement following.
+        */
+#endif
+
+   /* generate the table here, before lbl_exit (general jump target) */
+   setlabel(lbl_table);
+
+   if (swdefault == FALSE)
+     {
+	/* store lbl_exit as the "none-matched" label in the switch table */
+	strcpy(labelname, itoh(lbl_exit));
+     }
+   else
+     {
+	/* lbl_case holds the label of the "default" clause */
+	strcpy(labelname, itoh(lbl_case));
+     }				/* if */
+   ffcase(casecount, labelname, TRUE);
+   /* generate the rest of the table */
+   for (cse = caselist.next; cse; cse = cse->next)
+      ffcase(cse->value, cse->name, FALSE);
+
+   setlabel(lbl_exit);
+   delete_consttable(&caselist);	/* clear list of case labels */
+}
+
+static void
+doassert(void)
+{
+   int                 flab1, idx;
+   cell                cidx;
+   value               lval = { NULL, 0, 0, 0, 0, NULL };
+
+   if ((sc_debug & sCHKBOUNDS) != 0)
+     {
+	flab1 = getlabel();	/* get label number for "OK" branch */
+	test(flab1, FALSE, TRUE);	/* get expression and branch
+					 * to flab1 if true */
+	setline(fline, fcurrent);	/* make sure we abort on the correct
+					 * line number */
+	ffabort(xASSERTION);
+	setlabel(flab1);
+     }
+   else
+     {
+	stgset(TRUE);		/* start staging */
+	stgget(&idx, &cidx);	/* mark position in code generator */
+	do
+	  {
+	     if (hier14(&lval))
+		rvalue(&lval);
+	     stgdel(idx, cidx);	/* just scrap the code */
+	  }
+	while (matchtoken(','));
+	stgset(FALSE);		/* stop staging */
+     }				/* if */
+   needtoken(tTERM);
+}
+
+static void
+dogoto(void)
+{
+   char               *st;
+   cell                val;
+   symbol             *sym;
+
+   if (lex(&val, &st) == tSYMBOL)
+     {
+	sym = fetchlab(st);
+	jumplabel((int)sym->addr);
+	sym->usage |= uREAD;	/* set "uREAD" bit */
+	/*
+	 * // ??? if the label is defined (check sym->usage & uDEFINE), check
+	 * //   sym->compound (nesting level of the label) against nestlevel;
+	 * //     if sym->compound < nestlevel, call the destructor operator
+	 */
+     }
+   else
+     {
+	error(20, st);		/* illegal symbol name */
+     }				/* if */
+   needtoken(tTERM);
+}
+
+static void
+dolabel(void)
+{
+   char               *st;
+   cell                val;
+   symbol             *sym;
+
+   tokeninfo(&val, &st);	/* retrieve label name again */
+   if (find_constval(&tagname_tab, st, 0))
+      error(221, st);		/* label name shadows tagname */
+   sym = fetchlab(st);
+   setlabel((int)sym->addr);
+   /* since one can jump around variable declarations or out of compound
+    * blocks, the stack must be manually adjusted
+    */
+   setstk(-declared * sizeof(cell));
+   sym->usage |= uDEFINE;	/* label is now defined */
+}
+
+/*  fetchlab
+ *
+ *  Finds a label from the (local) symbol table or adds one to it.
+ *  Labels are local in scope.
+ *
+ *  Note: The "_usage" bit is set to zero. The routines that call
+ *  "fetchlab()" must set this bit accordingly.
+ */
+static symbol      *
+fetchlab(char *name)
+{
+   symbol             *sym;
+
+   sym = findloc(name);		/* labels are local in scope */
+   if (sym)
+     {
+	if (sym->ident != iLABEL)
+	   error(19, sym->name);	/* not a label: ... */
+     }
+   else
+     {
+	sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
+	sym->x.declared = (int)declared;
+	sym->compound = nestlevel;
+     }				/* if */
+   return sym;
+}
+
+/*  doreturn
+ *
+ *  Global references: rettype  (altered)
+ */
+static void
+doreturn(void)
+{
+   int                 tag;
+
+   if (matchtoken(tTERM) == 0)
+     {
+	if ((rettype & uRETNONE) != 0)
+	   error(208);		/* mix "return;" and "return value;" */
+	doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+	needtoken(tTERM);
+	rettype |= uRETVALUE;	/* function returns a value */
+	/* check tagname with function tagname */
+	assert(curfunc != NULL);
+	if (!matchtag(curfunc->tag, tag, TRUE))
+	   error(213);		/* tagname mismatch */
+     }
+   else
+     {
+	/* this return statement contains no expression */
+	const1(0);
+	if ((rettype & uRETVALUE) != 0)
+	  {
+	     char                symname[2 * sNAMEMAX + 16];	/* allow space for user
+								 * defined operators */
+	     assert(curfunc != NULL);
+	     funcdisplayname(symname, curfunc->name);
+	     error(209, symname);	/* function should return a value */
+	  }			/* if */
+	rettype |= uRETNONE;	/* function does not return anything */
+     }				/* if */
+   destructsymbols(&loctab, 0);	/*call destructor for *all* locals */
+   modstk((int)declared * sizeof(cell));	/* end of function, remove
+						 *all* * local variables*/
+   ffret();
+}
+
+static void
+dobreak(void)
+{
+   int                *ptr;
+
+   ptr = readwhile();		/* readwhile() gives an error if not in loop */
+   needtoken(tTERM);
+   if (!ptr)
+      return;
+   destructsymbols(&loctab, nestlevel);
+   modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
+   jumplabel(ptr[wqEXIT]);
+}
+
+static void
+docont(void)
+{
+   int                *ptr;
+
+   ptr = readwhile();		/* readwhile() gives an error if not in loop */
+   needtoken(tTERM);
+   if (!ptr)
+      return;
+   destructsymbols(&loctab, nestlevel);
+   modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
+   jumplabel(ptr[wqLOOP]);
+}
+
+void
+exporttag(int tag)
+{
+   /* find the tag by value in the table, then set the top bit to mark it
+    * "public"
+    */
+   if (tag != 0)
+     {
+	constvalue         *ptr;
+
+	assert((tag & PUBLICTAG) == 0);
+	for (ptr = tagname_tab.next;
+	     ptr && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
+	   /* nothing */ ;
+	if (ptr)
+	   ptr->value |= PUBLICTAG;
+     }				/* if */
+}
+
+static void
+doexit(void)
+{
+   int                 tag = 0;
+
+   if (matchtoken(tTERM) == 0)
+     {
+	doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+	needtoken(tTERM);
+     }
+   else
+     {
+	const1(0);
+     }				/* if */
+   const2(tag);
+   exporttag(tag);
+   destructsymbols(&loctab, 0);	/* call destructor for *all* locals */
+   ffabort(xEXIT);
+}
+
+static void
+dosleep(void)
+{
+   int                 tag = 0;
+
+   if (matchtoken(tTERM) == 0)
+     {
+	doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
+	needtoken(tTERM);
+     }
+   else
+     {
+	const1(0);
+     }				/* if */
+   const2(tag);
+   exporttag(tag);
+   ffabort(xSLEEP);
+}
+
+static void
+addwhile(int *ptr)
+{
+   int                 k;
+
+   ptr[wqBRK] = (int)declared;	/* stack pointer (for "break") */
+   ptr[wqCONT] = (int)declared;	/* for "continue", possibly adjusted later */
+   ptr[wqLOOP] = getlabel();
+   ptr[wqEXIT] = getlabel();
+   if (wqptr >= (wq + wqTABSZ - wqSIZE))
+      error(102, "loop table");	/* loop table overflow (too many active loops) */
+   k = 0;
+   while (k < wqSIZE)
+     {				/* copy "ptr" to while queue table */
+	*wqptr = *ptr;
+	wqptr += 1;
+	ptr += 1;
+	k += 1;
+     }				/* while */
+}
+
+static void
+delwhile(void)
+{
+   if (wqptr > wq)
+      wqptr -= wqSIZE;
+}
+
+static int         *
+readwhile(void)
+{
+   if (wqptr <= wq)
+     {
+	error(24);		/* out of context */
+	return NULL;
+     }
+   else
+     {
+	return (wqptr - wqSIZE);
+     }				/* if */
+}
diff --git a/src/bin/embryo_cc_sc2.c b/src/bin/embryo_cc_sc2.c
new file mode 100644
index 0000000..04cb537
--- /dev/null
+++ b/src/bin/embryo_cc_sc2.c
@@ -0,0 +1,2779 @@
+/*  Small compiler - File input, preprocessing and lexical analysis functions
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include "embryo_cc_sc.h"
+#include "Embryo.h"
+
+static int          match(char *st, int end);
+static cell         litchar(char **lptr, int rawmode);
+static int          alpha(char c);
+
+static int          icomment;	/* currently in multiline comment? */
+static int          iflevel;	/* nesting level if #if/#else/#endif */
+static int          skiplevel;	/* level at which we started skipping */
+static int          elsedone;	/* level at which we have seen an #else */
+static char         term_expr[] = "";
+static int          listline = -1;	/* "current line" for the list file */
+
+/*  pushstk & popstk
+ *
+ *  Uses a LIFO stack to store information. The stack is used by doinclude(),
+ *  doswitch() (to hold the state of "swactive") and some other routines.
+ *
+ *  Porting note: I made the bold assumption that an integer will not be
+ *  larger than a pointer (it may be smaller). That is, the stack element
+ *  is typedef'ed as a pointer type, but I also store integers on it. See
+ *  SC.H for "stkitem"
+ *
+ *  Global references: stack,stkidx (private to pushstk() and popstk())
+ */
+static stkitem      stack[sSTKMAX];
+static int          stkidx;
+void
+pushstk(stkitem val)
+{
+   if (stkidx >= sSTKMAX)
+      error(102, "parser stack");	/* stack overflow (recursive include?) */
+   stack[stkidx] = val;
+   stkidx += 1;
+}
+
+stkitem
+popstk(void)
+{
+   if (stkidx == 0)
+      return (stkitem) - 1;	/* stack is empty */
+   stkidx -= 1;
+   return stack[stkidx];
+}
+
+int
+plungequalifiedfile(char *name)
+{
+   static char        *extensions[] = { ".inc", ".sma", ".small" };
+   FILE               *fp;
+   char               *ext;
+   int                 ext_idx;
+
+   ext_idx = 0;
+   do
+     {
+	fp = (FILE *) sc_opensrc(name);
+	ext = strchr(name, '\0');	/* save position */
+	if (!fp)
+	  {
+	     /* try to append an extension */
+	     strcpy(ext, extensions[ext_idx]);
+	     fp = (FILE *) sc_opensrc(name);
+	     if (!fp)
+		*ext = '\0';	/* on failure, restore filename */
+	  }			/* if */
+	ext_idx++;
+     }
+   while ((!fp) && 
+          (ext_idx < (int)(sizeof extensions / sizeof extensions[0])));
+   if (!fp)
+     {
+	*ext = '\0';		/* restore filename */
+	return FALSE;
+     }				/* if */
+   pushstk((stkitem) inpf);
+   pushstk((stkitem) inpfname);	/* pointer to current file name */
+   pushstk((stkitem) curlibrary);
+   pushstk((stkitem) iflevel);
+   assert(skiplevel == 0);
+   pushstk((stkitem) icomment);
+   pushstk((stkitem) fcurrent);
+   pushstk((stkitem) fline);
+   inpfname = strdup(name);	/* set name of include file */
+   if (!inpfname)
+      error(103);		/* insufficient memory */
+   inpf = fp;			/* set input file pointer to include file */
+   fnumber++;
+   fline = 0;			/* set current line number to 0 */
+   fcurrent = fnumber;
+   icomment = FALSE;
+   setfile(inpfname, fcurrent);
+   listline = -1;		/* force a #line directive when changing the file */
+   setactivefile(fcurrent);
+   return TRUE;
+}
+
+int
+plungefile(char *name, int try_currentpath, int try_includepaths)
+{
+   int                 result = FALSE;
+   int                 i;
+   char               *ptr;
+
+   if (try_currentpath)
+      result = plungequalifiedfile(name);
+
+   if (try_includepaths && name[0] != DIRSEP_CHAR)
+     {
+	for (i = 0; !result && (ptr = get_path(i)); i++)
+	  {
+	     char                path[PATH_MAX];
+
+	     strncpy(path, ptr, sizeof path);
+	     path[sizeof path - 1] = '\0';	/* force '\0' termination */
+	     strncat(path, name, sizeof(path) - strlen(path));
+	     path[sizeof path - 1] = '\0';
+	     result = plungequalifiedfile(path);
+	  }			/* while */
+     }				/* if */
+   return result;
+}
+
+static void
+check_empty(char *lptr)
+{
+   /* verifies that the string contains only whitespace */
+   while (*lptr <= ' ' && *lptr != '\0')
+      lptr++;
+   if (*lptr != '\0')
+      error(38);		/* extra characters on line */
+}
+
+/*  doinclude
+ *
+ *  Gets the name of an include file, pushes the old file on the stack and
+ *  sets some options. This routine doesn't use lex(), since lex() doesn't
+ *  recognize file names (and directories).
+ *
+ *  Global references: inpf     (altered)
+ *                     inpfname (altered)
+ *                     fline    (altered)
+ *                     lptr     (altered)
+ */
+static void
+doinclude(void)
+{
+   char                name[PATH_MAX], c;
+   int                 i, result;
+
+   while (*lptr <= ' ' && *lptr != 0)	/* skip leading whitespace */
+      lptr++;
+   if (*lptr == '<' || *lptr == '\"')
+     {
+	c = (char)((*lptr == '\"') ? '\"' : '>');	/* termination character */
+	lptr++;
+	while (*lptr <= ' ' && *lptr != 0)	/* skip whitespace after quote */
+	   lptr++;
+     }
+   else
+     {
+	c = '\0';
+     }				/* if */
+
+   i = 0;
+   while ((*lptr != c) && (*lptr != '\0') && (i < (int)(sizeof(name) - 1))) /* find the end of the string */
+      name[i++] = *lptr++;
+   while (i > 0 && name[i - 1] <= ' ')
+      i--;			/* strip trailing whitespace */
+   assert((i >= 0) && (i < (int)(sizeof(name))));
+   name[i] = '\0';		/* zero-terminate the string */
+
+   if (*lptr != c)
+     {				/* verify correct string termination */
+	error(37);		/* invalid string */
+	return;
+     }				/* if */
+   if (c != '\0')
+      check_empty(lptr + 1);	/* verify that the rest of the line is whitespace */
+
+   /* Include files between "..." or without quotes are read from the current
+    * directory, or from a list of "include directories". Include files
+    * between <...> are only read from the list of include directories.
+    */
+   result = plungefile(name, (c != '>'), TRUE);
+   if (!result)
+      error(100, name);		/* cannot read from ... (fatal error) */
+}
+
+/*  readline
+ *
+ *  Reads in a new line from the input file pointed to by "inpf". readline()
+ *  concatenates lines that end with a \ with the next line. If no more data
+ *  can be read from the file, readline() attempts to pop off the previous file
+ *  from the stack. If that fails too, it sets "freading" to 0.
+ *
+ *  Global references: inpf,fline,inpfname,freading,icomment (altered)
+ */
+static void
+readline(char *line)
+{
+   int                 i, num, cont;
+   char               *ptr;
+
+   if (lptr == term_expr)
+      return;
+   num = sLINEMAX;
+   cont = FALSE;
+   do
+     {
+	if (!inpf || sc_eofsrc(inpf))
+	  {
+	     if (cont)
+		error(49);	/* invalid line continuation */
+	     if (inpf && inpf != inpf_org)
+		sc_closesrc(inpf);
+	     i = (int)(long)popstk();
+	     if (i == -1)
+	       {		/* All's done; popstk() returns "stack is empty" */
+		  freading = FALSE;
+		  *line = '\0';
+		  /* when there is nothing more to read, the #if/#else stack should
+		   * be empty and we should not be in a comment
+		   */
+		  assert(iflevel >= 0);
+		  if (iflevel > 0)
+		     error(1, "#endif", "-end of file-");
+		  else if (icomment)
+		     error(1, "*/", "-end of file-");
+		  return;
+	       }		/* if */
+	     fline = i;
+	     fcurrent = (int)(long)popstk();
+	     icomment = (int)(long)popstk();
+	     assert(skiplevel == 0);	/* skiplevel was not stored on stack, because it should always be zero at this point */
+	     iflevel = (int)(long)popstk();
+	     curlibrary = (constvalue *) popstk();
+	     free(inpfname);	/* return memory allocated for the include file name */
+	     inpfname = (char *)popstk();
+	     inpf = (FILE *) popstk();
+	     setactivefile(fcurrent);
+	     listline = -1;	/* force a #line directive when changing the file */
+	     elsedone = 0;
+	  }			/* if */
+
+	if (!sc_readsrc(inpf, line, num))
+	  {
+	     *line = '\0';	/* delete line */
+	     cont = FALSE;
+	  }
+	else
+	  {
+	     /* check whether to erase leading spaces */
+	     if (cont)
+	       {
+		  char               *ptr = line;
+
+		  while (*ptr == ' ' || *ptr == '\t')
+		     ptr++;
+		  if (ptr != line)
+		     memmove(line, ptr, strlen(ptr) + 1);
+	       }		/* if */
+	     cont = FALSE;
+	     /* check whether a full line was read */
+	     if (!strchr(line, '\n') && !sc_eofsrc(inpf))
+		error(75);	/* line too long */
+	     /* check if the next line must be concatenated to this line */
+	     if ((ptr = strchr(line, '\n')) && ptr > line)
+	       {
+		  assert(*(ptr + 1) == '\0');	/* '\n' should be last in the string */
+		  while (ptr > line
+			 && (*ptr == '\n' || *ptr == ' ' || *ptr == '\t'))
+		     ptr--;	/* skip trailing whitespace */
+		  if (*ptr == '\\')
+		    {
+		       cont = TRUE;
+		       /* set '\a' at the position of '\\' to make it possible to check
+		        * for a line continuation in a single line comment (error 49)
+		        */
+		       *ptr++ = '\a';
+		       *ptr = '\0';	/* erase '\n' (and any trailing whitespace) */
+		    }		/* if */
+	       }		/* if */
+	     num -= strlen(line);
+	     line += strlen(line);
+	  }			/* if */
+	fline += 1;
+     }
+   while (num >= 0 && cont);
+}
+
+/*  stripcom
+ *
+ *  Replaces all comments from the line by space characters. It updates
+ *  a global variable ("icomment") for multiline comments.
+ *
+ *  This routine also supports the C++ extension for single line comments.
+ *  These comments are started with "//" and end at the end of the line.
+ *
+ *  Global references: icomment  (private to "stripcom")
+ */
+static void
+stripcom(char *line)
+{
+   char                c;
+
+   while (*line)
+     {
+	if (icomment)
+	  {
+	     if (*line == '*' && *(line + 1) == '/')
+	       {
+		  icomment = FALSE;	/* comment has ended */
+		  *line = ' ';	/* replace '*' and '/' characters by spaces */
+		  *(line + 1) = ' ';
+		  line += 2;
+	       }
+	     else
+	       {
+		  if (*line == '/' && *(line + 1) == '*')
+		     error(216);	/* nested comment */
+		  *line = ' ';	/* replace comments by spaces */
+		  line += 1;
+	       }		/* if */
+	  }
+	else
+	  {
+	     if (*line == '/' && *(line + 1) == '*')
+	       {
+		  icomment = TRUE;	/* start comment */
+		  *line = ' ';	/* replace '/' and '*' characters by spaces */
+		  *(line + 1) = ' ';
+		  line += 2;
+	       }
+	     else if (*line == '/' && *(line + 1) == '/')
+	       {		/* comment to end of line */
+		  if (strchr(line, '\a'))
+		     error(49);	/* invalid line continuation */
+		  *line++ = '\n';	/* put "newline" at first slash */
+		  *line = '\0';	/* put "zero-terminator" at second slash */
+	       }
+	     else
+	       {
+		  if (*line == '\"' || *line == '\'')
+		    {		/* leave literals unaltered */
+		       c = *line;	/* ending quote, single or double */
+		       line += 1;
+		       while ((*line != c || *(line - 1) == '\\')
+			      && *line != '\0')
+			  line += 1;
+		       line += 1;	/* skip final quote */
+		    }
+		  else
+		    {
+		       line += 1;
+		    }		/* if */
+	       }		/* if */
+	  }			/* if */
+     }				/* while */
+}
+
+/*  btoi
+ *
+ *  Attempts to interpret a numeric symbol as a boolean value. On success
+ *  it returns the number of characters processed (so the line pointer can be
+ *  adjusted) and the value is stored in "val". Otherwise it returns 0 and
+ *  "val" is garbage.
+ *
+ *  A boolean value must start with "0b"
+ */
+static int
+btoi(cell * val, char *curptr)
+{
+   char               *ptr;
+
+   *val = 0;
+   ptr = curptr;
+   if (*ptr == '0' && *(ptr + 1) == 'b')
+     {
+	ptr += 2;
+	while (*ptr == '0' || *ptr == '1' || *ptr == '_')
+	  {
+	     if (*ptr != '_')
+		*val = (*val << 1) | (*ptr - '0');
+	     ptr++;
+	  }			/* while */
+     }
+   else
+     {
+	return 0;
+     }				/* if */
+   if (alphanum(*ptr))		/* number must be delimited by non-alphanumeric char */
+      return 0;
+   else
+      return (int)(ptr - curptr);
+}
+
+/*  dtoi
+ *
+ *  Attempts to interpret a numeric symbol as a decimal value. On success
+ *  it returns the number of characters processed and the value is stored in
+ *  "val". Otherwise it returns 0 and "val" is garbage.
+ */
+static int
+dtoi(cell * val, char *curptr)
+{
+   char               *ptr;
+
+   *val = 0;
+   ptr = curptr;
+   if (!isdigit(*ptr))		/* should start with digit */
+      return 0;
+   while (isdigit(*ptr) || *ptr == '_')
+     {
+	if (*ptr != '_')
+	   *val = (*val * 10) + (*ptr - '0');
+	ptr++;
+     }				/* while */
+   if (alphanum(*ptr))		/* number must be delimited by non-alphanumerical */
+      return 0;
+   if (*ptr == '.' && isdigit(*(ptr + 1)))
+      return 0;			/* but a fractional part must not be present */
+   return (int)(ptr - curptr);
+}
+
+/*  htoi
+ *
+ *  Attempts to interpret a numeric symbol as a hexadecimal value. On
+ *  success it returns the number of characters processed and the value is
+ *  stored in "val". Otherwise it return 0 and "val" is garbage.
+ */
+static int
+htoi(cell * val, char *curptr)
+{
+   char               *ptr;
+
+   *val = 0;
+   ptr = curptr;
+   if (!isdigit(*ptr))		/* should start with digit */
+      return 0;
+   if (*ptr == '0' && *(ptr + 1) == 'x')
+     {				/* C style hexadecimal notation */
+	ptr += 2;
+	while (isxdigit(*ptr) || *ptr == '_')
+	  {
+	     if (*ptr != '_')
+	       {
+		  assert(isxdigit(*ptr));
+		  *val = *val << 4;
+		  if (isdigit(*ptr))
+		     *val += (*ptr - '0');
+		  else
+		     *val += (tolower(*ptr) - 'a' + 10);
+	       }		/* if */
+	     ptr++;
+	  }			/* while */
+     }
+   else
+     {
+	return 0;
+     }				/* if */
+   if (alphanum(*ptr))
+      return 0;
+   else
+      return (int)(ptr - curptr);
+}
+
+#if defined LINUX
+static double
+pow10(int value)
+{
+   double              res = 1.0;
+
+   while (value >= 4)
+     {
+	res *= 10000.0;
+	value -= 5;
+     }				/* while */
+   while (value >= 2)
+     {
+	res *= 100.0;
+	value -= 2;
+     }				/* while */
+   while (value >= 1)
+     {
+	res *= 10.0;
+	value -= 1;
+     }				/* while */
+   return res;
+}
+#endif
+
+/*  ftoi
+ *
+ *  Attempts to interpret a numeric symbol as a rational number, either as
+ *  IEEE 754 single precision floating point or as a fixed point integer.
+ *  On success it returns the number of characters processed and the value is
+ *  stored in "val". Otherwise it returns 0 and "val" is unchanged.
+ *
+ *  Small has stricter definition for floating point numbers than most:
+ *  o  the value must start with a digit; ".5" is not a valid number, you
+ *     should write "0.5"
+ *  o  a period must appear in the value, even if an exponent is given; "2e3"
+ *     is not a valid number, you should write "2.0e3"
+ *  o  at least one digit must follow the period; "6." is not a valid number,
+ *     you should write "6.0"
+ */
+static int
+ftoi(cell * val, char *curptr)
+{
+   char               *ptr;
+   double              fnum, ffrac, fmult;
+   unsigned long       dnum, dbase;
+   int                 i, ignore;
+
+   assert(rational_digits >= 0 && rational_digits < 9);
+   for (i = 0, dbase = 1; i < rational_digits; i++)
+      dbase *= 10;
+   fnum = 0.0;
+   dnum = 0L;
+   ptr = curptr;
+   if (!isdigit(*ptr))		/* should start with digit */
+      return 0;
+   while (isdigit(*ptr) || *ptr == '_')
+     {
+	if (*ptr != '_')
+	  {
+	     fnum = (fnum * 10.0) + (*ptr - '0');
+	     dnum = (dnum * 10L) + (*ptr - '0') * dbase;
+	  }			/* if */
+	ptr++;
+     }				/* while */
+   if (*ptr != '.')
+      return 0;			/* there must be a period */
+   ptr++;
+   if (!isdigit(*ptr))		/* there must be at least one digit after the dot */
+      return 0;
+   ffrac = 0.0;
+   fmult = 1.0;
+   ignore = FALSE;
+   while (isdigit(*ptr) || *ptr == '_')
+     {
+	if (*ptr != '_')
+	  {
+	     ffrac = (ffrac * 10.0) + (*ptr - '0');
+	     fmult = fmult / 10.0;
+	     dbase /= 10L;
+	     dnum += (*ptr - '0') * dbase;
+	     if (dbase == 0L && sc_rationaltag && rational_digits > 0
+		 && !ignore)
+	       {
+		  error(222);	/* number of digits exceeds rational number precision */
+		  ignore = TRUE;
+	       }		/* if */
+	  }			/* if */
+	ptr++;
+     }				/* while */
+   fnum += ffrac * fmult;	/* form the number so far */
+   if (*ptr == 'e')
+     {				/* optional fractional part */
+	int                 exp, sign;
+
+	ptr++;
+	if (*ptr == '-')
+	  {
+	     sign = -1;
+	     ptr++;
+	  }
+	else
+	  {
+	     sign = 1;
+	  }			/* if */
+	if (!isdigit(*ptr))	/* 'e' should be followed by a digit */
+	   return 0;
+	exp = 0;
+	while (isdigit(*ptr))
+	  {
+	     exp = (exp * 10) + (*ptr - '0');
+	     ptr++;
+	  }			/* while */
+#if defined LINUX
+	fmult = pow10(exp * sign);
+#else
+	fmult = pow(10, exp * sign);
+#endif
+	fnum *= fmult;
+	dnum *= (unsigned long)(fmult + 0.5);
+     }				/* if */
+
+   /* decide how to store the number */
+   if (sc_rationaltag == 0)
+     {
+	error(70);		/* rational number support was not enabled */
+	*val = 0;
+     }
+   else if (rational_digits == 0)
+     {
+	float f = (float) fnum;
+	/* floating point */
+      *val = EMBRYO_FLOAT_TO_CELL(f);
+#if !defined NDEBUG
+	/* I assume that the C/C++ compiler stores "float" values in IEEE 754
+	 * format (as mandated in the ANSI standard). Test this assumption anyway.
+	 */
+	{
+	   float test1 = 0.0, test2 = 50.0;
+	   Embryo_Cell c1 = EMBRYO_FLOAT_TO_CELL(test1);
+	   Embryo_Cell c2 = EMBRYO_FLOAT_TO_CELL(test2);
+
+	   if (c1 != 0x00000000L)
+	     {
+		fprintf(stderr,
+			"embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+			"point math as embryo expects. this could be bad.\n"
+			"\n"
+			"(float 0.0 != 0x00000000 bitpattern, 0x%08x instead)\n"
+			"\n"
+			"this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+			"to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+			, c1);
+	     }
+	  else if (c2 != 0x42480000L)
+	     {
+		fprintf(stderr,
+			"embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
+			"point math as embryo expects. This could be bad.\n"
+			"\n"
+			"(float 50.0 != 0x42480000 bitpattern, 0x%08x instead)\n"
+			"\n"
+			"this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
+			"to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
+			, c2);
+	     }
+	}
+#endif
+     }
+   else
+     {
+	/* fixed point */
+	*val = (cell) dnum;
+     }				/* if */
+
+   return (int)(ptr - curptr);
+}
+
+/*  number
+ *
+ *  Reads in a number (binary, decimal or hexadecimal). It returns the number
+ *  of characters processed or 0 if the symbol couldn't be interpreted as a
+ *  number (in this case the argument "val" remains unchanged). This routine
+ *  relies on the 'early dropout' implementation of the logical or (||)
+ *  operator.
+ *
+ *  Note: the routine doesn't check for a sign (+ or -). The - is checked
+ *        for at "hier2()" (in fact, it is viewed as an operator, not as a
+ *        sign) and the + is invalid (as in K&R C, and unlike ANSI C).
+ */
+static int
+number(cell * val, char *curptr)
+{
+   int                 i;
+   cell                value;
+
+   if ((i = btoi(&value, curptr)) != 0	/* binary? */
+       || (i = htoi(&value, curptr)) != 0	/* hexadecimal? */
+       || (i = dtoi(&value, curptr)) != 0)	/* decimal? */
+     {
+	*val = value;
+	return i;
+     }
+   else
+     {
+	return 0;		/* else not a number */
+     }				/* if */
+}
+
+static void
+chrcat(char *str, char chr)
+{
+   str = strchr(str, '\0');
+   *str++ = chr;
+   *str = '\0';
+}
+
+static int
+preproc_expr(cell * val, int *tag)
+{
+   int                 result;
+   int                 idx;
+   cell                code_index;
+   char               *term;
+
+   /* Disable staging; it should be disabled already because
+    * expressions may not be cut off half-way between conditional
+    * compilations. Reset the staging index, but keep the code
+    * index.
+    */
+   if (stgget(&idx, &code_index))
+     {
+	error(57);		/* unfinished expression */
+	stgdel(0, code_index);
+	stgset(FALSE);
+     }				/* if */
+   /* append a special symbol to the string, so the expression
+    * analyzer won't try to read a next line when it encounters
+    * an end-of-line
+    */
+   assert(strlen(pline) < sLINEMAX);
+   term = strchr(pline, '\0');
+   assert(term != NULL);
+   chrcat(pline, PREPROC_TERM);	/* the "DEL" code (see SC.H) */
+   result = constexpr(val, tag);	/* get value (or 0 on error) */
+   *term = '\0';		/* erase the token (if still present) */
+   lexclr(FALSE);		/* clear any "pushed" tokens */
+   return result;
+}
+
+/* getstring
+ * Returns returns a pointer behind the closing quote or to the other
+ * character that caused the input to be ended.
+ */
+static char        *
+getstring(char *dest, int max)
+{
+   assert(dest != NULL);
+   *dest = '\0';
+   while (*lptr <= ' ' && *lptr != '\0')
+      lptr++;			/* skip whitespace */
+   if (*lptr != '"')
+     {
+	error(37);		/* invalid string */
+     }
+   else
+     {
+	int                 len = 0;
+
+	lptr++;			/* skip " */
+	while (*lptr != '"' && *lptr != '\0')
+	  {
+	     if (len < max - 1)
+		dest[len++] = *lptr;
+	     lptr++;
+	  }			/* if */
+	dest[len] = '\0';
+	if (*lptr == '"')
+	   lptr++;		/* skip closing " */
+	else
+	   error(37);		/* invalid string */
+     }				/* if */
+   return lptr;
+}
+
+enum
+{
+   CMD_NONE,
+   CMD_TERM,
+   CMD_EMPTYLINE,
+   CMD_CONDFALSE,
+   CMD_INCLUDE,
+   CMD_DEFINE,
+   CMD_IF,
+   CMD_DIRECTIVE,
+};
+
+/*  command
+ *
+ *  Recognizes the compiler directives. The function returns:
+ *     CMD_NONE         the line must be processed
+ *     CMD_TERM         a pending expression must be completed before processing further lines
+ *     Other value: the line must be skipped, because:
+ *     CMD_CONDFALSE    false "#if.." code
+ *     CMD_EMPTYLINE    line is empty
+ *     CMD_INCLUDE      the line contains a #include directive
+ *     CMD_DEFINE       the line contains a #subst directive
+ *     CMD_IF           the line contains a #if/#else/#endif directive
+ *     CMD_DIRECTIVE    the line contains some other compiler directive
+ *
+ *  Global variables: iflevel, skiplevel, elsedone (altered)
+ *                    lptr      (altered)
+ */
+static int
+command(void)
+{
+   int                 tok, ret;
+   cell                val;
+   char               *str;
+   int                 idx;
+   cell                code_index;
+
+   while (*lptr <= ' ' && *lptr != '\0')
+      lptr += 1;
+   if (*lptr == '\0')
+      return CMD_EMPTYLINE;	/* empty line */
+   if (*lptr != '#')
+      return skiplevel > 0 ? CMD_CONDFALSE : CMD_NONE;	/* it is not a compiler directive */
+   /* compiler directive found */
+   indent_nowarn = TRUE;	/* allow loose indentation" */
+   lexclr(FALSE);		/* clear any "pushed" tokens */
+   /* on a pending expression, force to return a silent ';' token and force to
+    * re-read the line
+    */
+   if (!sc_needsemicolon && stgget(&idx, &code_index))
+     {
+	lptr = term_expr;
+	return CMD_TERM;
+     }				/* if */
+   tok = lex(&val, &str);
+   ret = skiplevel > 0 ? CMD_CONDFALSE : CMD_DIRECTIVE;	/* preset 'ret' to CMD_DIRECTIVE (most common case) */
+   switch (tok)
+     {
+     case tpIF:		/* conditional compilation */
+	ret = CMD_IF;
+	iflevel += 1;
+	if (skiplevel)
+	   break;		/* break out of switch */
+	preproc_expr(&val, NULL);	/* get value (or 0 on error) */
+	if (!val)
+	   skiplevel = iflevel;
+	check_empty(lptr);
+	break;
+     case tpELSE:
+	ret = CMD_IF;
+	if (iflevel == 0 && skiplevel == 0)
+	  {
+	     error(26);		/* no matching #if */
+	     errorset(sRESET);
+	  }
+	else
+	  {
+	     if (elsedone == iflevel)
+		error(60);	/* multiple #else directives between #if ... #endif */
+	     elsedone = iflevel;
+	     if (skiplevel == iflevel)
+		skiplevel = 0;
+	     else if (skiplevel == 0)
+		skiplevel = iflevel;
+	  }			/* if */
+	check_empty(lptr);
+	break;
+#if 0				/* ??? *really* need to use a stack here */
+     case tpELSEIF:
+	ret = CMD_IF;
+	if (iflevel == 0 && skiplevel == 0)
+	  {
+	     error(26);		/* no matching #if */
+	     errorset(sRESET);
+	  }
+	else if (elsedone == iflevel)
+	  {
+	     error(61);		/* #elseif directive may not follow an #else */
+	     errorset(sRESET);
+	  }
+	else
+	  {
+	     preproc_expr(&val, NULL);	/* get value (or 0 on error) */
+	     if (skiplevel == 0)
+		skiplevel = iflevel;	/* we weren't skipping, start skipping now */
+	     else if (val)
+		skiplevel = 0;	/* we were skipping, condition is valid -> stop skipping */
+	     /* else: we were skipping and condition is invalid -> keep skipping */
+	     check_empty(lptr);
+	  }			/* if */
+	break;
+#endif
+     case tpENDIF:
+	ret = CMD_IF;
+	if (iflevel == 0 && skiplevel == 0)
+	  {
+	     error(26);
+	     errorset(sRESET);
+	  }
+	else
+	  {
+	     if (skiplevel == iflevel)
+		skiplevel = 0;
+	     if (elsedone == iflevel)
+		elsedone = 0;	/* ??? actually, should build a stack of #if/#endif and keep
+				 * the state whether an #else was seen per nesting level */
+	     iflevel -= 1;
+	  }			/* if */
+	check_empty(lptr);
+	break;
+     case tINCLUDE:		/* #include directive */
+	ret = CMD_INCLUDE;
+	if (skiplevel == 0)
+	   doinclude();
+	break;
+     case tpFILE:
+	if (skiplevel == 0)
+	  {
+	     char                pathname[PATH_MAX];
+
+	     lptr = getstring(pathname, sizeof pathname);
+	     if (pathname[0] != '\0')
+	       {
+		  free(inpfname);
+		  inpfname = strdup(pathname);
+		  if (!inpfname)
+		     error(103);	/* insufficient memory */
+	       }		/* if */
+	  }			/* if */
+	check_empty(lptr);
+	break;
+     case tpLINE:
+	if (skiplevel == 0)
+	  {
+	     if (lex(&val, &str) != tNUMBER)
+		error(8);	/* invalid/non-constant expression */
+	     fline = (int)val;
+
+	     while (*lptr == ' ' && *lptr != '\0')
+	        lptr++;			/* skip whitespace */
+	     if (*lptr == '"')
+               {
+		  char pathname[PATH_MAX];
+
+		  lptr = getstring(pathname, sizeof pathname);
+		  if (pathname[0] != '\0')
+		    {
+		       free(inpfname);
+		       inpfname = strdup(pathname);
+		       if (!inpfname)
+		          error(103);	/* insufficient memory */
+		    }		/* if */
+	       }
+	  }			/* if */
+	check_empty(lptr);
+	break;
+     case tpASSERT:
+	if (skiplevel == 0 && (sc_debug & sCHKBOUNDS) != 0)
+	  {
+	     preproc_expr(&val, NULL);	/* get constant expression (or 0 on error) */
+	     if (!val)
+		error(7);	/* assertion failed */
+	     check_empty(lptr);
+	  }			/* if */
+	break;
+     case tpPRAGMA:
+	if (skiplevel == 0)
+	  {
+	     if (lex(&val, &str) == tSYMBOL)
+	       {
+		  if (strcmp(str, "ctrlchar") == 0)
+		    {
+		       if (lex(&val, &str) != tNUMBER)
+			  error(27);	/* invalid character constant */
+		       sc_ctrlchar = (char)val;
+		    }
+		  else if (strcmp(str, "compress") == 0)
+		    {
+		       cell                val;
+
+		       preproc_expr(&val, NULL);
+		       sc_compress = (int)val;	/* switch code packing on/off */
+		    }
+		  else if (strcmp(str, "dynamic") == 0)
+		    {
+		       preproc_expr(&sc_stksize, NULL);
+		    }
+		  else if (strcmp(str, "library") == 0)
+		    {
+		       char                name[sNAMEMAX + 1];
+
+		       while (*lptr <= ' ' && *lptr != '\0')
+			  lptr++;
+		       if (*lptr == '"')
+			 {
+			    lptr = getstring(name, sizeof name);
+			 }
+		       else
+			 {
+			    int                 i;
+
+			    for (i = 0; 
+                                 (i < (int)(sizeof(name))) && 
+                                 (alphanum(*lptr));
+				 i++, lptr++)
+			       name[i] = *lptr;
+			    name[i] = '\0';
+			 }	/* if */
+		       if (name[0] == '\0')
+			 {
+			    curlibrary = NULL;
+			 }
+		       else
+			 {
+			    if (strlen(name) > sEXPMAX)
+			       error(220, name, sEXPMAX);	/* exported symbol is truncated */
+			    /* add the name if it does not yet exist in the table */
+			    if (!find_constval(&libname_tab, name, 0))
+			       curlibrary =
+				  append_constval(&libname_tab, name, 0, 0);
+			 }	/* if */
+		    }
+		  else if (strcmp(str, "pack") == 0)
+		    {
+		       cell                val;
+
+		       preproc_expr(&val, NULL);	/* default = packed/unpacked */
+		       sc_packstr = (int)val;
+		    }
+		  else if (strcmp(str, "rational") == 0)
+		    {
+		       char                name[sNAMEMAX + 1];
+		       cell                digits = 0;
+		       int                 i;
+
+		       /* first gather all information, start with the tag name */
+		       while ((*lptr <= ' ') && (*lptr != '\0'))
+			  lptr++;
+		       for (i = 0; 
+                            (i < (int)(sizeof(name))) && 
+                            (alphanum(*lptr));
+			    i++, lptr++)
+			  name[i] = *lptr;
+		       name[i] = '\0';
+		       /* then the precision (for fixed point arithmetic) */
+		       while (*lptr <= ' ' && *lptr != '\0')
+			  lptr++;
+		       if (*lptr == '(')
+			 {
+			    preproc_expr(&digits, NULL);
+			    if (digits <= 0 || digits > 9)
+			      {
+				 error(68);	/* invalid rational number precision */
+				 digits = 0;
+			      }	/* if */
+			    if (*lptr == ')')
+			       lptr++;
+			 }	/* if */
+		       /* add the tag (make it public) and check the values */
+		       i = sc_addtag(name);
+		       exporttag(i);
+		       if (sc_rationaltag == 0
+			   || (sc_rationaltag == i
+			       && rational_digits == (int)digits))
+			 {
+			    sc_rationaltag = i;
+			    rational_digits = (int)digits;
+			 }
+		       else
+			 {
+			    error(69);	/* rational number format already set, can only be set once */
+			 }	/* if */
+		    }
+		  else if (strcmp(str, "semicolon") == 0)
+		    {
+		       cell                val;
+
+		       preproc_expr(&val, NULL);
+		       sc_needsemicolon = (int)val;
+		    }
+		  else if (strcmp(str, "tabsize") == 0)
+		    {
+		       cell                val;
+
+		       preproc_expr(&val, NULL);
+		       sc_tabsize = (int)val;
+		    }
+		  else if (strcmp(str, "align") == 0)
+		    {
+		       sc_alignnext = TRUE;
+		    }
+		  else if (strcmp(str, "unused") == 0)
+		    {
+		       char                name[sNAMEMAX + 1];
+		       int                 i, comma;
+		       symbol             *sym;
+
+		       do
+			 {
+			    /* get the name */
+			    while ((*lptr <= ' ') && (*lptr != '\0'))
+			       lptr++;
+			    for (i = 0; 
+                                 (i < (int)(sizeof(name))) && 
+                                 (isalpha(*lptr));
+				 i++, lptr++)
+			       name[i] = *lptr;
+			    name[i] = '\0';
+			    /* get the symbol */
+			    sym = findloc(name);
+			    if (!sym)
+			       sym = findglb(name);
+			    if (sym)
+			      {
+				 sym->usage |= uREAD;
+				 if (sym->ident == iVARIABLE
+				     || sym->ident == iREFERENCE
+				     || sym->ident == iARRAY
+				     || sym->ident == iREFARRAY)
+				    sym->usage |= uWRITTEN;
+			      }
+			    else
+			      {
+				 error(17, name);	/* undefined symbol */
+			      }	/* if */
+			    /* see if a comma follows the name */
+			    while (*lptr <= ' ' && *lptr != '\0')
+			       lptr++;
+			    comma = (*lptr == ',');
+			    if (comma)
+			       lptr++;
+			 }
+		       while (comma);
+		    }
+		  else
+		    {
+		       error(207);	/* unknown #pragma */
+		    }		/* if */
+	       }
+	     else
+	       {
+		  error(207);	/* unknown #pragma */
+	       }		/* if */
+	     check_empty(lptr);
+	  }			/* if */
+	break;
+     case tpENDINPUT:
+     case tpENDSCRPT:
+	if (skiplevel == 0)
+	  {
+	     check_empty(lptr);
+	     assert(inpf != NULL);
+	     if (inpf != inpf_org)
+		sc_closesrc(inpf);
+	     inpf = NULL;
+	  }			/* if */
+	break;
+#if !defined NOEMIT
+     case tpEMIT:
+	{
+	   /* write opcode to output file */
+	   char                name[40];
+	   int                 i;
+
+	   while (*lptr <= ' ' && *lptr != '\0')
+	      lptr++;
+	   for (i = 0; i < 40 && (isalpha(*lptr) || *lptr == '.'); i++, lptr++)
+	      name[i] = (char)tolower(*lptr);
+	   name[i] = '\0';
+	   stgwrite("\t");
+	   stgwrite(name);
+	   stgwrite(" ");
+	   code_idx += opcodes(1);
+	   /* write parameter (if any) */
+	   while (*lptr <= ' ' && *lptr != '\0')
+	      lptr++;
+	   if (*lptr != '\0')
+	     {
+		symbol             *sym;
+
+		tok = lex(&val, &str);
+		switch (tok)
+		  {
+		  case tNUMBER:
+		  case tRATIONAL:
+		     outval(val, FALSE);
+		     code_idx += opargs(1);
+		     break;
+		  case tSYMBOL:
+		     sym = findloc(str);
+		     if (!sym)
+			sym = findglb(str);
+		     if (!sym || (sym->ident != iFUNCTN
+			 && sym->ident != iREFFUNC
+			 && (sym->usage & uDEFINE) == 0))
+		       {
+			  error(17, str);	/* undefined symbol */
+		       }
+		     else
+		       {
+			  outval(sym->addr, FALSE);
+			  /* mark symbol as "used", unknown whether for read or write */
+			  markusage(sym, uREAD | uWRITTEN);
+			  code_idx += opargs(1);
+		       }	/* if */
+		     break;
+		  default:
+		     {
+			char                s2[20];
+			extern char        *sc_tokens[];	/* forward declaration */
+
+			if (tok < 256)
+			   sprintf(s2, "%c", (char)tok);
+			else
+			   strcpy(s2, sc_tokens[tok - tFIRST]);
+			error(1, sc_tokens[tSYMBOL - tFIRST], s2);
+			break;
+		     }		/* case */
+		  }		/* switch */
+	     }			/* if */
+	   stgwrite("\n");
+	   check_empty(lptr);
+	   break;
+	}			/* case */
+#endif
+#if !defined NO_DEFINE
+     case tpDEFINE:
+	{
+	   ret = CMD_DEFINE;
+	   if (skiplevel == 0)
+	     {
+		char               *pattern, *substitution;
+		char               *start, *end;
+		int                 count, prefixlen;
+		stringpair         *def;
+
+		/* find the pattern to match */
+		while (*lptr <= ' ' && *lptr != '\0')
+		   lptr++;
+		start = lptr;	/* save starting point of the match pattern */
+		count = 0;
+		while (*lptr > ' ' && *lptr != '\0')
+		  {
+		     litchar(&lptr, FALSE);	/* litchar() advances "lptr" and handles escape characters */
+		     count++;
+		  }		/* while */
+		end = lptr;
+		/* check pattern to match */
+		if (!isalpha(*start) && *start != '_')
+		  {
+		     error(74);	/* pattern must start with an alphabetic character */
+		     break;
+		  }		/* if */
+		/* store matched pattern */
+		pattern = malloc(count + 1);
+		if (!pattern)
+		   error(103);	/* insufficient memory */
+		lptr = start;
+		count = 0;
+		while (lptr != end)
+		  {
+		     assert(lptr < end);
+		     assert(*lptr != '\0');
+		     pattern[count++] = (char)litchar(&lptr, FALSE);
+		  }		/* while */
+		pattern[count] = '\0';
+		/* special case, erase trailing variable, because it could match anything */
+		if (count >= 2 && isdigit(pattern[count - 1])
+		    && pattern[count - 2] == '%')
+		   pattern[count - 2] = '\0';
+		/* find substitution string */
+		while (*lptr <= ' ' && *lptr != '\0')
+		   lptr++;
+		start = lptr;	/* save starting point of the match pattern */
+		count = 0;
+		end = NULL;
+		while (*lptr != '\0')
+		  {
+		     /* keep position of the start of trailing whitespace */
+		     if (*lptr <= ' ')
+		       {
+			  if (!end)
+			     end = lptr;
+		       }
+		     else
+		       {
+			  end = NULL;
+		       }	/* if */
+		     count++;
+		     lptr++;
+		  }		/* while */
+		if (!end)
+		   end = lptr;
+		/* store matched substitution */
+		substitution = malloc(count + 1);	/* +1 for '\0' */
+		if (!substitution)
+		   error(103);	/* insufficient memory */
+		lptr = start;
+		count = 0;
+		while (lptr != end)
+		  {
+		     assert(lptr < end);
+		     assert(*lptr != '\0');
+		     substitution[count++] = *lptr++;
+		  }		/* while */
+		substitution[count] = '\0';
+		/* check whether the definition already exists */
+		for (prefixlen = 0, start = pattern;
+		     isalpha(*start) || isdigit(*start) || *start == '_';
+		     prefixlen++, start++)
+		   /* nothing */ ;
+		assert(prefixlen > 0);
+		if ((def = find_subst(pattern, prefixlen)))
+		  {
+		     if (strcmp(def->first, pattern) != 0
+			 || strcmp(def->second, substitution) != 0)
+			error(201, pattern);	/* redefinition of macro (non-identical) */
+		     delete_subst(pattern, prefixlen);
+		  }		/* if */
+		/* add the pattern/substitution pair to the list */
+		assert(pattern[0] != '\0');
+		insert_subst(pattern, substitution, prefixlen);
+		free(pattern);
+		free(substitution);
+	     }			/* if */
+	   break;
+	}			/* case */
+     case tpUNDEF:
+	if (skiplevel == 0)
+	  {
+	     if (lex(&val, &str) == tSYMBOL)
+	       {
+		  if (!delete_subst(str, strlen(str)))
+		     error(17, str);	/* undefined symbol */
+	       }
+	     else
+	       {
+		  error(20, str);	/* invalid symbol name */
+	       }		/* if */
+	     check_empty(lptr);
+	  }			/* if */
+	break;
+#endif
+     default:
+	error(31);		/* unknown compiler directive */
+	ret = skiplevel > 0 ? CMD_DIRECTIVE : CMD_NONE;	/* line must be processed (if skiplevel==0) */
+     }				/* switch */
+   return ret;
+}
+
+#if !defined NO_DEFINE
+static int
+is_startstring(char *string)
+{
+   if (*string == '\"' || *string == '\'')
+      return TRUE;		/* "..." */
+
+   if (*string == '!')
+     {
+	string++;
+	if (*string == '\"' || *string == '\'')
+	   return TRUE;		/* !"..." */
+	if (*string == sc_ctrlchar)
+	  {
+	     string++;
+	     if (*string == '\"' || *string == '\'')
+		return TRUE;	/* !\"..." */
+	  }			/* if */
+     }
+   else if (*string == sc_ctrlchar)
+     {
+	string++;
+	if (*string == '\"' || *string == '\'')
+	   return TRUE;		/* \"..." */
+	if (*string == '!')
+	  {
+	     string++;
+	     if (*string == '\"' || *string == '\'')
+		return TRUE;	/* \!"..." */
+	  }			/* if */
+     }				/* if */
+
+   return FALSE;
+}
+
+static char        *
+skipstring(char *string)
+{
+   char                endquote;
+   int                 rawstring = FALSE;
+
+   while (*string == '!' || *string == sc_ctrlchar)
+     {
+	rawstring = (*string == sc_ctrlchar);
+	string++;
+     }				/* while */
+
+   endquote = *string;
+   assert(endquote == '\"' || endquote == '\'');
+   string++;			/* skip open quote */
+   while (*string != endquote && *string != '\0')
+      litchar(&string, rawstring);
+   return string;
+}
+
+static char        *
+skippgroup(char *string)
+{
+   int                 nest = 0;
+   char                open = *string;
+   char                close;
+
+   switch (open)
+     {
+     case '(':
+	close = ')';
+	break;
+     case '{':
+	close = '}';
+	break;
+     case '[':
+	close = ']';
+	break;
+     case '<':
+	close = '>';
+	break;
+     default:
+	assert(0);
+	close = '\0';		/* only to avoid a compiler warning */
+     }				/* switch */
+
+   string++;
+   while (*string != close || nest > 0)
+     {
+	if (*string == open)
+	   nest++;
+	else if (*string == close)
+	   nest--;
+	else if (is_startstring(string))
+	   string = skipstring(string);
+	if (*string == '\0')
+	   break;
+	string++;
+     }				/* while */
+   return string;
+}
+
+static char        *
+strdel(char *str, size_t len)
+{
+   size_t              length = strlen(str);
+
+   if (len > length)
+      len = length;
+   memmove(str, str + len, length - len + 1);	/* include EOS byte */
+   return str;
+}
+
+static char        *
+strins(char *dest, char *src, size_t srclen)
+{
+   size_t              destlen = strlen(dest);
+
+   assert(srclen <= strlen(src));
+   memmove(dest + srclen, dest, destlen + 1);	/* include EOS byte */
+   memcpy(dest, src, srclen);
+   return dest;
+}
+
+static int
+substpattern(char *line, size_t buffersize, char *pattern, char *substitution)
+{
+   int                 prefixlen;
+   char               *p, *s, *e, *args[10];
+   int                 match, arg, len;
+
+   memset(args, 0, sizeof args);
+
+   /* check the length of the prefix */
+   for (prefixlen = 0, s = pattern; isalpha(*s) || isdigit(*s) || *s == '_';
+	prefixlen++, s++)
+      /* nothing */ ;
+   assert(prefixlen > 0);
+   assert(strncmp(line, pattern, prefixlen) == 0);
+
+   /* pattern prefix matches; match the rest of the pattern, gather
+    * the parameters
+    */
+   s = line + prefixlen;
+   p = pattern + prefixlen;
+   match = TRUE;		/* so far, pattern matches */
+   while (match && *s != '\0' && *p != '\0')
+     {
+	if (*p == '%')
+	  {
+	     p++;		/* skip '%' */
+	     if (isdigit(*p))
+	       {
+		  arg = *p - '0';
+		  assert(arg >= 0 && arg <= 9);
+		  p++;		/* skip parameter id */
+		  assert(*p != '\0');
+		  /* match the source string up to the character after the digit
+		   * (skipping strings in the process
+		   */
+		  e = s;
+		  while (*e != *p && *e != '\0' && *e != '\n')
+		    {
+		       if (is_startstring(e))	/* skip strings */
+			  e = skipstring(e);
+		       else if (strchr("({[", *e))	/* skip parenthized groups */
+			  e = skippgroup(e);
+		       if (*e != '\0')
+			  e++;	/* skip non-alphapetic character (or closing quote of
+				 * a string, or the closing paranthese of a group) */
+		    }		/* while */
+		  /* store the parameter (overrule any earlier) */
+		  if (args[arg])
+		     free(args[arg]);
+		  len = (int)(e - s);
+		  args[arg] = malloc(len + 1);
+		  if (!args[arg])
+		     error(103);	/* insufficient memory */
+		  strncpy(args[arg], s, len);
+		  args[arg][len] = '\0';
+		  /* character behind the pattern was matched too */
+		  if (*e == *p)
+		    {
+		       s = e + 1;
+		    }
+		  else if (*e == '\n' && *p == ';' && *(p + 1) == '\0'
+			   && !sc_needsemicolon)
+		    {
+		       s = e;	/* allow a trailing ; in the pattern match to end of line */
+		    }
+		  else
+		    {
+		       assert(*e == '\0' || *e == '\n');
+		       match = FALSE;
+		       s = e;
+		    }		/* if */
+		  p++;
+	       }
+	     else
+	       {
+		  match = FALSE;
+	       }		/* if */
+	  }
+	else if (*p == ';' && *(p + 1) == '\0' && !sc_needsemicolon)
+	  {
+	     /* source may be ';' or end of the line */
+	     while (*s <= ' ' && *s != '\0')
+		s++;		/* skip white space */
+	     if (*s != ';' && *s != '\0')
+		match = FALSE;
+	     p++;		/* skip the semicolon in the pattern */
+	  }
+	else
+	  {
+	     cell                ch;
+
+	     /* skip whitespace between two non-alphanumeric characters, except
+	      * for two identical symbols
+	      */
+	     assert(p > pattern);
+	     if (!alphanum(*p) && *(p - 1) != *p)
+		while (*s <= ' ' && *s != '\0')
+		   s++;		/* skip white space */
+	     ch = litchar(&p, FALSE);	/* this increments "p" */
+	     if (*s != ch)
+		match = FALSE;
+	     else
+		s++;		/* this character matches */
+	  }			/* if */
+     }				/* while */
+
+   if (match && *p == '\0')
+     {
+	/* if the last character to match is an alphanumeric character, the
+	 * current character in the source may not be alphanumeric
+	 */
+	assert(p > pattern);
+	if (alphanum(*(p - 1)) && alphanum(*s))
+	   match = FALSE;
+     }				/* if */
+
+   if (match)
+     {
+	/* calculate the length of the substituted string */
+	for (e = substitution, len = 0; *e != '\0'; e++)
+	  {
+	     if (*e == '%' && isdigit(*(e + 1)))
+	       {
+		  arg = *(e + 1) - '0';
+		  assert(arg >= 0 && arg <= 9);
+		  if (args[arg])
+		     len += strlen(args[arg]);
+		  e++;		/* skip %, digit is skipped later */
+	       }
+	     else
+	       {
+		  len++;
+	       }		/* if */
+	  }			/* for */
+	/* check length of the string after substitution */
+	if (strlen(line) + len - (int)(s - line) > buffersize)
+	  {
+	     error(75);		/* line too long */
+	  }
+	else
+	  {
+	     /* substitute pattern */
+	     strdel(line, (int)(s - line));
+	     for (e = substitution, s = line; *e != '\0'; e++)
+	       {
+		  if (*e == '%' && isdigit(*(e + 1)))
+		    {
+		       arg = *(e + 1) - '0';
+		       assert(arg >= 0 && arg <= 9);
+		       if (args[arg])
+			 {
+			    strins(s, args[arg], strlen(args[arg]));
+			    s += strlen(args[arg]);
+			 }	/* if */
+		       e++;	/* skip %, digit is skipped later */
+		    }
+		  else
+		    {
+		       strins(s, e, 1);
+		       s++;
+		    }		/* if */
+	       }		/* for */
+	  }			/* if */
+     }				/* if */
+
+   for (arg = 0; arg < 10; arg++)
+      if (args[arg])
+	 free(args[arg]);
+
+   return match;
+}
+
+static void
+substallpatterns(char *line, int buffersize)
+{
+   char               *start, *end;
+   int                 prefixlen;
+   stringpair         *subst;
+
+   start = line;
+   while (*start != '\0')
+     {
+	/* find the start of a prefix (skip all non-alphabetic characters),
+	 * also skip strings
+	 */
+	while (!isalpha(*start) && *start != '_' && *start != '\0')
+	  {
+	     /* skip strings */
+	     if (is_startstring(start))
+	       {
+		  start = skipstring(start);
+		  if (*start == '\0')
+		     break;	/* abort loop on error */
+	       }		/* if */
+	     start++;		/* skip non-alphapetic character (or closing quote of a string) */
+	  }			/* while */
+	if (*start == '\0')
+	   break;		/* abort loop on error */
+	/* get the prefix (length), look for a matching definition */
+	prefixlen = 0;
+	end = start;
+	while (isalpha(*end) || isdigit(*end) || *end == '_')
+	  {
+	     prefixlen++;
+	     end++;
+	  }			/* while */
+	assert(prefixlen > 0);
+	subst = find_subst(start, prefixlen);
+	if (subst)
+	  {
+	     /* properly match the pattern and substitute */
+	     if (!substpattern
+		 (start, buffersize - (start - line), subst->first,
+		  subst->second))
+		start = end;	/* match failed, skip this prefix */
+	     /* match succeeded: do not update "start", because the substitution text
+	      * may be matched by other macros
+	      */
+	  }
+	else
+	  {
+	     start = end;	/* no macro with this prefix, skip this prefix */
+	  }			/* if */
+     }				/* while */
+}
+#endif
+
+/*  preprocess
+ *
+ *  Reads a line by readline() into "pline" and performs basic preprocessing:
+ *  deleting comments, skipping lines with false "#if.." code and recognizing
+ *  other compiler directives. There is an indirect recursion: lex() calls
+ *  preprocess() if a new line must be read, preprocess() calls command(),
+ *  which at his turn calls lex() to identify the token.
+ *
+ *  Global references: lptr     (altered)
+ *                     pline    (altered)
+ *                     freading (referred to only)
+ */
+void
+preprocess(void)
+{
+   int                 iscommand;
+
+   if (!freading)
+      return;
+   do
+     {
+	readline(pline);
+	stripcom(pline);	/* ??? no need for this when reading back from list file (in the second pass) */
+	lptr = pline;		/* set "line pointer" to start of the parsing buffer */
+	iscommand = command();
+	if (iscommand != CMD_NONE)
+	   errorset(sRESET);	/* reset error flag ("panic mode") on empty line or directive */
+#if !defined NO_DEFINE
+	if (iscommand == CMD_NONE)
+	  {
+	     assert(lptr != term_expr);
+	     substallpatterns(pline, sLINEMAX);
+	     lptr = pline;	/* reset "line pointer" to start of the parsing buffer */
+	  }			/* if */
+#endif
+     }
+   while (iscommand != CMD_NONE && iscommand != CMD_TERM && freading);	/* enddo */
+}
+
+static char        *
+unpackedstring(char *lptr, int rawstring)
+{
+   while (*lptr != '\0')
+     {
+	/* check for doublequotes indicating the end of the string */
+	if (*lptr == '\"')
+	{
+	   /* check whether there's another pair of quotes following.
+	    * If so, paste the two strings together, thus
+	    * "pants""off" becomes "pantsoff"
+	    */
+	   if (*(lptr + 1) == '\"')
+	      lptr += 2;
+	   else
+	      break;
+	}
+
+	if (*lptr == '\a')
+	  {			/* ignore '\a' (which was inserted at a line concatenation) */
+	     lptr++;
+	     continue;
+	  }			/* if */
+	stowlit(litchar(&lptr, rawstring));	/* litchar() alters "lptr" */
+     }				/* while */
+   stowlit(0);			/* terminate string */
+   return lptr;
+}
+
+static char        *
+packedstring(char *lptr, int rawstring)
+{
+   int                 i;
+   ucell               val, c;
+
+   i = sizeof(ucell) - (charbits / 8);	/* start at most significant byte */
+   val = 0;
+   while (*lptr != '\0')
+     {
+	/* check for doublequotes indicating the end of the string */
+	if (*lptr == '\"')
+	{
+	   /* check whether there's another pair of quotes following.
+	    * If so, paste the two strings together, thus
+	    * "pants""off" becomes "pantsoff"
+	    */
+	   if (*(lptr + 1) == '\"')
+	      lptr += 2;
+	   else
+	      break;
+	}
+
+	if (*lptr == '\a')
+	  {			/* ignore '\a' (which was inserted at a line concatenation) */
+	     lptr++;
+	     continue;
+	  }			/* if */
+	c = litchar(&lptr, rawstring);	/* litchar() alters "lptr" */
+	if (c >= (ucell) (1 << charbits))
+	   error(43);		/* character constant exceeds range */
+	val |= (c << 8 * i);
+	if (i == 0)
+	  {
+	     stowlit(val);
+	     val = 0;
+	  }			/* if */
+	i = (i + sizeof(ucell) - (charbits / 8)) % sizeof(ucell);
+     }				/* if */
+   /* save last code; make sure there is at least one terminating zero character */
+   if (i != (int)(sizeof(ucell) - (charbits / 8)))
+      stowlit(val);		/* at least one zero character in "val" */
+   else
+      stowlit(0);		/* add full cell of zeros */
+   return lptr;
+}
+
+/*  lex(lexvalue,lexsym)        Lexical Analysis
+ *
+ *  lex() first deletes leading white space, then checks for multi-character
+ *  operators, keywords (including most compiler directives), numbers,
+ *  labels, symbols and literals (literal characters are converted to a number
+ *  and are returned as such). If every check fails, the line must contain
+ *  a single-character operator. So, lex() returns this character. In the other
+ *  case (something did match), lex() returns the number of the token. All
+ *  these tokens have been assigned numbers above 255.
+ *
+ *  Some tokens have "attributes":
+ *     tNUMBER        the value of the number is return in "lexvalue".
+ *     tRATIONAL      the value is in IEEE 754 encoding or in fixed point
+ *                    encoding in "lexvalue".
+ *     tSYMBOL        the first sNAMEMAX characters of the symbol are
+ *                    stored in a buffer, a pointer to this buffer is
+ *                    returned in "lexsym".
+ *     tLABEL         the first sNAMEMAX characters of the label are
+ *                    stored in a buffer, a pointer to this buffer is
+ *                    returned in "lexsym".
+ *     tSTRING        the string is stored in the literal pool, the index
+ *                    in the literal pool to this string is stored in
+ *                    "lexvalue".
+ *
+ *  lex() stores all information (the token found and possibly its attribute)
+ *  in global variables. This allows a token to be examined twice. If "_pushed"
+ *  is true, this information is returned.
+ *
+ *  Global references: lptr          (altered)
+ *                     fline         (referred to only)
+ *                     litidx        (referred to only)
+ *                     _lextok, _lexval, _lexstr
+ *                     _pushed
+ */
+
+static int          _pushed;
+static int          _lextok;
+static cell         _lexval;
+static char         _lexstr[sLINEMAX + 1];
+static int          _lexnewline;
+
+void
+lexinit(void)
+{
+   stkidx = 0;			/* index for pushstk() and popstk() */
+   iflevel = 0;			/* preprocessor: nesting of "#if" */
+   skiplevel = 0;		/* preprocessor: skipping lines or compiling lines */
+   icomment = FALSE;		/* currently not in a multiline comment */
+   _pushed = FALSE;		/* no token pushed back into lex */
+   _lexnewline = FALSE;
+}
+
+char               *sc_tokens[] = {
+   "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
+   "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
+   "...", "..",
+   "assert", "break", "case", "char", "const", "continue", "default",
+   "defined", "do", "else", "enum", "exit", "for", "forward", "goto",
+   "if", "native", "new", "operator", "public", "return", "sizeof",
+   "sleep", "static", "stock", "switch", "tagof", "while",
+   "#assert", "#define", "#else", "#emit", "#endif", "#endinput",
+   "#endscript", "#file", "#if", "#include", "#line", "#pragma", "#undef",
+   ";", ";", "-integer value-", "-rational value-", "-identifier-",
+   "-label-", "-string-"
+};
+
+int
+lex(cell * lexvalue, char **lexsym)
+{
+   int                 i, toolong, newline, rawstring;
+   char              **tokptr;
+
+   if (_pushed)
+     {
+	_pushed = FALSE;	/* reset "_pushed" flag */
+	*lexvalue = _lexval;
+	*lexsym = _lexstr;
+	return _lextok;
+     }				/* if */
+
+   _lextok = 0;			/* preset all values */
+   _lexval = 0;
+   _lexstr[0] = '\0';
+   *lexvalue = _lexval;
+   *lexsym = _lexstr;
+   _lexnewline = FALSE;
+   if (!freading)
+      return 0;
+
+   newline = (lptr == pline);	/* does lptr point to start of line buffer */
+   while (*lptr <= ' ')
+     {				/* delete leading white space */
+	if (*lptr == '\0')
+	  {
+	     preprocess();	/* preprocess resets "lptr" */
+	     if (!freading)
+		return 0;
+	     if (lptr == term_expr)	/* special sequence to terminate a pending expression */
+		return (_lextok = tENDEXPR);
+	     _lexnewline = TRUE;	/* set this after preprocess(), because
+					 * preprocess() calls lex() recursively */
+	     newline = TRUE;
+	  }
+	else
+	  {
+	     lptr += 1;
+	  }			/* if */
+     }				/* while */
+   if (newline)
+     {
+	stmtindent = 0;
+	for (i = 0; i < (int)(lptr - pline); i++)
+	   if (pline[i] == '\t' && sc_tabsize > 0)
+	      stmtindent +=
+		 (int)(sc_tabsize - (stmtindent + sc_tabsize) % sc_tabsize);
+	   else
+	      stmtindent++;
+     }				/* if */
+
+   i = tFIRST;
+   tokptr = sc_tokens;
+   while (i <= tMIDDLE)
+     {				/* match multi-character operators */
+	if (match(*tokptr, FALSE))
+	  {
+	     _lextok = i;
+	     return _lextok;
+	  }			/* if */
+	i += 1;
+	tokptr += 1;
+     }				/* while */
+   while (i <= tLAST)
+     {				/* match reserved words and compiler directives */
+	if (match(*tokptr, TRUE))
+	  {
+	     _lextok = i;
+	     errorset(sRESET);	/* reset error flag (clear the "panic mode") */
+	     return _lextok;
+	  }			/* if */
+	i += 1;
+	tokptr += 1;
+     }				/* while */
+
+   if ((i = number(&_lexval, lptr)) != 0)
+     {				/* number */
+	_lextok = tNUMBER;
+	*lexvalue = _lexval;
+	lptr += i;
+     }
+   else if ((i = ftoi(&_lexval, lptr)) != 0)
+     {
+	_lextok = tRATIONAL;
+	*lexvalue = _lexval;
+	lptr += i;
+     }
+   else if (alpha(*lptr))
+     {				/* symbol or label */
+	/*  Note: only sNAMEMAX characters are significant. The compiler
+	 *        generates a warning if a symbol exceeds this length.
+	 */
+	_lextok = tSYMBOL;
+	i = 0;
+	toolong = 0;
+	while (alphanum(*lptr))
+	  {
+	     _lexstr[i] = *lptr;
+	     lptr += 1;
+	     if (i < sNAMEMAX)
+		i += 1;
+	     else
+		toolong = 1;
+	  }			/* while */
+	_lexstr[i] = '\0';
+	if (toolong)
+	   error(200, _lexstr, sNAMEMAX);	/* symbol too long, truncated to sNAMEMAX chars */
+	if (_lexstr[0] == PUBLIC_CHAR && _lexstr[1] == '\0')
+	  {
+	     _lextok = PUBLIC_CHAR;	/* '@' all alone is not a symbol, it is an operator */
+	  }
+	else if (_lexstr[0] == '_' && _lexstr[1] == '\0')
+	  {
+	     _lextok = '_';	/* '_' by itself is not a symbol, it is a placeholder */
+	  }			/* if */
+	if (*lptr == ':' && sc_allowtags && _lextok != PUBLIC_CHAR)
+	  {
+	     _lextok = tLABEL;	/* it wasn't a normal symbol, it was a label/tagname */
+	     lptr += 1;		/* skip colon */
+	  }			/* if */
+     }
+   else if (*lptr == '\"' || (*lptr == sc_ctrlchar && *(lptr + 1) == '\"'))
+     {				/* unpacked string literal */
+	_lextok = tSTRING;
+	rawstring = (*lptr == sc_ctrlchar);
+	*lexvalue = _lexval = litidx;
+	lptr += 1;		/* skip double quote */
+	if (rawstring)
+	   lptr += 1;		/* skip "escape" character too */
+	lptr =
+	   sc_packstr ? packedstring(lptr, rawstring) : unpackedstring(lptr,
+								       rawstring);
+	if (*lptr == '\"')
+	   lptr += 1;		/* skip final quote */
+	else
+	   error(37);		/* invalid (non-terminated) string */
+     }
+   else if ((*lptr == '!' && *(lptr + 1) == '\"')
+	    || (*lptr == '!' && *(lptr + 1) == sc_ctrlchar && *(lptr + 2) == '\"')
+	    || (*lptr == sc_ctrlchar && *(lptr + 1) == '!'
+	    && *(lptr + 2) == '\"'))
+     {				/* packed string literal */
+	_lextok = tSTRING;
+	rawstring = (*lptr == sc_ctrlchar || *(lptr + 1) == sc_ctrlchar);
+	*lexvalue = _lexval = litidx;
+	lptr += 2;		/* skip exclamation point and double quote */
+	if (rawstring)
+	   lptr += 1;		/* skip "escape" character too */
+	lptr =
+	   sc_packstr ? unpackedstring(lptr, rawstring) : packedstring(lptr,
+								       rawstring);
+	if (*lptr == '\"')
+	   lptr += 1;		/* skip final quote */
+	else
+	   error(37);		/* invalid (non-terminated) string */
+     }
+   else if (*lptr == '\'')
+     {				/* character literal */
+	lptr += 1;		/* skip quote */
+	_lextok = tNUMBER;
+	*lexvalue = _lexval = litchar(&lptr, FALSE);
+	if (*lptr == '\'')
+	   lptr += 1;		/* skip final quote */
+	else
+	   error(27);		/* invalid character constant (must be one character) */
+     }
+   else if (*lptr == ';')
+     {				/* semicolumn resets "error" flag */
+	_lextok = ';';
+	lptr += 1;
+	errorset(sRESET);	/* reset error flag (clear the "panic mode") */
+     }
+   else
+     {
+	_lextok = *lptr;	/* if every match fails, return the character */
+	lptr += 1;		/* increase the "lptr" pointer */
+     }				/* if */
+   return _lextok;
+}
+
+/*  lexpush
+ *
+ *  Pushes a token back, so the next call to lex() will return the token
+ *  last examined, instead of a new token.
+ *
+ *  Only one token can be pushed back.
+ *
+ *  In fact, lex() already stores the information it finds into global
+ *  variables, so all that is to be done is set a flag that informs lex()
+ *  to read and return the information from these variables, rather than
+ *  to read in a new token from the input file.
+ */
+void
+lexpush(void)
+{
+   assert(_pushed == FALSE);
+   _pushed = TRUE;
+}
+
+/*  lexclr
+ *
+ *  Sets the variable "_pushed" to 0 to make sure lex() will read in a new
+ *  symbol (a not continue with some old one). This is required upon return
+ *  from Assembler mode.
+ */
+void
+lexclr(int clreol)
+{
+   _pushed = FALSE;
+   if (clreol)
+     {
+	lptr = strchr(pline, '\0');
+	assert(lptr != NULL);
+     }				/* if */
+}
+
+/*  matchtoken
+ *
+ *  This routine is useful if only a simple check is needed. If the token
+ *  differs from the one expected, it is pushed back.
+ */
+int
+matchtoken(int token)
+{
+   cell                val;
+   char               *str;
+   int                 tok;
+
+   tok = lex(&val, &str);
+   if (tok == token || (token == tTERM && (tok == ';' || tok == tENDEXPR)))
+     {
+	return 1;
+     }
+   else if (!sc_needsemicolon && token == tTERM && (_lexnewline || !freading))
+     {
+	lexpush();		/* push "tok" back, we use the "hidden" newline token */
+	return 1;
+     }
+   else
+     {
+	lexpush();
+	return 0;
+     }				/* if */
+}
+
+/*  tokeninfo
+ *
+ *  Returns additional information of a token after using "matchtoken()"
+ *  or needtoken(). It does no harm using this routine after a call to
+ *  "lex()", but lex() already returns the same information.
+ *
+ *  The token itself is the return value. Normally, this one is already known.
+ */
+int
+tokeninfo(cell * val, char **str)
+{
+   /* if the token was pushed back, tokeninfo() returns the token and
+    * parameters of the *next* token, not of the *current* token.
+    */
+   assert(!_pushed);
+   *val = _lexval;
+   *str = _lexstr;
+   return _lextok;
+}
+
+/*  needtoken
+ *
+ *  This routine checks for a required token and gives an error message if
+ *  it isn't there (and returns FALSE in that case).
+ *
+ *  Global references: _lextok;
+ */
+int
+needtoken(int token)
+{
+   char                s1[20], s2[20];
+
+   if (matchtoken(token))
+     {
+	return TRUE;
+     }
+   else
+     {
+	/* token already pushed back */
+	assert(_pushed);
+	if (token < 256)
+	   sprintf(s1, "%c", (char)token);	/* single character token */
+	else
+	   strcpy(s1, sc_tokens[token - tFIRST]);	/* multi-character symbol */
+	if (!freading)
+	   strcpy(s2, "-end of file-");
+	else if (_lextok < 256)
+	   sprintf(s2, "%c", (char)_lextok);
+	else
+	   strcpy(s2, sc_tokens[_lextok - tFIRST]);
+	error(1, s1, s2);	/* expected ..., but found ... */
+	return FALSE;
+     }				/* if */
+}
+
+/*  match
+ *
+ *  Compares a series of characters from the input file with the characters
+ *  in "st" (that contains a token). If the token on the input file matches
+ *  "st", the input file pointer "lptr" is adjusted to point to the next
+ *  token, otherwise "lptr" remains unaltered.
+ *
+ *  If the parameter "end: is true, match() requires that the first character
+ *  behind the recognized token is non-alphanumeric.
+ *
+ *  Global references: lptr   (altered)
+ */
+static int
+match(char *st, int end)
+{
+   int                 k;
+   char               *ptr;
+
+   k = 0;
+   ptr = lptr;
+   while (st[k])
+     {
+	if (st[k] != *ptr)
+	   return 0;
+	k += 1;
+	ptr += 1;
+     }				/* while */
+   if (end)
+     {				/* symbol must terminate with non-alphanumeric char */
+	if (alphanum(*ptr))
+	   return 0;
+     }				/* if */
+   lptr = ptr;			/* match found, skip symbol */
+   return 1;
+}
+
+/*  stowlit
+ *
+ *  Stores a value into the literal queue. The literal queue is used for
+ *  literal strings used in functions and for initializing array variables.
+ *
+ *  Global references: litidx  (altered)
+ *                     litq    (altered)
+ */
+void
+stowlit(cell value)
+{
+   if (litidx >= litmax)
+     {
+	cell               *p;
+
+	litmax += sDEF_LITMAX;
+	p = (cell *) realloc(litq, litmax * sizeof(cell));
+	if (!p)
+	   error(102, "literal table");	/* literal table overflow (fatal error) */
+	litq = p;
+     }				/* if */
+   assert(litidx < litmax);
+   litq[litidx++] = value;
+}
+
+/*  litchar
+ *
+ *  Return current literal character and increase the pointer to point
+ *  just behind this literal character.
+ *
+ *  Note: standard "escape sequences" are suported, but the backslash may be
+ *        replaced by another character; the syntax '\ddd' is supported,
+ *        but ddd must be decimal!
+ */
+static cell
+litchar(char **lptr, int rawmode)
+{
+   cell                c = 0;
+   unsigned char      *cptr;
+
+   cptr = (unsigned char *)*lptr;
+   if (rawmode || *cptr != sc_ctrlchar)
+     {				/* no escape character */
+	c = *cptr;
+	cptr += 1;
+     }
+   else
+     {
+	cptr += 1;
+	if (*cptr == sc_ctrlchar)
+	  {
+	     c = *cptr;		/* \\ == \ (the escape character itself) */
+	     cptr += 1;
+	  }
+	else
+	  {
+	     switch (*cptr)
+	       {
+	       case 'a':	/* \a == audible alarm */
+		  c = 7;
+		  cptr += 1;
+		  break;
+	       case 'b':	/* \b == backspace */
+		  c = 8;
+		  cptr += 1;
+		  break;
+	       case 'e':	/* \e == escape */
+		  c = 27;
+		  cptr += 1;
+		  break;
+	       case 'f':	/* \f == form feed */
+		  c = 12;
+		  cptr += 1;
+		  break;
+	       case 'n':	/* \n == NewLine character */
+		  c = 10;
+		  cptr += 1;
+		  break;
+	       case 'r':	/* \r == carriage return */
+		  c = 13;
+		  cptr += 1;
+		  break;
+	       case 't':	/* \t == horizontal TAB */
+		  c = 9;
+		  cptr += 1;
+		  break;
+	       case 'v':	/* \v == vertical TAB */
+		  c = 11;
+		  cptr += 1;
+		  break;
+	       case '\'':	/* \' == ' (single quote) */
+	       case '"':	/* \" == " (single quote) */
+	       case '%':	/* \% == % (percent) */
+		  c = *cptr;
+		  cptr += 1;
+		  break;
+	       default:
+		  if (isdigit(*cptr))
+		    {		/* \ddd */
+		       c = 0;
+		       while (*cptr >= '0' && *cptr <= '9')	/* decimal! */
+			  c = c * 10 + *cptr++ - '0';
+		       if (*cptr == ';')
+			  cptr++;	/* swallow a trailing ';' */
+		    }
+		  else
+		    {
+		       error(27);	/* invalid character constant */
+		    }		/* if */
+	       }		/* switch */
+	  }			/* if */
+     }				/* if */
+   *lptr = (char *)cptr;
+   assert(c >= 0 && c < 256);
+   return c;
+}
+
+/*  alpha
+ *
+ *  Test if character "c" is alphabetic ("a".."z"), an underscore ("_")
+ *  or an "at" sign ("@"). The "@" is an extension to standard C.
+ */
+static int
+alpha(char c)
+{
+   return (isalpha(c) || c == '_' || c == PUBLIC_CHAR);
+}
+
+/*  alphanum
+ *
+ *  Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")
+ */
+int
+alphanum(char c)
+{
+   return (alpha(c) || isdigit(c));
+}
+
+/* The local variable table must be searched backwards, so that the deepest
+ * nesting of local variables is searched first. The simplest way to do
+ * this is to insert all new items at the head of the list.
+ * In the global list, the symbols are kept in sorted order, so that the
+ * public functions are written in sorted order.
+ */
+static symbol      *
+add_symbol(symbol * root, symbol * entry, int sort)
+{
+   symbol             *newsym;
+
+   if (sort)
+      while (root->next && strcmp(entry->name, root->next->name) > 0)
+	 root = root->next;
+
+   if (!(newsym = (symbol *)malloc(sizeof(symbol))))
+     {
+	error(103);
+	return NULL;
+     }				/* if */
+   memcpy(newsym, entry, sizeof(symbol));
+   newsym->next = root->next;
+   root->next = newsym;
+   return newsym;
+}
+
+static void
+free_symbol(symbol * sym)
+{
+   arginfo            *arg;
+
+   /* free all sub-symbol allocated memory blocks, depending on the
+    * kind of the symbol
+    */
+   assert(sym != NULL);
+   if (sym->ident == iFUNCTN)
+     {
+	/* run through the argument list; "default array" arguments
+	 * must be freed explicitly; the tag list must also be freed */
+	assert(sym->dim.arglist != NULL);
+	for (arg = sym->dim.arglist; arg->ident != 0; arg++)
+	  {
+	     if (arg->ident == iREFARRAY && arg->hasdefault)
+		free(arg->defvalue.array.data);
+	     else if (arg->ident == iVARIABLE
+		      && ((arg->hasdefault & uSIZEOF) != 0
+			  || (arg->hasdefault & uTAGOF) != 0))
+		free(arg->defvalue.size.symname);
+	     assert(arg->tags != NULL);
+	     free(arg->tags);
+	  }			/* for */
+	free(sym->dim.arglist);
+     }				/* if */
+   assert(sym->refer != NULL);
+   free(sym->refer);
+   free(sym);
+}
+
+void
+delete_symbol(symbol * root, symbol * sym)
+{
+   /* find the symbol and its predecessor
+    * (this function assumes that you will never delete a symbol that is not
+    * in the table pointed at by "root")
+    */
+   assert(root != sym);
+   while (root->next != sym)
+     {
+	root = root->next;
+	assert(root != NULL);
+     }				/* while */
+
+   /* unlink it, then free it */
+   root->next = sym->next;
+   free_symbol(sym);
+}
+
+void
+delete_symbols(symbol * root, int level, int delete_labels,
+	       int delete_functions)
+{
+   symbol             *sym;
+
+   /* erase only the symbols with a deeper nesting level than the
+    * specified nesting level */
+   while (root->next)
+     {
+	sym = root->next;
+	if (sym->compound < level)
+	   break;
+	if ((delete_labels || sym->ident != iLABEL)
+	    && (delete_functions || sym->ident != iFUNCTN
+		|| (sym->usage & uNATIVE) != 0) && (delete_functions
+						    || sym->ident != iCONSTEXPR
+						    || (sym->usage & uPREDEF) ==
+						    0) && (delete_functions
+							   || (sym->ident !=
+							       iVARIABLE
+							       && sym->ident !=
+							       iARRAY)))
+	  {
+	     root->next = sym->next;
+	     free_symbol(sym);
+	  }
+	else
+	  {
+	     /* if the function was prototyped, but not implemented in this source,
+	      * mark it as such, so that its use can be flagged
+	      */
+	     if (sym->ident == iFUNCTN && (sym->usage & uDEFINE) == 0)
+		sym->usage |= uMISSING;
+	     if (sym->ident == iFUNCTN || sym->ident == iVARIABLE
+		 || sym->ident == iARRAY)
+		sym->usage &= ~uDEFINE;	/* clear "defined" flag */
+	     /* for user defined operators, also remove the "prototyped" flag, as
+	      * user-defined operators *must* be declared before use
+	      */
+	     if (sym->ident == iFUNCTN && !isalpha(*sym->name)
+		 && *sym->name != '_' && *sym->name != PUBLIC_CHAR)
+		sym->usage &= ~uPROTOTYPED;
+	     root = sym;	/* skip the symbol */
+	  }			/* if */
+     }				/* if */
+}
+
+/* The purpose of the hash is to reduce the frequency of a "name"
+ * comparison (which is costly). There is little interest in avoiding
+ * clusters in similar names, which is why this function is plain simple.
+ */
+unsigned int
+namehash(char *name)
+{
+   unsigned char      *ptr = (unsigned char *)name;
+   int                 len = strlen(name);
+
+   if (len == 0)
+      return 0L;
+   assert(len < 256);
+   return (len << 24Lu) + (ptr[0] << 16Lu) + (ptr[len - 1] << 8Lu) +
+      (ptr[len >> 1Lu]);
+}
+
+static symbol      *
+find_symbol(symbol * root, char *name, int fnumber)
+{
+   symbol             *ptr = root->next;
+   unsigned long       hash = namehash(name);
+
+   while (ptr)
+     {
+	if (hash == ptr->hash && strcmp(name, ptr->name) == 0
+	    && !ptr->parent && (ptr->fnumber < 0
+				       || ptr->fnumber == fnumber))
+	   return ptr;
+	ptr = ptr->next;
+     }				/* while */
+   return NULL;
+}
+
+static symbol      *
+find_symbol_child(symbol * root, symbol * sym)
+{
+   symbol             *ptr = root->next;
+
+   while (ptr)
+     {
+	if (ptr->parent == sym)
+	   return ptr;
+	ptr = ptr->next;
+     }				/* while */
+   return NULL;
+}
+
+/* Adds "bywhom" to the list of referrers of "entry". Typically,
+ * bywhom will be the function that uses a variable or that calls
+ * the function.
+ */
+int
+refer_symbol(symbol * entry, symbol * bywhom)
+{
+   int                 count;
+
+   assert(bywhom != NULL);	/* it makes no sense to add a "void" referrer */
+   assert(entry != NULL);
+   assert(entry->refer != NULL);
+
+   /* see if it is already there */
+   for (count = 0; count < entry->numrefers && entry->refer[count] != bywhom;
+	count++)
+      /* nothing */ ;
+   if (count < entry->numrefers)
+     {
+	assert(entry->refer[count] == bywhom);
+	return TRUE;
+     }				/* if */
+
+   /* see if there is an empty spot in the referrer list */
+   for (count = 0; count < entry->numrefers && entry->refer[count];
+	count++)
+      /* nothing */ ;
+   assert(count <= entry->numrefers);
+   if (count == entry->numrefers)
+     {
+	symbol            **refer;
+	int                 newsize = 2 * entry->numrefers;
+
+	assert(newsize > 0);
+	/* grow the referrer list */
+	refer = (symbol **) realloc(entry->refer, newsize * sizeof(symbol *));
+	if (!refer)
+	   return FALSE;	/* insufficient memory */
+	/* initialize the new entries */
+	entry->refer = refer;
+	for (count = entry->numrefers; count < newsize; count++)
+	   entry->refer[count] = NULL;
+	count = entry->numrefers;	/* first empty spot */
+	entry->numrefers = newsize;
+     }				/* if */
+
+   /* add the referrer */
+   assert(entry->refer[count] == NULL);
+   entry->refer[count] = bywhom;
+   return TRUE;
+}
+
+void
+markusage(symbol * sym, int usage)
+{
+   sym->usage |= (char)usage;
+   /* check if (global) reference must be added to the symbol */
+   if ((usage & (uREAD | uWRITTEN)) != 0)
+     {
+	/* only do this for global symbols */
+	if (sym->vclass == sGLOBAL)
+	  {
+	     /* "curfunc" should always be valid, since statements may not occurs
+	      * outside functions; in the case of syntax errors, however, the
+	      * compiler may arrive through this function
+	      */
+	     if (curfunc)
+		refer_symbol(sym, curfunc);
+	  }			/* if */
+     }				/* if */
+}
+
+/*  findglb
+ *
+ *  Returns a pointer to the global symbol (if found) or NULL (if not found)
+ */
+symbol     *
+findglb(char *name)
+{
+   return find_symbol(&glbtab, name, fcurrent);
+}
+
+/*  findloc
+ *
+ *  Returns a pointer to the local symbol (if found) or NULL (if not found).
+ *  See add_symbol() how the deepest nesting level is searched first.
+ */
+symbol     *
+findloc(char *name)
+{
+   return find_symbol(&loctab, name, -1);
+}
+
+symbol     *
+findconst(char *name)
+{
+   symbol             *sym;
+
+   sym = find_symbol(&loctab, name, -1);	/* try local symbols first */
+   if (!sym || sym->ident != iCONSTEXPR)	/* not found, or not a constant */
+      sym = find_symbol(&glbtab, name, fcurrent);
+   if (!sym || sym->ident != iCONSTEXPR)
+      return NULL;
+   assert(sym->parent == NULL);	/* constants have no hierarchy */
+   return sym;
+}
+
+symbol     *
+finddepend(symbol * parent)
+{
+   symbol             *sym;
+
+   sym = find_symbol_child(&loctab, parent);	/* try local symbols first */
+   if (!sym)		/* not found */
+      sym = find_symbol_child(&glbtab, parent);
+   return sym;
+}
+
+/*  addsym
+ *
+ *  Adds a symbol to the symbol table (either global or local variables,
+ *  or global and local constants).
+ */
+symbol     *
+addsym(char *name, cell addr, int ident, int vclass, int tag, int usage)
+{
+   symbol              entry, **refer;
+
+   /* global variables/constants/functions may only be defined once */
+   assert(!(ident == iFUNCTN || ident == iCONSTEXPR) || vclass != sGLOBAL
+	  || findglb(name) == NULL);
+   /* labels may only be defined once */
+   assert(ident != iLABEL || findloc(name) == NULL);
+
+   /* create an empty referrer list */
+   if (!(refer = (symbol **)malloc(sizeof(symbol *))))
+     {
+	error(103);		/* insufficient memory */
+	return NULL;
+     }				/* if */
+   *refer = NULL;
+
+   /* first fill in the entry */
+   strcpy(entry.name, name);
+   entry.hash = namehash(name);
+   entry.addr = addr;
+   entry.vclass = (char)vclass;
+   entry.ident = (char)ident;
+   entry.tag = tag;
+   entry.usage = (char)usage;
+   entry.compound = 0;		/* may be overridden later */
+   entry.fnumber = -1;		/* assume global visibility (ignored for local symbols) */
+   entry.numrefers = 1;
+   entry.refer = refer;
+   entry.parent = NULL;
+
+   /* then insert it in the list */
+   if (vclass == sGLOBAL)
+      return add_symbol(&glbtab, &entry, TRUE);
+   else
+      return add_symbol(&loctab, &entry, FALSE);
+}
+
+symbol     *
+addvariable(char *name, cell addr, int ident, int vclass, int tag,
+	    int dim[], int numdim, int idxtag[])
+{
+   symbol             *sym, *parent, *top;
+   int                 level;
+
+   /* global variables may only be defined once */
+   assert(vclass != sGLOBAL || (sym = findglb(name)) == NULL
+	  || (sym->usage & uDEFINE) == 0);
+
+   if (ident == iARRAY || ident == iREFARRAY)
+     {
+	parent = NULL;
+	sym = NULL;		/* to avoid a compiler warning */
+	for (level = 0; level < numdim; level++)
+	  {
+	     top = addsym(name, addr, ident, vclass, tag, uDEFINE);
+	     top->dim.array.length = dim[level];
+	     top->dim.array.level = (short)(numdim - level - 1);
+	     top->x.idxtag = idxtag[level];
+	     top->parent = parent;
+	     parent = top;
+	     if (level == 0)
+		sym = top;
+	  }			/* for */
+     }
+   else
+     {
+	sym = addsym(name, addr, ident, vclass, tag, uDEFINE);
+     }				/* if */
+   return sym;
+}
+
+/*  getlabel
+ *
+ *  Return next available internal label number.
+ */
+int
+getlabel(void)
+{
+   return labnum++;
+}
+
+/*  itoh
+ *
+ *  Converts a number to a hexadecimal string and returns a pointer to that
+ *  string.
+ */
+char       *
+itoh(ucell val)
+{
+   static char         itohstr[15];	/* hex number is 10 characters long at most */
+   char               *ptr;
+   int                 i, nibble[8];	/* a 32-bit hexadecimal cell has 8 nibbles */
+   int                 max;
+
+#if defined(BIT16)
+   max = 4;
+#else
+   max = 8;
+#endif
+   ptr = itohstr;
+   for (i = 0; i < max; i += 1)
+     {
+	nibble[i] = (int)(val & 0x0f);	/* nibble 0 is lowest nibble */
+	val >>= 4;
+     }				/* endfor */
+   i = max - 1;
+   while (nibble[i] == 0 && i > 0)	/* search for highest non-zero nibble */
+      i -= 1;
+   while (i >= 0)
+     {
+	if (nibble[i] >= 10)
+	   *ptr++ = (char)('a' + (nibble[i] - 10));
+	else
+	   *ptr++ = (char)('0' + nibble[i]);
+	i -= 1;
+     }				/* while */
+   *ptr = '\0';			/* and a zero-terminator */
+   return itohstr;
+}
diff --git a/src/bin/embryo_cc_sc3.c b/src/bin/embryo_cc_sc3.c
new file mode 100644
index 0000000..1206857
--- /dev/null
+++ b/src/bin/embryo_cc_sc3.c
@@ -0,0 +1,2438 @@
+/*  Small compiler - Recursive descend expresion parser
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <limits.h>		/* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+static int          skim(int *opstr, void (*testfunc) (int), int dropval,
+			 int endval, int (*hier) (value *), value * lval);
+static void         dropout(int lvalue, void (*testfunc) (int val), int exit1,
+			    value * lval);
+static int          plnge(int *opstr, int opoff, int (*hier) (value * lval),
+			  value * lval, char *forcetag, int chkbitwise);
+static int          plnge1(int (*hier) (value * lval), value * lval);
+static void         plnge2(void (*oper) (void),
+			   int (*hier) (value * lval),
+			   value * lval1, value * lval2);
+static cell         calc(cell left, void (*oper) (), cell right,
+			 char *boolresult);
+static int          hier13(value * lval);
+static int          hier12(value * lval);
+static int          hier11(value * lval);
+static int          hier10(value * lval);
+static int          hier9(value * lval);
+static int          hier8(value * lval);
+static int          hier7(value * lval);
+static int          hier6(value * lval);
+static int          hier5(value * lval);
+static int          hier4(value * lval);
+static int          hier3(value * lval);
+static int          hier2(value * lval);
+static int          hier1(value * lval1);
+static int          primary(value * lval);
+static void         clear_value(value * lval);
+static void         callfunction(symbol * sym);
+static int          dbltest(void (*oper) (), value * lval1, value * lval2);
+static int          commutative(void (*oper) ());
+static int          constant(value * lval);
+
+static char         lastsymbol[sNAMEMAX + 1];	/* name of last function/variable */
+static int          bitwise_opercount;	/* count of bitwise operators in an expression */
+
+/* Function addresses of binary operators for signed operations */
+static void         (*op1[17]) (void) =
+{
+   os_mult, os_div, os_mod,	/* hier3, index 0 */
+      ob_add, ob_sub,		/* hier4, index 3 */
+      ob_sal, os_sar, ou_sar,	/* hier5, index 5 */
+      ob_and,			/* hier6, index 8 */
+      ob_xor,			/* hier7, index 9 */
+      ob_or,			/* hier8, index 10 */
+      os_le, os_ge, os_lt, os_gt,	/* hier9, index 11 */
+      ob_eq, ob_ne,		/* hier10, index 15 */
+};
+/* These two functions are defined because the functions inc() and dec() in
+ * SC4.C have a different prototype than the other code generation functions.
+ * The arrays for user-defined functions use the function pointers for
+ * identifying what kind of operation is requested; these functions must all
+ * have the same prototype. As inc() and dec() are special cases already, it
+ * is simplest to add two "do-nothing" functions.
+ */
+static void
+user_inc(void)
+{
+}
+static void
+user_dec(void)
+{
+}
+
+/*
+ *  Searches for a binary operator a list of operators. The list is stored in
+ *  the array "list". The last entry in the list should be set to 0.
+ *
+ *  The index of an operator in "list" (if found) is returned in "opidx". If
+ *  no operator is found, nextop() returns 0.
+ */
+static int
+nextop(int *opidx, int *list)
+{
+   *opidx = 0;
+   while (*list)
+     {
+	if (matchtoken(*list))
+	  {
+	     return TRUE;	/* found! */
+	  }
+	else
+	  {
+	     list += 1;
+	     *opidx += 1;
+	  }			/* if */
+     }				/* while */
+   return FALSE;		/* entire list scanned, nothing found */
+}
+
+int
+check_userop(void   (*oper) (void), int tag1, int tag2, int numparam,
+	     value * lval, int *resulttag)
+{
+   static char        *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "",
+      "", "", "", "<=", ">=", "<", ">", "==", "!="
+   };
+   static int          binoper_savepri[] =
+      { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+      FALSE, FALSE, FALSE, FALSE, FALSE,
+      TRUE, TRUE, TRUE, TRUE, FALSE, FALSE
+   };
+   static char        *unoperstr[] = { "!", "-", "++", "--" };
+   static void         (*unopers[]) (void) =
+   {
+   lneg, neg, user_inc, user_dec};
+   char                opername[4] = "", symbolname[sNAMEMAX + 1];
+   int                 i, swapparams, savepri, savealt;
+   int                 paramspassed;
+   symbol             *sym;
+
+   /* since user-defined operators on untagged operands are forbidden, we have
+    * a quick exit.
+    */
+   assert(numparam == 1 || numparam == 2);
+   if (tag1 == 0 && (numparam == 1 || tag2 == 0))
+      return FALSE;
+
+   savepri = savealt = FALSE;
+   /* find the name with the operator */
+   if (numparam == 2)
+     {
+	if (!oper)
+	  {
+	     /* assignment operator: a special case */
+	     strcpy(opername, "=");
+	     if (lval
+		 && (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR))
+		savealt = TRUE;
+	  }
+	else
+	  {
+	     assert((sizeof binoperstr / sizeof binoperstr[0]) ==
+		    (sizeof op1 / sizeof op1[0]));
+	     for (i = 0; i < (int)(sizeof op1 / sizeof op1[0]); i++)
+	       {
+		  if (oper == op1[i])
+		    {
+		       strcpy(opername, binoperstr[i]);
+		       savepri = binoper_savepri[i];
+		       break;
+		    }		/* if */
+	       }		/* for */
+	  }			/* if */
+     }
+   else
+     {
+	assert(oper != NULL);
+	assert(numparam == 1);
+	/* try a select group of unary operators */
+	assert((sizeof unoperstr / sizeof unoperstr[0]) ==
+	       (sizeof unopers / sizeof unopers[0]));
+	if (opername[0] == '\0')
+	  {
+	     for (i = 0; i < (int)(sizeof unopers / sizeof unopers[0]); i++)
+	       {
+		  if (oper == unopers[i])
+		    {
+		       strcpy(opername, unoperstr[i]);
+		       break;
+		    }		/* if */
+	       }		/* for */
+	  }			/* if */
+     }				/* if */
+   /* if not found, quit */
+   if (opername[0] == '\0')
+      return FALSE;
+
+   /* create a symbol name from the tags and the operator name */
+   assert(numparam == 1 || numparam == 2);
+   operator_symname(symbolname, opername, tag1, tag2, numparam, tag2);
+   swapparams = FALSE;
+   sym = findglb(symbolname);
+   if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+     {				/* ??? should not check uDEFINE; first pass clears these bits */
+	/* check for commutative operators */
+	if (tag1 == tag2 || !oper || !commutative(oper))
+	   return FALSE;	/* not commutative, cannot swap operands */
+	/* if arrived here, the operator is commutative and the tags are different,
+	 * swap tags and try again
+	 */
+	assert(numparam == 2);	/* commutative operator must be a binary operator */
+	operator_symname(symbolname, opername, tag2, tag1, numparam, tag1);
+	swapparams = TRUE;
+	sym = findglb(symbolname);
+	if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
+	   return FALSE;
+     }				/* if */
+
+   /* check existence and the proper declaration of this function */
+   if ((sym->usage & uMISSING) != 0 || (sym->usage & uPROTOTYPED) == 0)
+     {
+	char                symname[2 * sNAMEMAX + 16];	/* allow space for user defined operators */
+
+	funcdisplayname(symname, sym->name);
+	if ((sym->usage & uMISSING) != 0)
+	   error(4, symname);	/* function not defined */
+	if ((sym->usage & uPROTOTYPED) == 0)
+	   error(71, symname);	/* operator must be declared before use */
+     }				/* if */
+
+   /* we don't want to use the redefined operator in the function that
+    * redefines the operator itself, otherwise the snippet below gives
+    * an unexpected recursion:
+    *    fixed:operator+(fixed:a, fixed:b)
+    *        return a + b
+    */
+   if (sym == curfunc)
+      return FALSE;
+
+   /* for increment and decrement operators, the symbol must first be loaded
+    * (and stored back afterwards)
+    */
+   if (oper == user_inc || oper == user_dec)
+     {
+	assert(!savepri);
+	assert(lval != NULL);
+	if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+	   push1();		/* save current address in PRI */
+	rvalue(lval);		/* get the symbol's value in PRI */
+     }				/* if */
+
+   assert(!savepri || !savealt);	/* either one MAY be set, but not both */
+   if (savepri)
+     {
+	/* the chained comparison operators require that the ALT register is
+	 * unmodified, so we save it here; actually, we save PRI because the normal
+	 * instruction sequence (without user operator) swaps PRI and ALT
+	 */
+	push1();		/* right-hand operand is in PRI */
+     }
+   else if (savealt)
+     {
+	/* for the assignment operator, ALT may contain an address at which the
+	 * result must be stored; this address must be preserved across the
+	 * call
+	 */
+	assert(lval != NULL);	/* this was checked earlier */
+	assert(lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR);	/* checked earlier */
+	push2();
+     }				/* if */
+
+   /* push parameters, call the function */
+   paramspassed = (!oper) ? 1 : numparam;
+   switch (paramspassed)
+     {
+     case 1:
+	push1();
+	break;
+     case 2:
+	/* note that 1) a function expects that the parameters are pushed
+	 * in reversed order, and 2) the left operand is in the secondary register
+	 * and the right operand is in the primary register */
+	if (swapparams)
+	  {
+	     push2();
+	     push1();
+	  }
+	else
+	  {
+	     push1();
+	     push2();
+	  }			/* if */
+	break;
+     default:
+	assert(0);
+     }				/* switch */
+   endexpr(FALSE);		/* mark the end of a sub-expression */
+   pushval((cell) paramspassed * sizeof(cell));
+   assert(sym->ident == iFUNCTN);
+   ffcall(sym, paramspassed);
+   if (sc_status != statSKIP)
+      markusage(sym, uREAD);	/* do not mark as "used" when this call itself is skipped */
+   if (sym->x.lib)
+      sym->x.lib->value += 1;	/* increment "usage count" of the library */
+   sideeffect = TRUE;		/* assume functions carry out a side-effect */
+   assert(resulttag != NULL);
+   *resulttag = sym->tag;	/* save tag of the called function */
+
+   if (savepri || savealt)
+      pop2();			/* restore the saved PRI/ALT that into ALT */
+   if (oper == user_inc || oper == user_dec)
+     {
+	assert(lval != NULL);
+	if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
+	   pop2();		/* restore address (in ALT) */
+	store(lval);		/* store PRI in the symbol */
+	moveto1();		/* make sure PRI is restored on exit */
+     }				/* if */
+   return TRUE;
+}
+
+int
+matchtag(int formaltag, int actualtag, int allowcoerce)
+{
+   if (formaltag != actualtag)
+     {
+	/* if the formal tag is zero and the actual tag is not "fixed", the actual
+	 * tag is "coerced" to zero
+	 */
+	if (!allowcoerce || formaltag != 0 || (actualtag & FIXEDTAG) != 0)
+	   return FALSE;
+     }				/* if */
+   return TRUE;
+}
+
+/*
+ *  The AMX pseudo-processor has no direct support for logical (boolean)
+ *  operations. These have to be done via comparing and jumping. Since we are
+ *  already jumping through the code, we might as well implement an "early
+ *  drop-out" evaluation (also called "short-circuit"). This conforms to
+ *  standard C:
+ *
+ *  expr1 || expr2           expr2 will only be evaluated if expr1 is false.
+ *  expr1 && expr2           expr2 will only be evaluated if expr1 is true.
+ *
+ *  expr1 || expr2 && expr3  expr2 will only be evaluated if expr1 is false
+ *                           and expr3 will only be evaluated if expr1 is
+ *                           false and expr2 is true.
+ *
+ *  Code generation for the last example proceeds thus:
+ *
+ *      evaluate expr1
+ *      operator || found
+ *      jump to "l1" if result of expr1 not equal to 0
+ *      evaluate expr2
+ *      ->  operator && found; skip to higher level in hierarchy diagram
+ *          jump to "l2" if result of expr2 equal to 0
+ *          evaluate expr3
+ *          jump to "l2" if result of expr3 equal to 0
+ *          set expression result to 1 (true)
+ *          jump to "l3"
+ *      l2: set expression result to 0 (false)
+ *      l3:
+ *      <-  drop back to previous hierarchy level
+ *      jump to "l1" if result of expr2 && expr3 not equal to 0
+ *      set expression result to 0 (false)
+ *      jump to "l4"
+ *  l1: set expression result to 1 (true)
+ *  l4:
+ *
+ */
+
+/*  Skim over terms adjoining || and && operators
+ *  dropval   The value of the expression after "dropping out". An "or" drops
+ *            out when the left hand is TRUE, so dropval must be 1 on "or"
+ *            expressions.
+ *  endval    The value of the expression when no expression drops out. In an
+ *            "or" expression, this happens when both the left hand and the
+ *            right hand are FALSE, so endval must be 0 for "or" expressions.
+ */
+static int
+skim(int *opstr, void (*testfunc) (int), int dropval, int endval,
+     int (*hier) (value *), value * lval)
+{
+   int                 lvalue, hits, droplab, endlab, opidx;
+   int                 allconst;
+   cell                constval;
+   int                 index;
+   cell                cidx;
+
+   stgget(&index, &cidx);	/* mark position in code generator */
+   hits = FALSE;		/* no logical operators "hit" yet */
+   allconst = TRUE;		/* assume all values "const" */
+   constval = 0;
+   droplab = 0;			/* to avoid a compiler warning */
+   for (;;)
+     {
+	lvalue = plnge1(hier, lval);	/* evaluate left expression */
+
+	allconst = allconst && (lval->ident == iCONSTEXPR);
+	if (allconst)
+	  {
+	     if (hits)
+	       {
+		  /* one operator was already found */
+		  if (testfunc == jmp_ne0)
+		     lval->constval = lval->constval || constval;
+		  else
+		     lval->constval = lval->constval && constval;
+	       }		/* if */
+	     constval = lval->constval;	/* save result accumulated so far */
+	  }			/* if */
+
+	if (nextop(&opidx, opstr))
+	  {
+	     if (!hits)
+	       {
+		  /* this is the first operator in the list */
+		  hits = TRUE;
+		  droplab = getlabel();
+	       }		/* if */
+	     dropout(lvalue, testfunc, droplab, lval);
+	  }
+	else if (hits)
+	  {			/* no (more) identical operators */
+	     dropout(lvalue, testfunc, droplab, lval);	/* found at least one operator! */
+	     const1(endval);
+	     jumplabel(endlab = getlabel());
+	     setlabel(droplab);
+	     const1(dropval);
+	     setlabel(endlab);
+	     lval->sym = NULL;
+	     lval->tag = 0;
+	     if (allconst)
+	       {
+		  lval->ident = iCONSTEXPR;
+		  lval->constval = constval;
+		  stgdel(index, cidx);	/* scratch generated code and calculate */
+	       }
+	     else
+	       {
+		  lval->ident = iEXPRESSION;
+		  lval->constval = 0;
+	       }		/* if */
+	     return FALSE;
+	  }
+	else
+	  {
+	     return lvalue;	/* none of the operators in "opstr" were found */
+	  }			/* if */
+
+     }				/* while */
+}
+
+/*
+ *  Reads into the primary register the variable pointed to by lval if
+ *  plunging through the hierarchy levels detected an lvalue. Otherwise
+ *  if a constant was detected, it is loaded. If there is no constant and
+ *  no lvalue, the primary register must already contain the expression
+ *  result.
+ *
+ *  After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which
+ *  compare the primary register against 0, and jump to the "early drop-out"
+ *  label "exit1" if the condition is true.
+ */
+static void
+dropout(int lvalue, void (*testfunc) (int val), int exit1, value * lval)
+{
+   if (lvalue)
+      rvalue(lval);
+   else if (lval->ident == iCONSTEXPR)
+      const1(lval->constval);
+   (*testfunc) (exit1);
+}
+
+static void
+checkfunction(value * lval)
+{
+   symbol             *sym = lval->sym;
+
+   if (!sym || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+      return;			/* no known symbol, or not a function result */
+
+   if ((sym->usage & uDEFINE) != 0)
+     {
+	/* function is defined, can now check the return value (but make an
+	 * exception for directly recursive functions)
+	 */
+	if (sym != curfunc && (sym->usage & uRETVALUE) == 0)
+	  {
+	     char                symname[2 * sNAMEMAX + 16];	/* allow space for user defined operators */
+
+	     funcdisplayname(symname, sym->name);
+	     error(209, symname);	/* function should return a value */
+	  }			/* if */
+     }
+   else
+     {
+	/* function not yet defined, set */
+	sym->usage |= uRETVALUE;	/* make sure that a future implementation of
+					 * the function uses "return <value>" */
+     }				/* if */
+}
+
+/*
+ *  Plunge to a lower level
+ */
+static int
+plnge(int *opstr, int opoff, int (*hier) (value * lval), value * lval,
+      char *forcetag, int chkbitwise)
+{
+   int                 lvalue, opidx;
+   int                 count;
+   value               lval2 = { NULL, 0, 0, 0, 0, NULL };
+
+   lvalue = plnge1(hier, lval);
+   if (nextop(&opidx, opstr) == 0)
+      return lvalue;		/* no operator in "opstr" found */
+   if (lvalue)
+      rvalue(lval);
+   count = 0;
+   do
+     {
+	if (chkbitwise && count++ > 0 && bitwise_opercount != 0)
+	   error(212);
+	opidx += opoff;		/* add offset to index returned by nextop() */
+	plnge2(op1[opidx], hier, lval, &lval2);
+	if (op1[opidx] == ob_and || op1[opidx] == ob_or)
+	   bitwise_opercount++;
+	if (forcetag)
+	   lval->tag = sc_addtag(forcetag);
+     }
+   while (nextop(&opidx, opstr));	/* do */
+   return FALSE;		/* result of expression is not an lvalue */
+}
+
+/*  plnge_rel
+ *
+ *  Binary plunge to lower level; this is very simular to plnge, but
+ *  it has special code generation sequences for chained operations.
+ */
+static int
+plnge_rel(int *opstr, int opoff, int (*hier) (value * lval), value * lval)
+{
+   int                 lvalue, opidx;
+   value               lval2 = { NULL, 0, 0, 0, 0, NULL };
+   int                 count;
+
+   /* this function should only be called for relational operators */
+   assert(op1[opoff] == os_le);
+   lvalue = plnge1(hier, lval);
+   if (nextop(&opidx, opstr) == 0)
+      return lvalue;		/* no operator in "opstr" found */
+   if (lvalue)
+      rvalue(lval);
+   count = 0;
+   lval->boolresult = TRUE;
+   do
+     {
+	/* same check as in plnge(), but "chkbitwise" is always TRUE */
+	if (count > 0 && bitwise_opercount != 0)
+	   error(212);
+	if (count > 0)
+	  {
+	     relop_prefix();
+	     *lval = lval2;	/* copy right hand expression of the previous iteration */
+	  }			/* if */
+	opidx += opoff;
+	plnge2(op1[opidx], hier, lval, &lval2);
+	if (count++ > 0)
+	   relop_suffix();
+     }
+   while (nextop(&opidx, opstr));	/* enddo */
+   lval->constval = lval->boolresult;
+   lval->tag = sc_addtag("bool");	/* force tag to be "bool" */
+   return FALSE;		/* result of expression is not an lvalue */
+}
+
+/*  plnge1
+ *
+ *  Unary plunge to lower level
+ *  Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()
+ */
+static int
+plnge1(int          (*hier) (value * lval), value * lval)
+{
+   int                 lvalue, index;
+   cell                cidx;
+
+   stgget(&index, &cidx);	/* mark position in code generator */
+   lvalue = (*hier) (lval);
+   if (lval->ident == iCONSTEXPR)
+      stgdel(index, cidx);	/* load constant later */
+   return lvalue;
+}
+
+/*  plnge2
+ *
+ *  Binary plunge to lower level
+ *  Called by: plnge(), plnge_rel(), hier14() and hier1()
+ */
+static void
+plnge2(void         (*oper) (void),
+       int (*hier) (value * lval), value * lval1, value * lval2)
+{
+   int                 index;
+   cell                cidx;
+
+   stgget(&index, &cidx);	/* mark position in code generator */
+   if (lval1->ident == iCONSTEXPR)
+     {				/* constant on left side; it is not yet loaded */
+	if (plnge1(hier, lval2))
+	   rvalue(lval2);	/* load lvalue now */
+	else if (lval2->ident == iCONSTEXPR)
+	   const1(lval2->constval << dbltest(oper, lval2, lval1));
+	const2(lval1->constval << dbltest(oper, lval2, lval1));
+	/* ^ doubling of constants operating on integer addresses */
+	/*   is restricted to "add" and "subtract" operators */
+     }
+   else
+     {				/* non-constant on left side */
+	push1();
+	if (plnge1(hier, lval2))
+	   rvalue(lval2);
+	if (lval2->ident == iCONSTEXPR)
+	  {			/* constant on right side */
+	     if (commutative(oper))
+	       {		/* test for commutative operators */
+		  value               lvaltmp = { NULL, 0, 0, 0, 0, NULL };
+		  stgdel(index, cidx);	/* scratch push1() and constant fetch (then
+					 * fetch the constant again */
+		  const2(lval2->constval << dbltest(oper, lval1, lval2));
+		  /* now, the primary register has the left operand and the secondary
+		   * register the right operand; swap the "lval" variables so that lval1
+		   * is associated with the secondary register and lval2 with the
+		   * primary register, as is the "normal" case.
+		   */
+		  lvaltmp = *lval1;
+		  *lval1 = *lval2;
+		  *lval2 = lvaltmp;
+	       }
+	     else
+	       {
+		  const1(lval2->constval << dbltest(oper, lval1, lval2));
+		  pop2();	/* pop result of left operand into secondary register */
+	       }		/* if */
+	  }
+	else
+	  {			/* non-constants on both sides */
+	     pop2();
+	     if (dbltest(oper, lval1, lval2))
+		cell2addr();	/* double primary register */
+	     if (dbltest(oper, lval2, lval1))
+		cell2addr_alt();	/* double secondary register */
+	  }			/* if */
+     }				/* if */
+   if (oper)
+     {
+	/* If used in an expression, a function should return a value.
+	 * If the function has been defined, we can check this. If the
+	 * function was not defined, we can set this requirement (so that
+	 * a future function definition can check this bit.
+	 */
+	checkfunction(lval1);
+	checkfunction(lval2);
+	if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+	  {
+	     char               *ptr =
+		(lval1->sym) ? lval1->sym->name : "-unknown-";
+	     error(33, ptr);	/* array must be indexed */
+	  }
+	else if (lval2->ident == iARRAY || lval2->ident == iREFARRAY)
+	  {
+	     char               *ptr =
+		(lval2->sym) ? lval2->sym->name : "-unknown-";
+	     error(33, ptr);	/* array must be indexed */
+	  }			/* if */
+	/* ??? ^^^ should do same kind of error checking with functions */
+
+	/* check whether an "operator" function is defined for the tag names
+	 * (a constant expression cannot be optimized in that case)
+	 */
+	if (check_userop(oper, lval1->tag, lval2->tag, 2, NULL, &lval1->tag))
+	  {
+	     lval1->ident = iEXPRESSION;
+	     lval1->constval = 0;
+	  }
+	else if (lval1->ident == iCONSTEXPR && lval2->ident == iCONSTEXPR)
+	  {
+	     /* only constant expression if both constant */
+	     stgdel(index, cidx);	/* scratch generated code and calculate */
+	     if (!matchtag(lval1->tag, lval2->tag, FALSE))
+		error(213);	/* tagname mismatch */
+	     lval1->constval =
+		calc(lval1->constval, oper, lval2->constval,
+		     &lval1->boolresult);
+	  }
+	else
+	  {
+	     if (!matchtag(lval1->tag, lval2->tag, FALSE))
+		error(213);	/* tagname mismatch */
+	     (*oper) ();	/* do the (signed) operation */
+	     lval1->ident = iEXPRESSION;
+	  }			/* if */
+     }				/* if */
+}
+
+static cell
+truemodulus(cell a, cell b)
+{
+   return (a % b + b) % b;
+}
+
+static cell
+calc(cell left, void (*oper) (), cell right, char *boolresult)
+{
+   if (oper == ob_or)
+      return (left | right);
+   else if (oper == ob_xor)
+      return (left ^ right);
+   else if (oper == ob_and)
+      return (left & right);
+   else if (oper == ob_eq)
+      return (left == right);
+   else if (oper == ob_ne)
+      return (left != right);
+   else if (oper == os_le)
+      return *boolresult &= (char)(left <= right), right;
+   else if (oper == os_ge)
+      return *boolresult &= (char)(left >= right), right;
+   else if (oper == os_lt)
+      return *boolresult &= (char)(left < right), right;
+   else if (oper == os_gt)
+      return *boolresult &= (char)(left > right), right;
+   else if (oper == os_sar)
+      return (left >> (int)right);
+   else if (oper == ou_sar)
+      return ((ucell) left >> (ucell) right);
+   else if (oper == ob_sal)
+      return ((ucell) left << (int)right);
+   else if (oper == ob_add)
+      return (left + right);
+   else if (oper == ob_sub)
+      return (left - right);
+   else if (oper == os_mult)
+      return (left * right);
+   else if (oper == os_div)
+      return (left - truemodulus(left, right)) / right;
+   else if (oper == os_mod)
+      return truemodulus(left, right);
+   else
+      error(29);		/* invalid expression, assumed 0 (this should never occur) */
+   return 0;
+}
+
+int
+expression(int *constant, cell * val, int *tag, int chkfuncresult)
+{
+   value               lval = { NULL, 0, 0, 0, 0, NULL };
+
+   if (hier14(&lval))
+      rvalue(&lval);
+   if (lval.ident == iCONSTEXPR)
+     {				/* constant expression */
+	*constant = TRUE;
+	*val = lval.constval;
+     }
+   else
+     {
+	*constant = FALSE;
+	*val = 0;
+     }				/* if */
+   if (tag)
+      *tag = lval.tag;
+   if (chkfuncresult)
+      checkfunction(&lval);
+   return lval.ident;
+}
+
+static cell
+array_totalsize(symbol * sym)
+{
+   cell                length;
+
+   assert(sym != NULL);
+   assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+   length = sym->dim.array.length;
+   if (sym->dim.array.level > 0)
+     {
+	cell                sublength = array_totalsize(finddepend(sym));
+
+	if (sublength > 0)
+	   length = length + length * sublength;
+	else
+	   length = 0;
+     }				/* if */
+   return length;
+}
+
+static cell
+array_levelsize(symbol * sym, int level)
+{
+   assert(sym != NULL);
+   assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
+   assert(level <= sym->dim.array.level);
+   while (level-- > 0)
+     {
+	sym = finddepend(sym);
+	assert(sym != NULL);
+     }				/* if */
+   return sym->dim.array.length;
+}
+
+/*  hier14
+ *
+ *  Lowest hierarchy level (except for the , operator).
+ *
+ *  Global references: intest   (referred to only)
+ */
+int
+hier14(value * lval1)
+{
+   int                 lvalue;
+   value               lval2 = { NULL, 0, 0, 0, 0, NULL };
+   value               lval3 = { NULL, 0, 0, 0, 0, NULL };
+   void                (*oper) (void);
+   int                 tok, level, i;
+   cell                val;
+   char               *st;
+   int                 bwcount;
+   cell                arrayidx1[sDIMEN_MAX], arrayidx2[sDIMEN_MAX];	/* last used array indices */
+   cell               *org_arrayidx;
+
+   bwcount = bitwise_opercount;
+   bitwise_opercount = 0;
+   for (i = 0; i < sDIMEN_MAX; i++)
+      arrayidx1[i] = arrayidx2[i] = 0;
+   org_arrayidx = lval1->arrayidx;	/* save current pointer, to reset later */
+   if (!lval1->arrayidx)
+      lval1->arrayidx = arrayidx1;
+   lvalue = plnge1(hier13, lval1);
+   if (lval1->ident != iARRAYCELL && lval1->ident != iARRAYCHAR)
+      lval1->arrayidx = NULL;
+   if (lval1->ident == iCONSTEXPR)	/* load constant here */
+      const1(lval1->constval);
+   tok = lex(&val, &st);
+   switch (tok)
+     {
+     case taOR:
+	oper = ob_or;
+	break;
+     case taXOR:
+	oper = ob_xor;
+	break;
+     case taAND:
+	oper = ob_and;
+	break;
+     case taADD:
+	oper = ob_add;
+	break;
+     case taSUB:
+	oper = ob_sub;
+	break;
+     case taMULT:
+	oper = os_mult;
+	break;
+     case taDIV:
+	oper = os_div;
+	break;
+     case taMOD:
+	oper = os_mod;
+	break;
+     case taSHRU:
+	oper = ou_sar;
+	break;
+     case taSHR:
+	oper = os_sar;
+	break;
+     case taSHL:
+	oper = ob_sal;
+	break;
+     case '=':			/* simple assignment */
+	oper = NULL;
+	if (intest)
+	   error(211);		/* possibly unintended assignment */
+	break;
+     default:
+	lexpush();
+	bitwise_opercount = bwcount;
+	lval1->arrayidx = org_arrayidx;	/* restore array index pointer */
+	return lvalue;
+     }				/* switch */
+
+   /* if we get here, it was an assignment; first check a few special cases
+    * and then the general */
+   if (lval1->ident == iARRAYCHAR)
+     {
+	/* special case, assignment to packed character in a cell is permitted */
+	lvalue = TRUE;
+     }
+   else if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+     {
+	/* array assignment is permitted too (with restrictions) */
+	if (oper)
+	   return error(23);	/* array assignment must be simple assigment */
+	assert(lval1->sym != NULL);
+	if (array_totalsize(lval1->sym) == 0)
+	   return error(46, lval1->sym->name);	/* unknown array size */
+	lvalue = TRUE;
+     }				/* if */
+
+   /* operand on left side of assignment must be lvalue */
+   if (!lvalue)
+      return error(22);		/* must be lvalue */
+   /* may not change "constant" parameters */
+   assert(lval1->sym != NULL);
+   if ((lval1->sym->usage & uCONST) != 0)
+      return error(22);		/* assignment to const argument */
+   lval3 = *lval1;		/* save symbol to enable storage of expresion result */
+   lval1->arrayidx = org_arrayidx;	/* restore array index pointer */
+   if (lval1->ident == iARRAYCELL || lval1->ident == iARRAYCHAR
+       || lval1->ident == iARRAY || lval1->ident == iREFARRAY)
+     {
+	/* if indirect fetch: save PRI (cell address) */
+	if (oper)
+	  {
+	     push1();
+	     rvalue(lval1);
+	  }			/* if */
+	lval2.arrayidx = arrayidx2;
+	plnge2(oper, hier14, lval1, &lval2);
+	if (lval2.ident != iARRAYCELL && lval2.ident != iARRAYCHAR)
+	   lval2.arrayidx = NULL;
+	if (oper)
+	   pop2();
+	if (!oper && lval3.arrayidx && lval2.arrayidx
+	    && lval3.ident == lval2.ident && lval3.sym == lval2.sym)
+	  {
+	     int                 same = TRUE;
+
+	     assert(lval3.arrayidx == arrayidx1);
+	     assert(lval2.arrayidx == arrayidx2);
+	     for (i = 0; i < sDIMEN_MAX; i++)
+		same = same && (lval3.arrayidx[i] == lval2.arrayidx[i]);
+	     if (same)
+		error(226, lval3.sym->name);	/* self-assignment */
+	  }			/* if */
+     }
+   else
+     {
+	if (oper)
+	  {
+	     rvalue(lval1);
+	     plnge2(oper, hier14, lval1, &lval2);
+	  }
+	else
+	  {
+	     /* if direct fetch and simple assignment: no "push"
+	      * and "pop" needed -> call hier14() directly, */
+	     if (hier14(&lval2))
+		rvalue(&lval2);	/* instead of plnge2(). */
+	     checkfunction(&lval2);
+	     /* check whether lval2 and lval3 (old lval1) refer to the same variable */
+	     if (lval2.ident == iVARIABLE && lval3.ident == lval2.ident
+		 && lval3.sym == lval2.sym)
+	       {
+		  assert(lval3.sym != NULL);
+		  error(226, lval3.sym->name);	/* self-assignment */
+	       }		/* if */
+	  }			/* if */
+     }				/* if */
+   if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+     {
+	/* left operand is an array, right operand should be an array variable
+	 * of the same size and the same dimension, an array literal (of the
+	 * same size) or a literal string.
+	 */
+	int                 exactmatch = TRUE;
+
+	if (lval2.ident != iARRAY && lval2.ident != iREFARRAY)
+	   error(33, lval3.sym->name);	/* array must be indexed */
+	if (lval2.sym)
+	  {
+	     val = lval2.sym->dim.array.length;	/* array variable */
+	     level = lval2.sym->dim.array.level;
+	  }
+	else
+	  {
+	     val = lval2.constval;	/* literal array */
+	     level = 0;
+	     /* If val is negative, it means that lval2 is a
+	      * literal string. The string array size may be
+	      * smaller than the destination array.
+	      */
+	     if (val < 0)
+	       {
+		  val = -val;
+		  exactmatch = FALSE;
+	       }		/* if */
+	  }			/* if */
+	if (lval3.sym->dim.array.level != level)
+	   return error(48);	/* array dimensions must match */
+	else if (lval3.sym->dim.array.length < val
+		 || (exactmatch && lval3.sym->dim.array.length > val))
+	   return error(47);	/* array sizes must match */
+	if (level > 0)
+	  {
+	     /* check the sizes of all sublevels too */
+	     symbol             *sym1 = lval3.sym;
+	     symbol             *sym2 = lval2.sym;
+	     int                 i;
+
+	     assert(sym1 != NULL && sym2 != NULL);
+	     /* ^^^ sym2 must be valid, because only variables can be
+	      *     multi-dimensional (there are no multi-dimensional arrays),
+	      *     sym1 must be valid because it must be an lvalue
+	      */
+	     assert(exactmatch);
+	     for (i = 0; i < level; i++)
+	       {
+		  sym1 = finddepend(sym1);
+		  sym2 = finddepend(sym2);
+		  assert(sym1 != NULL && sym2 != NULL);
+		  /* ^^^ both arrays have the same dimensions (this was checked
+		   *     earlier) so the dependend should always be found
+		   */
+		  if (sym1->dim.array.length != sym2->dim.array.length)
+		     error(47);	/* array sizes must match */
+	       }		/* for */
+	     /* get the total size in cells of the multi-dimensional array */
+	     val = array_totalsize(lval3.sym);
+	     assert(val > 0);	/* already checked */
+	  }			/* if */
+     }
+   else
+     {
+	/* left operand is not an array, right operand should then not be either */
+	if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+	   error(6);		/* must be assigned to an array */
+     }				/* if */
+   if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
+     {
+	memcopy(val * sizeof(cell));
+     }
+   else
+     {
+	check_userop(NULL, lval2.tag, lval3.tag, 2, &lval3, &lval2.tag);
+	store(&lval3);		/* now, store the expression result */
+     }				/* if */
+   if (!oper && !matchtag(lval3.tag, lval2.tag, TRUE))
+      error(213);		/* tagname mismatch (if "oper", warning already given in plunge2()) */
+   if (lval3.sym)
+      markusage(lval3.sym, uWRITTEN);
+   sideeffect = TRUE;
+   bitwise_opercount = bwcount;
+   return FALSE;		/* expression result is never an lvalue */
+}
+
+static int
+hier13(value * lval)
+{
+   int                 lvalue, flab1, flab2;
+   value               lval2 = { NULL, 0, 0, 0, 0, NULL };
+   int                 array1, array2;
+
+   lvalue = plnge1(hier12, lval);
+   if (matchtoken('?'))
+     {
+	flab1 = getlabel();
+	flab2 = getlabel();
+	if (lvalue)
+	  {
+	     rvalue(lval);
+	  }
+	else if (lval->ident == iCONSTEXPR)
+	  {
+	     const1(lval->constval);
+	     error(lval->constval ? 206 : 205);	/* redundant test */
+	  }			/* if */
+	jmp_eq0(flab1);		/* go to second expression if primary register==0 */
+	if (hier14(lval))
+	   rvalue(lval);
+	jumplabel(flab2);
+	setlabel(flab1);
+	needtoken(':');
+	if (hier14(&lval2))
+	   rvalue(&lval2);
+	array1 = (lval->ident == iARRAY || lval->ident == iREFARRAY);
+	array2 = (lval2.ident == iARRAY || lval2.ident == iREFARRAY);
+	if (array1 && !array2)
+	  {
+	     char               *ptr =
+		(lval->sym->name) ? lval->sym->name : "-unknown-";
+	     error(33, ptr);	/* array must be indexed */
+	  }
+	else if (!array1 && array2)
+	  {
+	     char               *ptr =
+		(lval2.sym->name) ? lval2.sym->name : "-unknown-";
+	     error(33, ptr);	/* array must be indexed */
+	  }			/* if */
+	/* ??? if both are arrays, should check dimensions */
+	if (!matchtag(lval->tag, lval2.tag, FALSE))
+	   error(213);		/* tagname mismatch ('true' and 'false' expressions) */
+	setlabel(flab2);
+	if (lval->ident == iARRAY)
+	   lval->ident = iREFARRAY;	/* iARRAY becomes iREFARRAY */
+	else if (lval->ident != iREFARRAY)
+	   lval->ident = iEXPRESSION;	/* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */
+	return FALSE;		/* conditional expression is no lvalue */
+     }
+   else
+     {
+	return lvalue;
+     }				/* endif */
+}
+
+/* the order of the operators in these lists is important and must cohere */
+/* with the order of the operators in the array "op1" */
+static int          list3[] = { '*', '/', '%', 0 };
+static int          list4[] = { '+', '-', 0 };
+static int          list5[] = { tSHL, tSHR, tSHRU, 0 };
+static int          list6[] = { '&', 0 };
+static int          list7[] = { '^', 0 };
+static int          list8[] = { '|', 0 };
+static int          list9[] = { tlLE, tlGE, '<', '>', 0 };
+static int          list10[] = { tlEQ, tlNE, 0 };
+static int          list11[] = { tlAND, 0 };
+static int          list12[] = { tlOR, 0 };
+
+static int
+hier12(value * lval)
+{
+   return skim(list12, jmp_ne0, 1, 0, hier11, lval);
+}
+
+static int
+hier11(value * lval)
+{
+   return skim(list11, jmp_eq0, 0, 1, hier10, lval);
+}
+
+static int
+hier10(value * lval)
+{				/* ==, != */
+   return plnge(list10, 15, hier9, lval, "bool", TRUE);
+}				/* ^ this variable is the starting index in the op1[]
+				 *   array of the operators of this hierarchy level */
+
+static int
+hier9(value * lval)
+{				/* <=, >=, <, > */
+   return plnge_rel(list9, 11, hier8, lval);
+}
+
+static int
+hier8(value * lval)
+{				/* | */
+   return plnge(list8, 10, hier7, lval, NULL, FALSE);
+}
+
+static int
+hier7(value * lval)
+{				/* ^ */
+   return plnge(list7, 9, hier6, lval, NULL, FALSE);
+}
+
+static int
+hier6(value * lval)
+{				/* & */
+   return plnge(list6, 8, hier5, lval, NULL, FALSE);
+}
+
+static int
+hier5(value * lval)
+{				/* <<, >>, >>> */
+   return plnge(list5, 5, hier4, lval, NULL, FALSE);
+}
+
+static int
+hier4(value * lval)
+{				/* +, - */
+   return plnge(list4, 3, hier3, lval, NULL, FALSE);
+}
+
+static int
+hier3(value * lval)
+{				/* *, /, % */
+   return plnge(list3, 0, hier2, lval, NULL, FALSE);
+}
+
+static int
+hier2(value * lval)
+{
+   int                 lvalue, tok;
+   int                 tag, paranthese;
+   cell                val;
+   char               *st;
+   symbol             *sym;
+   int                 saveresult;
+
+   tok = lex(&val, &st);
+   switch (tok)
+     {
+     case tINC:		/* ++lval */
+	if (!hier2(lval))
+	   return error(22);	/* must be lvalue */
+	assert(lval->sym != NULL);
+	if ((lval->sym->usage & uCONST) != 0)
+	   return error(22);	/* assignment to const argument */
+	if (!check_userop(user_inc, lval->tag, 0, 1, lval, &lval->tag))
+	   inc(lval);		/* increase variable first */
+	rvalue(lval);		/* and read the result into PRI */
+	sideeffect = TRUE;
+	return FALSE;		/* result is no longer lvalue */
+     case tDEC:		/* --lval */
+	if (!hier2(lval))
+	   return error(22);	/* must be lvalue */
+	assert(lval->sym != NULL);
+	if ((lval->sym->usage & uCONST) != 0)
+	   return error(22);	/* assignment to const argument */
+	if (!check_userop(user_dec, lval->tag, 0, 1, lval, &lval->tag))
+	   dec(lval);		/* decrease variable first */
+	rvalue(lval);		/* and read the result into PRI */
+	sideeffect = TRUE;
+	return FALSE;		/* result is no longer lvalue */
+     case '~':			/* ~ (one's complement) */
+	if (hier2(lval))
+	   rvalue(lval);
+	invert();		/* bitwise NOT */
+	lval->constval = ~lval->constval;
+	return FALSE;
+     case '!':			/* ! (logical negate) */
+	if (hier2(lval))
+	   rvalue(lval);
+	if (check_userop(lneg, lval->tag, 0, 1, NULL, &lval->tag))
+	  {
+	     lval->ident = iEXPRESSION;
+	     lval->constval = 0;
+	  }
+	else
+	  {
+	     lneg();		/* 0 -> 1,  !0 -> 0 */
+	     lval->constval = !lval->constval;
+	     lval->tag = sc_addtag("bool");
+	  }			/* if */
+	return FALSE;
+     case '-':			/* unary - (two's complement) */
+	if (hier2(lval))
+	   rvalue(lval);
+	/* make a special check for a constant expression with the tag of a
+	 * rational number, so that we can simple swap the sign of that constant.
+	 */
+	if (lval->ident == iCONSTEXPR && lval->tag == sc_rationaltag
+	    && sc_rationaltag != 0)
+	  {
+	     if (rational_digits == 0)
+	       {
+		  float              *f = (float *)&lval->constval;
+
+		  *f = -*f;	/* this modifies lval->constval */
+	       }
+	     else
+	       {
+		  /* the negation of a fixed point number is just an integer negation */
+		  lval->constval = -lval->constval;
+	       }		/* if */
+	  }
+	else if (check_userop(neg, lval->tag, 0, 1, NULL, &lval->tag))
+	  {
+	     lval->ident = iEXPRESSION;
+	     lval->constval = 0;
+	  }
+	else
+	  {
+	     neg();		/* arithmic negation */
+	     lval->constval = -lval->constval;
+	  }			/* if */
+	return FALSE;
+     case tLABEL:		/* tagname override */
+	tag = sc_addtag(st);
+	lvalue = hier2(lval);
+	lval->tag = tag;
+	return lvalue;
+     case tDEFINED:
+	paranthese = 0;
+	while (matchtoken('('))
+	   paranthese++;
+	tok = lex(&val, &st);
+	if (tok != tSYMBOL)
+	   return error(20, st);	/* illegal symbol name */
+	sym = findloc(st);
+	if (!sym)
+	   sym = findglb(st);
+	if (sym && sym->ident != iFUNCTN && sym->ident != iREFFUNC
+	    && (sym->usage & uDEFINE) == 0)
+	   sym = NULL;		/* symbol is not a function, it is in the table, but not "defined" */
+	val = !!sym;
+	if (!val && find_subst(st, strlen(st)))
+	   val = 1;
+	clear_value(lval);
+	lval->ident = iCONSTEXPR;
+	lval->constval = val;
+	const1(lval->constval);
+	while (paranthese--)
+	   needtoken(')');
+	return FALSE;
+     case tSIZEOF:
+	paranthese = 0;
+	while (matchtoken('('))
+	   paranthese++;
+	tok = lex(&val, &st);
+	if (tok != tSYMBOL)
+	   return error(20, st);	/* illegal symbol name */
+	sym = findloc(st);
+	if (!sym)
+	   sym = findglb(st);
+	if (!sym)
+	   return error(17, st);	/* undefined symbol */
+	if (sym->ident == iCONSTEXPR)
+	   error(39);		/* constant symbol has no size */
+	else if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+	   error(72);		/* "function" symbol has no size */
+	else if ((sym->usage & uDEFINE) == 0)
+	   return error(17, st);	/* undefined symbol (symbol is in the table, but it is "used" only) */
+	clear_value(lval);
+	lval->ident = iCONSTEXPR;
+	lval->constval = 1;	/* preset */
+	if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+	  {
+	     int                 level;
+
+	     for (level = 0; matchtoken('['); level++)
+		needtoken(']');
+	     if (level > sym->dim.array.level)
+		error(28);	/* invalid subscript */
+	     else
+		lval->constval = array_levelsize(sym, level);
+	     if (lval->constval == 0 && !strchr(lptr, PREPROC_TERM))
+		error(224, st);	/* indeterminate array size in "sizeof" expression */
+	  }			/* if */
+	const1(lval->constval);
+	while (paranthese--)
+	   needtoken(')');
+	return FALSE;
+     case tTAGOF:
+	paranthese = 0;
+	while (matchtoken('('))
+	   paranthese++;
+	tok = lex(&val, &st);
+	if (tok != tSYMBOL && tok != tLABEL)
+	   return error(20, st);	/* illegal symbol name */
+	if (tok == tLABEL)
+	  {
+	     tag = sc_addtag(st);
+	  }
+	else
+	  {
+	     sym = findloc(st);
+	     if (!sym)
+		sym = findglb(st);
+	     if (!sym)
+		return error(17, st);	/* undefined symbol */
+	     if ((sym->usage & uDEFINE) == 0)
+		return error(17, st);	/* undefined symbol (symbol is in the table, but it is "used" only) */
+	     tag = sym->tag;
+	  }			/* if */
+	exporttag(tag);
+	clear_value(lval);
+	lval->ident = iCONSTEXPR;
+	lval->constval = tag;
+	const1(lval->constval);
+	while (paranthese--)
+	   needtoken(')');
+	return FALSE;
+     default:
+	lexpush();
+	lvalue = hier1(lval);
+	/* check for postfix operators */
+	if (matchtoken(';'))
+	  {
+	     /* Found a ';', do not look further for postfix operators */
+	     lexpush();		/* push ';' back after successful match */
+	     return lvalue;
+	  }
+	else if (matchtoken(tTERM))
+	  {
+	     /* Found a newline that ends a statement (this is the case when
+	      * semicolons are optional). Note that an explicit semicolon was
+	      * handled above. This case is similar, except that the token must
+	      * not be pushed back.
+	      */
+	     return lvalue;
+	  }
+	else
+	  {
+	     tok = lex(&val, &st);
+	     switch (tok)
+	       {
+	       case tINC:	/* lval++ */
+		  if (!lvalue)
+		     return error(22);	/* must be lvalue */
+		  assert(lval->sym != NULL);
+		  if ((lval->sym->usage & uCONST) != 0)
+		     return error(22);	/* assignment to const argument */
+		  /* on incrementing array cells, the address in PRI must be saved for
+		   * incremening the value, whereas the current value must be in PRI
+		   * on exit.
+		   */
+		  saveresult = (lval->ident == iARRAYCELL
+				|| lval->ident == iARRAYCHAR);
+		  if (saveresult)
+		     push1();	/* save address in PRI */
+		  rvalue(lval);	/* read current value into PRI */
+		  if (saveresult)
+		     swap1();	/* save PRI on the stack, restore address in PRI */
+		  if (!check_userop
+		      (user_inc, lval->tag, 0, 1, lval, &lval->tag))
+		     inc(lval);	/* increase variable afterwards */
+		  if (saveresult)
+		     pop1();	/* restore PRI (result of rvalue()) */
+		  sideeffect = TRUE;
+		  return FALSE;	/* result is no longer lvalue */
+	       case tDEC:	/* lval-- */
+		  if (!lvalue)
+		     return error(22);	/* must be lvalue */
+		  assert(lval->sym != NULL);
+		  if ((lval->sym->usage & uCONST) != 0)
+		     return error(22);	/* assignment to const argument */
+		  saveresult = (lval->ident == iARRAYCELL
+				|| lval->ident == iARRAYCHAR);
+		  if (saveresult)
+		     push1();	/* save address in PRI */
+		  rvalue(lval);	/* read current value into PRI */
+		  if (saveresult)
+		     swap1();	/* save PRI on the stack, restore address in PRI */
+		  if (!check_userop
+		      (user_dec, lval->tag, 0, 1, lval, &lval->tag))
+		     dec(lval);	/* decrease variable afterwards */
+		  if (saveresult)
+		     pop1();	/* restore PRI (result of rvalue()) */
+		  sideeffect = TRUE;
+		  return FALSE;
+	       case tCHAR:	/* char (compute required # of cells */
+		  if (lval->ident == iCONSTEXPR)
+		    {
+		       lval->constval *= charbits / 8;	/* from char to bytes */
+		       lval->constval =
+			  (lval->constval + sizeof(cell) - 1) / sizeof(cell);
+		    }
+		  else
+		    {
+		       if (lvalue)
+			  rvalue(lval);	/* fetch value if not already in PRI */
+		       char2addr();	/* from characters to bytes */
+		       addconst(sizeof(cell) - 1);	/* make sure the value is rounded up */
+		       addr2cell();	/* truncate to number of cells */
+		    }		/* if */
+		  return FALSE;
+	       default:
+		  lexpush();
+		  return lvalue;
+	       }		/* switch */
+	  }			/* if */
+     }				/* switch */
+}
+
+/*  hier1
+ *
+ *  The highest hierarchy level: it looks for pointer and array indices
+ *  and function calls.
+ *  Generates code to fetch a pointer value if it is indexed and code to
+ *  add to the pointer value or the array address (the address is already
+ *  read at primary()). It also generates code to fetch a function address
+ *  if that hasn't already been done at primary() (check lval[4]) and calls
+ *  callfunction() to call the function.
+ */
+static int
+hier1(value * lval1)
+{
+   int                 lvalue, index, tok, symtok;
+   cell                val, cidx;
+   value               lval2 = { NULL, 0, 0, 0, 0, NULL };
+   char               *st;
+   char                close;
+   symbol             *sym;
+
+   lvalue = primary(lval1);
+   symtok = tokeninfo(&val, &st);	/* get token read by primary() */
+ restart:
+   sym = lval1->sym;
+   if (matchtoken('[') || matchtoken('{') || matchtoken('('))
+     {
+	tok = tokeninfo(&val, &st);	/* get token read by matchtoken() */
+	if (!sym && symtok != tSYMBOL)
+	  {
+	     /* we do not have a valid symbol and we appear not to have read a valid
+	      * symbol name (so it is unlikely that we would have read a name of an
+	      * undefined symbol) */
+	     error(29);		/* expression error, assumed 0 */
+	     lexpush();		/* analyse '(', '{' or '[' again later */
+	     return FALSE;
+	  }			/* if */
+	if (tok == '[' || tok == '{')
+	  {			/* subscript */
+	     close = (char)((tok == '[') ? ']' : '}');
+	     if (!sym)
+	       {		/* sym==NULL if lval is a constant or a literal */
+		  error(28);	/* cannot subscript */
+		  needtoken(close);
+		  return FALSE;
+	       }
+	     else if (sym->ident != iARRAY && sym->ident != iREFARRAY)
+	       {
+		  error(28);	/* cannot subscript, variable is not an array */
+		  needtoken(close);
+		  return FALSE;
+	       }
+	     else if (sym->dim.array.level > 0 && close != ']')
+	       {
+		  error(51);	/* invalid subscript, must use [ ] */
+		  needtoken(close);
+		  return FALSE;
+	       }		/* if */
+	     stgget(&index, &cidx);	/* mark position in code generator */
+	     push1();		/* save base address of the array */
+	     if (hier14(&lval2))	/* create expression for the array index */
+		rvalue(&lval2);
+	     if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
+		error(33, lval2.sym->name);	/* array must be indexed */
+	     needtoken(close);
+	     if (!matchtag(sym->x.idxtag, lval2.tag, TRUE))
+		error(213);
+	     if (lval2.ident == iCONSTEXPR)
+	       {		/* constant expression */
+		  stgdel(index, cidx);	/* scratch generated code */
+		  if (lval1->arrayidx)
+		    {		/* keep constant index, for checking */
+		       assert(sym->dim.array.level >= 0
+			      && sym->dim.array.level < sDIMEN_MAX);
+		       lval1->arrayidx[sym->dim.array.level] = lval2.constval;
+		    }		/* if */
+		  if (close == ']')
+		    {
+		       /* normal array index */
+		       if (lval2.constval < 0 || (sym->dim.array.length != 0
+			   && sym->dim.array.length <= lval2.constval))
+			  error(32, sym->name);	/* array index out of bounds */
+		       if (lval2.constval != 0)
+			 {
+			    /* don't add offsets for zero subscripts */
+#if defined(BIT16)
+			    const2(lval2.constval << 1);
+#else
+			    const2(lval2.constval << 2);
+#endif
+			    ob_add();
+			 }	/* if */
+		    }
+		  else
+		    {
+		       /* character index */
+		       if (lval2.constval < 0 || (sym->dim.array.length != 0
+			   && sym->dim.array.length * ((8 * sizeof(cell)) /
+						       charbits) <=
+			   (ucell) lval2.constval))
+			  error(32, sym->name);	/* array index out of bounds */
+		       if (lval2.constval != 0)
+			 {
+			    /* don't add offsets for zero subscripts */
+			    if (charbits == 16)
+			       const2(lval2.constval << 1);	/* 16-bit character */
+			    else
+			       const2(lval2.constval);	/* 8-bit character */
+			    ob_add();
+			 }	/* if */
+		       charalign();	/* align character index into array */
+		    }		/* if */
+	       }
+	     else
+	       {
+		  /* array index is not constant */
+		  lval1->arrayidx = NULL;	/* reset, so won't be checked */
+		  if (close == ']')
+		    {
+		       if (sym->dim.array.length != 0)
+			  ffbounds(sym->dim.array.length - 1);	/* run time check for array bounds */
+		       cell2addr();	/* normal array index */
+		    }
+		  else
+		    {
+		       if (sym->dim.array.length != 0)
+			  ffbounds(sym->dim.array.length * (32 / charbits) - 1);
+		       char2addr();	/* character array index */
+		    }		/* if */
+		  pop2();
+		  ob_add();	/* base address was popped into secondary register */
+		  if (close != ']')
+		     charalign();	/* align character index into array */
+	       }		/* if */
+	     /* the indexed item may be another array (multi-dimensional arrays) */
+	     assert(lval1->sym == sym && sym != NULL);	/* should still be set */
+	     if (sym->dim.array.level > 0)
+	       {
+		  assert(close == ']');	/* checked earlier */
+		  /* read the offset to the subarray and add it to the current address */
+		  lval1->ident = iARRAYCELL;
+		  push1();	/* the optimizer makes this to a MOVE.alt */
+		  rvalue(lval1);
+		  pop2();
+		  ob_add();
+		  /* adjust the "value" structure and find the referenced array */
+		  lval1->ident = iREFARRAY;
+		  lval1->sym = finddepend(sym);
+		  assert(lval1->sym != NULL);
+		  assert(lval1->sym->dim.array.level ==
+			 sym->dim.array.level - 1);
+		  /* try to parse subsequent array indices */
+		  lvalue = FALSE;	/* for now, a iREFARRAY is no lvalue */
+		  goto restart;
+	       }		/* if */
+	     assert(sym->dim.array.level == 0);
+	     /* set type to fetch... INDIRECTLY */
+	     lval1->ident = (char)((close == ']') ? iARRAYCELL : iARRAYCHAR);
+	     lval1->tag = sym->tag;
+	     /* a cell in an array is an lvalue, a character in an array is not
+	      * always a *valid* lvalue */
+	     return TRUE;
+	  }
+	else
+	  {			/* tok=='(' -> function(...) */
+	     if (!sym
+		 || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
+	       {
+		  if (!sym && sc_status == statFIRST)
+		    {
+		       /* could be a "use before declaration"; in that case, create a stub
+		        * function so that the usage can be marked.
+		        */
+		       sym = fetchfunc(lastsymbol, 0);
+		       if (sym)
+			  markusage(sym, uREAD);
+		    }		/* if */
+		  return error(12);	/* invalid function call */
+	       }
+	     else if ((sym->usage & uMISSING) != 0)
+	       {
+		  char                symname[2 * sNAMEMAX + 16];	/* allow space for user defined operators */
+
+		  funcdisplayname(symname, sym->name);
+		  error(4, symname);	/* function not defined */
+	       }		/* if */
+	     callfunction(sym);
+	     lval1->ident = iEXPRESSION;
+	     lval1->constval = 0;
+	     lval1->tag = sym->tag;
+	     return FALSE;	/* result of function call is no lvalue */
+	  }			/* if */
+     }				/* if */
+   if (sym && lval1->ident == iFUNCTN)
+     {
+	assert(sym->ident == iFUNCTN);
+	address(sym);
+	lval1->sym = NULL;
+	lval1->ident = iREFFUNC;
+	/* ??? however... function pointers (or function references are not (yet) allowed */
+	error(29);		/* expression error, assumed 0 */
+	return FALSE;
+     }				/* if */
+   return lvalue;
+}
+
+/*  primary
+ *
+ *  Returns 1 if the operand is an lvalue (everything except arrays, functions
+ *  constants and -of course- errors).
+ *  Generates code to fetch the address of arrays. Code for constants is
+ *  already generated by constant().
+ *  This routine first clears the entire lval array (all fields are set to 0).
+ *
+ *  Global references: intest  (may be altered, but restored upon termination)
+ */
+static int
+primary(value * lval)
+{
+   char               *st;
+   int                 lvalue, tok;
+   cell                val;
+   symbol             *sym;
+
+   if (matchtoken('('))
+     {				/* sub-expression - (expression,...) */
+	pushstk((stkitem) intest);
+	pushstk((stkitem) sc_allowtags);
+
+	intest = 0;		/* no longer in "test" expression */
+	sc_allowtags = TRUE;	/* allow tagnames to be used in parenthised expressions */
+	do
+	   lvalue = hier14(lval);
+	while (matchtoken(','));
+	needtoken(')');
+	lexclr(FALSE);		/* clear lex() push-back, it should have been
+				 * cleared already by needtoken() */
+	sc_allowtags = (int)(long)popstk();
+	intest = (int)(long)popstk();
+	return lvalue;
+     }				/* if */
+
+   clear_value(lval);		/* clear lval */
+   tok = lex(&val, &st);
+   if (tok == tSYMBOL)
+     {
+	/* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol
+	 * to sNAMEMAX significant characters */
+	assert(strlen(st) < sizeof lastsymbol);
+	strcpy(lastsymbol, st);
+     }				/* if */
+   if (tok == tSYMBOL && !findconst(st))
+     {
+	/* first look for a local variable */
+	if ((sym = findloc(st)))
+	  {
+	     if (sym->ident == iLABEL)
+	       {
+		  error(29);	/* expression error, assumed 0 */
+		  const1(0);	/* load 0 */
+		  return FALSE;	/* return 0 for labels (expression error) */
+	       }		/* if */
+	     lval->sym = sym;
+	     lval->ident = sym->ident;
+	     lval->tag = sym->tag;
+	     if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+	       {
+		  address(sym);	/* get starting address in primary register */
+		  return FALSE;	/* return 0 for array (not lvalue) */
+	       }
+	     else
+	       {
+		  return TRUE;	/* return 1 if lvalue (not label or array) */
+	       }		/* if */
+	  }			/* if */
+	/* now try a global variable */
+	if ((sym = findglb(st)))
+	  {
+	     if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
+	       {
+		  /* if the function is only in the table because it was inserted as a
+		   * stub in the first pass (i.e. it was "used" but never declared or
+		   * implemented, issue an error
+		   */
+		  if ((sym->usage & uPROTOTYPED) == 0)
+		     error(17, st);
+	       }
+	     else
+	       {
+		  if ((sym->usage & uDEFINE) == 0)
+		     error(17, st);
+		  lval->sym = sym;
+		  lval->ident = sym->ident;
+		  lval->tag = sym->tag;
+		  if (sym->ident == iARRAY || sym->ident == iREFARRAY)
+		    {
+		       address(sym);	/* get starting address in primary register */
+		       return FALSE;	/* return 0 for array (not lvalue) */
+		    }
+		  else
+		    {
+		       return TRUE;	/* return 1 if lvalue (not function or array) */
+		    }		/* if */
+	       }		/* if */
+	  }
+	else
+	  {
+	     return error(17, st);	/* undefined symbol */
+	  }			/* endif */
+	assert(sym != NULL);
+	assert(sym->ident == iFUNCTN || sym->ident != iREFFUNC);
+	lval->sym = sym;
+	lval->ident = sym->ident;
+	lval->tag = sym->tag;
+	return FALSE;		/* return 0 for function (not an lvalue) */
+     }				/* if */
+   lexpush();			/* push the token, it is analyzed by constant() */
+   if (constant(lval) == 0)
+     {
+	error(29);		/* expression error, assumed 0 */
+	const1(0);		/* load 0 */
+     }				/* if */
+   return FALSE;		/* return 0 for constants (or errors) */
+}
+
+static void
+clear_value(value * lval)
+{
+   lval->sym = NULL;
+   lval->constval = 0L;
+   lval->tag = 0;
+   lval->ident = 0;
+   lval->boolresult = FALSE;
+   /* do not clear lval->arrayidx, it is preset in hier14() */
+}
+
+static void
+setdefarray(cell * string, cell size, cell array_sz, cell * dataaddr,
+	    int fconst)
+{
+   /* The routine must copy the default array data onto the heap, as to avoid
+    * that a function can change the default value. An optimization is that
+    * the default array data is "dumped" into the data segment only once (on the
+    * first use).
+    */
+   assert(string != NULL);
+   assert(size > 0);
+   /* check whether to dump the default array */
+   assert(dataaddr != NULL);
+   if (sc_status == statWRITE && *dataaddr < 0)
+     {
+	int                 i;
+
+	*dataaddr = (litidx + glb_declared) * sizeof(cell);
+	for (i = 0; i < size; i++)
+	   stowlit(*string++);
+     }				/* if */
+
+   /* if the function is known not to modify the array (meaning that it also
+    * does not modify the default value), directly pass the address of the
+    * array in the data segment.
+    */
+   if (fconst)
+     {
+	const1(*dataaddr);
+     }
+   else
+     {
+	/* Generate the code:
+	 *  CONST.pri dataaddr                ;address of the default array data
+	 *  HEAP      array_sz*sizeof(cell)   ;heap address in ALT
+	 *  MOVS      size*sizeof(cell)       ;copy data from PRI to ALT
+	 *  MOVE.PRI                          ;PRI = address on the heap
+	 */
+	const1(*dataaddr);
+	/* "array_sz" is the size of the argument (the value between the brackets
+	 * in the declaration), "size" is the size of the default array data.
+	 */
+	assert(array_sz >= size);
+	modheap((int)array_sz * sizeof(cell));
+	/* ??? should perhaps fill with zeros first */
+	memcopy(size * sizeof(cell));
+	moveto1();
+     }				/* if */
+}
+
+static int
+findnamedarg(arginfo * arg, char *name)
+{
+   int                 i;
+
+   for (i = 0; arg[i].ident != 0 && arg[i].ident != iVARARGS; i++)
+      if (strcmp(arg[i].name, name) == 0)
+	 return i;
+   return -1;
+}
+
+static int
+checktag(int tags[], int numtags, int exprtag)
+{
+   int                 i;
+
+   assert(tags != 0);
+   assert(numtags > 0);
+   for (i = 0; i < numtags; i++)
+      if (matchtag(tags[i], exprtag, TRUE))
+	 return TRUE;		/* matching tag */
+   return FALSE;		/* no tag matched */
+}
+
+enum
+{
+   ARG_UNHANDLED,
+   ARG_IGNORED,
+   ARG_DONE,
+};
+
+/*  callfunction
+ *
+ *  Generates code to call a function. This routine handles default arguments
+ *  and positional as well as named parameters.
+ */
+static void
+callfunction(symbol * sym)
+{
+   int                 close, lvalue;
+   int                 argpos;	/* index in the output stream (argpos==nargs if positional parameters) */
+   int                 argidx = 0;	/* index in "arginfo" list */
+   int                 nargs = 0;	/* number of arguments */
+   int                 heapalloc = 0;
+   int                 namedparams = FALSE;
+   value               lval = { NULL, 0, 0, 0, 0, NULL };
+   arginfo            *arg;
+   char                arglist[sMAXARGS];
+   constvalue          arrayszlst = { NULL, "", 0, 0 };	/* array size list starts empty */
+   cell                lexval;
+   char               *lexstr;
+
+   assert(sym != NULL);
+   arg = sym->dim.arglist;
+   assert(arg != NULL);
+   stgmark(sSTARTREORDER);
+   for (argpos = 0; argpos < sMAXARGS; argpos++)
+      arglist[argpos] = ARG_UNHANDLED;
+   if (!matchtoken(')'))
+     {
+	do
+	  {
+	     if (matchtoken('.'))
+	       {
+		  namedparams = TRUE;
+		  if (needtoken(tSYMBOL))
+		     tokeninfo(&lexval, &lexstr);
+		  else
+		     lexstr = "";
+		  argpos = findnamedarg(arg, lexstr);
+		  if (argpos < 0)
+		    {
+		       error(17, lexstr);	/* undefined symbol */
+		       break;	/* exit loop, argpos is invalid */
+		    }		/* if */
+		  needtoken('=');
+		  argidx = argpos;
+	       }
+	     else
+	       {
+		  if (namedparams)
+		     error(44);	/* positional parameters must precede named parameters */
+		  argpos = nargs;
+	       }		/* if */
+	     stgmark((char)(sEXPRSTART + argpos));	/* mark beginning of new expression in stage */
+	     if (arglist[argpos] != ARG_UNHANDLED)
+		error(58);	/* argument already set */
+	     if (matchtoken('_'))
+	       {
+		  arglist[argpos] = ARG_IGNORED;	/* flag argument as "present, but ignored" */
+		  if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS)
+		    {
+		       error(202);	/* argument count mismatch */
+		    }
+		  else if (!arg[argidx].hasdefault)
+		    {
+		       error(34, nargs + 1);	/* argument has no default value */
+		    }		/* if */
+		  if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS)
+		     argidx++;
+		  /* The rest of the code to handle default values is at the bottom
+		   * of this routine where default values for unspecified parameters
+		   * are (also) handled. Note that above, the argument is flagged as
+		   * ARG_IGNORED.
+		   */
+	       }
+	     else
+	       {
+		  arglist[argpos] = ARG_DONE;	/* flag argument as "present" */
+		  lvalue = hier14(&lval);
+		  switch (arg[argidx].ident)
+		    {
+		    case 0:
+		       error(202);	/* argument count mismatch */
+		       break;
+		    case iVARARGS:
+		       /* always pass by reference */
+		       if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+			 {
+			    assert(lval.sym != NULL);
+			    if ((lval.sym->usage & uCONST) != 0
+				&& (arg[argidx].usage & uCONST) == 0)
+			      {
+				 /* treat a "const" variable passed to a function with a non-const
+				  * "variable argument list" as a constant here */
+				 assert(lvalue);
+				 rvalue(&lval);	/* get value in PRI */
+				 setheap_pri();	/* address of the value on the heap in PRI */
+				 heapalloc++;
+			      }
+			    else if (lvalue)
+			      {
+				 address(lval.sym);
+			      }
+			    else
+			      {
+				 setheap_pri();	/* address of the value on the heap in PRI */
+				 heapalloc++;
+			      }	/* if */
+			 }
+		       else if (lval.ident == iCONSTEXPR
+				|| lval.ident == iEXPRESSION
+				|| lval.ident == iARRAYCHAR)
+			 {
+			    /* fetch value if needed */
+			    if (lval.ident == iARRAYCHAR)
+			       rvalue(&lval);
+			    /* allocate a cell on the heap and store the
+			     * value (already in PRI) there */
+			    setheap_pri();	/* address of the value on the heap in PRI */
+			    heapalloc++;
+			 }	/* if */
+		       /* ??? handle const array passed by reference */
+		       /* otherwise, the address is already in PRI */
+		       if (lval.sym)
+			  markusage(lval.sym, uWRITTEN);
+/*
+ * Dont need this warning - its varargs. there is no way of knowing the
+ * required tag/type...
+ *
+          if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
+            error(213);
+ */
+		       break;
+		    case iVARIABLE:
+		       if (lval.ident == iLABEL || lval.ident == iFUNCTN
+			   || lval.ident == iREFFUNC || lval.ident == iARRAY
+			   || lval.ident == iREFARRAY)
+			  error(35, argidx + 1);	/* argument type mismatch */
+		       if (lvalue)
+			  rvalue(&lval);	/* get value (direct or indirect) */
+		       /* otherwise, the expression result is already in PRI */
+		       assert(arg[argidx].numtags > 0);
+		       check_userop(NULL, lval.tag, arg[argidx].tags[0], 2,
+				    NULL, &lval.tag);
+		       if (!checktag
+			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+			  error(213);
+		       argidx++;	/* argument done */
+		       break;
+		    case iREFERENCE:
+		       if (!lvalue || lval.ident == iARRAYCHAR)
+			  error(35, argidx + 1);	/* argument type mismatch */
+		       if (lval.sym && (lval.sym->usage & uCONST) != 0
+			   && (arg[argidx].usage & uCONST) == 0)
+			  error(35, argidx + 1);	/* argument type mismatch */
+		       if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
+			 {
+			    if (lvalue)
+			      {
+				 assert(lval.sym != NULL);
+				 address(lval.sym);
+			      }
+			    else
+			      {
+				 setheap_pri();	/* address of the value on the heap in PRI */
+				 heapalloc++;
+			      }	/* if */
+			 }	/* if */
+		       /* otherwise, the address is already in PRI */
+		       if (!checktag
+			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+			  error(213);
+		       argidx++;	/* argument done */
+		       if (lval.sym)
+			  markusage(lval.sym, uWRITTEN);
+		       break;
+		    case iREFARRAY:
+		       if (lval.ident != iARRAY && lval.ident != iREFARRAY
+			   && lval.ident != iARRAYCELL)
+			 {
+			    error(35, argidx + 1);	/* argument type mismatch */
+			    break;
+			 }	/* if */
+		       if (lval.sym && (lval.sym->usage & uCONST) != 0
+			   && (arg[argidx].usage & uCONST) == 0)
+			  error(35, argidx + 1);	/* argument type mismatch */
+		       /* Verify that the dimensions match with those in arg[argidx].
+		        * A literal array always has a single dimension.
+		        * An iARRAYCELL parameter is also assumed to have a single dimension.
+		        */
+		       if (!lval.sym || lval.ident == iARRAYCELL)
+			 {
+			    if (arg[argidx].numdim != 1)
+			      {
+				 error(48);	/* array dimensions must match */
+			      }
+			    else if (arg[argidx].dim[0] != 0)
+			      {
+				 assert(arg[argidx].dim[0] > 0);
+				 if (lval.ident == iARRAYCELL)
+				   {
+				      error(47);	/* array sizes must match */
+				   }
+				 else
+				   {
+				      assert(lval.constval != 0);	/* literal array must have a size */
+				      /* A literal array must have exactly the same size as the
+				       * function argument; a literal string may be smaller than
+				       * the function argument.
+				       */
+				      if ((lval.constval > 0
+					  && arg[argidx].dim[0] != lval.constval)
+					  || (lval.constval < 0
+					  && arg[argidx].dim[0] <
+					  -lval.constval))
+					 error(47);	/* array sizes must match */
+				   }	/* if */
+			      }	/* if */
+			    if (lval.ident != iARRAYCELL)
+			      {
+				 /* save array size, for default values with uSIZEOF flag */
+				 cell                array_sz = lval.constval;
+
+				 assert(array_sz != 0);	/* literal array must have a size */
+				 if (array_sz < 0)
+				    array_sz = -array_sz;
+				 append_constval(&arrayszlst, arg[argidx].name,
+						 array_sz, 0);
+			      }	/* if */
+			 }
+		       else
+			 {
+			    symbol             *sym = lval.sym;
+			    short               level = 0;
+
+			    assert(sym != NULL);
+			    if (sym->dim.array.level + 1 != arg[argidx].numdim)
+			       error(48);	/* array dimensions must match */
+			    /* the lengths for all dimensions must match, unless the dimension
+			     * length was defined at zero (which means "undefined")
+			     */
+			    while (sym->dim.array.level > 0)
+			      {
+				 assert(level < sDIMEN_MAX);
+				 if (arg[argidx].dim[level] != 0
+				     && sym->dim.array.length !=
+				     arg[argidx].dim[level])
+				    error(47);	/* array sizes must match */
+				 append_constval(&arrayszlst, arg[argidx].name,
+						 sym->dim.array.length, level);
+				 sym = finddepend(sym);
+				 assert(sym != NULL);
+				 level++;
+			      }	/* if */
+			    /* the last dimension is checked too, again, unless it is zero */
+			    assert(level < sDIMEN_MAX);
+			    assert(sym != NULL);
+			    if (arg[argidx].dim[level] != 0
+				&& sym->dim.array.length !=
+				arg[argidx].dim[level])
+			       error(47);	/* array sizes must match */
+			    append_constval(&arrayszlst, arg[argidx].name,
+					    sym->dim.array.length, level);
+			 }	/* if */
+		       /* address already in PRI */
+		       if (!checktag
+			   (arg[argidx].tags, arg[argidx].numtags, lval.tag))
+			  error(213);
+		       // ??? set uWRITTEN?
+		       argidx++;	/* argument done */
+		       break;
+		    }		/* switch */
+		  push1();	/* store the function argument on the stack */
+		  endexpr(FALSE);	/* mark the end of a sub-expression */
+	       }		/* if */
+	     assert(arglist[argpos] != ARG_UNHANDLED);
+	     nargs++;
+	     close = matchtoken(')');
+	     if (!close)	/* if not paranthese... */
+		if (!needtoken(','))	/* ...should be comma... */
+		   break;	/* ...but abort loop if neither */
+	  }
+	while (!close && freading && !matchtoken(tENDEXPR));	/* do */
+     }				/* if */
+   /* check remaining function arguments (they may have default values) */
+   for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+	argidx++)
+     {
+	if (arglist[argidx] == ARG_DONE)
+	   continue;		/* already seen and handled this argument */
+	/* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;
+	 * these are handled last
+	 */
+	if ((arg[argidx].hasdefault & uSIZEOF) != 0
+	    || (arg[argidx].hasdefault & uTAGOF) != 0)
+	  {
+	     assert(arg[argidx].ident == iVARIABLE);
+	     continue;
+	  }			/* if */
+	stgmark((char)(sEXPRSTART + argidx));	/* mark beginning of new expression in stage */
+	if (arg[argidx].hasdefault)
+	  {
+	     if (arg[argidx].ident == iREFARRAY)
+	       {
+		  short               level;
+
+		  setdefarray(arg[argidx].defvalue.array.data,
+			      arg[argidx].defvalue.array.size,
+			      arg[argidx].defvalue.array.arraysize,
+			      &arg[argidx].defvalue.array.addr,
+			      (arg[argidx].usage & uCONST) != 0);
+		  if ((arg[argidx].usage & uCONST) == 0)
+		     heapalloc += arg[argidx].defvalue.array.arraysize;
+		  /* keep the lengths of all dimensions of a multi-dimensional default array */
+		  assert(arg[argidx].numdim > 0);
+		  if (arg[argidx].numdim == 1)
+		    {
+		       append_constval(&arrayszlst, arg[argidx].name,
+				       arg[argidx].defvalue.array.arraysize, 0);
+		    }
+		  else
+		    {
+		       for (level = 0; level < arg[argidx].numdim; level++)
+			 {
+			    assert(level < sDIMEN_MAX);
+			    append_constval(&arrayszlst, arg[argidx].name,
+					    arg[argidx].dim[level], level);
+			 }	/* for */
+		    }		/* if */
+	       }
+	     else if (arg[argidx].ident == iREFERENCE)
+	       {
+		  setheap(arg[argidx].defvalue.val);
+		  /* address of the value on the heap in PRI */
+		  heapalloc++;
+	       }
+	     else
+	       {
+		  int                 dummytag = arg[argidx].tags[0];
+
+		  const1(arg[argidx].defvalue.val);
+		  assert(arg[argidx].numtags > 0);
+		  check_userop(NULL, arg[argidx].defvalue_tag,
+			       arg[argidx].tags[0], 2, NULL, &dummytag);
+		  assert(dummytag == arg[argidx].tags[0]);
+	       }		/* if */
+	     push1();		/* store the function argument on the stack */
+	     endexpr(FALSE);	/* mark the end of a sub-expression */
+	  }
+	else
+	  {
+	     error(202, argidx);	/* argument count mismatch */
+	  }			/* if */
+	if (arglist[argidx] == ARG_UNHANDLED)
+	   nargs++;
+	arglist[argidx] = ARG_DONE;
+     }				/* for */
+   /* now a second loop to catch the arguments with default values that are
+    * the "sizeof" or "tagof" of other arguments
+    */
+   for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
+	argidx++)
+     {
+	constvalue         *asz;
+	cell                array_sz;
+
+	if (arglist[argidx] == ARG_DONE)
+	   continue;		/* already seen and handled this argument */
+	stgmark((char)(sEXPRSTART + argidx));	/* mark beginning of new expression in stage */
+	assert(arg[argidx].ident == iVARIABLE);	/* if "sizeof", must be single cell */
+	/* if unseen, must be "sizeof" or "tagof" */
+	assert((arg[argidx].hasdefault & uSIZEOF) != 0
+	       || (arg[argidx].hasdefault & uTAGOF) != 0);
+	if ((arg[argidx].hasdefault & uSIZEOF) != 0)
+	  {
+	     /* find the argument; if it isn't found, the argument's default value
+	      * was a "sizeof" of a non-array (a warning for this was already given
+	      * when declaring the function)
+	      */
+	     asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname,
+				 arg[argidx].defvalue.size.level);
+	     if (asz)
+	       {
+		  array_sz = asz->value;
+		  if (array_sz == 0)
+		     error(224, arg[argidx].name);	/* indeterminate array size in "sizeof" expression */
+	       }
+	     else
+	       {
+		  array_sz = 1;
+	       }		/* if */
+	  }
+	else
+	  {
+	     symbol             *sym;
+
+	     assert((arg[argidx].hasdefault & uTAGOF) != 0);
+	     sym = findloc(arg[argidx].defvalue.size.symname);
+	     if (!sym)
+		sym = findglb(arg[argidx].defvalue.size.symname);
+	     array_sz = (sym) ? sym->tag : 0;
+	     exporttag(array_sz);
+	  }			/* if */
+	const1(array_sz);
+	push1();		/* store the function argument on the stack */
+	endexpr(FALSE);
+	if (arglist[argidx] == ARG_UNHANDLED)
+	   nargs++;
+	arglist[argidx] = ARG_DONE;
+     }				/* for */
+   stgmark(sENDREORDER);	/* mark end of reversed evaluation */
+   pushval((cell) nargs * sizeof(cell));
+   ffcall(sym, nargs);
+   if (sc_status != statSKIP)
+      markusage(sym, uREAD);	/* do not mark as "used" when this call itself is skipped */
+   if (sym->x.lib)
+      sym->x.lib->value += 1;	/* increment "usage count" of the library */
+   modheap(-heapalloc * sizeof(cell));
+   sideeffect = TRUE;		/* assume functions carry out a side-effect */
+   delete_consttable(&arrayszlst);	/* clear list of array sizes */
+}
+
+/*  dbltest
+ *
+ *  Returns a non-zero value if lval1 an array and lval2 is not an array and
+ *  the operation is addition or subtraction.
+ *
+ *  Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell
+ *  to an array offset.
+ */
+static int
+dbltest(void        (*oper) (), value * lval1, value * lval2)
+{
+   if ((oper != ob_add) && (oper != ob_sub))
+      return 0;
+   if (lval1->ident != iARRAY)
+      return 0;
+   if (lval2->ident == iARRAY)
+      return 0;
+   return sizeof(cell) / 2;	/* 1 for 16-bit, 2 for 32-bit */
+}
+
+/*  commutative
+ *
+ *  Test whether an operator is commutative, i.e. x oper y == y oper x.
+ *  Commutative operators are: +  (addition)
+ *                             *  (multiplication)
+ *                             == (equality)
+ *                             != (inequality)
+ *                             &  (bitwise and)
+ *                             ^  (bitwise xor)
+ *                             |  (bitwise or)
+ *
+ *  If in an expression, code for the left operand has been generated and
+ *  the right operand is a constant and the operator is commutative, the
+ *  precautionary "push" of the primary register is scrapped and the constant
+ *  is read into the secondary register immediately.
+ */
+static int
+commutative(void    (*oper) ())
+{
+   return oper == ob_add || oper == os_mult
+      || oper == ob_eq || oper == ob_ne
+      || oper == ob_and || oper == ob_xor || oper == ob_or;
+}
+
+/*  constant
+ *
+ *  Generates code to fetch a number, a literal character (which is returned
+ *  by lex() as a number as well) or a literal string (lex() stores the
+ *  strings in the literal queue). If the operand was a number, it is stored
+ *  in lval->constval.
+ *
+ *  The function returns 1 if the token was a constant or a string, 0
+ *  otherwise.
+ */
+static int
+constant(value * lval)
+{
+   int                 tok, index, constant;
+   cell                val, item, cidx;
+   char               *st;
+   symbol             *sym;
+
+   tok = lex(&val, &st);
+   if (tok == tSYMBOL && (sym = findconst(st)))
+     {
+	lval->constval = sym->addr;
+	const1(lval->constval);
+	lval->ident = iCONSTEXPR;
+	lval->tag = sym->tag;
+	markusage(sym, uREAD);
+     }
+   else if (tok == tNUMBER)
+     {
+	lval->constval = val;
+	const1(lval->constval);
+	lval->ident = iCONSTEXPR;
+     }
+   else if (tok == tRATIONAL)
+     {
+	lval->constval = val;
+	const1(lval->constval);
+	lval->ident = iCONSTEXPR;
+	lval->tag = sc_rationaltag;
+     }
+   else if (tok == tSTRING)
+     {
+	/* lex() stores starting index of string in the literal table in 'val' */
+	const1((val + glb_declared) * sizeof(cell));
+	lval->ident = iARRAY;	/* pretend this is a global array */
+	lval->constval = val - litidx;	/* constval == the negative value of the
+					 * size of the literal array; using a negative
+					 * value distinguishes between literal arrays
+					 * and literal strings (this was done for
+					 * array assignment). */
+     }
+   else if (tok == '{')
+     {
+	int                 tag, lasttag = -1;
+
+	val = litidx;
+	do
+	  {
+	     /* cannot call constexpr() here, because "staging" is already turned
+	      * on at this point */
+	     assert(staging);
+	     stgget(&index, &cidx);	/* mark position in code generator */
+	     expression(&constant, &item, &tag, FALSE);
+	     stgdel(index, cidx);	/* scratch generated code */
+	     if (constant == 0)
+		error(8);	/* must be constant expression */
+	     if (lasttag < 0)
+		lasttag = tag;
+	     else if (!matchtag(lasttag, tag, FALSE))
+		error(213);	/* tagname mismatch */
+	     stowlit(item);	/* store expression result in literal table */
+	  }
+	while (matchtoken(','));
+	needtoken('}');
+	const1((val + glb_declared) * sizeof(cell));
+	lval->ident = iARRAY;	/* pretend this is a global array */
+	lval->constval = litidx - val;	/* constval == the size of the literal array */
+     }
+   else
+     {
+	return FALSE;		/* no, it cannot be interpreted as a constant */
+     }				/* if */
+   return TRUE;			/* yes, it was a constant value */
+}
diff --git a/src/bin/embryo_cc_sc4.c b/src/bin/embryo_cc_sc4.c
new file mode 100644
index 0000000..258d714
--- /dev/null
+++ b/src/bin/embryo_cc_sc4.c
@@ -0,0 +1,1308 @@
+/*  Small compiler - code generation (unoptimized "assembler" code)
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <limits.h>		/* for PATH_MAX */
+#include <string.h>
+
+#include "embryo_cc_sc.h"
+
+/* When a subroutine returns to address 0, the AMX must halt. In earlier
+ * releases, the RET and RETN opcodes checked for the special case 0 address.
+ * Today, the compiler simply generates a HALT instruction at address 0. So
+ * a subroutine can savely return to 0, and then encounter a HALT.
+ */
+void
+writeleader(void)
+{
+   assert(code_idx == 0);
+   stgwrite(";program exit point\n");
+   stgwrite("\thalt 0\n");
+   /* calculate code length */
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*  writetrailer
+ *  Not much left of this once important function.
+ *
+ *  Global references: sc_stksize       (referred to only)
+ *                     sc_dataalign     (referred to only)
+ *                     code_idx         (altered)
+ *                     glb_declared     (altered)
+ */
+void
+writetrailer(void)
+{
+   assert(sc_dataalign % opcodes(1) == 0);	/* alignment must be a multiple of
+						 * the opcode size */
+   assert(sc_dataalign != 0);
+
+   /* pad code to align data segment */
+   if ((code_idx % sc_dataalign) != 0)
+     {
+	begcseg();
+	while ((code_idx % sc_dataalign) != 0)
+	   nooperation();
+     }				/* if */
+
+   /* pad data segment to align the stack and the heap */
+   assert(litidx == 0);		/* literal queue should have been emptied */
+   assert(sc_dataalign % sizeof(cell) == 0);
+   if (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+     {
+	begdseg();
+	defstorage();
+	while (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
+	  {
+	     stgwrite("0 ");
+	     glb_declared++;
+	  }			/* while */
+     }				/* if */
+
+   stgwrite("\nSTKSIZE ");	/* write stack size (align stack top) */
+   outval(sc_stksize - (sc_stksize % sc_dataalign), TRUE);
+}
+
+/*
+ *  Start (or restart) the CODE segment.
+ *
+ *  In fact, the code and data segment specifiers are purely informational;
+ *  the "DUMP" instruction itself already specifies that the following values
+ *  should go to the data segment. All otherinstructions go to the code
+ *  segment.
+ *
+ *  Global references: curseg
+ */
+void
+begcseg(void)
+{
+   if (curseg != sIN_CSEG)
+     {
+	stgwrite("\n");
+	stgwrite("CODE\t; ");
+	outval(code_idx, TRUE);
+	curseg = sIN_CSEG;
+     }				/* endif */
+}
+
+/*
+ *  Start (or restart) the DATA segment.
+ *
+ *  Global references: curseg
+ */
+void
+begdseg(void)
+{
+   if (curseg != sIN_DSEG)
+     {
+	stgwrite("\n");
+	stgwrite("DATA\t; ");
+	outval(glb_declared - litidx, TRUE);
+	curseg = sIN_DSEG;
+     }				/* if */
+}
+
+void
+setactivefile(int fnumber)
+{
+   stgwrite("curfile ");
+   outval(fnumber, TRUE);
+}
+
+cell
+nameincells(char *name)
+{
+   cell                clen =
+      (strlen(name) + sizeof(cell)) & ~(sizeof(cell) - 1);
+   return clen;
+}
+
+void
+setfile(char *name, int fileno)
+{
+   if ((sc_debug & sSYMBOLIC) != 0)
+     {
+	begcseg();
+	stgwrite("file ");
+	outval(fileno, FALSE);
+	stgwrite(" ");
+	stgwrite(name);
+	stgwrite("\n");
+	/* calculate code length */
+	code_idx += opcodes(1) + opargs(2) + nameincells(name);
+     }				/* if */
+}
+
+void
+setline(int line, int fileno)
+{
+   if ((sc_debug & (sSYMBOLIC | sCHKBOUNDS)) != 0)
+     {
+	stgwrite("line ");
+	outval(line, FALSE);
+	stgwrite(" ");
+	outval(fileno, FALSE);
+	stgwrite("\t; ");
+	outval(code_idx, TRUE);
+	code_idx += opcodes(1) + opargs(2);
+     }				/* if */
+}
+
+/*  setlabel
+ *
+ *  Post a code label (specified as a number), on a new line.
+ */
+void
+setlabel(int number)
+{
+   assert(number >= 0);
+   stgwrite("l.");
+   stgwrite((char *)itoh(number));
+   /* To assist verification of the assembled code, put the address of the
+    * label as a comment. However, labels that occur inside an expression
+    * may move (through optimization or through re-ordering). So write the
+    * address only if it is known to accurate.
+    */
+   if (!staging)
+     {
+	stgwrite("\t\t; ");
+	outval(code_idx, FALSE);
+     }				/* if */
+   stgwrite("\n");
+}
+
+/* Write a token that signifies the end of an expression, or the end of a
+ * function parameter. This allows several simple optimizations by the peephole
+ * optimizer.
+ */
+void
+endexpr(int fullexpr)
+{
+   if (fullexpr)
+      stgwrite("\t;$exp\n");
+   else
+      stgwrite("\t;$par\n");
+}
+
+/*  startfunc   - declare a CODE entry point (function start)
+ *
+ *  Global references: funcstatus  (referred to only)
+ */
+void
+startfunc(char *fname __UNUSED__)
+{
+   stgwrite("\tproc");
+   stgwrite("\n");
+   code_idx += opcodes(1);
+}
+
+/*  endfunc
+ *
+ *  Declare a CODE ending point (function end)
+ */
+void
+endfunc(void)
+{
+   stgwrite("\n");		/* skip a line */
+}
+
+/*  alignframe
+ *
+ *  Aligns the frame (and the stack) of the current function to a multiple
+ *  of the specified byte count. Two caveats: the alignment ("numbytes") should
+ *  be a power of 2, and this alignment must be done right after the frame
+ *  is set up (before the first variable is declared)
+ */
+void
+alignframe(int numbytes)
+{
+#if !defined NDEBUG
+   /* "numbytes" should be a power of 2 for this code to work */
+   int                 i, count = 0;
+
+   for (i = 0; i < (int)(sizeof(numbytes) * 8); i++)
+      if (numbytes & (1 << i))
+	 count++;
+   assert(count == 1);
+#endif
+
+   stgwrite("\tlctrl 4\n");	/* get STK in PRI */
+   stgwrite("\tconst.alt ");	/* get ~(numbytes-1) in ALT */
+   outval(~(numbytes - 1), TRUE);
+   stgwrite("\tand\n");		/* PRI = STK "and" ~(numbytes-1) */
+   stgwrite("\tsctrl 4\n");	/* set the new value of STK ... */
+   stgwrite("\tsctrl 5\n");	/* ... and FRM */
+   code_idx += opcodes(5) + opargs(4);
+}
+
+/*  Define a variable or function
+ */
+void
+defsymbol(char *name, int ident, int vclass, cell offset, int tag)
+{
+   if ((sc_debug & sSYMBOLIC) != 0)
+     {
+	begcseg();		/* symbol definition in code segment */
+	stgwrite("symbol ");
+
+	stgwrite(name);
+	stgwrite(" ");
+
+	outval(offset, FALSE);
+	stgwrite(" ");
+
+	outval(vclass, FALSE);
+	stgwrite(" ");
+
+	outval(ident, TRUE);
+
+	code_idx += opcodes(1) + opargs(3) + nameincells(name);	/* class and ident encoded in "flags" */
+
+	/* also write the optional tag */
+	if (tag != 0)
+	  {
+	     assert((tag & TAGMASK) != 0);
+	     stgwrite("symtag ");
+	     outval(tag & TAGMASK, TRUE);
+	     code_idx += opcodes(1) + opargs(1);
+	  }			/* if */
+     }				/* if */
+}
+
+void
+symbolrange(int level, cell size)
+{
+   if ((sc_debug & sSYMBOLIC) != 0)
+     {
+	begcseg();		/* symbol definition in code segment */
+	stgwrite("srange ");
+	outval(level, FALSE);
+	stgwrite(" ");
+	outval(size, TRUE);
+	code_idx += opcodes(1) + opargs(2);
+     }				/* if */
+}
+
+/*  rvalue
+ *
+ *  Generate code to get the value of a symbol into "primary".
+ */
+void
+rvalue(value * lval)
+{
+   symbol             *sym;
+
+   sym = lval->sym;
+   if (lval->ident == iARRAYCELL)
+     {
+	/* indirect fetch, address already in PRI */
+	stgwrite("\tload.i\n");
+	code_idx += opcodes(1);
+     }
+   else if (lval->ident == iARRAYCHAR)
+     {
+	/* indirect fetch of a character from a pack, address already in PRI */
+	stgwrite("\tlodb.i ");
+	outval(charbits / 8, TRUE);	/* read one or two bytes */
+	code_idx += opcodes(1) + opargs(1);
+     }
+   else if (lval->ident == iREFERENCE)
+     {
+	/* indirect fetch, but address not yet in PRI */
+	assert(sym != NULL);
+	assert(sym->vclass == sLOCAL);	/* global references don't exist in Small */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tlref.s.pri ");
+	else
+	   stgwrite("\tlref.pri ");
+	outval(sym->addr, TRUE);
+	markusage(sym, uREAD);
+	code_idx += opcodes(1) + opargs(1);
+     }
+   else
+     {
+	/* direct or stack relative fetch */
+	assert(sym != NULL);
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tload.s.pri ");
+	else
+	   stgwrite("\tload.pri ");
+	outval(sym->addr, TRUE);
+	markusage(sym, uREAD);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*
+ *  Get the address of a symbol into the primary register (used for arrays,
+ *  and for passing arguments by reference).
+ */
+void
+address(symbol * sym)
+{
+   assert(sym != NULL);
+   /* the symbol can be a local array, a global array, or an array
+    * that is passed by reference.
+    */
+   if (sym->ident == iREFARRAY || sym->ident == iREFERENCE)
+     {
+	/* reference to a variable or to an array; currently this is
+	 * always a local variable */
+	stgwrite("\tload.s.pri ");
+     }
+   else
+     {
+	/* a local array or local variable */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\taddr.pri ");
+	else
+	   stgwrite("\tconst.pri ");
+     }				/* if */
+   outval(sym->addr, TRUE);
+   markusage(sym, uREAD);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*  store
+ *
+ *  Saves the contents of "primary" into a memory cell, either directly
+ *  or indirectly (at the address given in the alternate register).
+ */
+void
+store(value * lval)
+{
+   symbol             *sym;
+
+   sym = lval->sym;
+   if (lval->ident == iARRAYCELL)
+     {
+	/* store at address in ALT */
+	stgwrite("\tstor.i\n");
+	code_idx += opcodes(1);
+     }
+   else if (lval->ident == iARRAYCHAR)
+     {
+	/* store at address in ALT */
+	stgwrite("\tstrb.i ");
+	outval(charbits / 8, TRUE);	/* write one or two bytes */
+	code_idx += opcodes(1) + opargs(1);
+     }
+   else if (lval->ident == iREFERENCE)
+     {
+	assert(sym != NULL);
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tsref.s.pri ");
+	else
+	   stgwrite("\tsref.pri ");
+	outval(sym->addr, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }
+   else
+     {
+	assert(sym != NULL);
+	markusage(sym, uWRITTEN);
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tstor.s.pri ");
+	else
+	   stgwrite("\tstor.pri ");
+	outval(sym->addr, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/* source must in PRI, destination address in ALT. The "size"
+ * parameter is in bytes, not cells.
+ */
+void
+memcopy(cell size)
+{
+   stgwrite("\tmovs ");
+   outval(size, TRUE);
+
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/* Address of the source must already have been loaded in PRI
+ * "size" is the size in bytes (not cells).
+ */
+void
+copyarray(symbol * sym, cell size)
+{
+   assert(sym != NULL);
+   /* the symbol can be a local array, a global array, or an array
+    * that is passed by reference.
+    */
+   if (sym->ident == iREFARRAY)
+     {
+	/* reference to an array; currently this is always a local variable */
+	assert(sym->vclass == sLOCAL);	/* symbol must be stack relative */
+	stgwrite("\tload.s.alt ");
+     }
+   else
+     {
+	/* a local or global array */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\taddr.alt ");
+	else
+	   stgwrite("\tconst.alt ");
+     }				/* if */
+   outval(sym->addr, TRUE);
+   markusage(sym, uWRITTEN);
+
+   code_idx += opcodes(1) + opargs(1);
+   memcopy(size);
+}
+
+void
+fillarray(symbol * sym, cell size, cell val)
+{
+   const1(val);		/* load val in PRI */
+
+   assert(sym != NULL);
+   /* the symbol can be a local array, a global array, or an array
+    * that is passed by reference.
+    */
+   if (sym->ident == iREFARRAY)
+     {
+	/* reference to an array; currently this is always a local variable */
+	assert(sym->vclass == sLOCAL);	/* symbol must be stack relative */
+	stgwrite("\tload.s.alt ");
+     }
+   else
+     {
+	/* a local or global array */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\taddr.alt ");
+	else
+	   stgwrite("\tconst.alt ");
+     }				/* if */
+   outval(sym->addr, TRUE);
+   markusage(sym, uWRITTEN);
+
+   stgwrite("\tfill ");
+   outval(size, TRUE);
+
+   code_idx += opcodes(2) + opargs(2);
+}
+
+/*
+ *  Instruction to get an immediate value into the primary register
+ */
+void
+const1(cell val)
+{
+   if (val == 0)
+     {
+	stgwrite("\tzero.pri\n");
+	code_idx += opcodes(1);
+     }
+   else
+     {
+	stgwrite("\tconst.pri ");
+	outval(val, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*
+ *  Instruction to get an immediate value into the secondary register
+ */
+void
+const2(cell val)
+{
+   if (val == 0)
+     {
+	stgwrite("\tzero.alt\n");
+	code_idx += opcodes(1);
+     }
+   else
+     {
+	stgwrite("\tconst.alt ");
+	outval(val, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/* Copy value in secondary register to the primary register */
+void
+moveto1(void)
+{
+   stgwrite("\tmove.pri\n");
+   code_idx += opcodes(1) + opargs(0);
+}
+
+/*
+ *  Push primary register onto the stack
+ */
+void
+push1(void)
+{
+   stgwrite("\tpush.pri\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  Push alternate register onto the stack
+ */
+void
+push2(void)
+{
+   stgwrite("\tpush.alt\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  Push a constant value onto the stack
+ */
+void
+pushval(cell val)
+{
+   stgwrite("\tpush.c ");
+   outval(val, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *  pop stack to the primary register
+ */
+void
+pop1(void)
+{
+   stgwrite("\tpop.pri\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  pop stack to the secondary register
+ */
+void
+pop2(void)
+{
+   stgwrite("\tpop.alt\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  swap the top-of-stack with the value in primary register
+ */
+void
+swap1(void)
+{
+   stgwrite("\tswap.pri\n");
+   code_idx += opcodes(1);
+}
+
+/* Switch statements
+ * The "switch" statement generates a "case" table using the "CASE" opcode.
+ * The case table contains a list of records, each record holds a comparison
+ * value and a label to branch to on a match. The very first record is an
+ * exception: it holds the size of the table (excluding the first record) and
+ * the label to branch to when none of the values in the case table match.
+ * The case table is sorted on the comparison value. This allows more advanced
+ * abstract machines to sift the case table with a binary search.
+ */
+void
+ffswitch(int label)
+{
+   stgwrite("\tswitch ");
+   outval(label, TRUE);		/* the label is the address of the case table */
+   code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffcase(cell val, char *labelname, int newtable)
+{
+   if (newtable)
+     {
+	stgwrite("\tcasetbl\n");
+	code_idx += opcodes(1);
+     }				/* if */
+   stgwrite("\tcase ");
+   outval(val, FALSE);
+   stgwrite(" ");
+   stgwrite(labelname);
+   stgwrite("\n");
+   code_idx += opcodes(0) + opargs(2);
+}
+
+/*
+ *  Call specified function
+ */
+void
+ffcall(symbol * sym, int numargs)
+{
+   assert(sym != NULL);
+   assert(sym->ident == iFUNCTN);
+   if ((sym->usage & uNATIVE) != 0)
+     {
+	/* reserve a SYSREQ id if called for the first time */
+	if (sc_status == statWRITE && (sym->usage & uREAD) == 0
+	    && sym->addr >= 0)
+	   sym->addr = ntv_funcid++;
+	stgwrite("\tsysreq.c ");
+	outval(sym->addr, FALSE);
+	stgwrite("\n\tstack ");
+	outval((numargs + 1) * sizeof(cell), TRUE);
+	code_idx += opcodes(2) + opargs(2);
+     }
+   else
+     {
+	/* normal function */
+	stgwrite("\tcall ");
+	stgwrite(sym->name);
+	stgwrite("\n");
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*  Return from function
+ *
+ *  Global references: funcstatus  (referred to only)
+ */
+void
+ffret(void)
+{
+   stgwrite("\tretn\n");
+   code_idx += opcodes(1);
+}
+
+void
+ffabort(int reason)
+{
+   stgwrite("\thalt ");
+   outval(reason, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+void
+ffbounds(cell size)
+{
+   if ((sc_debug & sCHKBOUNDS) != 0)
+     {
+	stgwrite("\tbounds ");
+	outval(size, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*
+ *  Jump to local label number (the number is converted to a name)
+ */
+void
+jumplabel(int number)
+{
+   stgwrite("\tjump ");
+   outval(number, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *   Define storage (global and static variables)
+ */
+void
+defstorage(void)
+{
+   stgwrite("dump ");
+}
+
+/*
+ *  Inclrement/decrement stack pointer. Note that this routine does
+ *  nothing if the delta is zero.
+ */
+void
+modstk(int delta)
+{
+   if (delta)
+     {
+	stgwrite("\tstack ");
+	outval(delta, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/* set the stack to a hard offset from the frame */
+void
+setstk(cell val)
+{
+   stgwrite("\tlctrl 5\n");	/* get FRM */
+   assert(val <= 0);		/* STK should always become <= FRM */
+   if (val < 0)
+     {
+	stgwrite("\tadd.c ");
+	outval(val, TRUE);	/* add (negative) offset */
+	code_idx += opcodes(1) + opargs(1);
+	// ??? write zeros in the space between STK and the val in PRI (the new stk)
+	//     get val of STK in ALT
+	//     zero PRI
+	//     need new FILL opcode that takes a variable size
+     }				/* if */
+   stgwrite("\tsctrl 4\n");	/* store in STK */
+   code_idx += opcodes(2) + opargs(2);
+}
+
+void
+modheap(int delta)
+{
+   if (delta)
+     {
+	stgwrite("\theap ");
+	outval(delta, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+void
+setheap_pri(void)
+{
+   stgwrite("\theap ");		/* ALT = HEA++ */
+   outval(sizeof(cell), TRUE);
+   stgwrite("\tstor.i\n");	/* store PRI (default value) at address ALT */
+   stgwrite("\tmove.pri\n");	/* move ALT to PRI: PRI contains the address */
+   code_idx += opcodes(3) + opargs(1);
+}
+
+void
+setheap(cell val)
+{
+   stgwrite("\tconst.pri ");	/* load default val in PRI */
+   outval(val, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+   setheap_pri();
+}
+
+/*
+ *  Convert a cell number to a "byte" address; i.e. double or quadruple
+ *  the primary register.
+ */
+void
+cell2addr(void)
+{
+#if defined(BIT16)
+   stgwrite("\tshl.c.pri 1\n");
+#else
+   stgwrite("\tshl.c.pri 2\n");
+#endif
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *  Double or quadruple the alternate register.
+ */
+void
+cell2addr_alt(void)
+{
+#if defined(BIT16)
+   stgwrite("\tshl.c.alt 1\n");
+#else
+   stgwrite("\tshl.c.alt 2\n");
+#endif
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *  Convert "distance of addresses" to "number of cells" in between.
+ *  Or convert a number of packed characters to the number of cells (with
+ *  truncation).
+ */
+void
+addr2cell(void)
+{
+#if defined(BIT16)
+   stgwrite("\tshr.c.pri 1\n");
+#else
+   stgwrite("\tshr.c.pri 2\n");
+#endif
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/* Convert from character index to byte address. This routine does
+ * nothing if a character has the size of a byte.
+ */
+void
+char2addr(void)
+{
+   if (charbits == 16)
+     {
+	stgwrite("\tshl.c.pri 1\n");
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/* Align PRI (which should hold a character index) to an address.
+ * The first character in a "pack" occupies the highest bits of
+ * the cell. This is at the lower memory address on Big Endian
+ * computers and on the higher address on Little Endian computers.
+ * The ALIGN.pri/alt instructions must solve this machine dependence;
+ * that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
+ * and on Little Endian computers they should toggle the address.
+ */
+void
+charalign(void)
+{
+   stgwrite("\talign.pri ");
+   outval(charbits / 8, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *  Add a constant to the primary register.
+ */
+void
+addconst(cell val)
+{
+   if (val != 0)
+     {
+	stgwrite("\tadd.c ");
+	outval(val, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*
+ *  signed multiply of primary and secundairy registers (result in primary)
+ */
+void
+os_mult(void)
+{
+   stgwrite("\tsmul\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  signed divide of alternate register by primary register (quotient in
+ *  primary; remainder in alternate)
+ */
+void
+os_div(void)
+{
+   stgwrite("\tsdiv.alt\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  modulus of (alternate % primary), result in primary (signed)
+ */
+void
+os_mod(void)
+{
+   stgwrite("\tsdiv.alt\n");
+   stgwrite("\tmove.pri\n");	/* move ALT to PRI */
+   code_idx += opcodes(2);
+}
+
+/*
+ *  Add primary and alternate registers (result in primary).
+ */
+void
+ob_add(void)
+{
+   stgwrite("\tadd\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  subtract primary register from alternate register (result in primary)
+ */
+void
+ob_sub(void)
+{
+   stgwrite("\tsub.alt\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  arithmic shift left alternate register the number of bits
+ *  given in the primary register (result in primary).
+ *  There is no need for a "logical shift left" routine, since
+ *  logical shift left is identical to arithmic shift left.
+ */
+void
+ob_sal(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tshl\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  arithmic shift right alternate register the number of bits
+ *  given in the primary register (result in primary).
+ */
+void
+os_sar(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tsshr\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  logical (unsigned) shift right of the alternate register by the
+ *  number of bits given in the primary register (result in primary).
+ */
+void
+ou_sar(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tshr\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  inclusive "or" of primary and secondary registers (result in primary)
+ */
+void
+ob_or(void)
+{
+   stgwrite("\tor\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  "exclusive or" of primary and alternate registers (result in primary)
+ */
+void
+ob_xor(void)
+{
+   stgwrite("\txor\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  "and" of primary and secundairy registers (result in primary)
+ */
+void
+ob_and(void)
+{
+   stgwrite("\tand\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  test ALT==PRI; result in primary register (1 or 0).
+ */
+void
+ob_eq(void)
+{
+   stgwrite("\teq\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  test ALT!=PRI
+ */
+void
+ob_ne(void)
+{
+   stgwrite("\tneq\n");
+   code_idx += opcodes(1);
+}
+
+/* The abstract machine defines the relational instructions so that PRI is
+ * on the left side and ALT on the right side of the operator. For example,
+ * SLESS sets PRI to either 1 or 0 depending on whether the expression
+ * "PRI < ALT" is true.
+ *
+ * The compiler generates comparisons with ALT on the left side of the
+ * relational operator and PRI on the right side. The XCHG instruction
+ * prefixing the relational operators resets this. We leave it to the
+ * peephole optimizer to choose more compact instructions where possible.
+ */
+
+/* Relational operator prefix for chained relational expressions. The
+ * "suffix" code restores the stack.
+ * For chained relational operators, the goal is to keep the comparison
+ * result "so far" in PRI and the value of the most recent operand in
+ * ALT, ready for a next comparison.
+ * The "prefix" instruction pushed the comparison result (PRI) onto the
+ * stack and moves the value of ALT into PRI. If there is a next comparison,
+ * PRI can now serve as the "left" operand of the relational operator.
+ */
+void
+relop_prefix(void)
+{
+   stgwrite("\tpush.pri\n");
+   stgwrite("\tmove.pri\n");
+   code_idx += opcodes(2);
+}
+
+void
+relop_suffix(void)
+{
+   stgwrite("\tswap.alt\n");
+   stgwrite("\tand\n");
+   stgwrite("\tpop.alt\n");
+   code_idx += opcodes(3);
+}
+
+/*
+ *  test ALT<PRI (signed)
+ */
+void
+os_lt(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tsless\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  test ALT<=PRI (signed)
+ */
+void
+os_le(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tsleq\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  test ALT>PRI (signed)
+ */
+void
+os_gt(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tsgrtr\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  test ALT>=PRI (signed)
+ */
+void
+os_ge(void)
+{
+   stgwrite("\txchg\n");
+   stgwrite("\tsgeq\n");
+   code_idx += opcodes(2);
+}
+
+/*
+ *  logical negation of primary register
+ */
+void
+lneg(void)
+{
+   stgwrite("\tnot\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  two's complement primary register
+ */
+void
+neg(void)
+{
+   stgwrite("\tneg\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  one's complement of primary register
+ */
+void
+invert(void)
+{
+   stgwrite("\tinvert\n");
+   code_idx += opcodes(1);
+}
+
+/*
+ *  nop
+ */
+void
+nooperation(void)
+{
+   stgwrite("\tnop\n");
+   code_idx += opcodes(1);
+}
+
+/*  increment symbol
+ */
+void
+inc(value * lval)
+{
+   symbol             *sym;
+
+   sym = lval->sym;
+   if (lval->ident == iARRAYCELL)
+     {
+	/* indirect increment, address already in PRI */
+	stgwrite("\tinc.i\n");
+	code_idx += opcodes(1);
+     }
+   else if (lval->ident == iARRAYCHAR)
+     {
+	/* indirect increment of single character, address already in PRI */
+	stgwrite("\tpush.pri\n");
+	stgwrite("\tpush.alt\n");
+	stgwrite("\tmove.alt\n");	/* copy address */
+	stgwrite("\tlodb.i ");	/* read from PRI into PRI */
+	outval(charbits / 8, TRUE);	/* read one or two bytes */
+	stgwrite("\tinc.pri\n");
+	stgwrite("\tstrb.i ");	/* write PRI to ALT */
+	outval(charbits / 8, TRUE);	/* write one or two bytes */
+	stgwrite("\tpop.alt\n");
+	stgwrite("\tpop.pri\n");
+	code_idx += opcodes(8) + opargs(2);
+     }
+   else if (lval->ident == iREFERENCE)
+     {
+	assert(sym != NULL);
+	stgwrite("\tpush.pri\n");
+	/* load dereferenced value */
+	assert(sym->vclass == sLOCAL);	/* global references don't exist in Small */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tlref.s.pri ");
+	else
+	   stgwrite("\tlref.pri ");
+	outval(sym->addr, TRUE);
+	/* increment */
+	stgwrite("\tinc.pri\n");
+	/* store dereferenced value */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tsref.s.pri ");
+	else
+	   stgwrite("\tsref.pri ");
+	outval(sym->addr, TRUE);
+	stgwrite("\tpop.pri\n");
+	code_idx += opcodes(5) + opargs(2);
+     }
+   else
+     {
+	/* local or global variable */
+	assert(sym != NULL);
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tinc.s ");
+	else
+	   stgwrite("\tinc ");
+	outval(sym->addr, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*  decrement symbol
+ *
+ *  in case of an integer pointer, the symbol must be incremented by 2.
+ */
+void
+dec(value * lval)
+{
+   symbol             *sym;
+
+   sym = lval->sym;
+   if (lval->ident == iARRAYCELL)
+     {
+	/* indirect decrement, address already in PRI */
+	stgwrite("\tdec.i\n");
+	code_idx += opcodes(1);
+     }
+   else if (lval->ident == iARRAYCHAR)
+     {
+	/* indirect decrement of single character, address already in PRI */
+	stgwrite("\tpush.pri\n");
+	stgwrite("\tpush.alt\n");
+	stgwrite("\tmove.alt\n");	/* copy address */
+	stgwrite("\tlodb.i ");	/* read from PRI into PRI */
+	outval(charbits / 8, TRUE);	/* read one or two bytes */
+	stgwrite("\tdec.pri\n");
+	stgwrite("\tstrb.i ");	/* write PRI to ALT */
+	outval(charbits / 8, TRUE);	/* write one or two bytes */
+	stgwrite("\tpop.alt\n");
+	stgwrite("\tpop.pri\n");
+	code_idx += opcodes(8) + opargs(2);
+     }
+   else if (lval->ident == iREFERENCE)
+     {
+	assert(sym != NULL);
+	stgwrite("\tpush.pri\n");
+	/* load dereferenced value */
+	assert(sym->vclass == sLOCAL);	/* global references don't exist in Small */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tlref.s.pri ");
+	else
+	   stgwrite("\tlref.pri ");
+	outval(sym->addr, TRUE);
+	/* decrement */
+	stgwrite("\tdec.pri\n");
+	/* store dereferenced value */
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tsref.s.pri ");
+	else
+	   stgwrite("\tsref.pri ");
+	outval(sym->addr, TRUE);
+	stgwrite("\tpop.pri\n");
+	code_idx += opcodes(5) + opargs(2);
+     }
+   else
+     {
+	/* local or global variable */
+	assert(sym != NULL);
+	if (sym->vclass == sLOCAL)
+	   stgwrite("\tdec.s ");
+	else
+	   stgwrite("\tdec ");
+	outval(sym->addr, TRUE);
+	code_idx += opcodes(1) + opargs(1);
+     }				/* if */
+}
+
+/*
+ *  Jumps to "label" if PRI != 0
+ */
+void
+jmp_ne0(int number)
+{
+   stgwrite("\tjnz ");
+   outval(number, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/*
+ *  Jumps to "label" if PRI == 0
+ */
+void
+jmp_eq0(int number)
+{
+   stgwrite("\tjzer ");
+   outval(number, TRUE);
+   code_idx += opcodes(1) + opargs(1);
+}
+
+/* write a value in hexadecimal; optionally adds a newline */
+void
+outval(cell val, int newline)
+{
+   stgwrite(itoh(val));
+   if (newline)
+      stgwrite("\n");
+}
diff --git a/src/bin/embryo_cc_sc5.c b/src/bin/embryo_cc_sc5.c
new file mode 100644
index 0000000..a8af498
--- /dev/null
+++ b/src/bin/embryo_cc_sc5.c
@@ -0,0 +1,154 @@
+/*  Small compiler - Error message system
+ *  In fact a very simple system, using only 'panic mode'.
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#include "embryo_cc_sc.h"
+#include "embryo_cc_sc5.scp"
+
+static int errflag;
+static int errstart;	/* line number at which the instruction started */
+
+/*  error
+ *
+ *  Outputs an error message (note: msg is passed optionally).
+ *  If an error is found, the variable "errflag" is set and subsequent
+ *  errors are ignored until lex() finds a semicolumn or a keyword
+ *  (lex() resets "errflag" in that case).
+ *
+ *  Global references: inpfname   (referred to only)
+ *                     fline      (referred to only)
+ *                     fcurrent   (referred to only)
+ *                     errflag    (altered)
+ */
+int
+error(int number, ...)
+{
+   static int          lastline, lastfile, errorcount;
+   char               *msg;
+   va_list             argptr;
+   char                string[1024];
+   int start;
+
+   /* errflag is reset on each semicolon.
+    * In a two-pass compiler, an error should not be reported twice. Therefore
+    * the error reporting is enabled only in the second pass (and only when
+    * actually producing output). Fatal errors may never be ignored.
+    */
+   if (((errflag) || (sc_status != statWRITE)) &&
+       ((number < 100) || (number >= 200)))
+     return 0;
+
+   if (number < 100)
+     {
+	msg = errmsg[number - 1];
+	errflag = TRUE;	/* set errflag (skip rest of erroneous expression) */
+	errnum++;
+     }
+   else if (number < 200)
+     {
+	msg = fatalmsg[number - 100];
+	errnum++; /* a fatal error also counts as an error */
+     }
+   else
+     {
+	msg = warnmsg[number - 200];
+	warnnum++;
+     }
+
+   strexpand(string, (unsigned char *)msg, sizeof string, SCPACK_TABLE);
+
+   va_start(argptr, number);
+
+   start = (errstart == fline) ? -1 : errstart;
+
+   if (sc_error(number, string, inpfname, start, fline, argptr))
+   {
+      sc_closeasm(outf);
+      outf = NULL;
+      longjmp(errbuf, 3);
+   }
+
+   va_end(argptr);
+
+   if (((number >= 100) && (number < 200)) || (errnum > 250))
+     {
+	va_start(argptr, number);
+	sc_error(0, "\nCompilation aborted.", NULL, 0, 0, argptr);
+	va_end(argptr);
+
+	if (outf)
+	  {
+	     sc_closeasm(outf);
+	     outf = NULL;
+	  }			/* if */
+	longjmp(errbuf, 2);	/* fatal error, quit */
+     }				/* if */
+
+   /* check whether we are seeing many errors on the same line */
+   if (((errstart < 0) && (lastline != fline)) ||
+       (lastline < errstart) || (lastline > fline) || (fcurrent != lastfile))
+      errorcount = 0;
+   lastline = fline;
+   lastfile = fcurrent;
+   if (number < 200)
+      errorcount++;
+   if (errorcount >= 3)
+      error(107); /* too many error/warning messages on one line */
+   return 0;
+}
+
+void
+errorset(int code)
+{
+   switch (code)
+     {
+      case sRESET:
+	errflag = FALSE;	/* start reporting errors */
+	break;
+      case sFORCESET:
+	errflag = TRUE;		/* stop reporting errors */
+	break;
+      case sEXPRMARK:
+	errstart = fline;	/* save start line number */
+	break;
+      case sEXPRRELEASE:
+	errstart = -1;		/* forget start line number */
+	break;
+      default:
+	break;
+     }
+}
diff --git a/src/bin/embryo_cc_sc5.scp b/src/bin/embryo_cc_sc5.scp
new file mode 100644
index 0000000..bf0a606
--- /dev/null
+++ b/src/bin/embryo_cc_sc5.scp
@@ -0,0 +1,317 @@
+/*  Small compiler - Error message strings (plain and compressed formats)
+ *
+ *  Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+int         strexpand(char *dest, unsigned char *source, int maxlen,
+			      unsigned char pairtable[128][2]);
+
+#define SCPACK_TABLE errstr_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char       errstr_table[][2] = {
+   {101, 32}, {116, 32}, {111, 110}, {105, 110}, {97, 114}, {100, 32}, {105,
+									130},
+      {101, 114}, {101, 110}, {115, 32}, {97, 108}, {97, 116}, {117, 110}, {115,
+									    34},
+      {37, 141}, {34, 142},
+   {109, 136}, {121, 32}, {97, 110}, {114, 101}, {99, 116}, {134, 32}, {110,
+									111},
+      {101, 133}, {118, 138}, {115, 105}, {98, 108}, {111, 114}, {115, 116},
+      {41, 10}, {109, 98}, {100, 101},
+   {117, 115}, {150, 129}, {102, 140}, {117, 144}, {162, 148}, {103, 163}, {132,
+									    165},
+      {114, 97}, {105, 133}, {152, 168}, {99, 104}, {32, 143}, {97, 32}, {131,
+									  169},
+      {97, 115}, {164, 149},
+   {111, 108}, {101, 120}, {97, 154}, {135, 32}, {132, 167}, {111, 102}, {105,
+									  116},
+      {166, 129}, {101, 100}, {98, 128}, {178, 128}, {160, 129}, {105, 137},
+      {180, 145}, {121, 158}, {190, 176},
+   {109, 187}, {115, 191}, {118, 132}, {101, 10}, {115, 10}, {112, 147}, {155,
+									  32},
+      {181, 32}, {159, 102}, {194, 105}, {99, 130}, {103, 32}, {201, 186}, {116,
+									    111},
+      {34, 32}, {109, 97},
+   {153, 122}, {171, 10}, {104, 97}, {100, 105}, {108, 111}, {111, 112}, {200,
+									  131},
+      {139, 134}, {213, 135}, {101, 137}, {202, 156}, {143, 157}, {138, 32},
+      {192, 185}, {58, 209}, {105, 99},
+   {112, 111}, {115, 115}, {110, 117}, {115, 117}, {146, 129}, {226, 158}, {229,
+									    179},
+      {177, 197}, {231, 225}, {132, 97}, {98, 101}, {99, 111}, {216, 139}, {109,
+									    139},
+      {116, 10}, {99, 146},
+   {44, 32}, {237, 170}, {131, 203}, {116, 104}, {117, 108}, {152, 117}, {108,
+									  128},
+      {118, 128}, {101, 144}, {233, 148}, {174, 153}, {110, 32}, {131, 32},
+      {146, 32}, {239, 161}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+static char        *errmsg[] = {
+#ifdef SCPACK
+/*001*/ "expected token: \"%s\", but found \"%s\"\n",
+/*002*/ "only a single statement (or expression) can follow each \"case\"\n",
+/*003*/ "declaration of a local variable must appear in a compound block\n",
+/*004*/ "function \"%s\" is not implemented\n",
+/*005*/ "function may not have arguments\n",
+/*006*/ "must be assigned to an array\n",
+/*007*/ "assertion failed\n",
+/*008*/ "must be a constant expression; assumed zero\n",
+/*009*/ "invalid array size (negative or zero)\n",
+/*010*/ "invalid function or declaration\n",
+/*011*/ "invalid outside functions\n",
+/*012*/ "invalid function call, not a valid address\n",
+/*013*/ "no entry point (no public functions)\n",
+/*014*/ "invalid statement; not in switch\n",
+/*015*/ "\"default\" case must be the last case in switch statement\n",
+/*016*/ "multiple defaults in \"switch\"\n",
+/*017*/ "undefined symbol \"%s\"\n",
+/*018*/ "initialization data exceeds declared size\n",
+/*019*/ "not a label: \"%s\"\n",
+/*020*/ "invalid symbol name \"%s\"\n",
+/*021*/ "symbol already defined: \"%s\"\n",
+/*022*/ "must be lvalue (non-constant)\n",
+/*023*/ "array assignment must be simple assignment\n",
+/*024*/ "\"break\" or \"continue\" is out of context\n",
+/*025*/ "function heading differs from prototype\n",
+/*026*/ "no matching \"#if...\"\n",
+/*027*/ "invalid character constant\n",
+/*028*/ "invalid subscript (not an array or too many subscripts)\n",
+/*029*/ "invalid expression, assumed zero\n",
+/*030*/ "compound statement not closed at the end of file\n",
+/*031*/ "unknown directive\n",
+/*032*/ "array index out of bounds (variable \"%s\")\n",
+/*033*/ "array must be indexed (variable \"%s\")\n",
+/*034*/ "argument does not have a default value (argument %d)\n",
+/*035*/ "argument type mismatch (argument %d)\n",
+/*036*/ "empty statement\n",
+/*037*/ "invalid string (possibly non-terminated string)\n",
+/*038*/ "extra characters on line\n",
+/*039*/ "constant symbol has no size\n",
+/*040*/ "duplicate \"case\" label (value %d)\n",
+/*041*/ "invalid ellipsis, array size is not known\n",
+/*042*/ "invalid combination of class specifiers\n",
+/*043*/ "character constant exceeds range for packed string\n",
+/*044*/ "positional parameters must precede all named parameters\n",
+/*045*/ "too many function arguments\n",
+/*046*/ "unknown array size (variable \"%s\")\n",
+/*047*/ "array sizes must match\n",
+/*048*/ "array dimensions must match\n",
+/*049*/ "invalid line continuation\n",
+/*050*/ "invalid range\n",
+/*051*/ "invalid subscript, use \"[ ]\" operators on major dimensions\n",
+/*052*/ "only the last dimension may be variable length\n",
+/*053*/ "exceeding maximum number of dimensions\n",
+/*054*/ "unmatched closing brace\n",
+/*055*/ "start of function body without function header\n",
+/*056*/
+      "arrays, local variables and function arguments cannot be public (variable \"%s\")\n",
+/*057*/ "unfinished expression before compiler directive\n",
+/*058*/ "duplicate argument; same argument is passed twice\n",
+/*059*/ "function argument may not have a default value (variable \"%s\")\n",
+/*060*/ "multiple \"#else\" directives between \"#if ... #endif\"\n",
+/*061*/ "operator cannot be redefined\n",
+/*062*/ "number of operands does not fit the operator\n",
+/*063*/ "function result tag of operator \"%s\" must be \"%s\"\n",
+/*064*/ "cannot change predefined operators\n",
+/*065*/ "function argument may only have a single tag (argument %d)\n",
+/*066*/
+      "function argument may not be a reference argument or an array (argument \"%s\")\n",
+/*067*/
+      "variable cannot be both a reference and an array (variable \"%s\")\n",
+/*068*/ "invalid rational number precision in #pragma\n",
+/*069*/ "rational number format already defined\n",
+/*070*/ "rational number support was not enabled\n",
+/*071*/
+      "user-defined operator must be declared before use (function \"%s\")\n",
+/*072*/ "\"sizeof\" operator is invalid on \"function\" symbols\n",
+/*073*/ "function argument must be an array (argument \"%s\")\n",
+/*074*/ "#define pattern must start with an alphabetic character\n",
+/*075*/ "input line too long (after substitutions)\n"
+#else
+   "\261pe\224\227\315k\210:\253\360bu\201fo\214\205\217\012",
+   "\202l\221\254s\203g\366\234\213\370\201(\306\350\206) \357 f\260\324w ea\252 \042c\256e\042\012",
+   "\237cl\204\213\225\307\254\324c\334\314\300appe\204 \374\254\353m\340\214\205\232ock\012",
+   "\257\217 \274\241impl\370t\270\012",
+   "\257\317\221\241\322\367\246t\304",
+   "\335\372gn\227\315 \375\264y\012",
+   "\256s\207t\225fail\270\012",
+   "\335\254\332\344\350\206; \256\343m\227z\207o\012",
+   "\255\275\320\200(neg\213i\367\306z\207o\235",
+   "\255\257\306\237cl\204\327\012",
+   "\255out\231d\200\244\206\304",
+   "\255\257c\212l\360\241\254\251add\223s\304",
+   "\226 \210tr\221\340\203\201(\226 pu\232\337 \244\206s\235",
+   "\255\234\213\370t; \241\374sw\266\252\012",
+   "\042\310a\364t\316c\256\200\335\363\200l\256\201c\256\200\374sw\266\252 \234\213\370\356",
+   "m\364tip\366\310a\364t\211\374\042sw\266\252\042\012",
+   "\214\326\227\301\321",
+   "\203\266i\212iz\213\225d\213\254\261ce\270\211\237cl\204\227\320\303",
+   "\241\254la\352l\336",
+   "\255\301 nam\200\217\012",
+   "\301 \212\223ad\221\326\270\336",
+   "\335l\365\200(n\202-\332\222t\235",
+   "\275\372gn\220\201\335\231mp\366\372gn\220\356",
+   "\042b\223ak\316\306\042\312t\203ue\316\274ou\201\307\312t\261\356",
+   "\257head\362\323ff\207\211from pro\315typ\303",
+   "\226 \361\362\042#if...\042\012",
+   "\255\252\371\263\332\222\356",
+   "\255\343bscrip\201(\241\375\275\306\315o m\222\221\343bscripts\235",
+   "\255\350\206\360\256\343m\227z\207o\012",
+   "\353m\340\214\205\234\213\370\201\241c\324s\227a\201\363\200\210\205\307fil\303",
+   "\214k\226w\373\323\223\224iv\303",
+   "\275\203\237x ou\201\307bo\214d\211(\314\333",
+   "\275\335\203\237x\227(\314\333",
+   "\267do\331\241\322\367\254\310a\364\201\365\200(\267%d\235",
+   "\267typ\200mis\361 (\267%d\235",
+   "empt\221\234\213\370\356",
+   "\255\234r\362(\340s\231\232\221n\202-t\207m\203\213\227\234r\203g\235",
+   "\261t\247 \252\371\207\211\202 l\203\303",
+   "\332\344\301 \322\211\226 \320\303",
+   "dupl\337\213\200\042c\256e\316la\352l (\365\200%d\235",
+   "\255ellip\231s\360\275\320\200\274\241k\226wn\012",
+   "\255\353\236\203\213\225\307cl\256\211specifi\207\304",
+   "\252\371\263\332\344\261ce\270\211r\222g\200f\306pack\227\234r\203g\012",
+   "\340\231t\206\334p\351met\207\211\300\305c\270\200\212l nam\227p\351met\207\304",
+   "\315o m\222\221\257\246t\304",
+   "\214k\226w\373\275\320\200(\314\333",
+   "\275\320\331\300\361\012",
+   "\275\323\220s\206\211\300\361\012",
+   "\255l\203\200\312t\203u\327\012",
+   "\255r\222g\303",
+   "\255\343bscript\360\240\200\042[ ]\316\354\233\211\202 \317j\306\323\220s\206\304",
+   "\202l\221\363\200l\256\201\323\220s\225\317\221\271\314l\210g\363\012",
+   "\261ce\270\362\317ximum \346\307\323\220s\206\304",
+   "\214\361\227c\324s\362b\247c\303",
+   "\234\204\201\307\257bod\221w\266hou\201\257head\207\012",
+   "\264ys\360\324c\334\311\262\331\222\205\257\246t\211\376\271pu\232\337 (\314\333",
+   "\214f\203ish\227\350\225\352f\233\200\353mpil\263\323\223\224iv\303",
+   "dupl\337\213\200\246t; sam\200\267\274p\256s\227tw\337\303",
+   "\257\267\317\221\241\322\367\254\310a\364\201\365\200(\314\333",
+   "m\364tip\366\042#else\316\323\223\224iv\331\352twe\210 \042#if ... #\210\323f\042\012",
+   "\354\306\376\271\223\326\270\012",
+   "\346\307\330\222d\211do\331\241fi\201\363\200\354\233\012",
+   "\257\223\343l\201ta\313\307\354\233\253 \335\217\012",
+   "\376\252\222g\200\305\326\227\354\233\304",
+   "\257\267\317\221\202l\221\322\367\254s\203g\366ta\313(\267%d\235",
+   "\257\267\317\221\241\271\254\223f\207\210c\200\267\306\375\275(\267\333",
+   "\314\376\271bo\363 \254\223f\207\210c\200\222\205\375\275(\314\333",
+   "\255r\327\334\346\305cis\225\374#p\247g\317\012",
+   "r\327\334\346f\233\317\201\212\223ad\221\326\270\012",
+   "r\327\334\346\343pp\233\201wa\211\241\210\262\270\012",
+   "\240\207-\326\227\354\306\335\237cl\204\227\352f\233\200\240\200(\257\333",
+   "\042\320e\265\316\354\306\274\255\202 \042\244\206\316\301\304",
+   "\257\267\335\375\275(\267\333",
+   "#\326\200p\213t\207\373\300\234\204\201w\266h \375\212p\322\352t\337 \252\371\207\012",
+   "\203pu\201l\203\200\315o l\202\313(aft\263\343b\234\266ut\206s\235"
+#endif
+};
+
+static char        *fatalmsg[] = {
+#ifdef SCPACK
+/*100*/ "cannot read from file: \"%s\"\n",
+/*101*/ "cannot write to file: \"%s\"\n",
+/*102*/ "table overflow: \"%s\"\n",
+   /* table can be: loop table
+    *               literal table
+    *               staging buffer
+    *               parser stack (recursive include?)
+    *               option table (response file)
+    *               peephole optimizer table
+    */
+/*103*/ "insufficient memory\n",
+/*104*/ "invalid assembler instruction \"%s\"\n",
+/*105*/ "numeric overflow, exceeding capacity\n",
+/*106*/ "compaction buffer overflow\n",
+/*107*/ "too many error messages on one line\n"
+#else
+   "\376\223a\205from file\336",
+   "\376wr\266\200\315 file\336",
+   "t\272ov\207f\324w\336",
+   "\203\343ff\337i\210\201mem\233y\012",
+   "\255\256sem\232\263\203\234ru\224\225\217\012",
+   "\342m\207\337 ov\207f\324w\360\261ce\270\362capac\266y\012",
+   "\353mpa\224\225buff\263ov\207f\324w\012",
+   "\315o m\222\221\207r\306me\341ag\331\202 \202\200l\203\303"
+#endif
+};
+
+static char        *warnmsg[] = {
+#ifdef SCPACK
+/*200*/ "symbol \"%s\" is truncated to %d characters\n",
+/*201*/ "redefinition of constant/macro (symbol \"%s\")\n",
+/*202*/ "number of arguments does not match definition\n",
+/*203*/ "symbol is never used: \"%s\"\n",
+/*204*/ "symbol is assigned a value that is never used: \"%s\"\n",
+/*205*/ "redundant code: constant expression is zero\n",
+/*206*/ "redundant test: constant expression is non-zero\n",
+/*207*/ "unknown #pragma\n",
+/*208*/ "function uses both \"return;\" and \"return <value>;\"\n",
+/*209*/ "function \"%s\" should return a value\n",
+/*210*/ "possible use of symbol before initialization: \"%s\"\n",
+/*211*/ "possibly unintended assignment\n",
+/*212*/ "possibly unintended bitwise operation\n",
+/*213*/ "tag mismatch\n",
+/*214*/ "possibly a \"const\" array argument was intended: \"%s\"\n",
+/*215*/ "expression has no effect\n",
+/*216*/ "nested comment\n",
+/*217*/ "loose indentation\n",
+/*218*/ "old style prototypes used with optional semicolumns\n",
+/*219*/ "local variable \"%s\" shadows a variable at a preceding level\n",
+/*220*/ "exported or native symbol \"%s\" is truncated to %d characters\n",
+/*221*/ "label name \"%s\" shadows tag name\n",
+/*222*/ "number of digits exceeds rational number precision\n",
+/*223*/ "redundant \"sizeof\": argument size is always 1 (symbol \"%s\")\n",
+/*224*/
+      "indeterminate array size in \"sizeof\" expression (symbol \"%s\")\n",
+/*225*/ "unreachable code\n",
+/*226*/ "a variable is assigned to itself (symbol \"%s\")\n"
+#else
+   "\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+   "\223\326\266\225\307\332\222t/\317cro (\301\253\235",
+   "\346\307\246t\211do\331\241\361 \326\266\206\012",
+   "\301 \274nev\263\240\270\336",
+   "\301 \274\372gn\227\254\365\200t\322\201\274nev\263\240\270\336",
+   "\223d\214d\344\353\237: \332\344\350\225\274z\207o\012",
+   "\223d\214d\344te\234: \332\344\350\225\274n\202-z\207o\012",
+   "\214k\226w\373#p\247g\317\012",
+   "\257\240\331bo\363 \042\223turn;\316\222\205\042\223tur\373<\365e>;\042\012",
+   "\257\217 sho\364\205\223tur\373\254\365\303",
+   "\340s\231\232\200\240\200\307\301 \352f\233\200\203\266i\212iz\327\336",
+   "\340s\231\232\221\214\203t\210d\227\372gn\220\356",
+   "\340s\231\232\221\214\203t\210d\227b\266wis\200\330\327\012",
+   "ta\313mis\361\012",
+   "\340s\231\232\221\254\042\332\316\275\267wa\211\203t\210\237d\336",
+   "\350\225\322\211\226 effe\224\012",
+   "ne\234\227\353m\220\356",
+   "\324os\200\203d\210t\327\012",
+   "\260\205\234y\366pro\315typ\331\240\227w\266h \325t\206\334sem\337\260umn\304",
+   "\324c\334\314\217 s\322dow\211\254\314a\201\254\305c\270\362level\012",
+   "\261p\233t\227\306n\213i\367\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
+   "la\352l nam\200\217 s\322dow\211ta\313nam\303",
+   "\346\307\323g\266\211\261ce\270\211r\327\334\346\305cis\206\012",
+   "\223d\214d\344\042\320e\265\042: \267\320\200\274\212way\2111 (\301\253\235",
+   "\203\237t\207m\203\213\200\275\320\200\374\042\320e\265\316\350\225(\301\253\235",
+   "\214\223a\252\272\353\237\012",
+   "\254\314\274\372gn\227\315 \266self (\301\253\235"
+#endif
+};
diff --git a/src/bin/embryo_cc_sc6.c b/src/bin/embryo_cc_sc6.c
new file mode 100644
index 0000000..417a8a1
--- /dev/null
+++ b/src/bin/embryo_cc_sc6.c
@@ -0,0 +1,1077 @@
+/*  Small compiler - Binary code generation (the "assembler")
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>		/* for macro max() */
+#include <string.h>
+#include <ctype.h>
+#include "embryo_cc_sc.h"
+
+typedef             cell(*OPCODE_PROC) (FILE * fbin, char *params, cell opcode);
+
+typedef struct
+{
+   cell                opcode;
+   char               *name;
+   int                 segment;	/* sIN_CSEG=parse in cseg, sIN_DSEG=parse in dseg */
+   OPCODE_PROC         func;
+} OPCODE;
+
+static cell         codeindex;	/* similar to "code_idx" */
+static cell        *lbltab;	/* label table */
+static int          writeerror;
+static int          bytes_in, bytes_out;
+
+/* apparently, strtol() does not work correctly on very large (unsigned)
+ * hexadecimal values */
+static ucell
+hex2long(char *s, char **n)
+{
+   unsigned long       result = 0L;
+   int                 negate = FALSE;
+   int                 digit;
+
+   /* ignore leading whitespace */
+   while (*s == ' ' || *s == '\t')
+      s++;
+
+   /* allow a negation sign to create the two's complement of numbers */
+   if (*s == '-')
+     {
+	negate = TRUE;
+	s++;
+     }				/* if */
+
+   assert((*s >= '0' && *s <= '9') || (*s >= 'a' && *s <= 'f')
+	  || (*s >= 'a' && *s <= 'f'));
+   for (;;)
+     {
+	if (*s >= '0' && *s <= '9')
+	   digit = *s - '0';
+	else if (*s >= 'a' && *s <= 'f')
+	   digit = *s - 'a' + 10;
+	else if (*s >= 'A' && *s <= 'F')
+	   digit = *s - 'A' + 10;
+	else
+	   break;		/* probably whitespace */
+	result = (result << 4) | digit;
+	s++;
+     }				/* for */
+   if (n)
+      *n = s;
+   if (negate)
+      result = (~result) + 1;	/* take two's complement of the result */
+   return (ucell) result;
+}
+
+#ifdef WORDS_BIGENDIAN
+static short       *
+align16(short *v)
+{
+   unsigned char      *s = (unsigned char *)v;
+   unsigned char       t;
+
+   /* swap two bytes */
+   t = s[0];
+   s[0] = s[1];
+   s[1] = t;
+   return v;
+}
+
+static long        *
+align32(long *v)
+{
+   unsigned char      *s = (unsigned char *)v;
+   unsigned char       t;
+
+   /* swap outer two bytes */
+   t = s[0];
+   s[0] = s[3];
+   s[3] = t;
+   /* swap inner two bytes */
+   t = s[1];
+   s[1] = s[2];
+   s[2] = t;
+   return v;
+}
+#if defined BIT16
+#define aligncell(v)  align16(v)
+#else
+#define aligncell(v)  align32(v)
+#endif
+#else
+#define align16(v)    (v)
+#define align32(v)    (v)
+#define aligncell(v)  (v)
+#endif
+
+static char        *
+skipwhitespace(char *str)
+{
+   while (isspace(*str))
+      str++;
+   return str;
+}
+
+static char        *
+stripcomment(char *str)
+{
+   char               *ptr = strchr(str, ';');
+
+   if (ptr)
+     {
+	*ptr++ = '\n';		/* terminate the line, but leave the '\n' */
+	*ptr = '\0';
+     }				/* if */
+   return str;
+}
+
+static void
+write_encoded(FILE * fbin, ucell * c, int num)
+{
+   assert(sizeof(cell) <= 4);	/* code must be adjusted for larger cells */
+   assert(fbin != NULL);
+   while (num-- > 0)
+     {
+	if (sc_compress)
+	  {
+	     ucell               p = (ucell) * c;
+	     unsigned char       t[5];	/* a 32-bit cell is encoded in max. 5 bytes (3 bytes for a 16-bit cell) */
+	     unsigned char       code;
+	     int                 index;
+
+	     for (index = 0; index < 5; index++)
+	       {
+		  t[index] = (unsigned char)(p & 0x7f);	/* store 7 bits */
+		  p >>= 7;
+	       }		/* for */
+	     /* skip leading zeros */
+	     while (index > 1 && t[index - 1] == 0
+		    && (t[index - 2] & 0x40) == 0)
+		index--;
+	     /* skip leading -1s *//* ??? for BIT16, check for index==3 && t[index-1]==0x03 */
+	     if (index == 5 && t[index - 1] == 0x0f
+		 && (t[index - 2] & 0x40) != 0)
+		index--;
+	     while (index > 1 && t[index - 1] == 0x7f
+		    && (t[index - 2] & 0x40) != 0)
+		index--;
+	     /* write high byte first, write continuation bits */
+	     assert(index > 0);
+	     while (index-- > 0)
+	       {
+		  code =
+		     (unsigned char)((index == 0) ? t[index]
+				     : (t[index] | 0x80));
+		  writeerror |= !sc_writebin(fbin, &code, 1);
+		  bytes_out++;
+	       }		/* while */
+	     bytes_in += sizeof *c;
+	     assert(AMX_EXPANDMARGIN > 2);
+	     if (bytes_out - bytes_in >= AMX_EXPANDMARGIN - 2)
+		error(106);	/* compression buffer overflow */
+	  }
+	else
+	  {
+	     assert((sc_lengthbin(fbin) % sizeof(cell)) == 0);
+	     writeerror |= !sc_writebin(fbin, aligncell(c), sizeof *c);
+	  }			/* if */
+	c++;
+     }				/* while */
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+noop(FILE * fbin __UNUSED__, char *params __UNUSED__, cell opcode __UNUSED__)
+{
+   return 0;
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+parm0(FILE * fbin, char *params __UNUSED__, cell opcode)
+{
+   if (fbin)
+      write_encoded(fbin, (ucell *) & opcode, 1);
+   return opcodes(1);
+}
+
+static cell
+parm1(FILE * fbin, char *params, cell opcode)
+{
+   ucell               p = hex2long(params, NULL);
+
+   if (fbin)
+     {
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &p, 1);
+     }				/* if */
+   return opcodes(1) + opargs(1);
+}
+
+static cell
+parm2(FILE * fbin, char *params, cell opcode)
+{
+   ucell               p[2];
+
+   p[0] = hex2long(params, &params);
+   p[1] = hex2long(params, NULL);
+   if (fbin)
+     {
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, p, 2);
+     }				/* if */
+   return opcodes(1) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_dump(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+   ucell               p;
+   int                 num = 0;
+
+   while (*params != '\0')
+     {
+	p = hex2long(params, &params);
+	if (fbin)
+	   write_encoded(fbin, &p, 1);
+	num++;
+	while (isspace(*params))
+	   params++;
+     }				/* while */
+   return num * sizeof(cell);
+}
+
+static cell
+do_call(FILE * fbin, char *params, cell opcode)
+{
+   char                name[sNAMEMAX + 1];
+   int                 i;
+   symbol             *sym;
+   ucell               p;
+
+   for (i = 0; !isspace(*params); i++, params++)
+     {
+	assert(*params != '\0');
+	assert(i < sNAMEMAX);
+	name[i] = *params;
+     }				/* for */
+   name[i] = '\0';
+
+   /* look up the function address; note that the correct file number must
+    * already have been set (in order for static globals to be found).
+    */
+   sym = findglb(name);
+   assert(sym != NULL);
+   assert(sym->ident == iFUNCTN || sym->ident == iREFFUNC);
+   assert(sym->vclass == sGLOBAL);
+
+   p = sym->addr;
+   if (fbin)
+     {
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &p, 1);
+     }				/* if */
+   return opcodes(1) + opargs(1);
+}
+
+static cell
+do_jump(FILE * fbin, char *params, cell opcode)
+{
+   int                 i;
+   ucell               p;
+
+   i = (int)hex2long(params, NULL);
+   assert(i >= 0 && i < labnum);
+
+   if (fbin)
+     {
+	assert(lbltab != NULL);
+	p = lbltab[i];
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &p, 1);
+     }				/* if */
+   return opcodes(1) + opargs(1);
+}
+
+static cell
+do_file(FILE * fbin, char *params, cell opcode)
+{
+   ucell               p, clen;
+   int                 len;
+
+   p = hex2long(params, &params);
+
+   /* remove leading and trailing white space from the filename */
+   while (isspace(*params))
+      params++;
+   len = strlen(params);
+   while (len > 0 && isspace(params[len - 1]))
+      len--;
+   params[len++] = '\0';	/* zero-terminate */
+   while (len % sizeof(cell) != 0)
+      params[len++] = '\0';	/* pad with zeros up to full cell */
+   assert(len > 0 && len < 256);
+   clen = len + sizeof(cell);	/* add size of file ordinal */
+
+   if (fbin)
+     {
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &clen, 1);
+	write_encoded(fbin, &p, 1);
+	write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+     }				/* if */
+   return opcodes(1) + opargs(1) + clen;	/* other argument is in clen */
+}
+
+static cell
+do_symbol(FILE * fbin, char *params, cell opcode)
+{
+   char               *endptr;
+   ucell               offset, clen, flags;
+   int                 len;
+   unsigned char       mclass, type;
+
+   for (endptr = params; !isspace(*endptr) && endptr != '\0'; endptr++)
+      /* nothing */ ;
+   assert(*endptr == ' ');
+
+   len = (int)(endptr - params);
+   assert(len > 0 && len < sNAMEMAX);
+   /* first get the other parameters from the line */
+   offset = hex2long(endptr, &endptr);
+   mclass = (unsigned char)hex2long(endptr, &endptr);
+   type = (unsigned char)hex2long(endptr, NULL);
+   flags = type + 256 * mclass;
+   /* now finish up the name (overwriting the input line) */
+   params[len++] = '\0';	/* zero-terminate */
+   while (len % sizeof(cell) != 0)
+      params[len++] = '\0';	/* pad with zeros up to full cell */
+   clen = len + 2 * sizeof(cell);	/* add size of symbol address and flags */
+
+   if (fbin)
+     {
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &clen, 1);
+	write_encoded(fbin, &offset, 1);
+	write_encoded(fbin, &flags, 1);
+	write_encoded(fbin, (ucell *) params, len / sizeof(cell));
+     }				/* if */
+
+#if !defined NDEBUG
+   /* function should start right after the symbolic information */
+   if (!fbin && mclass == 0 && type == iFUNCTN)
+      assert(offset == codeindex + opcodes(1) + opargs(1) + clen);
+#endif
+
+   return opcodes(1) + opargs(1) + clen;	/* other 2 arguments are in clen */
+}
+
+static cell
+do_switch(FILE * fbin, char *params, cell opcode)
+{
+   int                 i;
+   ucell               p;
+
+   i = (int)hex2long(params, NULL);
+   assert(i >= 0 && i < labnum);
+
+   if (fbin)
+     {
+	assert(lbltab != NULL);
+	p = lbltab[i];
+	write_encoded(fbin, (ucell *) & opcode, 1);
+	write_encoded(fbin, &p, 1);
+     }				/* if */
+   return opcodes(1) + opargs(1);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+do_case(FILE * fbin, char *params, cell opcode __UNUSED__)
+{
+   int                 i;
+   ucell               p, v;
+
+   v = hex2long(params, &params);
+   i = (int)hex2long(params, NULL);
+   assert(i >= 0 && i < labnum);
+
+   if (fbin)
+     {
+	assert(lbltab != NULL);
+	p = lbltab[i];
+	write_encoded(fbin, &v, 1);
+	write_encoded(fbin, &p, 1);
+     }				/* if */
+   return opcodes(0) + opargs(2);
+}
+
+#if defined __BORLANDC__ || defined __WATCOMC__
+#pragma argsused
+#endif
+
+static cell
+curfile(FILE * fbin __UNUSED__, char *params, cell opcode __UNUSED__)
+{
+   fcurrent = (int)hex2long(params, NULL);
+   return 0;
+}
+
+static OPCODE       opcodelist[] = {
+   /* node for "invalid instruction" */
+   {0, NULL, 0, noop},
+   /* opcodes in sorted order */
+   {78, "add", sIN_CSEG, parm0},
+   {87, "add.c", sIN_CSEG, parm1},
+   {14, "addr.alt", sIN_CSEG, parm1},
+   {13, "addr.pri", sIN_CSEG, parm1},
+   {30, "align.alt", sIN_CSEG, parm1},
+   {29, "align.pri", sIN_CSEG, parm1},
+   {81, "and", sIN_CSEG, parm0},
+   {121, "bounds", sIN_CSEG, parm1},
+   {49, "call", sIN_CSEG, do_call},
+   {50, "call.pri", sIN_CSEG, parm0},
+   {0, "case", sIN_CSEG, do_case},
+   {130, "casetbl", sIN_CSEG, parm0},	/* version 1 */
+   {118, "cmps", sIN_CSEG, parm1},
+   {0, "code", 0, noop},
+   {12, "const.alt", sIN_CSEG, parm1},
+   {11, "const.pri", sIN_CSEG, parm1},
+   {0, "curfile", sIN_CSEG, curfile},
+   {0, "data", 0, noop},
+   {114, "dec", sIN_CSEG, parm1},
+   {113, "dec.alt", sIN_CSEG, parm0},
+   {116, "dec.i", sIN_CSEG, parm0},
+   {112, "dec.pri", sIN_CSEG, parm0},
+   {115, "dec.s", sIN_CSEG, parm1},
+   {0, "dump", sIN_DSEG, do_dump},
+   {95, "eq", sIN_CSEG, parm0},
+   {106, "eq.c.alt", sIN_CSEG, parm1},
+   {105, "eq.c.pri", sIN_CSEG, parm1},
+   {124, "file", sIN_CSEG, do_file},
+   {119, "fill", sIN_CSEG, parm1},
+   {100, "geq", sIN_CSEG, parm0},
+   {99, "grtr", sIN_CSEG, parm0},
+   {120, "halt", sIN_CSEG, parm1},
+   {45, "heap", sIN_CSEG, parm1},
+   {27, "idxaddr", sIN_CSEG, parm0},
+   {28, "idxaddr.b", sIN_CSEG, parm1},
+   {109, "inc", sIN_CSEG, parm1},
+   {108, "inc.alt", sIN_CSEG, parm0},
+   {111, "inc.i", sIN_CSEG, parm0},
+   {107, "inc.pri", sIN_CSEG, parm0},
+   {110, "inc.s", sIN_CSEG, parm1},
+   {86, "invert", sIN_CSEG, parm0},
+   {55, "jeq", sIN_CSEG, do_jump},
+   {60, "jgeq", sIN_CSEG, do_jump},
+   {59, "jgrtr", sIN_CSEG, do_jump},
+   {58, "jleq", sIN_CSEG, do_jump},
+   {57, "jless", sIN_CSEG, do_jump},
+   {56, "jneq", sIN_CSEG, do_jump},
+   {54, "jnz", sIN_CSEG, do_jump},
+   {52, "jrel", sIN_CSEG, parm1},	/* always a number */
+   {64, "jsgeq", sIN_CSEG, do_jump},
+   {63, "jsgrtr", sIN_CSEG, do_jump},
+   {62, "jsleq", sIN_CSEG, do_jump},
+   {61, "jsless", sIN_CSEG, do_jump},
+   {51, "jump", sIN_CSEG, do_jump},
+   {128, "jump.pri", sIN_CSEG, parm0},	/* version 1 */
+   {53, "jzer", sIN_CSEG, do_jump},
+   {31, "lctrl", sIN_CSEG, parm1},
+   {98, "leq", sIN_CSEG, parm0},
+   {97, "less", sIN_CSEG, parm0},
+   {25, "lidx", sIN_CSEG, parm0},
+   {26, "lidx.b", sIN_CSEG, parm1},
+   {125, "line", sIN_CSEG, parm2},
+   {2, "load.alt", sIN_CSEG, parm1},
+   {9, "load.i", sIN_CSEG, parm0},
+   {1, "load.pri", sIN_CSEG, parm1},
+   {4, "load.s.alt", sIN_CSEG, parm1},
+   {3, "load.s.pri", sIN_CSEG, parm1},
+   {10, "lodb.i", sIN_CSEG, parm1},
+   {6, "lref.alt", sIN_CSEG, parm1},
+   {5, "lref.pri", sIN_CSEG, parm1},
+   {8, "lref.s.alt", sIN_CSEG, parm1},
+   {7, "lref.s.pri", sIN_CSEG, parm1},
+   {34, "move.alt", sIN_CSEG, parm0},
+   {33, "move.pri", sIN_CSEG, parm0},
+   {117, "movs", sIN_CSEG, parm1},
+   {85, "neg", sIN_CSEG, parm0},
+   {96, "neq", sIN_CSEG, parm0},
+   {134, "nop", sIN_CSEG, parm0},	/* version 6 */
+   {84, "not", sIN_CSEG, parm0},
+   {82, "or", sIN_CSEG, parm0},
+   {43, "pop.alt", sIN_CSEG, parm0},
+   {42, "pop.pri", sIN_CSEG, parm0},
+   {46, "proc", sIN_CSEG, parm0},
+   {40, "push", sIN_CSEG, parm1},
+   {37, "push.alt", sIN_CSEG, parm0},
+   {39, "push.c", sIN_CSEG, parm1},
+   {36, "push.pri", sIN_CSEG, parm0},
+   {38, "push.r", sIN_CSEG, parm1},
+   {41, "push.s", sIN_CSEG, parm1},
+   {133, "pushaddr", sIN_CSEG, parm1},	/* version 4 */
+   {47, "ret", sIN_CSEG, parm0},
+   {48, "retn", sIN_CSEG, parm0},
+   {32, "sctrl", sIN_CSEG, parm1},
+   {73, "sdiv", sIN_CSEG, parm0},
+   {74, "sdiv.alt", sIN_CSEG, parm0},
+   {104, "sgeq", sIN_CSEG, parm0},
+   {103, "sgrtr", sIN_CSEG, parm0},
+   {65, "shl", sIN_CSEG, parm0},
+   {69, "shl.c.alt", sIN_CSEG, parm1},
+   {68, "shl.c.pri", sIN_CSEG, parm1},
+   {66, "shr", sIN_CSEG, parm0},
+   {71, "shr.c.alt", sIN_CSEG, parm1},
+   {70, "shr.c.pri", sIN_CSEG, parm1},
+   {94, "sign.alt", sIN_CSEG, parm0},
+   {93, "sign.pri", sIN_CSEG, parm0},
+   {102, "sleq", sIN_CSEG, parm0},
+   {101, "sless", sIN_CSEG, parm0},
+   {72, "smul", sIN_CSEG, parm0},
+   {88, "smul.c", sIN_CSEG, parm1},
+   {127, "srange", sIN_CSEG, parm2},	/* version 1 */
+   {20, "sref.alt", sIN_CSEG, parm1},
+   {19, "sref.pri", sIN_CSEG, parm1},
+   {22, "sref.s.alt", sIN_CSEG, parm1},
+   {21, "sref.s.pri", sIN_CSEG, parm1},
+   {67, "sshr", sIN_CSEG, parm0},
+   {44, "stack", sIN_CSEG, parm1},
+   {0, "stksize", 0, noop},
+   {16, "stor.alt", sIN_CSEG, parm1},
+   {23, "stor.i", sIN_CSEG, parm0},
+   {15, "stor.pri", sIN_CSEG, parm1},
+   {18, "stor.s.alt", sIN_CSEG, parm1},
+   {17, "stor.s.pri", sIN_CSEG, parm1},
+   {24, "strb.i", sIN_CSEG, parm1},
+   {79, "sub", sIN_CSEG, parm0},
+   {80, "sub.alt", sIN_CSEG, parm0},
+   {132, "swap.alt", sIN_CSEG, parm0},	/* version 4 */
+   {131, "swap.pri", sIN_CSEG, parm0},	/* version 4 */
+   {129, "switch", sIN_CSEG, do_switch},	/* version 1 */
+   {126, "symbol", sIN_CSEG, do_symbol},
+   {136, "symtag", sIN_CSEG, parm1},	/* version 7 */
+   {123, "sysreq.c", sIN_CSEG, parm1},
+   {135, "sysreq.d", sIN_CSEG, parm1},	/* version 7, not generated directly */
+   {122, "sysreq.pri", sIN_CSEG, parm0},
+   {76, "udiv", sIN_CSEG, parm0},
+   {77, "udiv.alt", sIN_CSEG, parm0},
+   {75, "umul", sIN_CSEG, parm0},
+   {35, "xchg", sIN_CSEG, parm0},
+   {83, "xor", sIN_CSEG, parm0},
+   {91, "zero", sIN_CSEG, parm1},
+   {90, "zero.alt", sIN_CSEG, parm0},
+   {89, "zero.pri", sIN_CSEG, parm0},
+   {92, "zero.s", sIN_CSEG, parm1},
+};
+
+#define MAX_INSTR_LEN   30
+static int
+findopcode(char *instr, int maxlen)
+{
+   int                 low, high, mid, cmp;
+   char                str[MAX_INSTR_LEN];
+
+   if (maxlen >= MAX_INSTR_LEN)
+      return 0;
+   strncpy(str, instr, maxlen);
+   str[maxlen] = '\0';		/* make sure the string is zero terminated */
+   /* look up the instruction with a binary search
+    * the assembler is case insensitive to instructions (but case sensitive
+    * to symbols)
+    */
+   low = 1;			/* entry 0 is reserved (for "not found") */
+   high = (sizeof opcodelist / sizeof opcodelist[0]) - 1;
+   while (low < high)
+     {
+	mid = (low + high) / 2;
+	assert(opcodelist[mid].name != NULL);
+	cmp = strcasecmp(str, opcodelist[mid].name);
+	if (cmp > 0)
+	   low = mid + 1;
+	else
+	   high = mid;
+     }				/* while */
+
+   assert(low == high);
+   if (strcasecmp(str, opcodelist[low].name) == 0)
+      return low;		/* found */
+   return 0;			/* not found, return special index */
+}
+
+void
+assemble(FILE * fout, FILE * fin)
+{
+   typedef struct tagFUNCSTUB
+   {
+      unsigned int            address, nameofs;
+   } FUNCSTUB;
+   AMX_HEADER          hdr;
+   FUNCSTUB            func;
+   int                 numpublics, numnatives, numlibraries, numpubvars,
+      numtags, padding;
+   long                nametablesize, nameofs;
+   char                line[256], *instr, *params;
+   int                 i, pass;
+   short               count;
+   symbol             *sym, **nativelist;
+   constvalue         *constptr;
+   cell                mainaddr;
+   int                 nametable, tags, libraries, publics, natives, pubvars;
+   int                 cod, defsize;
+
+#if !defined NDEBUG
+   /* verify that the opcode list is sorted (skip entry 1; it is reserved
+    * for a non-existent opcode)
+    */
+   assert(opcodelist[1].name != NULL);
+   for (i = 2; i < (int)(sizeof(opcodelist) / sizeof(opcodelist[0])); i++)
+     {
+	assert(opcodelist[i].name != NULL);
+	assert(strcasecmp(opcodelist[i].name, opcodelist[i - 1].name) > 0);
+     }				/* for */
+#endif
+
+   writeerror = FALSE;
+   nametablesize = sizeof(short);
+   numpublics = 0;
+   numnatives = 0;
+   numpubvars = 0;
+   mainaddr = -1;
+   /* count number of public and native functions and public variables */
+   for (sym = glbtab.next; sym; sym = sym->next)
+     {
+	char                alias[sNAMEMAX + 1] = "";
+	int                 match = 0;
+
+	if (sym->ident == iFUNCTN)
+	  {
+	     assert(strlen(sym->name) <= sNAMEMAX);
+	     if ((sym->usage & uNATIVE) != 0 && (sym->usage & uREAD) != 0
+		 && sym->addr >= 0)
+	       {
+		  match = ++numnatives;
+		  if (!lookup_alias(alias, sym->name))
+		     strcpy(alias, sym->name);
+	       }		/* if */
+	     if ((sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+	       {
+		  match = ++numpublics;
+		  strcpy(alias, sym->name);
+	       }		/* if */
+	     if (strcmp(sym->name, uMAINFUNC) == 0)
+	       {
+		  assert(sym->vclass == sGLOBAL);
+		  mainaddr = sym->addr;
+	       }		/* if */
+	  }
+	else if (sym->ident == iVARIABLE)
+	  {
+	     if ((sym->usage & uPUBLIC) != 0)
+	       {
+		  match = ++numpubvars;
+		  strcpy(alias, sym->name);
+	       }		/* if */
+	  }			/* if */
+	if (match)
+	  {
+	     assert(alias[0] != '\0');
+	     nametablesize += strlen(alias) + 1;
+	  }			/* if */
+     }				/* for */
+   assert(numnatives == ntv_funcid);
+
+   /* count number of libraries */
+   numlibraries = 0;
+   for (constptr = libname_tab.next; constptr;
+	constptr = constptr->next)
+     {
+	if (constptr->value > 0)
+	  {
+	     assert(constptr->name[0] != '\0');
+	     numlibraries++;
+	     nametablesize += strlen(constptr->name) + 1;
+	  }			/* if */
+     }				/* for */
+
+   /* count number of public tags */
+   numtags = 0;
+   for (constptr = tagname_tab.next; constptr;
+	constptr = constptr->next)
+     {
+	if ((constptr->value & PUBLICTAG) != 0)
+	  {
+	     assert(constptr->name[0] != '\0');
+	     numtags++;
+	     nametablesize += strlen(constptr->name) + 1;
+	  }			/* if */
+     }				/* for */
+
+   /* pad the header to sc_dataalign
+    * => thereby the code segment is aligned
+    * => since the code segment is padded to a sc_dataalign boundary, the data segment is aligned
+    * => and thereby the stack top is aligned too
+    */
+   assert(sc_dataalign != 0);
+   padding = sc_dataalign - (sizeof hdr + nametablesize) % sc_dataalign;
+   if (padding == sc_dataalign)
+      padding = 0;
+
+   /* write the abstract machine header */
+   memset(&hdr, 0, sizeof hdr);
+   hdr.magic = (unsigned short)0xF1E0;
+   hdr.file_version = CUR_FILE_VERSION;
+   hdr.amx_version = MIN_AMX_VERSION;
+   hdr.flags = (short)(sc_debug & sSYMBOLIC);
+   if (charbits == 16)
+      hdr.flags |= AMX_FLAG_CHAR16;
+   if (sc_compress)
+      hdr.flags |= AMX_FLAG_COMPACT;
+   if (sc_debug == 0)
+      hdr.flags |= AMX_FLAG_NOCHECKS;
+//  #ifdef WORDS_BIGENDIAN
+//    hdr.flags|=AMX_FLAG_BIGENDIAN;
+//  #endif
+   defsize = hdr.defsize = sizeof(FUNCSTUB);
+   assert((hdr.defsize % sizeof(cell)) == 0);
+   publics = hdr.publics = sizeof hdr;	/* public table starts right after the header */
+   natives = hdr.natives = hdr.publics + numpublics * sizeof(FUNCSTUB);
+   libraries = hdr.libraries = hdr.natives + numnatives * sizeof(FUNCSTUB);
+   pubvars = hdr.pubvars = hdr.libraries + numlibraries * sizeof(FUNCSTUB);
+   tags = hdr.tags = hdr.pubvars + numpubvars * sizeof(FUNCSTUB);
+   nametable = hdr.nametable = hdr.tags + numtags * sizeof(FUNCSTUB);
+   cod = hdr.cod = hdr.nametable + nametablesize + padding;
+   hdr.dat = hdr.cod + code_idx;
+   hdr.hea = hdr.dat + glb_declared * sizeof(cell);
+   hdr.stp = hdr.hea + sc_stksize * sizeof(cell);
+   hdr.cip = mainaddr;
+   hdr.size = hdr.hea;	/* preset, this is incorrect in case of compressed output */
+#ifdef WORDS_BIGENDIAN
+   align32(&hdr.size);
+   align16(&hdr.magic);
+   align16(&hdr.flags);
+   align16(&hdr.defsize);
+   align32(&hdr.cod);
+   align32(&hdr.dat);
+   align32(&hdr.hea);
+   align32(&hdr.stp);
+   align32(&hdr.cip);
+   align32(&hdr.publics);
+   align32(&hdr.natives);
+   align32(&hdr.libraries);
+   align32(&hdr.pubvars);
+   align32(&hdr.tags);
+   align32(&hdr.nametable);
+#endif
+   sc_writebin(fout, &hdr, sizeof hdr);
+
+   /* dump zeros up to the rest of the header, so that we can easily "seek" */
+   for (nameofs = sizeof hdr; nameofs < cod; nameofs++)
+      putc(0, fout);
+   nameofs = nametable + sizeof(short);
+
+   /* write the public functions table */
+   count = 0;
+   for (sym = glbtab.next; sym; sym = sym->next)
+     {
+	if (sym->ident == iFUNCTN
+	    && (sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
+	  {
+	     assert(sym->vclass == sGLOBAL);
+	     func.address = sym->addr;
+	     func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+	     align32(&func.address);
+	     align32(&func.nameofs);
+#endif
+	     fseek(fout, publics + count * sizeof(FUNCSTUB), SEEK_SET);
+	     sc_writebin(fout, &func, sizeof func);
+	     fseek(fout, nameofs, SEEK_SET);
+	     sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+	     nameofs += strlen(sym->name) + 1;
+	     count++;
+	  }			/* if */
+     }				/* for */
+
+   /* write the natives table */
+   /* The native functions must be written in sorted order. (They are
+    * sorted on their "id", not on their name). A nested loop to find
+    * each successive function would be an O(n^2) operation. But we
+    * do not really need to sort, because the native function id's
+    * are sequential and there are no duplicates. So we first walk
+    * through the complete symbol list and store a pointer to every
+    * native function of interest in a temporary table, where its id
+    * serves as the index in the table. Now we can walk the table and
+    * have all native functions in sorted order.
+    */
+   if (numnatives > 0)
+     {
+	nativelist = (symbol **) malloc(numnatives * sizeof(symbol *));
+	if (!nativelist)
+	   error(103);		/* insufficient memory */
+#if !defined NDEBUG
+	memset(nativelist, 0, numnatives * sizeof(symbol *));	/* for NULL checking */
+#endif
+	for (sym = glbtab.next; sym; sym = sym->next)
+	  {
+	     if (sym->ident == iFUNCTN && (sym->usage & uNATIVE) != 0
+		 && (sym->usage & uREAD) != 0 && sym->addr >= 0)
+	       {
+		  assert(sym->addr < numnatives);
+		  nativelist[(int)sym->addr] = sym;
+	       }		/* if */
+	  }			/* for */
+	count = 0;
+	for (i = 0; i < numnatives; i++)
+	  {
+	     char                alias[sNAMEMAX + 1];
+
+	     sym = nativelist[i];
+	     assert(sym != NULL);
+	     if (!lookup_alias(alias, sym->name))
+	       {
+		  assert(strlen(sym->name) <= sNAMEMAX);
+		  strcpy(alias, sym->name);
+	       }		/* if */
+	     assert(sym->vclass == sGLOBAL);
+	     func.address = 0;
+	     func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+	     align32(&func.address);
+	     align32(&func.nameofs);
+#endif
+	     fseek(fout, natives + count * sizeof(FUNCSTUB), SEEK_SET);
+	     sc_writebin(fout, &func, sizeof func);
+	     fseek(fout, nameofs, SEEK_SET);
+	     sc_writebin(fout, alias, strlen(alias) + 1);
+	     nameofs += strlen(alias) + 1;
+	     count++;
+	  }			/* for */
+	free(nativelist);
+     }				/* if */
+
+   /* write the libraries table */
+   count = 0;
+   for (constptr = libname_tab.next; constptr;
+	constptr = constptr->next)
+     {
+	if (constptr->value > 0)
+	  {
+	     assert(constptr->name[0] != '\0');
+	     func.address = 0;
+	     func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+	     align32(&func.address);
+	     align32(&func.nameofs);
+#endif
+	     fseek(fout, libraries + count * sizeof(FUNCSTUB), SEEK_SET);
+	     sc_writebin(fout, &func, sizeof func);
+	     fseek(fout, nameofs, SEEK_SET);
+	     sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+	     nameofs += strlen(constptr->name) + 1;
+	     count++;
+	  }			/* if */
+     }				/* for */
+
+   /* write the public variables table */
+   count = 0;
+   for (sym = glbtab.next; sym; sym = sym->next)
+     {
+	if (sym->ident == iVARIABLE && (sym->usage & uPUBLIC) != 0)
+	  {
+	     assert((sym->usage & uDEFINE) != 0);
+	     assert(sym->vclass == sGLOBAL);
+	     func.address = sym->addr;
+	     func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+	     align32(&func.address);
+	     align32(&func.nameofs);
+#endif
+	     fseek(fout, pubvars + count * sizeof(FUNCSTUB), SEEK_SET);
+	     sc_writebin(fout, &func, sizeof func);
+	     fseek(fout, nameofs, SEEK_SET);
+	     sc_writebin(fout, sym->name, strlen(sym->name) + 1);
+	     nameofs += strlen(sym->name) + 1;
+	     count++;
+	  }			/* if */
+     }				/* for */
+
+   /* write the public tagnames table */
+   count = 0;
+   for (constptr = tagname_tab.next; constptr;
+	constptr = constptr->next)
+     {
+	if ((constptr->value & PUBLICTAG) != 0)
+	  {
+	     assert(constptr->name[0] != '\0');
+	     func.address = constptr->value & TAGMASK;
+	     func.nameofs = nameofs;
+#ifdef WORDS_BIGENDIAN
+	     align32(&func.address);
+	     align32(&func.nameofs);
+#endif
+	     fseek(fout, tags + count * sizeof(FUNCSTUB), SEEK_SET);
+	     sc_writebin(fout, &func, sizeof func);
+	     fseek(fout, nameofs, SEEK_SET);
+	     sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
+	     nameofs += strlen(constptr->name) + 1;
+	     count++;
+	  }			/* if */
+     }				/* for */
+
+   /* write the "maximum name length" field in the name table */
+   assert(nameofs == nametable + nametablesize);
+   fseek(fout, nametable, SEEK_SET);
+   count = sNAMEMAX;
+#ifdef WORDS_BIGENDIAN
+   align16(&count);
+#endif
+   sc_writebin(fout, &count, sizeof count);
+   fseek(fout, cod, SEEK_SET);
+
+   /* First pass: relocate all labels */
+   /* This pass is necessary because the code addresses of labels is only known
+    * after the peephole optimization flag. Labels can occur inside expressions
+    * (e.g. the conditional operator), which are optimized.
+    */
+   lbltab = NULL;
+   if (labnum > 0)
+     {
+	/* only very short programs have zero labels; no first pass is needed
+	 * if there are no labels */
+	lbltab = (cell *) malloc(labnum * sizeof(cell));
+	if (!lbltab)
+	   error(103);		/* insufficient memory */
+	codeindex = 0;
+	sc_resetasm(fin);
+	while (sc_readasm(fin, line, sizeof line))
+	  {
+	     stripcomment(line);
+	     instr = skipwhitespace(line);
+	     /* ignore empty lines */
+	     if (*instr == '\0')
+		continue;
+	     if (tolower(*instr) == 'l' && *(instr + 1) == '.')
+	       {
+		  int                 lindex = (int)hex2long(instr + 2, NULL);
+
+		  assert(lindex < labnum);
+		  lbltab[lindex] = codeindex;
+	       }
+	     else
+	       {
+		  /* get to the end of the instruction (make use of the '\n' that fgets()
+		   * added at the end of the line; this way we will *always* drop on a
+		   * whitespace character) */
+		  for (params = instr; *params != '\0' && !isspace(*params);
+		       params++)
+		     /* nothing */ ;
+		  assert(params > instr);
+		  i = findopcode(instr, (int)(params - instr));
+		  if (!opcodelist[i].name)
+		    {
+		       *params = '\0';
+		       error(104, instr);	/* invalid assembler instruction */
+		    }		/* if */
+		  if (opcodelist[i].segment == sIN_CSEG)
+		     codeindex +=
+			opcodelist[i].func(NULL, skipwhitespace(params),
+					   opcodelist[i].opcode);
+	       }		/* if */
+	  }			/* while */
+     }				/* if */
+
+   /* Second pass (actually 2 more passes, one for all code and one for all data) */
+   bytes_in = 0;
+   bytes_out = 0;
+   for (pass = sIN_CSEG; pass <= sIN_DSEG; pass++)
+     {
+	sc_resetasm(fin);
+	while (sc_readasm(fin, line, sizeof line))
+	  {
+	     stripcomment(line);
+	     instr = skipwhitespace(line);
+	     /* ignore empty lines and labels (labels have a special syntax, so these
+	      * must be parsed separately) */
+	     if (*instr == '\0' || (tolower(*instr) == 'l'
+		 && *(instr + 1) == '.'))
+		continue;
+	     /* get to the end of the instruction (make use of the '\n' that fgets()
+	      * added at the end of the line; this way we will *always* drop on a
+	      * whitespace character) */
+	     for (params = instr; *params != '\0' && !isspace(*params);
+		  params++)
+		/* nothing */ ;
+	     assert(params > instr);
+	     i = findopcode(instr, (int)(params - instr));
+	     assert(opcodelist[i].name != NULL);
+	     if (opcodelist[i].segment == pass)
+		opcodelist[i].func(fout, skipwhitespace(params),
+				   opcodelist[i].opcode);
+	  }			/* while */
+     }				/* for */
+   if (bytes_out - bytes_in > 0)
+      error(106);		/* compression buffer overflow */
+
+   if (lbltab)
+     {
+	free(lbltab);
+#if !defined NDEBUG
+	lbltab = NULL;
+#endif
+     }				/* if */
+
+   if (writeerror)
+      error(101, "disk full");
+
+   /* adjust the header */
+   if (sc_compress)
+     {
+	hdr.size = sc_lengthbin(fout);
+#ifdef WORDS_BIGENDIAN
+	align32(&hdr.size);
+#endif
+	sc_resetbin(fout);	/* "size" is the very first field */
+	sc_writebin(fout, &hdr.size, sizeof hdr.size);
+     }				/* if */
+}
diff --git a/src/bin/embryo_cc_sc7.c b/src/bin/embryo_cc_sc7.c
new file mode 100644
index 0000000..910c522
--- /dev/null
+++ b/src/bin/embryo_cc_sc7.c
@@ -0,0 +1,688 @@
+/*  Small compiler - Staging buffer and optimizer
+ *
+ *  The staging buffer
+ *  ------------------
+ *  The staging buffer allows buffered output of generated code, deletion
+ *  of redundant code, optimization by a tinkering process and reversing
+ *  the ouput of evaluated expressions (which is used for the reversed
+ *  evaluation of arguments in functions).
+ *  Initially, stgwrite() writes to the file directly, but after a call to
+ *  stgset(TRUE), output is redirected to the buffer. After a call to
+ *  stgset(FALSE), stgwrite()'s output is directed to the file again. Thus
+ *  only one routine is used for writing to the output, which can be
+ *  buffered output or direct output.
+ *
+ *  staging buffer variables:   stgbuf  - the buffer
+ *                              stgidx  - current index in the staging buffer
+ *                              staging - if true, write to the staging buffer;
+ *                                        if false, write to file directly.
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>		/* for atoi() */
+#include <string.h>
+#include <ctype.h>
+
+#include "embryo_cc_sc.h"
+
+#if defined _MSC_VER
+#pragma warning(push)
+#pragma warning(disable:4125)	/* decimal digit terminates octal escape sequence */
+#endif
+
+#include "embryo_cc_sc7.scp"
+
+#if defined _MSC_VER
+#pragma warning(pop)
+#endif
+
+static void         stgstring(char *start, char *end);
+static void         stgopt(char *start, char *end);
+
+#define sSTG_GROW   512
+#define sSTG_MAX    20480
+
+static char        *stgbuf = NULL;
+static int          stgmax = 0;	/* current size of the staging buffer */
+
+#define CHECK_STGBUFFER(index) if ((int)(index)>=stgmax) grow_stgbuffer((index)+1)
+
+static void
+grow_stgbuffer(int requiredsize)
+{
+   char               *p;
+   int                 clear = !stgbuf;	/* if previously none, empty buffer explicitly */
+
+   assert(stgmax < requiredsize);
+   /* if the staging buffer (holding intermediate code for one line) grows
+    * over a few kBytes, there is probably a run-away expression
+    */
+   if (requiredsize > sSTG_MAX)
+      error(102, "staging buffer");	/* staging buffer overflow (fatal error) */
+   stgmax = requiredsize + sSTG_GROW;
+   if (stgbuf)
+      p = (char *)realloc(stgbuf, stgmax * sizeof(char));
+   else
+      p = (char *)malloc(stgmax * sizeof(char));
+   if (!p)
+      error(102, "staging buffer");	/* staging buffer overflow (fatal error) */
+   stgbuf = p;
+   if (clear)
+      *stgbuf = '\0';
+}
+
+void
+stgbuffer_cleanup(void)
+{
+   if (stgbuf)
+     {
+	free(stgbuf);
+	stgbuf = NULL;
+	stgmax = 0;
+     }				/* if */
+}
+
+/* the variables "stgidx" and "staging" are declared in "scvars.c" */
+
+/*  stgmark
+ *
+ *  Copies a mark into the staging buffer. At this moment there are three
+ *  possible marks:
+ *     sSTARTREORDER    identifies the beginning of a series of expression
+ *                      strings that must be written to the output file in
+ *                      reordered order
+ *    sENDREORDER       identifies the end of 'reverse evaluation'
+ *    sEXPRSTART + idx  only valid within a block that is evaluated in
+ *                      reordered order, it identifies the start of an
+ *                      expression; the "idx" value is the argument position
+ *
+ *  Global references: stgidx  (altered)
+ *                     stgbuf  (altered)
+ *                     staging (referred to only)
+ */
+void
+stgmark(char mark)
+{
+   if (staging)
+     {
+	CHECK_STGBUFFER(stgidx);
+	stgbuf[stgidx++] = mark;
+     }				/* if */
+}
+
+static int
+filewrite(char *str)
+{
+   if (sc_status == statWRITE)
+      return sc_writeasm(outf, str);
+   return TRUE;
+}
+
+/*  stgwrite
+ *
+ *  Writes the string "st" to the staging buffer or to the output file. In the
+ *  case of writing to the staging buffer, the terminating byte of zero is
+ *  copied too, but... the optimizer can only work on complete lines (not on
+ *  fractions of it. Therefore if the string is staged, if the last character
+ *  written to the buffer is a '\0' and the previous-to-last is not a '\n',
+ *  the string is concatenated to the last string in the buffer (the '\0' is
+ *  overwritten). This also means an '\n' used in the middle of a string isn't
+ *  recognized and could give wrong results with the optimizer.
+ *  Even when writing to the output file directly, all strings are buffered
+ *  until a whole line is complete.
+ *
+ *  Global references: stgidx  (altered)
+ *                     stgbuf  (altered)
+ *                     staging (referred to only)
+ */
+void
+stgwrite(char *st)
+{
+   int                 len;
+
+   CHECK_STGBUFFER(0);
+   if (staging)
+     {
+	if (stgidx >= 2 && stgbuf[stgidx - 1] == '\0'
+	    && stgbuf[stgidx - 2] != '\n')
+	   stgidx -= 1;		/* overwrite last '\0' */
+	while (*st != '\0')
+	  {			/* copy to staging buffer */
+	     CHECK_STGBUFFER(stgidx);
+	     stgbuf[stgidx++] = *st++;
+	  }			/* while */
+	CHECK_STGBUFFER(stgidx);
+	stgbuf[stgidx++] = '\0';
+     }
+   else
+     {
+	CHECK_STGBUFFER(strlen(stgbuf) + strlen(st) + 1);
+	strcat(stgbuf, st);
+	len = strlen(stgbuf);
+	if (len > 0 && stgbuf[len - 1] == '\n')
+	  {
+	     filewrite(stgbuf);
+	     stgbuf[0] = '\0';
+	  }			/* if */
+     }				/* if */
+}
+
+/*  stgout
+ *
+ *  Writes the staging buffer to the output file via stgstring() (for
+ *  reversing expressions in the buffer) and stgopt() (for optimizing). It
+ *  resets "stgidx".
+ *
+ *  Global references: stgidx  (altered)
+ *                     stgbuf  (referred to only)
+ *                     staging (referred to only)
+ */
+void
+stgout(int index)
+{
+   if (!staging)
+      return;
+   stgstring(&stgbuf[index], &stgbuf[stgidx]);
+   stgidx = index;
+}
+
+typedef struct
+{
+   char               *start, *end;
+} argstack;
+
+/*  stgstring
+ *
+ *  Analyses whether code strings should be output to the file as they appear
+ *  in the staging buffer or whether portions of it should be re-ordered.
+ *  Re-ordering takes place in function argument lists; Small passes arguments
+ *  to functions from right to left. When arguments are "named" rather than
+ *  positional, the order in the source stream is indeterminate.
+ *  This function calls itself recursively in case it needs to re-order code
+ *  strings, and it uses a private stack (or list) to mark the start and the
+ *  end of expressions in their correct (reversed) order.
+ *  In any case, stgstring() sends a block as large as possible to the
+ *  optimizer stgopt().
+ *
+ *  In "reorder" mode, each set of code strings must start with the token
+ *  sEXPRSTART, even the first. If the token sSTARTREORDER is represented
+ *  by '[', sENDREORDER by ']' and sEXPRSTART by '|' the following applies:
+ *     '[]...'     valid, but useless; no output
+ *     '[|...]     valid, but useless; only one string
+ *     '[|...|...] valid and useful
+ *     '[...|...]  invalid, first string doesn't start with '|'
+ *     '[|...|]    invalid
+ */
+static void
+stgstring(char *start, char *end)
+{
+   char               *ptr;
+   int                 nest, argc, arg;
+   argstack           *stack;
+
+   while (start < end)
+     {
+	if (*start == sSTARTREORDER)
+	  {
+	     start += 1;	/* skip token */
+	     /* allocate a argstack with sMAXARGS items */
+	     stack = (argstack *) malloc(sMAXARGS * sizeof(argstack));
+	     if (!stack)
+		error(103);	/* insufficient memory */
+	     nest = 1;		/* nesting counter */
+	     argc = 0;		/* argument counter */
+	     arg = -1;		/* argument index; no valid argument yet */
+	     do
+	       {
+		  switch (*start)
+		    {
+		    case sSTARTREORDER:
+		       nest++;
+		       start++;
+		       break;
+		    case sENDREORDER:
+		       nest--;
+		       start++;
+		       break;
+		    default:
+		       if ((*start & sEXPRSTART) == sEXPRSTART)
+			 {
+			    if (nest == 1)
+			      {
+				 if (arg >= 0)
+				    stack[arg].end = start - 1;	/* finish previous argument */
+				 arg = (unsigned char)*start - sEXPRSTART;
+				 stack[arg].start = start + 1;
+				 if (arg >= argc)
+				    argc = arg + 1;
+			      }	/* if */
+			    start++;
+			 }
+		       else
+			 {
+			    start += strlen(start) + 1;
+			 }	/* if */
+		    }		/* switch */
+	       }
+	     while (nest);	/* enddo */
+	     if (arg >= 0)
+		stack[arg].end = start - 1;	/* finish previous argument */
+	     while (argc > 0)
+	       {
+		  argc--;
+		  stgstring(stack[argc].start, stack[argc].end);
+	       }		/* while */
+	     free(stack);
+	  }
+	else
+	  {
+	     ptr = start;
+	     while (ptr < end && *ptr != sSTARTREORDER)
+		ptr += strlen(ptr) + 1;
+	     stgopt(start, ptr);
+	     start = ptr;
+	  }			/* if */
+     }				/* while */
+}
+
+/*  stgdel
+ *
+ *  Scraps code from the staging buffer by resetting "stgidx" to "index".
+ *
+ *  Global references: stgidx (altered)
+ *                     staging (referred to only)
+ */
+void
+stgdel(int index, cell code_index)
+{
+   if (staging)
+     {
+	stgidx = index;
+	code_idx = code_index;
+     }				/* if */
+}
+
+int
+stgget(int *index, cell * code_index)
+{
+   if (staging)
+     {
+	*index = stgidx;
+	*code_index = code_idx;
+     }				/* if */
+   return staging;
+}
+
+/*  stgset
+ *
+ *  Sets staging on or off. If it's turned off, the staging buffer must be
+ *  initialized to an empty string. If it's turned on, the routine makes sure
+ *  the index ("stgidx") is set to 0 (it should already be 0).
+ *
+ *  Global references: staging  (altered)
+ *                     stgidx   (altered)
+ *                     stgbuf   (contents altered)
+ */
+void
+stgset(int onoff)
+{
+   staging = onoff;
+   if (staging)
+     {
+	assert(stgidx == 0);
+	stgidx = 0;
+	CHECK_STGBUFFER(stgidx);
+	/* write any contents that may be put in the buffer by stgwrite()
+	 * when "staging" was 0
+	 */
+	if (stgbuf[0] != '\0')
+	   filewrite(stgbuf);
+     }				/* if */
+   stgbuf[0] = '\0';
+}
+
+/* phopt_init
+ * Initialize all sequence strings of the peehole optimizer. The strings
+ * are embedded in the .EXE file in compressed format, here we expand
+ * them (and allocate memory for the sequences).
+ */
+static SEQUENCE    *sequences;
+
+int
+phopt_init(void)
+{
+   int                 number, i, len;
+   char                str[160];
+
+   /* count number of sequences */
+   for (number = 0; sequences_cmp[number].find; number++)
+      /* nothing */ ;
+   number++;			/* include an item for the NULL terminator */
+
+   if (!(sequences = (SEQUENCE *)malloc(number * sizeof(SEQUENCE))))
+      return FALSE;
+
+   /* pre-initialize all to NULL (in case of failure) */
+   for (i = 0; i < number; i++)
+     {
+	sequences[i].find = NULL;
+	sequences[i].replace = NULL;
+	sequences[i].savesize = 0;
+     }				/* for */
+
+   /* expand all strings */
+   for (i = 0; i < number - 1; i++)
+     {
+	len =
+	   strexpand(str, (unsigned char *)sequences_cmp[i].find, sizeof str,
+		     SCPACK_TABLE);
+	assert(len <= (int)(sizeof(str)));
+	assert(len == (int)(strlen(str) + 1));
+	sequences[i].find = (char *)malloc(len);
+	if (sequences[i].find)
+	   strcpy(sequences[i].find, str);
+	len =
+	   strexpand(str, (unsigned char *)sequences_cmp[i].replace, sizeof str,
+		     SCPACK_TABLE);
+	assert(len <= (int)(sizeof(str)));
+	assert(len == (int)(strlen(str) + 1));
+	sequences[i].replace = (char *)malloc(len);
+	if (sequences[i].replace)
+	   strcpy(sequences[i].replace, str);
+	sequences[i].savesize = sequences_cmp[i].savesize;
+	if (!sequences[i].find || !sequences[i].replace)
+	   return phopt_cleanup();
+     }				/* for */
+
+   return TRUE;
+}
+
+int
+phopt_cleanup(void)
+{
+   int                 i;
+
+   if (sequences)
+     {
+	i = 0;
+	while (sequences[i].find || sequences[i].replace)
+	  {
+	     if (sequences[i].find)
+		free(sequences[i].find);
+	     if (sequences[i].replace)
+		free(sequences[i].replace);
+	     i++;
+	  }			/* while */
+	free(sequences);
+	sequences = NULL;
+     }				/* if */
+   return FALSE;
+}
+
+#define _maxoptvars     4
+#define _aliasmax       10	/* a 32-bit number can be represented in
+				 * 9 decimal digits */
+
+static int
+matchsequence(char *start, char *end, char *pattern,
+	      char symbols[_maxoptvars][_aliasmax + 1], int *match_length)
+{
+   int                 var, i;
+   char                str[_aliasmax + 1];
+   char               *start_org = start;
+
+   *match_length = 0;
+   for (var = 0; var < _maxoptvars; var++)
+      symbols[var][0] = '\0';
+
+   while (*start == '\t' || *start == ' ')
+      start++;
+   while (*pattern)
+     {
+	if (start >= end)
+	   return FALSE;
+	switch (*pattern)
+	  {
+	  case '%':		/* new "symbol" */
+	     pattern++;
+	     assert(isdigit(*pattern));
+	     var = atoi(pattern) - 1;
+	     assert(var >= 0 && var < _maxoptvars);
+	     assert(alphanum(*start));
+	     for (i = 0; start < end && alphanum(*start); i++, start++)
+	       {
+		  assert(i <= _aliasmax);
+		  str[i] = *start;
+	       }		/* for */
+	     str[i] = '\0';
+	     if (symbols[var][0] != '\0')
+	       {
+		  if (strcmp(symbols[var], str) != 0)
+		     return FALSE;	/* symbols should be identical */
+	       }
+	     else
+	       {
+		  strcpy(symbols[var], str);
+	       }		/* if */
+	     break;
+	  case ' ':
+	     if (*start != '\t' && *start != ' ')
+		return FALSE;
+	     while ((start < end && *start == '\t') || *start == ' ')
+		start++;
+	     break;
+	  case '!':
+	     while ((start < end && *start == '\t') || *start == ' ')
+		start++;	/* skip trailing white space */
+	     if (*start != '\n')
+		return FALSE;
+	     assert(*(start + 1) == '\0');
+	     start += 2;	/* skip '\n' and '\0' */
+	     if (*(pattern + 1) != '\0')
+		while ((start < end && *start == '\t') || *start == ' ')
+		   start++;	/* skip leading white space of next instruction */
+	     break;
+	  default:
+	     if (tolower(*start) != tolower(*pattern))
+		return FALSE;
+	     start++;
+	  }			/* switch */
+	pattern++;
+     }				/* while */
+
+   *match_length = (int)(start - start_org);
+   return TRUE;
+}
+
+static char        *
+replacesequence(char *pattern, char symbols[_maxoptvars][_aliasmax + 1],
+		int *repl_length)
+{
+   char               *lptr;
+   int                 var;
+   char               *buffer;
+
+   /* calculate the length of the new buffer
+    * this is the length of the pattern plus the length of all symbols (note
+    * that the same symbol may occur multiple times in the pattern) plus
+    * line endings and startings ('\t' to start a line and '\n\0' to end one)
+    */
+   assert(repl_length != NULL);
+   *repl_length = 0;
+   lptr = pattern;
+   while (*lptr)
+     {
+	switch (*lptr)
+	  {
+	  case '%':
+	     lptr++;		/* skip '%' */
+	     assert(isdigit(*lptr));
+	     var = atoi(lptr) - 1;
+	     assert(var >= 0 && var < _maxoptvars);
+	     assert(symbols[var][0] != '\0');	/* variable should be defined */
+	     *repl_length += strlen(symbols[var]);
+	     break;
+	  case '!':
+	     *repl_length += 3;	/* '\t', '\n' & '\0' */
+	     break;
+	  default:
+	     *repl_length += 1;
+	  }			/* switch */
+	lptr++;
+     }				/* while */
+
+   /* allocate a buffer to replace the sequence in */
+   if (!(buffer = malloc(*repl_length)))
+     {
+	error(103);
+	return NULL;
+     }
+
+   /* replace the pattern into this temporary buffer */
+   lptr = buffer;
+   *lptr++ = '\t';		/* the "replace" patterns do not have tabs */
+   while (*pattern)
+     {
+	assert((int)(lptr - buffer) < *repl_length);
+	switch (*pattern)
+	  {
+	  case '%':
+	     /* write out the symbol */
+	     pattern++;
+	     assert(isdigit(*pattern));
+	     var = atoi(pattern) - 1;
+	     assert(var >= 0 && var < _maxoptvars);
+	     assert(symbols[var][0] != '\0');	/* variable should be defined */
+	     strcpy(lptr, symbols[var]);
+	     lptr += strlen(symbols[var]);
+	     break;
+	  case '!':
+	     /* finish the line, optionally start the next line with an indent */
+	     *lptr++ = '\n';
+	     *lptr++ = '\0';
+	     if (*(pattern + 1) != '\0')
+		*lptr++ = '\t';
+	     break;
+	  default:
+	     *lptr++ = *pattern;
+	  }			/* switch */
+	pattern++;
+     }				/* while */
+
+   assert((int)(lptr - buffer) == *repl_length);
+   return buffer;
+}
+
+static void
+strreplace(char *dest, char *replace, int sub_length, int repl_length,
+	   int dest_length)
+{
+   int                 offset = sub_length - repl_length;
+
+   if (offset > 0)		/* delete a section */
+      memmove(dest, dest + offset, dest_length - offset);
+   else if (offset < 0)		/* insert a section */
+      memmove(dest - offset, dest, dest_length);
+   memcpy(dest, replace, repl_length);
+}
+
+/*  stgopt
+ *
+ *  Optimizes the staging buffer by checking for series of instructions that
+ *  can be coded more compact. The routine expects the lines in the staging
+ *  buffer to be separated with '\n' and '\0' characters.
+ *
+ *  The longest sequences must be checked first.
+ */
+
+static void
+stgopt(char *start, char *end)
+{
+   char                symbols[_maxoptvars][_aliasmax + 1];
+   int                 seq, match_length, repl_length;
+
+   assert(sequences != NULL);
+   while (start < end)
+     {
+	if ((sc_debug & sNOOPTIMIZE) != 0 || sc_status != statWRITE)
+	  {
+	     /* do not match anything if debug-level is maximum */
+	     filewrite(start);
+	  }
+	else
+	  {
+	     seq = 0;
+	     while (sequences[seq].find)
+	       {
+		  assert(seq >= 0);
+		  if (matchsequence
+		      (start, end, sequences[seq].find, symbols, &match_length))
+		    {
+		       char               *replace =
+			  replacesequence(sequences[seq].replace, symbols,
+					  &repl_length);
+		       /* If the replacement is bigger than the original section, we may need
+		        * to "grow" the staging buffer. This is quite complex, due to the
+		        * re-ordering of expressions that can also happen in the staging
+		        * buffer. In addition, it should not happen: the peephole optimizer
+		        * must replace sequences with *shorter* sequences, not longer ones.
+		        * So, I simply forbid sequences that are longer than the ones they
+		        * are meant to replace.
+		        */
+		       assert(match_length >= repl_length);
+		       if (match_length >= repl_length)
+			 {
+			    strreplace(start, replace, match_length,
+				       repl_length, (int)(end - start));
+			    end -= match_length - repl_length;
+			    free(replace);
+			    code_idx -= sequences[seq].savesize;
+			    seq = 0;	/* restart search for matches */
+			 }
+		       else
+			 {
+			    /* actually, we should never get here (match_length<repl_length) */
+			    assert(0);
+			    seq++;
+			 }	/* if */
+		    }
+		  else
+		    {
+		       seq++;
+		    }		/* if */
+	       }		/* while */
+	     assert(sequences[seq].find == NULL);
+	     filewrite(start);
+	  }			/* if */
+	assert(start < end);
+	start += strlen(start) + 1;	/* to next string */
+     }				/* while (start<end) */
+}
+
+#undef SCPACK_TABLE
diff --git a/src/bin/embryo_cc_sc7.scp b/src/bin/embryo_cc_sc7.scp
new file mode 100644
index 0000000..38f784d
--- /dev/null
+++ b/src/bin/embryo_cc_sc7.scp
@@ -0,0 +1,1473 @@
+/*  Small compiler - Peephole optimizer "sequences" strings (plain
+ *                   and compressed formats)
+ *
+ *  Copyright (c) ITB CompuPhase, 2000-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+int         strexpand(char *dest, unsigned char *source, int maxlen,
+			      unsigned char pairtable[128][2]);
+
+#define SCPACK_TERMINATOR ,	/* end each section with a comma */
+
+#define SCPACK_TABLE sequences_table
+/*-*SCPACK start of pair table, do not change or remove this line */
+unsigned char       sequences_table[][2] = {
+   {32, 37}, {114, 105}, {112, 129}, {46, 130}, {49, 33}, {128, 132}, {97, 100},
+      {46, 97}, {135, 108}, {136, 116}, {111, 134}, {108, 138}, {50, 33}, {115,
+									   104},
+      {128, 140}, {137, 33},
+   {46, 115}, {117, 141}, {112, 145}, {131, 133}, {139, 144}, {112, 143}, {131,
+									   142},
+      {115, 116}, {111, 149}, {112, 152}, {131, 33}, {134, 100}, {110, 151},
+      {111, 156}, {99, 157}, {59, 36},
+   {146, 154}, {148, 150}, {112, 33}, {120, 162}, {101, 163}, {159, 164}, {137,
+									   133},
+      {46, 99}, {122, 101}, {110, 100}, {155, 114}, {101, 113}, {168, 114},
+      {147, 160}, {51, 33}, {128, 174},
+   {103, 33}, {133, 165}, {104, 176}, {99, 178}, {120, 179}, {171, 33}, {106,
+									 172},
+      {173, 161}, {155, 33}, {108, 167}, {117, 169}, {115, 175}, {186, 187},
+      {153, 184}, {141, 185}, {111, 188},
+   {98, 191}, {105, 100}, {115, 103}, {115, 108}, {193, 120}, {182, 133}, {114,
+									   33},
+      {166, 161}, {190, 131}, {137, 142}, {169, 33}, {97, 202}, {139, 147},
+      {172, 111}, {158, 147}, {139, 150},
+   {105, 33}, {101, 115}, {209, 115}, {114, 116}, {148, 147}, {171, 133}, {189,
+									   139},
+      {32, 140}, {146, 167}, {196, 170}, {158, 183}, {170, 183}, {199, 192},
+      {108, 196}, {97, 198}, {194, 211},
+   {46, 208}, {195, 210}, {200, 215}, {112, 222}, {159, 227}, {46, 98}, {118,
+									 101},
+      {111, 230}, {109, 231}, {146, 143}, {99, 144}, {158, 150}, {97, 149},
+      {203, 153}, {52, 33}, {225, 33},
+   {158, 166}, {194, 181}, {195, 181}, {201, 180}, {223, 198}, {153, 203}, {214,
+									    224},
+      {100, 101}, {128, 238}, {119, 236}, {249, 237}, {105, 110}, {115, 250},
+      {232, 143}, {205, 154}
+};
+/*-*SCPACK end of pair table, do not change or remove this line */
+
+#define seqsize(o,p)    (opcodes(o)+opargs(p))
+typedef struct
+{
+   char               *find;
+   char               *replace;
+   int                 savesize;	/* number of bytes saved (in bytecode) */
+} SEQUENCE;
+static SEQUENCE     sequences_cmp[] = {
+   /* A very common sequence in four varieties
+    *    load.s.pri n1           load.s.pri n2
+    *    push.pri                load.s.alt n1
+    *    load.s.pri n2           -
+    *    pop.alt                 -
+    *    --------------------------------------
+    *    load.pri n1             load.s.pri n2
+    *    push.pri                load.alt n1
+    *    load.s.pri n2           -
+    *    pop.alt                 -
+    *    --------------------------------------
+    *    load.s.pri n1           load.pri n2
+    *    push.pri                load.s.alt n1
+    *    load.pri n2             -
+    *    pop.alt                 -
+    *    --------------------------------------
+    *    load.pri n1             load.pri n2
+    *    push.pri                load.alt n1
+    *    load.pri n2             -
+    *    pop.alt                 -
+    */
+   {
+#ifdef SCPACK
+    "load.s.pri %1!push.pri!load.s.pri %2!pop.alt!",
+    "load.s.pri %2!load.s.alt %1!",
+#else
+    "\224\267\231",
+    "\241\224\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!push.pri!load.s.pri %2!pop.alt!",
+    "load.s.pri %2!load.alt %1!",
+#else
+    "\213\267\231",
+    "\241\213\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!push.pri!load.pri %2!pop.alt!",
+    "load.pri %2!load.s.alt %1!",
+#else
+    "\224\255\317\231",
+    "\317\224\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!push.pri!load.pri %2!pop.alt!",
+    "load.pri %2!load.alt %1!",
+#else
+    "\213\255\317\231",
+    "\317\213\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   /* (#1#) The above also occurs with "addr.pri" (array
+    * indexing) as the first line; so that adds 2 cases.
+    */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!pop.alt!",
+    "addr.alt %1!load.s.pri %2!",
+#else
+    "\333\231",
+    "\252\307",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.pri %2!pop.alt!",
+    "addr.alt %1!load.pri %2!",
+#else
+    "\252\255\317\231",
+    "\252\246\317",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   /* And the same sequence with const.pri as either the first
+    * or the second load instruction: four more cases.
+    */
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!pop.alt!",
+    "load.s.pri %2!const.alt %1!",
+#else
+    "\332\231",
+    "\241\360",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.pri %2!pop.alt!",
+    "load.pri %2!const.alt %1!",
+#else
+    "\236\255\317\231",
+    "\317\360",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!push.pri!const.pri %2!pop.alt!",
+    "const.pri %2!load.s.alt %1!",
+#else
+    "\224\255\353\231",
+    "\353\224\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!push.pri!const.pri %2!pop.alt!",
+    "const.pri %2!load.alt %1!",
+#else
+    "\213\255\353\231",
+    "\353\213\246",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   /* The same as above, but now with "addr.pri" (array
+    * indexing) on the first line and const.pri on
+    * the second.
+    */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!const.pri %2!pop.alt!",
+    "addr.alt %1!const.pri %2!",
+#else
+    "\252\255\353\231",
+    "\252\246\353",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   /* ??? add references */
+   /* Chained relational operators can contain sequences like:
+    *    move.pri                load.s.pri n1
+    *    push.pri                -
+    *    load.s.pri n1           -
+    *    pop.alt                 -
+    * The above also accurs for "load.pri" and for "const.pri",
+    * so add another two cases.
+    */
+   {
+#ifdef SCPACK
+    "move.pri!push.pri!load.s.pri %1!pop.alt!",
+    "load.s.pri %1!",
+#else
+    "\350\232\240\324\231",
+    "\324",
+#endif
+    seqsize(4, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "move.pri!push.pri!load.pri %1!pop.alt!",
+    "load.pri %1!",
+#else
+    "\350\232\240\314\231",
+    "\314",
+#endif
+    seqsize(4, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "move.pri!push.pri!const.pri %1!pop.alt!",
+    "const.pri %1!",
+#else
+    "\350\232\240\316\231",
+    "\316",
+#endif
+    seqsize(4, 1) - seqsize(1, 1)},
+   /* More optimizations for chained relational operators; the
+    * continuation sequences can be simplified if they turn out
+    * to be termination sequences:
+    *    xchg                    sless       also for sless, sgeq and sleq
+    *    sgrtr                   pop.alt
+    *    swap.alt                and
+    *    and                     ;$exp
+    *    pop.alt                 -
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    xchg                    sless       also for sless, sgeq and sleq
+    *    sgrtr                   pop.alt
+    *    swap.alt                and
+    *    and                     jzer n1
+    *    pop.alt                 -
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    xchg                    jsgeq  n1   also for sless, sgeq and sleq
+    *    sgrtr                   ;$exp       (occurs for non-chained comparisons)
+    *    jzer n1                 -
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    xchg                    sless       also for sless, sgeq and sleq
+    *    sgrtr                   ;$exp       (occurs for non-chained comparisons)
+    *    ;$exp                   -
+    */
+   {
+#ifdef SCPACK
+    "xchg!sgrtr!swap.alt!and!pop.alt!;$exp!",
+    "sless!pop.alt!and!;$exp!",
+#else
+    "\264\364\374\245",
+    "\357\365\245",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sless!swap.alt!and!pop.alt!;$exp!",
+    "sgrtr!pop.alt!and!;$exp!",
+#else
+    "\264\357\374\245",
+    "\364\365\245",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sgeq!swap.alt!and!pop.alt!;$exp!",
+    "sleq!pop.alt!and!;$exp!",
+#else
+    "\264\361\374\245",
+    "\362\365\245",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sleq!swap.alt!and!pop.alt!;$exp!",
+    "sgeq!pop.alt!and!;$exp!",
+#else
+    "\264\362\374\245",
+    "\361\365\245",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sgrtr!swap.alt!and!pop.alt!jzer %1!",
+    "sless!pop.alt!and!jzer %1!",
+#else
+    "\264\364\374\305",
+    "\357\365\305",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sless!swap.alt!and!pop.alt!jzer %1!",
+    "sgrtr!pop.alt!and!jzer %1!",
+#else
+    "\264\357\374\305",
+    "\364\365\305",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sgeq!swap.alt!and!pop.alt!jzer %1!",
+    "sleq!pop.alt!and!jzer %1!",
+#else
+    "\264\361\374\305",
+    "\362\365\305",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sleq!swap.alt!and!pop.alt!jzer %1!",
+    "sgeq!pop.alt!and!jzer %1!",
+#else
+    "\264\362\374\305",
+    "\361\365\305",
+#endif
+    seqsize(5, 0) - seqsize(3, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sgrtr!jzer %1!;$exp!",
+    "jsgeq %1!;$exp!",
+#else
+    "\264\364\266\261",
+    "j\302\253\261",
+#endif
+    seqsize(3, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "xchg!sless!jzer %1!;$exp!",
+    "jsleq %1!;$exp!",
+#else
+    "\264\357\266\261",
+    "j\303\253\261",
+#endif
+    seqsize(3, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "xchg!sgeq!jzer %1!;$exp!",
+    "jsgrtr %1!;$exp!",
+#else
+    "\264\361\266\261",
+    "j\337r\261",
+#endif
+    seqsize(3, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "xchg!sleq!jzer %1!;$exp!",
+    "jsless %1!;$exp!",
+#else
+    "\264\362\266\261",
+    "j\341\261",
+#endif
+    seqsize(3, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "xchg!sgrtr!;$exp!",
+    "sless!;$exp!",
+#else
+    "\264\364\245",
+    "\357\245",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sless!;$exp!",
+    "sgrtr!;$exp!",
+#else
+    "\264\357\245",
+    "\364\245",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sgeq!;$exp!",
+    "sleq!;$exp!",
+#else
+    "\264\361\245",
+    "\362\245",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   {
+#ifdef SCPACK
+    "xchg!sleq!;$exp!",
+    "sgeq!;$exp!",
+#else
+    "\264\362\245",
+    "\361\245",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   /* The entry to chained operators is also opt to optimization
+    *    load.s.pri n1           load.s.pri n2
+    *    load.s.alt n2           load.s.alt n1
+    *    xchg                    -
+    *    --------------------------------------
+    *    load.s.pri n1           load.pri n2
+    *    load.alt n2             load.s.alt n1
+    *    xchg                    -
+    *    --------------------------------------
+    *    load.s.pri n1           const.pri n2
+    *    const.alt n2            load.s.alt n1
+    *    xchg                    -
+    *    --------------------------------------
+    * and all permutations...
+    */
+   {
+#ifdef SCPACK
+    "load.s.pri %1!load.s.alt %2!xchg!",
+    "load.s.pri %2!load.s.alt %1!",
+#else
+    "\324\224\363",
+    "\241\224\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!load.alt %2!xchg!",
+    "load.pri %2!load.s.alt %1!",
+#else
+    "\324\213\363",
+    "\317\224\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!const.alt %2!xchg!",
+    "const.pri %2!load.s.alt %1!",
+#else
+    "\324\236\363",
+    "\353\224\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!load.s.alt %2!xchg!",
+    "load.s.pri %2!load.alt %1!",
+#else
+    "\314\224\363",
+    "\241\213\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!load.alt %2!xchg!",
+    "load.pri %2!load.alt %1!",
+#else
+    "\314\213\363",
+    "\317\213\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!const.alt %2!xchg!",
+    "const.pri %2!load.alt %1!",
+#else
+    "\314\236\363",
+    "\353\213\246",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!load.s.alt %2!xchg!",
+    "load.s.pri %2!const.alt %1!",
+#else
+    "\316\224\363",
+    "\241\360",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!load.alt %2!xchg!",
+    "load.pri %2!const.alt %1!",
+#else
+    "\316\213\363",
+    "\317\360",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   /* Array indexing can merit from special instructions.
+    * Simple indexed array lookup can be optimized quite
+    * a bit.
+    *    addr.pri n1             addr.alt n1
+    *    push.pri                load.s.pri n2
+    *    load.s.pri n2           bounds n3
+    *    bounds n3               lidx.b n4
+    *    shl.c.pri n4            -
+    *    pop.alt                 -
+    *    add                     -
+    *    load.i                  -
+    *
+    * And to prepare for storing a value in an array
+    *    addr.pri n1             addr.alt n1
+    *    push.pri                load.s.pri n2
+    *    load.s.pri n2           bounds n3
+    *    bounds n3               idxaddr.b n4
+    *    shl.c.pri n4            -
+    *    pop.alt                 -
+    *    add                     -
+    *
+    * Notes (additional cases):
+    * 1. instruction addr.pri can also be const.pri (for
+    *    global arrays)
+    * 2. the bounds instruction can be absent
+    * 3. when "n4" (the shift value) is the 2 (with 32-bit cels), use the
+    *    even more optimal instructions LIDX and IDDXADDR
+    *
+    * If the array index is more complex, one can only optimize
+    * the last four instructions:
+    *    shl.c.pri n1            pop.alt
+    *    pop.alt                 lidx.b n1
+    *    add                     -
+    *    loadi                   -
+    *    --------------------------------------
+    *    shl.c.pri n1            pop.alt
+    *    pop.alt                 idxaddr.b n1
+    *    add                     -
+    */
+#if !defined BIT16
+   /* loading from array, "cell" shifted */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+    "addr.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+    "\333\300\342\366",
+    "\252\334\335!",
+#endif
+    seqsize(8, 4) - seqsize(4, 3)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
+    "const.alt %1!load.s.pri %2!bounds %3!lidx!",
+#else
+    "\332\300\342\366",
+    "\236\334\335!",
+#endif
+    seqsize(8, 4) - seqsize(4, 3)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+    "addr.alt %1!load.s.pri %2!lidx!",
+#else
+    "\333\342\366",
+    "\252\307\335!",
+#endif
+    seqsize(7, 3) - seqsize(3, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
+    "const.alt %1!load.s.pri %2!lidx!",
+#else
+    "\332\342\366",
+    "\236\307\335!",
+#endif
+    seqsize(7, 3) - seqsize(3, 2)},
+#endif
+   /* loading from array, not "cell" shifted */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+    "addr.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+    "\333\300\310\370\366",
+    "\252\334\335\345\370",
+#endif
+    seqsize(8, 4) - seqsize(4, 4)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
+    "const.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
+#else
+    "\332\300\310\370\366",
+    "\236\334\335\345\370",
+#endif
+    seqsize(8, 4) - seqsize(4, 4)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+    "addr.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+    "\333\310\257\366",
+    "\252\307\335\345\257",
+#endif
+    seqsize(7, 3) - seqsize(3, 3)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
+    "const.alt %1!load.s.pri %2!lidx.b %3!",
+#else
+    "\332\310\257\366",
+    "\236\307\335\345\257",
+#endif
+    seqsize(7, 3) - seqsize(3, 3)},
+#if !defined BIT16
+   /* array index calculation for storing a value, "cell" aligned */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+    "addr.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+    "\333\300\342\275",
+    "\252\334\331!",
+#endif
+    seqsize(7, 4) - seqsize(4, 3)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
+    "const.alt %1!load.s.pri %2!bounds %3!idxaddr!",
+#else
+    "\332\300\342\275",
+    "\236\334\331!",
+#endif
+    seqsize(7, 4) - seqsize(4, 3)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+    "addr.alt %1!load.s.pri %2!idxaddr!",
+#else
+    "\333\342\275",
+    "\252\307\331!",
+#endif
+    seqsize(6, 3) - seqsize(3, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
+    "const.alt %1!load.s.pri %2!idxaddr!",
+#else
+    "\332\342\275",
+    "\236\307\331!",
+#endif
+    seqsize(6, 3) - seqsize(3, 2)},
+#endif
+   /* array index calculation for storing a value, not "cell" packed */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+    "addr.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+    "\333\300\310\370\275",
+    "\252\334\331\345\370",
+#endif
+    seqsize(7, 4) - seqsize(4, 4)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
+    "const.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
+#else
+    "\332\300\310\370\275",
+    "\236\334\331\345\370",
+#endif
+    seqsize(7, 4) - seqsize(4, 4)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+    "addr.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+    "\333\310\257\275",
+    "\252\307\331\345\257",
+#endif
+    seqsize(6, 3) - seqsize(3, 3)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
+    "const.alt %1!load.s.pri %2!idxaddr.b %3!",
+#else
+    "\332\310\257\275",
+    "\236\307\331\345\257",
+#endif
+    seqsize(6, 3) - seqsize(3, 3)},
+#if !defined BIT16
+   /* the shorter array indexing sequences, see above for comments */
+   {
+#ifdef SCPACK
+    "shl.c.pri 2!pop.alt!add!loadi!",
+    "pop.alt!lidx!",
+#else
+    "\342\326\320",
+    "\231\335!",
+#endif
+    seqsize(4, 1) - seqsize(2, 0)},
+   {
+#ifdef SCPACK
+    "shl.c.pri 2!pop.alt!add!",
+    "pop.alt!idxaddr!",
+#else
+    "\342\275",
+    "\231\331!",
+#endif
+    seqsize(3, 1) - seqsize(2, 0)},
+#endif
+   {
+#ifdef SCPACK
+    "shl.c.pri %1!pop.alt!add!loadi!",
+    "pop.alt!lidx.b %1!",
+#else
+    "\276\223\326\320",
+    "\231\335\345\205",
+#endif
+    seqsize(4, 1) - seqsize(2, 1)},
+   {
+#ifdef SCPACK
+    "shl.c.pri %1!pop.alt!add!",
+    "pop.alt!idxaddr.b %1!",
+#else
+    "\276\223\275",
+    "\231\331\345\205",
+#endif
+    seqsize(3, 1) - seqsize(2, 1)},
+   /* For packed arrays, there is another case (packed arrays
+    * do not take advantage of the LIDX or IDXADDR instructions).
+    *    addr.pri n1             addr.alt n1
+    *    push.pri                load.s.pri n2
+    *    load.s.pri n2           bounds n3
+    *    bounds n3               -
+    *    pop.alt                 -
+    *
+    * Notes (additional cases):
+    * 1. instruction addr.pri can also be const.pri (for
+    *    global arrays)
+    * 2. the bounds instruction can be absent, but that
+    *    case is already handled (see #1#)
+    */
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+    "addr.alt %1!load.s.pri %2!bounds %3!",
+#else
+    "\333\300\231",
+    "\252\334",
+#endif
+    seqsize(5, 3) - seqsize(3, 3)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
+    "const.alt %1!load.s.pri %2!bounds %3!",
+#else
+    "\332\300\231",
+    "\236\334",
+#endif
+    seqsize(5, 3) - seqsize(3, 3)},
+   /* During a calculation, the intermediate result must sometimes
+    * be moved from PRI to ALT, like in:
+    *    push.pri                move.alt
+    *    load.s.pri n1           load.s.pri n1
+    *    pop.alt                 -
+    *
+    * The above also accurs for "load.pri" and for "const.pri",
+    * so add another two cases.
+    */
+   {
+#ifdef SCPACK
+    "push.pri!load.s.pri %1!pop.alt!",
+    "move.alt!load.s.pri %1!",
+#else
+    "\240\324\231",
+    "\375\324",
+#endif
+    seqsize(3, 1) - seqsize(2, 1)},
+   {
+#ifdef SCPACK
+    "push.pri!load.pri %1!pop.alt!",
+    "move.alt!load.pri %1!",
+#else
+    "\240\314\231",
+    "\375\314",
+#endif
+    seqsize(3, 1) - seqsize(2, 1)},
+   {
+#ifdef SCPACK
+    "push.pri!const.pri %1!pop.alt!",
+    "move.alt!const.pri %1!",
+#else
+    "\240\316\231",
+    "\375\316",
+#endif
+    seqsize(3, 1) - seqsize(2, 1)},
+   {
+#ifdef SCPACK
+    "push.pri!zero.pri!pop.alt!",
+    "move.alt!zero.pri!",
+#else
+    "\240\376\231",
+    "\375\376",
+#endif
+    seqsize(3, 0) - seqsize(2, 0)},
+   /* saving PRI and then loading from its address
+    * occurs when indexing a multi-dimensional array
+    */
+   {
+#ifdef SCPACK
+    "push.pri!load.i!pop.alt!",
+    "move.alt!load.i!",
+#else
+    "\240\213\340\231",
+    "\375\213\340",
+#endif
+    seqsize(3, 0) - seqsize(2, 0)},
+   /* An even simpler PUSH/POP optimization (occurs in
+    * switch statements):
+    *    push.pri                move.alt
+    *    pop.alt                 -
+    */
+   {
+#ifdef SCPACK
+    "push.pri!pop.alt!",
+    "move.alt!",
+#else
+    "\240\231",
+    "\375",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   /* And what to think of this PUSH/POP sequence, which occurs
+    * due to the support for user-defined assignment operator):
+    *    push.alt                -
+    *    pop.alt                 -
+    */
+//???
+//{
+//  #ifdef SCPACK
+//    "push.alt!pop.alt!",
+//    ";$",     /* SCPACK cannot handle empty strings */
+//  #else
+//    "\225\237",
+//    "\353",
+//  #endif
+//  seqsize(2,0) - seqsize(0,0)
+//},
+   /* Functions with many parameters with the same default
+    * value have sequences like:
+    *    push.c n1               const.pri n1
+    *    ;$par                   push.r.pri n2   ; where n2 is the number of pushes
+    *    push.c n1               ;$par
+    *    ;$par                   -
+    *    push.c n1               -
+    *    ;$par                   -
+    *    etc.                    etc.
+    * The shortest matched sequence is 3, because a sequence of two can also be
+    * optimized as two "push.c n1" instructions.
+    * => this optimization does not work, because the argument re-ordering in
+    *    a function call causes each argument to be optimized individually
+    */
+//{
+//  #ifdef SCPACK
+//    "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+//    "const.pri %1!push.r.pri 5!;$par!",
+//  #else
+//    "\327\327\254",
+//    "\352\221.r\2745!",
+//  #endif
+//  seqsize(10,5) - seqsize(2,2)
+//},
+//{
+//  #ifdef SCPACK
+//    "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+//    "const.pri %1!push.r.pri 4!;$par!",
+//  #else
+//    "\327\327",
+//    "\352\221.r\274\326",
+//  #endif
+//  seqsize(8,4) - seqsize(2,2)
+//},
+//{
+//  #ifdef SCPACK
+//    "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
+//    "const.pri %1!push.r.pri 3!;$par!",
+//  #else
+//    "\327\254",
+//    "\352\221.r\274\247",
+//  #endif
+//  seqsize(6,3) - seqsize(2,2)
+//},
+   /* User-defined operators first load the operands into registers and
+    * then have them pushed onto the stack. This can give rise to sequences
+    * like:
+    *    const.pri n1            push.c n1
+    *    const.alt n2            push.c n2
+    *    push.pri                -
+    *    push.alt                -
+    * A similar sequence occurs with the two PUSH.pri/alt instructions inverted.
+    * The first, second, or both CONST.pri/alt instructions can also be
+    * LOAD.pri/alt.
+    * This gives 2 x 4 cases.
+    */
+   {
+#ifdef SCPACK
+    "const.pri %1!const.alt %2!push.pri!push.alt!",
+    "push.c %1!push.c %2!",
+#else
+    "\316\236\311\240\351",
+    "\330\205\330\216",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!const.alt %2!push.alt!push.pri!",
+    "push.c %2!push.c %1!",
+#else
+    "\316\236\311\351\240",
+    "\330\216\330\205",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!load.alt %2!push.pri!push.alt!",
+    "push.c %1!push %2!",
+#else
+    "\316\213\311\240\351",
+    "\330\205\222\216",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!load.alt %2!push.alt!push.pri!",
+    "push %2!push.c %1!",
+#else
+    "\316\213\311\351\240",
+    "\222\216\330\205",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!const.alt %2!push.pri!push.alt!",
+    "push %1!push.c %2!",
+#else
+    "\314\236\311\240\351",
+    "\222\205\330\216",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!const.alt %2!push.alt!push.pri!",
+    "push.c %2!push %1!",
+#else
+    "\314\236\311\351\240",
+    "\330\216\222\205",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!load.alt %2!push.pri!push.alt!",
+    "push %1!push %2!",
+#else
+    "\314\213\311\240\351",
+    "\222\205\222\216",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "load.pri %1!load.alt %2!push.alt!push.pri!",
+    "push %2!push %1!",
+#else
+    "\314\213\311\351\240",
+    "\222\216\222\205",
+#endif
+    seqsize(4, 2) - seqsize(2, 2)},
+   /* Function calls (parameters are passed on the stack)
+    *    load.s.pri n1           push.s n1
+    *    push.pri                -
+    *    --------------------------------------
+    *    load.pri n1             push n1
+    *    push.pri                -
+    *    --------------------------------------
+    *    const.pri n1            push.c n1
+    *    push.pri                -
+    *    --------------------------------------
+    *    zero.pri                push.c 0
+    *    push.pri                -
+    *    --------------------------------------
+    *    addr.pri n1             pushaddr n1
+    *    push.pri                -
+    *
+    * However, PRI must not be needed after this instruction
+    * if this shortcut is used. Check for the ;$par comment.
+    */
+   {
+#ifdef SCPACK
+    "load.s.pri %1!push.pri!;$par!",
+    "push.s %1!;$par!",
+#else
+    "\224\255\344",
+    "\222\220\205\344",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "load.pri %1!push.pri!;$par!",
+    "push %1!;$par!",
+#else
+    "\213\255\344",
+    "\222\205\344",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.pri %1!push.pri!;$par!",
+    "push.c %1!;$par!",
+#else
+    "\236\255\344",
+    "\330\205\344",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "zero.pri!push.pri!;$par!",
+    "push.c 0!;$par!",
+#else
+    "\376\240\344",
+    "\330 0!\344",
+#endif
+    seqsize(2, 0) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "addr.pri %1!push.pri!;$par!",
+    "pushaddr %1!;$par!",
+#else
+    "\252\255\344",
+    "\222\252\205\344",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   /* References with a default value generate new cells on the heap
+    * dynamically. That code often ends with:
+    *    move.pri                push.alt
+    *    push.pri                -
+    */
+   {
+#ifdef SCPACK
+    "move.pri!push.pri!",
+    "push.alt!",
+#else
+    "\350\232\240",
+    "\351",
+#endif
+    seqsize(2, 0) - seqsize(1, 0)},
+   /* Simple arithmetic operations on constants. Noteworthy is the
+    * subtraction of a constant, since it is converted to the addition
+    * of the inverse value.
+    *    const.alt n1            add.c n1
+    *    add                     -
+    *    --------------------------------------
+    *    const.alt n1            add.c -n1
+    *    sub                     -
+    *    --------------------------------------
+    *    const.alt n1            smul.c n1
+    *    smul                    -
+    *    --------------------------------------
+    *    const.alt n1            eq.c.pri n1
+    *    eq                      -
+    */
+   {
+#ifdef SCPACK
+    "const.alt %1!add!",
+    "add.c %1!",
+#else
+    "\360\270",
+    "\233\247\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.alt %1!sub!",
+    "add.c -%1!",
+#else
+    "\360sub!",
+    "\233\247 -%\204",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.alt %1!smul!",
+    "smul.c %1!",
+#else
+    "\360smul!",
+    "smu\271\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.alt %1!eq!",
+    "eq.c.pri %1!",
+#else
+    "\360\265",
+    "\253\247\223",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   /* Some operations use the alternative subtraction operation --these
+    * can also be optimized.
+    *    const.pri n1            load.s.pri n2
+    *    load.s.alt n2           add.c -n1
+    *    sub.alt                 -
+    *    --------------------------------------
+    *    const.pri n1            load.pri n2
+    *    load.alt n2             add.c -n1
+    *    sub.alt                 -
+    */
+   {
+#ifdef SCPACK
+    "const.pri %1!load.s.alt %2!sub.alt!",
+    "load.s.pri %2!add.c -%1!",
+#else
+    "\316\224\311sub\217",
+    "\241\233\247 -%\204",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   {
+#ifdef SCPACK
+    "const.pri %1!load.alt %2!sub.alt!",
+    "load.pri %2!add.c -%1!",
+#else
+    "\316\213\311sub\217",
+    "\317\233\247 -%\204",
+#endif
+    seqsize(3, 2) - seqsize(2, 2)},
+   /* Compare and jump
+    *    eq                      jneq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    eq                      jeq n1
+    *    jnz n1                  -
+    *    --------------------------------------
+    *    neq                     jeq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    neq                     jneq n1
+    *    jnz n1                  -
+    * Compares followed by jzer occur much more
+    * often than compares followed with jnz. So we
+    * take the easy route here.
+    *    less                    jgeq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    leq                     jgrtr n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    grtr                    jleq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    geq                     jless n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    sless                   jsgeq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    sleq                    jsgrtr n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    sgrtr                   jsleq n1
+    *    jzer n1                 -
+    *    --------------------------------------
+    *    sgeq                    jsless n1
+    *    jzer n1                 -
+    */
+   {
+#ifdef SCPACK
+    "eq!jzer %1!",
+    "jneq %1!",
+#else
+    "\265\305",
+    "jn\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "eq!jnz %1!",
+    "jeq %1!",
+#else
+    "\265jnz\205",
+    "j\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "neq!jzer %1!",
+    "jeq %1!",
+#else
+    "n\265\305",
+    "j\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "neq!jnz %1!",
+    "jneq %1!",
+#else
+    "n\265jnz\205",
+    "jn\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "less!jzer %1!",
+    "jgeq %1!",
+#else
+    "l\322!\305",
+    "jg\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "leq!jzer %1!",
+    "jgrtr %1!",
+#else
+    "l\265\305",
+    "jg\323r\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "grtr!jzer %1!",
+    "jleq %1!",
+#else
+    "g\323\306\305",
+    "jl\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "geq!jzer %1!",
+    "jless %1!",
+#else
+    "g\265\305",
+    "jl\322\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "sless!jzer %1!",
+    "jsgeq %1!",
+#else
+    "\357\305",
+    "j\302\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "sleq!jzer %1!",
+    "jsgrtr %1!",
+#else
+    "\362\305",
+    "j\337r\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "sgrtr!jzer %1!",
+    "jsleq %1!",
+#else
+    "\364\305",
+    "j\303\325",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "sgeq!jzer %1!",
+    "jsless %1!",
+#else
+    "\361\305",
+    "j\341\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   /* Test for zero (common case, especially for strings)
+    * E.g. the test expression of: "for (i=0; str{i}!=0; ++i)"
+    *
+    *    zero.alt                jzer n1
+    *    jeq n1                  -
+    *    --------------------------------------
+    *    zero.alt                jnz n1
+    *    jneq n1                 -
+    */
+   {
+#ifdef SCPACK
+    "zero.alt!jeq %1!",
+    "jzer %1!",
+#else
+    "\315\217j\325",
+    "\305",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "zero.alt!jneq %1!",
+    "jnz %1!",
+#else
+    "\315\217jn\325",
+    "jnz\205",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   /* Incrementing and decrementing leaves a value in
+    * in PRI which may not be used (for example, as the
+    * third expression in a "for" loop).
+    *    inc n1                  inc n1  ; ++n
+    *    load.pri n1             ;$exp
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    load.pri n1             inc n1  ; n++, e.g. "for (n=0; n<10; n++)"
+    *    inc n1                  ;$exp
+    *    ;$exp                   -
+    * Plus the varieties for stack relative increments
+    * and decrements.
+    */
+   {
+#ifdef SCPACK
+    "inc %1!load.pri %1!;$exp!",
+    "inc %1!;$exp!",
+#else
+    "\373c\205\314\245",
+    "\373c\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "load.pri %1!inc %1!;$exp!",
+    "inc %1!;$exp!",
+#else
+    "\314\373c\261",
+    "\373c\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "inc.s %1!load.s.pri %1!;$exp!",
+    "inc.s %1!;$exp!",
+#else
+    "\373\352\205\324\245",
+    "\373\352\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!inc.s %1!;$exp!",
+    "inc.s %1!;$exp!",
+#else
+    "\324\373\352\261",
+    "\373\352\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "dec %1!load.pri %1!;$exp!",
+    "dec %1!;$exp!",
+#else
+    "\367c\205\314\245",
+    "\367c\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "load.pri %1!dec %1!;$exp!",
+    "dec %1!;$exp!",
+#else
+    "\314\367c\261",
+    "\367c\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "dec.s %1!load.s.pri %1!;$exp!",
+    "dec.s %1!;$exp!",
+#else
+    "\367\352\205\324\245",
+    "\367\352\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "load.s.pri %1!dec.s %1!;$exp!",
+    "dec.s %1!;$exp!",
+#else
+    "\324\367\352\261",
+    "\367\352\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   /* ??? the same (increments and decrements) for references */
+   /* Loading the constant zero has a special opcode.
+    * When storing zero in memory, the value of PRI must not be later on.
+    *    const.pri 0             zero n1
+    *    stor.pri n1             ;$exp
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    const.pri 0             zero.s n1
+    *    stor.s.pri n1           ;$exp
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    zero.pri                zero n1
+    *    stor.pri n1             ;$exp
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    zero.pri                zero.s n1
+    *    stor.s.pri n1           ;$exp
+    *    ;$exp                   -
+    *    --------------------------------------
+    *    const.pri 0             zero.pri
+    *    --------------------------------------
+    *    const.alt 0             zero.alt
+    * The last two alternatives save more memory than they save
+    * time, but anyway...
+    */
+   {
+#ifdef SCPACK
+    "const.pri 0!stor.pri %1!;$exp!",
+    "zero %1!;$exp!",
+#else
+    "\236\203 0!\227or\223\245",
+    "\315\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.pri 0!stor.s.pri %1!;$exp!",
+    "zero.s %1!;$exp!",
+#else
+    "\236\203 0!\227or\220\223\245",
+    "\315\220\261",
+#endif
+    seqsize(2, 2) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "zero.pri!stor.pri %1!;$exp!",
+    "zero %1!;$exp!",
+#else
+    "\376\227or\223\245",
+    "\315\261",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "zero.pri!stor.s.pri %1!;$exp!",
+    "zero.s %1!;$exp!",
+#else
+    "\376\227or\220\223\245",
+    "\315\220\261",
+#endif
+    seqsize(2, 1) - seqsize(1, 1)},
+   {
+#ifdef SCPACK
+    "const.pri 0!",
+    "zero.pri!",
+#else
+    "\236\203 0!",
+    "\376",
+#endif
+    seqsize(1, 1) - seqsize(1, 0)},
+   {
+#ifdef SCPACK
+    "const.alt 0!",
+    "zero.alt!",
+#else
+    "\236\211 0!",
+    "\315\217",
+#endif
+    seqsize(1, 1) - seqsize(1, 0)},
+   /* ----- */
+   {NULL, NULL, 0}
+};
diff --git a/src/bin/embryo_cc_scexpand.c b/src/bin/embryo_cc_scexpand.c
new file mode 100644
index 0000000..6ab34a1
--- /dev/null
+++ b/src/bin/embryo_cc_scexpand.c
@@ -0,0 +1,53 @@
+/* expand.c -- Byte Pair Encoding decompression */
+/* Copyright 1996 Philip Gage */
+
+/* Byte Pair Compression appeared in the September 1997
+ * issue of C/C++ Users Journal. The original source code
+ * may still be found at the web site of the magazine
+ * (www.cuj.com).
+ *
+ * The decompressor has been modified by me (Thiadmer
+ * Riemersma) to accept a string as input, instead of a
+ * complete file.
+ */
+
+
+#include "embryo_cc_sc.h"
+
+#define STACKSIZE 16
+
+int
+strexpand(char *dest, unsigned char *source, int maxlen, unsigned char pairtable[128][2])
+{
+   unsigned char       stack[STACKSIZE];
+   short               c, top = 0;
+   int                 len;
+
+   len = 1;			/* already 1 byte for '\0' */
+   for (;;)
+     {
+	/* Pop byte from stack or read byte from the input string */
+	if (top)
+	  c = stack[--top];
+	else if ((c = *(unsigned char *)source++) == '\0')
+	  break;
+
+	/* Push pair on stack or output byte to the output string */
+	if (c > 127)
+	  {
+	     stack[top++] = pairtable[c - 128][1];
+	     stack[top++] = pairtable[c - 128][0];
+	  }
+	else
+	  {
+	     len++;
+	     if (maxlen > 1)
+	       {
+		  *dest++ = (char)c;
+		  maxlen--;
+	       }
+	  }
+     }
+   *dest = '\0';
+   return len;
+}
diff --git a/src/bin/embryo_cc_sclist.c b/src/bin/embryo_cc_sclist.c
new file mode 100644
index 0000000..e908248
--- /dev/null
+++ b/src/bin/embryo_cc_sclist.c
@@ -0,0 +1,293 @@
+/*  Small compiler  - maintenance of various lists
+ *
+ *  Name list (aliases)
+ *  Include path list
+ *
+ *  Copyright (c) ITB CompuPhase, 2001-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+#include "embryo_cc_sc.h"
+
+static stringpair  *
+insert_stringpair(stringpair * root, char *first, char *second, int matchlength)
+{
+   stringpair         *cur, *pred;
+
+   assert(root != NULL);
+   assert(first != NULL);
+   assert(second != NULL);
+   /* create a new node, and check whether all is okay */
+   if (!(cur = (stringpair *)malloc(sizeof(stringpair))))
+      return NULL;
+   cur->first = strdup(first);
+   cur->second = strdup(second);
+   cur->matchlength = matchlength;
+   if (!cur->first || !cur->second)
+     {
+	if (cur->first)
+	   free(cur->first);
+	if (cur->second)
+	   free(cur->second);
+	free(cur);
+	return NULL;
+     }				/* if */
+   /* link the node to the tree, find the position */
+   for (pred = root; pred->next && strcmp(pred->next->first, first) < 0;
+	pred = pred->next)
+      /* nothing */ ;
+   cur->next = pred->next;
+   pred->next = cur;
+   return cur;
+}
+
+static void
+delete_stringpairtable(stringpair * root)
+{
+   stringpair         *cur, *next;
+
+   assert(root != NULL);
+   cur = root->next;
+   while (cur)
+     {
+	next = cur->next;
+	assert(cur->first != NULL);
+	assert(cur->second != NULL);
+	free(cur->first);
+	free(cur->second);
+	free(cur);
+	cur = next;
+     }				/* while */
+   memset(root, 0, sizeof(stringpair));
+}
+
+static stringpair  *
+find_stringpair(stringpair * cur, char *first, int matchlength)
+{
+   int                 result = 0;
+
+   assert(matchlength > 0);	/* the function cannot handle zero-length comparison */
+   assert(first != NULL);
+   while (cur && result <= 0)
+     {
+	result = (int)*cur->first - (int)*first;
+	if (result == 0 && matchlength == cur->matchlength)
+	  {
+	     result = strncmp(cur->first, first, matchlength);
+	     if (result == 0)
+		return cur;
+	  }			/* if */
+	cur = cur->next;
+     }				/* while */
+   return NULL;
+}
+
+static int
+delete_stringpair(stringpair * root, stringpair * item)
+{
+   stringpair         *cur;
+
+   assert(root != NULL);
+   cur = root;
+   while (cur->next)
+     {
+	if (cur->next == item)
+	  {
+	     cur->next = item->next;	/* unlink from list */
+	     assert(item->first != NULL);
+	     assert(item->second != NULL);
+	     free(item->first);
+	     free(item->second);
+	     free(item);
+	     return TRUE;
+	  }			/* if */
+	cur = cur->next;
+     }				/* while */
+   return FALSE;
+}
+
+/* ----- alias table --------------------------------------------- */
+static stringpair   alias_tab = { NULL, NULL, NULL, 0 };    /* alias table */
+
+stringpair *
+insert_alias(char *name, char *alias)
+{
+   stringpair         *cur;
+
+   assert(name != NULL);
+   assert(strlen(name) <= sNAMEMAX);
+   assert(alias != NULL);
+   assert(strlen(alias) <= sEXPMAX);
+   if (!(cur = insert_stringpair(&alias_tab, name, alias, strlen(name))))
+      error(103);		/* insufficient memory (fatal error) */
+   return cur;
+}
+
+int
+lookup_alias(char *target, char *name)
+{
+   stringpair         *cur =
+      find_stringpair(alias_tab.next, name, strlen(name));
+   if (cur)
+     {
+	assert(strlen(cur->second) <= sEXPMAX);
+	strcpy(target, cur->second);
+     }				/* if */
+   return !!cur;
+}
+
+void
+delete_aliastable(void)
+{
+   delete_stringpairtable(&alias_tab);
+}
+
+/* ----- include paths list -------------------------------------- */
+static stringlist   includepaths = { NULL, NULL };	/* directory list for include files */
+
+stringlist *
+insert_path(char *path)
+{
+   stringlist         *cur;
+
+   assert(path != NULL);
+   if (!(cur = (stringlist *)malloc(sizeof(stringlist))))
+      error(103);		/* insufficient memory (fatal error) */
+   if (!(cur->line = strdup(path)))
+      error(103);		/* insufficient memory (fatal error) */
+   cur->next = includepaths.next;
+   includepaths.next = cur;
+   return cur;
+}
+
+char       *
+get_path(int index)
+{
+   stringlist         *cur = includepaths.next;
+
+   while (cur && index-- > 0)
+      cur = cur->next;
+   if (cur)
+     {
+	assert(cur->line != NULL);
+	return cur->line;
+     }				/* if */
+   return NULL;
+}
+
+void
+delete_pathtable(void)
+{
+   stringlist         *cur = includepaths.next, *next;
+
+   while (cur)
+     {
+	next = cur->next;
+	assert(cur->line != NULL);
+	free(cur->line);
+	free(cur);
+	cur = next;
+     }				/* while */
+   memset(&includepaths, 0, sizeof(stringlist));
+}
+
+/* ----- text substitution patterns ------------------------------ */
+
+static stringpair   substpair = { NULL, NULL, NULL, 0 };    /* list of substitution pairs */
+static stringpair  *substindex['z' - 'A' + 1];	/* quick index to first character */
+
+static void
+adjustindex(char c)
+{
+   stringpair         *cur;
+
+   assert((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_');
+   assert('A' < '_' && '_' < 'z');
+
+   for (cur = substpair.next; cur && cur->first[0] != c;
+	cur = cur->next)
+      /* nothing */ ;
+   substindex[(int)c - 'A'] = cur;
+}
+
+stringpair *
+insert_subst(char *pattern, char *substitution, int prefixlen)
+{
+   stringpair         *cur;
+
+   assert(pattern != NULL);
+   assert(substitution != NULL);
+   if (!(cur = insert_stringpair(&substpair, pattern, substitution, prefixlen)))
+      error(103);		/* insufficient memory (fatal error) */
+   adjustindex(*pattern);
+   return cur;
+}
+
+stringpair *
+find_subst(char *name, int length)
+{
+   stringpair         *item;
+
+   assert(name != NULL);
+   assert(length > 0);
+   assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+	  || *name == '_');
+   item = substindex[(int)*name - 'A'];
+   if (item)
+      item = find_stringpair(item, name, length);
+   return item;
+}
+
+int
+delete_subst(char *name, int length)
+{
+   stringpair         *item;
+
+   assert(name != NULL);
+   assert(length > 0);
+   assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
+	  || *name == '_');
+   item = substindex[(int)*name - 'A'];
+   if (item)
+      item = find_stringpair(item, name, length);
+   if (!item)
+      return FALSE;
+   delete_stringpair(&substpair, item);
+   adjustindex(*name);
+   return TRUE;
+}
+
+void
+delete_substtable(void)
+{
+   int                 i;
+
+   delete_stringpairtable(&substpair);
+   for (i = 0; i < (int)(sizeof(substindex) / sizeof(substindex[0])); i++)
+      substindex[i] = NULL;
+}
diff --git a/src/bin/embryo_cc_scvars.c b/src/bin/embryo_cc_scvars.c
new file mode 100644
index 0000000..f369b9b
--- /dev/null
+++ b/src/bin/embryo_cc_scvars.c
@@ -0,0 +1,88 @@
+/*  Small compiler
+ *
+ *  Global (cross-module) variables.
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ *
+ *  Version: $Id$
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>		/* for PATH_MAX */
+#endif
+
+#include "embryo_cc_sc.h"
+
+/*  global variables
+ *
+ *  All global variables that are shared amongst the compiler files are
+ *  declared here.
+ */
+symbol   loctab;	/* local symbol table */
+symbol   glbtab;	/* global symbol table */
+cell    *litq;	/* the literal queue */
+char     pline[sLINEMAX + 1];	/* the line read from the input file */
+char    *lptr;	/* points to the current position in "pline" */
+constvalue tagname_tab = { NULL, "", 0, 0 };	/* tagname table */
+constvalue libname_tab = { NULL, "", 0, 0 };	/* library table (#pragma library "..." syntax) */
+constvalue *curlibrary = NULL;	/* current library */
+symbol  *curfunc;	/* pointer to current function */
+char    *inpfname;	/* pointer to name of the file currently read from */
+char     outfname[PATH_MAX];	/* output file name */
+char     sc_ctrlchar = CTRL_CHAR;	/* the control character (or escape character) */
+int      litidx = 0;	/* index to literal table */
+int      litmax = sDEF_LITMAX;	/* current size of the literal table */
+int      stgidx = 0;	/* index to the staging buffer */
+int      labnum = 0;	/* number of (internal) labels */
+int      staging = 0;	/* true if staging output */
+cell     declared = 0;	/* number of local cells declared */
+cell     glb_declared = 0;	/* number of global cells declared */
+cell     code_idx = 0;	/* number of bytes with generated code */
+int      ntv_funcid = 0;	/* incremental number of native function */
+int      errnum = 0;	/* number of errors */
+int      warnnum = 0;	/* number of warnings */
+int      sc_debug = sCHKBOUNDS;	/* by default: bounds checking+assertions */
+int      charbits = 8;	/* a "char" is 8 bits */
+int      sc_packstr = FALSE;	/* strings are packed by default? */
+int      sc_compress = TRUE;	/* compress bytecode? */
+int      sc_needsemicolon = TRUE;	/* semicolon required to terminate expressions? */
+int      sc_dataalign = sizeof(cell);	/* data alignment value */
+int      sc_alignnext = FALSE;	/* must frame of the next function be aligned? */
+int      curseg = 0;	/* 1 if currently parsing CODE, 2 if parsing DATA */
+cell     sc_stksize = sDEF_AMXSTACK;	/* default stack size */
+int      freading = FALSE;	/* Is there an input file ready for reading? */
+int      fline = 0;	/* the line number in the current file */
+int      fnumber = 0;	/* the file number in the file table (debugging) */
+int      fcurrent = 0;	/* current file being processed (debugging) */
+int      intest = 0;	/* true if inside a test */
+int      sideeffect = 0;	/* true if an expression causes a side-effect */
+int      stmtindent = 0;	/* current indent of the statement */
+int      indent_nowarn = TRUE;	/* skip warning "217 loose indentation" */
+int      sc_tabsize = 8;	/* number of spaces that a TAB represents */
+int      sc_allowtags = TRUE;	/* allow/detect tagnames in lex() */
+int      sc_status;	/* read/write status */
+int      sc_rationaltag = 0;	/* tag for rational numbers */
+int      rational_digits = 0;	/* number of fractional digits */
+
+FILE    *inpf = NULL;	/* file read from (source or include) */
+FILE    *inpf_org = NULL;	/* main source file */
+FILE    *outf = NULL;	/* file written to */
+
+jmp_buf  errbuf;
diff --git a/src/lib/Embryo.h b/src/lib/Embryo.h
new file mode 100644
index 0000000..e184ce2
--- /dev/null
+++ b/src/lib/Embryo.h
@@ -0,0 +1,901 @@
+/** 
+@brief Embryo Library
+ 
+These routines are used for Embryo.
+
+@mainpage Embryo Library Documentation
+
+@image html  e_big.png
+
+@version 1.7.0
+@author Carsten Haitzler <raster\@rasterman.com>
+@author Compuphase http://www.compuphase.com
+@date 2004-2012
+
+@section intro What is Embryo?
+
+Embryo is a tiny library designed to interpret limited Small programs
+compiled by the included compiler, @c embryo_cc.  It is mostly a cleaned
+up and smaller version of the original Small abstract machine.  The
+compiler is mostly untouched.
+
+Small was renamed to Pawn.
+For more information about the Pawn language, see 
+@htmlonly <a href=http://www.compuphase.com/pawn/pawn.htm>Pawn</a>
+@endhtmlonly
+@latexonly http://www.compuphase.com/pawn/pawn.htm @endlatexonly
+For the basics about the Small language, see @ref Small_Page.
+
+@section How_to_Use How to Use Embryo?
+
+To use Embryo in your code, you need to do at least the following:
+
+@li Include @ref Embryo.h.
+@li Load the Embryo program using one of the 
+    @ref Embryo_Program_Creation_Group.
+@li Set up the native calls with @ref embryo_program_native_call_add.
+@li Create a virtual machine with @ref embryo_program_vm_push.
+@li Then run the program with @ref embryo_program_run.
+
+@todo Clean up compiler code.
+@todo Proper overview of the operation of the interpreter, that is how
+      the heap, stack, virtual machines, etc fit together.
+
+@page Small_Page Brief Introduction to Small
+
+This section describes the basics of Small, as compiled and interpreted
+with Embryo.
+
+This summary assumes that you are familar with C.  For a full list of
+differences between C and Small, again, see the full documentation.
+
+@section Small_Variables_Section Variables
+
+@subsection Small_Type_Subsection Types
+
+There is only one type, known as the "cell", which can hold an integer.
+
+@subsection Small_Scope_Subsection Scope
+
+The scope and usage of a variable depends on its declaration.
+
+@li A local variable is normally declared with the @c new keyword. E.g.
+    @code new variable @endcode
+@li A static function variable is defined within a function with the
+    @c static keyword.
+@li A global static variable is one that is only available within the
+    file it was declared in.  Again, use the @c static keyword, but outside
+    of any function.
+@li A stock variable is one that may not be compiled into a program if it
+    is not used.  It is declared using @c stock.
+@li A public variable is one that can be read by the host program using
+    @ref embryo_program_variable_find.  It is declared using @c public
+    keyword.
+
+Remember that the keywords above are to be used on their own.  That is,
+for example: @code public testvar @endcode not:
+@code new public testvar @endcode
+
+@subsection Small_Constants_Subsection Constants
+
+You can declare constants in two ways:
+@li Using the preprocessor macro @c \#define.
+@li By inserting @c const between the keyword and variable name of a
+    variable declaration.  For example, to declare the variable @c var1
+    constant, you type @code new const var1 = 2 @endcode  Now @c var1
+    cannot be changed.
+
+@subsection Small_Arrays_Subsection Arrays
+
+To declare an array, append square brackets to the end of the variable
+name.  The following examples show how to declare arrays.  Note the
+use of the ellipsis operator, which bases the array based on the last two
+declared values:
+
+@code
+new msg[] = "A message."
+new ints[] = {1, 3, 4}
+new ints2[20] = {1, 3}         // All other elements 0.
+new ints3[10] = {1, ... }      // All elements = 1
+new ints4[10] = {10, 20, ... } // Elements = 10 -> 100.
+                               // The difference can be negative.
+new ints5[3][3] = {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
+@endcode
+
+@note Array initialisers need to be constant.
+
+@section Small_Func_Calls_Section Function Calls
+
+A typical function declaration is as follows:
+
+@code
+testfunc(param) {
+  // Do something ...
+  // over a couple of lines.
+}
+@endcode
+
+You can pass by reference.  That is, the parameter you pass is changed
+outside of the function.  For example:
+
+@code
+testfunc(&param) {
+  param = 10
+  // The passed variable will be set to 10 outside of the function.
+}
+@endcode
+
+To pass an array:
+
+@code
+testfunc(param[]) {
+  // Do something to the array
+}
+@endcode
+
+@note Arrays are passed by reference.
+
+@section Small_Control_Subsection Control Structures.
+
+Small has the following control structures, which similar to their C
+counterparts:
+@li @code if (expression) statement1 else statement2 @endcode
+@li @code switch (expression) {
+  case 0:
+    statement1 // Can only be one statement.  Look Ma, no breaks!
+  case 1..3:   // For values between 1 and 3 inclusive.
+    statement2
+  default:     // Optional
+    statement3
+}
+@endcode
+@li @code while(expression) statement @endcode
+@li @code do statement while (expression) @endcode
+@li @code for (init_expression; before_iter_test_expression; after_iter_expression) statement @endcode
+
+@section Small_Preprocessor_Section Preprocessor
+
+The following preprocessor directives are available:
+@li @code #assert constant_expression @endcode
+@li @code #define pattern replacement @endcode
+@li @code #define pattern(%1,%2,...) replacement @endcode
+@li @code #include filename @endcode
+@li @code #if constant_expression
+  // Various bits of code
+#else
+  // Other bits of code
+#endif 
+@endcode
+@li @code #undef pattern @endcode
+
+
+@page Available_Native_Calls_Page Available Calls
+
+Embryo provides a minimal set of native calls that can be used within
+any Embryo script.  Those calls are detailed here.
+
+@note Some of the "core" functions here are also described in the full
+      Small documentation given 
+
+@todo Finish this section.
+
+@section Args_ANC_Section Argument Functions
+
+@subsection Numargs_Desc numargs
+
+Returns the number of arguments passed to a function.  Useful
+when dealing with variable argument lists.
+
+@subsection Getargs_Desc getarg(arg, index=0)
+
+Retrieves the argument number @c arg.  If the argument is an array,
+use @c index to specify the index of the array to return.
+
+@subsection Setargs_Desc setargs(arg, index=0, value)
+
+Sets the argument number @c arg to the given @c arg.  @c index specifies
+the index of @c arg to set if @c arg is an array.
+
+@section String_ANC_Section String Functions
+
+Functions that work on strings.
+
+@subsection Atoi_Desc atoi
+
+Translates an number in string form into an integer.
+
+@subsection Fnmatch_Desc fnmatch
+
+Buggered if I know what this does?
+
+@subsection Strcmp_Desc strcmp
+
+String comparing function.
+
+
+@section Float_ANC_Section Float Functions
+
+@subsection Float_Desc float
+
+@subsection Atof_Desc atof
+
+@subsection Float_Mul_Desc float_mul
+
+@subsection Float_Div_Desc float_div
+
+@subsection Float_Add_Desc float_add
+
+@subsection Float_Sub_Desc float_sub
+
+@subsection Fract_Desc fract
+
+@subsection Round_Desc round
+
+@subsection Float_Cmp_Desc float_cmp
+
+@subsection Sqrt_Desc sqrt
+
+@subsection Pow_Desc pow
+
+@subsection Log_Desc log
+
+@subsection Sin_Desc sin
+
+@subsection Cos_Desc cos
+
+@subsection Tan_Desc tan
+
+@subsection Abs_Desc abs
+
+Returns the absolute value of the given float.
+
+@section Time_ANC_Section Time Functions
+
+@subsection Seconds_Desc seconds()
+
+@subsection Date_Desc date
+
+
+@section Rand_ANC_Section Random Functions
+
+@subsection Rand_Desc rand()
+
+Returns a random integer.
+
+@subsection Randf_Desc randf()
+
+Returns a random float.
+
+@file Embryo.h
+@brief Embryo virtual machine library.
+
+This file includes the routines needed for Embryo library interaction.
+This is the @e only file you need to include.
+
+*/
+
+// The following definitions are in Embryo.h, but I did not want to
+// mess up the formatting of the file
+
+/**
+  @def EMBRYO_FUNCTION_NONE 
+  An invalid/non-existent function.
+*/
+
+/**
+  @def EMBRYO_FUNCTION_MAIN
+  Start at program entry point.  For use with @ref embryo_program_run.
+*/
+
+/**
+  @def EMBRYO_FUNCTION_CONT
+  Continue from last address.  For use with @ref embryo_program_run.
+*/
+
+/**
+  @def EMBRYO_PROGRAM_OK
+  Program was run successfully.
+*/
+
+/**
+  @def EMBRYO_PROGRAM_SLEEP
+  The program's execution was interrupted by a Small @c sleep command.
+*/
+
+/**
+  @def EMBRYO_PROGRAM_FAIL
+  An error in the program caused it to fail.
+*/
+
+#ifndef _EMBRYO_H
+#define _EMBRYO_H
+
+#ifdef EAPI
+# undef EAPI
+#endif
+
+#ifdef _WIN32
+# ifdef EFL_EMBRYO_BUILD
+#  ifdef DLL_EXPORT
+#   define EAPI __declspec(dllexport)
+#  else
+#   define EAPI
+#  endif /* ! DLL_EXPORT */
+# else
+#  define EAPI __declspec(dllimport)
+# endif /* ! EFL_EMBRYO_BUILD */
+#else
+# ifdef __GNUC__
+#  if __GNUC__ >= 4
+#   define EAPI __attribute__ ((visibility("default")))
+#  else
+#   define EAPI
+#  endif
+# else
+#  define EAPI
+# endif
+#endif /* ! _WIN32 */
+
+#ifdef  __cplusplus
+extern "C" {
+#endif
+
+#define EMBRYO_VERSION_MAJOR 1
+#define EMBRYO_VERSION_MINOR 7
+   
+   typedef struct _Embryo_Version
+     {
+        int major;
+        int minor;
+        int micro;
+        int revision;
+     } Embryo_Version;
+   
+   EAPI extern Embryo_Version *embryo_version;
+   
+   /* potential error values */
+   typedef enum _Embryo_Error
+     {
+	EMBRYO_ERROR_NONE,
+	  /* reserve the first 15 error codes for exit codes of the abstract machine */
+	  EMBRYO_ERROR_EXIT,         /** Forced exit */
+	  EMBRYO_ERROR_ASSERT,       /** Assertion failed */
+	  EMBRYO_ERROR_STACKERR,     /** Stack/heap collision */
+	  EMBRYO_ERROR_BOUNDS,       /** Index out of bounds */
+	  EMBRYO_ERROR_MEMACCESS,    /** Invalid memory access */
+	  EMBRYO_ERROR_INVINSTR,     /** Invalid instruction */
+	  EMBRYO_ERROR_STACKLOW,     /** Stack underflow */
+	  EMBRYO_ERROR_HEAPLOW,      /** Heap underflow */
+	  EMBRYO_ERROR_CALLBACK,     /** No callback, or invalid callback */
+	  EMBRYO_ERROR_NATIVE,       /** Native function failed */
+	  EMBRYO_ERROR_DIVIDE,       /** Divide by zero */
+	  EMBRYO_ERROR_SLEEP,        /** Go into sleepmode - code can be restarted */
+
+	  EMBRYO_ERROR_MEMORY = 16,  /** Out of memory */
+	  EMBRYO_ERROR_FORMAT,       /** Invalid file format */
+	  EMBRYO_ERROR_VERSION,      /** File is for a newer version of the Embryo_Program */
+	  EMBRYO_ERROR_NOTFOUND,     /** Function not found */
+	  EMBRYO_ERROR_INDEX,        /** Invalid index parameter (bad entry point) */
+	  EMBRYO_ERROR_DEBUG,        /** Debugger cannot run */
+	  EMBRYO_ERROR_INIT,         /** Embryo_Program not initialized (or doubly initialized) */
+	  EMBRYO_ERROR_USERDATA,     /** Unable to set user data field (table full) */
+	  EMBRYO_ERROR_INIT_JIT,     /** Cannot initialize the JIT */
+	  EMBRYO_ERROR_PARAMS,       /** Parameter error */
+	  EMBRYO_ERROR_DOMAIN,       /** Domain error, expression result does not fit in range */
+     } Embryo_Error;
+
+   /* program run return values */
+   typedef enum _Embryo_Status
+     {
+        EMBRYO_PROGRAM_FAIL = 0,
+        EMBRYO_PROGRAM_OK = 1,
+        EMBRYO_PROGRAM_SLEEP = 2,
+        EMBRYO_PROGRAM_BUSY = 3,
+        EMBRYO_PROGRAM_TOOLONG = 4
+     } Embryo_Status;
+   
+   typedef unsigned int                Embryo_UCell;
+   typedef int                         Embryo_Cell;
+  /** An invalid cell reference */
+#define EMBRYO_CELL_NONE     0x7fffffff
+   
+   typedef struct _Embryo_Program      Embryo_Program;
+   typedef int                         Embryo_Function;
+   /* possible function type values that are enumerated */
+#define EMBRYO_FUNCTION_NONE 0x7fffffff /* An invalid/non existent function */
+#define EMBRYO_FUNCTION_MAIN -1         /* Start at program entry point */
+#define EMBRYO_FUNCTION_CONT -2         /* Continue from last address */
+
+   typedef union
+     {
+	float       f;
+	Embryo_Cell c;
+     } Embryo_Float_Cell;
+
+#if defined _MSC_VER || defined __SUNPRO_C
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) (((Embryo_Float_Cell *)&(f))->c)
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) (((Embryo_Float_Cell *)&(c))->f)
+#else
+/** Float to Embryo_Cell */
+# define EMBRYO_FLOAT_TO_CELL(f) ((Embryo_Float_Cell) f).c
+/** Embryo_Cell to float */
+# define EMBRYO_CELL_TO_FLOAT(c) ((Embryo_Float_Cell) c).f
+#endif
+
+   /**
+    * @defgroup Embryo_Library_Group Library Maintenance Functions
+    *
+    * Functions that start up and shutdown the Embryo library.
+    */
+   
+   
+/**
+ * Initialises the Embryo library.
+ * @return  The number of times the library has been initialised without being
+ *          shut down.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int              embryo_init(void);
+   
+/**
+ * Shuts down the Embryo library.
+ * @return  The number of times the library has been initialised without being
+ *          shutdown.
+ * @ingroup Embryo_Library_Group
+ */
+EAPI int              embryo_shutdown(void);
+
+   /**
+    * @defgroup Embryo_Program_Creation_Group Program Creation and Destruction Functions
+    *
+    * Functions that set up programs, and destroy them.
+    */
+   
+/**
+ * Creates a new Embryo program, with bytecode data that can be freed.
+ * @param   data Pointer to the bytecode of the program.
+ * @param   size Number of bytes of bytecode.
+ * @return  A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program  *embryo_program_new(void *data, int size);
+   
+/**
+ * Creates a new Embryo program, with bytecode data that cannot be
+ * freed.
+ * @param   data Pointer to the bytecode of the program.
+ * @param   size Number of bytes of bytecode.
+ * @return  A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program  *embryo_program_const_new(void *data, int size);
+   
+/**
+ * Creates a new Embryo program based on the bytecode data stored in the
+ * given file.
+ * @param   file Filename of the given file.
+ * @return  A new Embryo program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI Embryo_Program  *embryo_program_load(const char *file);
+   
+/**
+ * Frees the given Embryo program.
+ * @param   ep The given program.
+ * @ingroup Embryo_Program_Creation_Group
+ */
+EAPI void             embryo_program_free(Embryo_Program *ep);
+   
+/**
+ * Adds a native program call to the given Embryo program.
+ * @param   ep   The given Embryo program.
+ * @param   name The name for the call used in the script.
+ * @param   func The function to use when the call is made.
+ * @ingroup Embryo_Func_Group
+ */
+
+/**
+ * @defgroup Embryo_Func_Group Function Functions
+ *
+ * Functions that deal with Embryo program functions.
+ */
+EAPI void             embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params));
+   
+/**
+ * Resets the current virtual machine session of the given program.
+ * @param   ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_VM_Group Virtual Machine Functions
+ *
+ * Functions that deal with creating and destroying virtual machine sessions
+ * for a given program.
+ *
+ * A given embryo program can have multiple virtual machine sessions running.
+ * This is useful when you have a native call that in turn calls a function in
+ * the embryo program.  The native call can start a new virtual machine
+ * session to run the function it needs.  Once completed, the session can be
+ * popped off the program's stack, and the native call can return its value
+ * to the old session.
+ *
+ * A new virtual machine session is created by pushing a new virtual machine
+ * onto the session stack of a program using @ref embryo_program_vm_push.
+ * The current virtual machine session can be destroyed by calling
+ * @ref embryo_program_vm_pop.
+ */
+EAPI void             embryo_program_vm_reset(Embryo_Program *ep);
+   
+/**
+ * Starts a new virtual machine session for the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ *
+ * @param   ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void             embryo_program_vm_push(Embryo_Program *ep);
+   
+/**
+ * Frees the current virtual machine session associated with the given program.
+ *
+ * See @ref Embryo_Program_VM_Group for more information about how this works.
+ * Note that you will need to retrieve any return data or data on the stack
+ * before you pop.
+ *
+ * @param   ep The given program.
+ * @ingroup Embryo_Program_VM_Group
+ */
+EAPI void             embryo_program_vm_pop(Embryo_Program *ep);
+   
+/**
+ * Ensures that the given unsigned short integer is in the small
+ * endian format.
+ * @param   v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+
+/**
+ * @defgroup Embryo_Swap_Group Byte Swapping Functions
+ *
+ * Functions that are used to ensure that integers passed to the
+ * virtual machine are in small endian format.  These functions are
+ * used to ensure that the virtual machine operates correctly on big
+ * endian machines.
+ */
+EAPI void             embryo_swap_16(unsigned short *v);
+   
+/**
+ * Ensures that the given unsigned integer is in the small endian
+ * format.
+ * @param   v Pointer to the given integer.
+ * @ingroup Embryo_Swap_Group
+ */
+EAPI void             embryo_swap_32(unsigned int *v);
+   
+/**
+ * Returns the function in the given program with the given name.
+ * @param   ep The given program.
+ * @param   name The given function name.
+ * @return  The function if successful.  Otherwise, @c EMBRYO_FUNCTION_NONE.
+ * @ingroup Embryo_Func_Group
+ */
+EAPI Embryo_Function  embryo_program_function_find(Embryo_Program *ep, const char *name);
+   
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given name.
+ * @param   ep   The given program.
+ * @param   name The given name.
+ * @return  The address of the variable if found.  @c EMBRYO_CELL_NONE
+ *          otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+
+/**
+ * @defgroup Embryo_Public_Variable_Group Public Variable Access Functions
+ *
+ * In an Embryo program, a global variable can be declared public, as
+ * described in @ref Small_Scope_Subsection.  The functions here allow
+ * the host program to access these public variables.
+ */
+EAPI Embryo_Cell      embryo_program_variable_find(Embryo_Program *ep, const char *name);
+   
+/**
+ * Retrieves the number of public variables in the given program.
+ * @param   ep The given program.
+ * @return  The number of public variables.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI int              embryo_program_variable_count_get(Embryo_Program *ep);
+   
+/**
+ * Retrieves the location of the public variable in the given program
+ * with the given identifier.
+ * @param   ep  The given program.
+ * @param   num The identifier of the public variable.
+ * @return  The virtual machine address of the variable if found.
+ *          @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Public_Variable_Group
+ */
+EAPI Embryo_Cell      embryo_program_variable_get(Embryo_Program *ep, int num);
+   
+/**
+ * Sets the error code for the given program to the given code.
+ * @param   ep The given program.
+ * @param   error The given error code.
+ * @ingroup Embryo_Error_Group
+ */
+
+/**
+ * @defgroup Embryo_Error_Group Error Functions
+ *
+ * Functions that set and retrieve error codes in Embryo programs.
+ */
+EAPI void             embryo_program_error_set(Embryo_Program *ep, Embryo_Error error);
+   
+/**
+ * Retrieves the current error code for the given program.
+ * @param   ep The given program.
+ * @return  The current error code.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI Embryo_Error     embryo_program_error_get(Embryo_Program *ep);
+   
+/**
+ * Sets the data associated to the given program.
+ * @param   ep   The given program.
+ * @param   data New bytecode data.
+ * @ingroup Embryo_Program_Data_Group
+ */
+
+/**
+ * @defgroup Embryo_Program_Data_Group Program Data Functions
+ *
+ * Functions that set and retrieve data associated with the given
+ * program.
+ */
+EAPI void             embryo_program_data_set(Embryo_Program *ep, void *data);
+   
+/**
+ * Retrieves the data associated to the given program.
+ * @param   ep The given program.
+ * @ingroup Embryo_Program_Data_Group
+ */
+EAPI void            *embryo_program_data_get(Embryo_Program *ep);
+   
+/**
+ * Retrieves a string describing the given error code.
+ * @param   error The given error code.
+ * @return  String describing the given error code.  If the given code is not
+ *          known, the string "(unknown)" is returned.
+ * @ingroup Embryo_Error_Group
+ */
+EAPI const char      *embryo_error_string_get(Embryo_Error error);
+   
+/**
+ * Retrieves the length of the string starting at the given cell.
+ * @param   ep       The program the cell is part of.
+ * @param   str_cell Pointer to the first cell of the string.
+ * @return  The length of the string.  @c 0 is returned if there is an error.
+ * @ingroup Embryo_Data_String_Group
+ */
+
+/**
+ * @defgroup Embryo_Data_String_Group Embryo Data String Functions
+ *
+ * Functions that operate on strings in the memory of a virtual machine.
+ */
+EAPI int              embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell);
+   
+/**
+ * Copies the string starting at the given cell to the given buffer.
+ * @param   ep       The program the cell is part of.
+ * @param   str_cell Pointer to the first cell of the string.
+ * @param   dst      The given buffer.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void             embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst);
+   
+/**
+ * Copies string in the given buffer into the virtual machine memory
+ * starting at the given cell.
+ * @param ep       The program the cell is part of.
+ * @param src      The given buffer.
+ * @param str_cell Pointer to the first cell to copy the string to.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI void             embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell);
+   
+/**
+ * Retreives a pointer to the address in the virtual machine given by the
+ * given cell.
+ * @param   ep   The program whose virtual machine address is being queried.
+ * @param   addr The given cell.
+ * @return  A pointer to the cell at the given address.
+ * @ingroup Embryo_Data_String_Group
+ */
+EAPI Embryo_Cell     *embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr);
+   
+/**
+ * Increases the size of the heap of the given virtual machine by the given
+ * number of Embryo_Cells.
+ * @param   ep    The program with the given virtual machine.
+ * @param   cells The given number of Embryo_Cells.
+ * @return  The address of the new memory region on success.
+ *          @c EMBRYO_CELL_NONE otherwise.
+ * @ingroup Embryo_Heap_Group
+ */
+
+/**
+ * @defgroup Embryo_Heap_Group Heap Functions
+ *
+ * The heap is an area of memory that can be allocated for program
+ * use at runtime.  The heap functions here change the amount of heap
+ * memory available.
+ */
+EAPI Embryo_Cell      embryo_data_heap_push(Embryo_Program *ep, int cells);
+   
+/**
+ * Decreases the size of the heap of the given virtual machine down to the
+ * given size.
+ * @param   ep      The program with the given virtual machine.
+ * @param   down_to The given size.
+ * @ingroup Embryo_Heap_Group
+ */
+EAPI void             embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to);
+   
+/**
+ * Returns the number of virtual machines are running for the given program.
+ * @param   ep The given program.
+ * @return  The number of virtual machines running.
+ * @ingroup Embryo_Run_Group
+ */
+
+/**
+ * @defgroup Embryo_Run_Group Program Run Functions
+ *
+ * Functions that are involved in actually running functions in an
+ * Embryo program.
+ */
+EAPI int              embryo_program_recursion_get(Embryo_Program *ep);
+   
+/**
+ * Runs the given function of the given Embryo program in the current
+ * virtual machine.  The parameter @p fn can be found using
+ * @ref embryo_program_function_find.
+ *
+ * @note For Embryo to be able to run a function, it must have been
+ *       declared @c public in the Small source code.
+ *
+ * @param   ep The given program.
+ * @param   func The given function.  Normally "main", in which case the
+ *             constant @c EMBRYO_FUNCTION_MAIN can be used.
+ * @return  @c EMBRYO_PROGRAM_OK on success.  @c EMBRYO_PROGRAM_SLEEP if the
+ *          program is halted by the Small @c sleep call.
+ *          @c EMBRYO_PROGRAM_FAIL if there is an error.
+ *          @c EMBRYO_PROGRAM_TOOLONG if the program executes for longer than
+ *          it is allowed to in abstract machine instruction count.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Status    embryo_program_run(Embryo_Program *ep, Embryo_Function func);
+   
+/**
+ * Retreives the return value of the last called function of the given
+ * program.
+ * @param   ep The given program.
+ * @return  An Embryo_Cell representing the return value of the function
+ *          that was last called.
+ * @ingroup Embryo_Run_Group
+ */
+EAPI Embryo_Cell      embryo_program_return_value_get(Embryo_Program *ep);
+   
+/**
+ * Sets the maximum number of abstract machine cycles any given program run
+ * can execute before being put to sleep and returning.
+ *
+ * @param   ep The given program.
+ * @param   max The number of machine cycles as a limit.
+ *
+ * This sets the maximum number of abstract machine (virtual machine)
+ * instructions that a single run of an embryo function (even if its main)
+ * can use before embryo embryo_program_run() reutrns with the value
+ * EMBRYO_PROGRAM_TOOLONG. If the function fully executes within this number
+ * of cycles, embryo_program_run() will return as normal with either
+ * EMBRYO_PROGRAM_OK, EMBRYO_PROGRAM_FAIL or EMBRYO_PROGRAM_SLEEP. If the
+ * run exceeds this instruction count, then EMBRYO_PROGRAM_TOOLONG will be
+ * returned indicating the program exceeded its run count. If the app wishes
+ * to continue running this anyway - it is free to process its own events or
+ * whatever it wants and continue the function by calling
+ * embryo_program_run(program, EMBRYO_FUNCTION_CONT); which will start the
+ * run again until the instruction count is reached. This can keep being done
+ * to allow the calling program to still be able to control things outside the
+ * embryo function being called. If the maximum run cycle count is 0 then the
+ * program is allowed to run forever only returning when it is done.
+ *
+ * It is important to note that abstract machine cycles are NOT the same as
+ * the host machine cpu cycles. They are not fixed in runtime per cycle, so
+ * this is more of a helper tool than a way to HARD-FORCE a script to only
+ * run for a specific period of time. If the cycle count is set to something
+ * low like 5000 or 1000, then every 1000 (or 5000) cycles control will be
+ * returned to the calling process where it can check a timer to see if a
+ * physical runtime limit has been elapsed and then abort running further
+ * assuming a "runaway script" or keep continuing the script run. This
+ * limits resolution to only that many cycles which do not take a determined
+ * amount of time to execute, as this varies from cpu to cpu and also depends
+ * on how loaded the system is. Making the max cycle run too low will
+ * impact performance requiring the abstract machine to do setup and teardown
+ * cycles too often comapred to cycles actually executed.
+ *
+ * Also note it does NOT include nested abstract machines. IF this abstract
+ * machine run calls embryo script that calls a native function that in turn
+ * calls more embryo script, then the 2nd (and so on) levels are not included
+ * in this run count. They can set their own max instruction count values
+ * separately.
+ *
+ * The default max cycle run value is 0 in any program until set with this
+ * function.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI void             embryo_program_max_cycle_run_set(Embryo_Program *ep, int max);
+   
+/**
+ * Retreives the maximum number of abstract machine cycles a program is allowed
+ * to run.
+ * @param   ep The given program.
+ * @return  The number of cycles a run cycle is allowed to run for this
+ *          program.
+ *
+ * This returns the value set by embryo_program_max_cycle_run_set(). See
+ * embryo_program_max_cycle_run_set() for more information.
+ *
+ * @ingroup Embryo_Run_Group
+ */
+EAPI int              embryo_program_max_cycle_run_get(Embryo_Program *ep);
+   
+/**
+ * Pushes an Embryo_Cell onto the function stack to use as a parameter for
+ * the next function that is called in the given program.
+ * @param   ep   The given program.
+ * @param   cell The Embryo_Cell to push onto the stack.
+ * @return  @c 1 if successful.  @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+
+/**
+ * @defgroup Embryo_Parameter_Group Function Parameter Functions
+ *
+ * Functions that set parameters for the next function that is called.
+ */
+EAPI int              embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell);
+   
+/**
+ * Pushes a string onto the function stack to use as a parameter for the
+ * next function that is called in the given program.
+ * @param   ep The given program.
+ * @param   str The string to push onto the stack.
+ * @return  @c 1 if successful.  @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int              embryo_parameter_string_push(Embryo_Program *ep, const char *str);
+   
+/**
+ * Pushes an array of Embryo_Cells onto the function stack to be used as
+ * parameters for the next function that is called in the given program.
+ * @param   ep    The given program.
+ * @param   cells The array of Embryo_Cells.
+ * @param   num   The number of cells in @p cells.
+ * @return  @c 1 if successful.  @c 0 otherwise.
+ * @ingroup Embryo_Parameter_Group
+ */
+EAPI int              embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num);
+
+#ifdef  __cplusplus
+}
+#endif
+
+#endif
diff --git a/src/lib/Makefile.am b/src/lib/Makefile.am
new file mode 100644
index 0000000..d2ccb55
--- /dev/null
+++ b/src/lib/Makefile.am
@@ -0,0 +1,36 @@
+
+MAINTAINERCLEANFILES = Makefile.in
+
+AM_CPPFLAGS = \
+-I. \
+-I$(top_srcdir)/src/lib \
+-I$(top_builddir) \
+-I$(top_srcdir)/src/lib \
+-I$(top_srcdir)/src/lib/include \
+-DPACKAGE_BIN_DIR=\"$(bindir)\" \
+-DPACKAGE_LIB_DIR=\"$(libdir)\" \
+-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
+@EVIL_CFLAGS@ \
+@EXOTIC_CFLAGS@ \
+@EMBRYO_CPPFLAGS@ \
+@EFL_EMBRYO_BUILD@
+
+includes_HEADERS = Embryo.h
+includesdir = $(includedir)/embryo-@VMAJ@
+
+lib_LTLIBRARIES = libembryo.la
+
+libembryo_la_SOURCES  = \
+embryo_amx.c \
+embryo_args.c \
+embryo_float.c \
+embryo_main.c \
+embryo_rand.c \
+embryo_str.c \
+embryo_time.c
+
+libembryo_la_CFLAGS = @EMBRYO_CFLAGS@
+libembryo_la_LIBADD = @EXOTIC_LIBS@ @EVIL_LIBS@ -lm
+libembryo_la_LDFLAGS = -no-undefined @lt_enable_auto_import@ -version-info @version_info@ @release_info@
+
+EXTRA_DIST = embryo_private.h
diff --git a/src/lib/embryo_amx.c b/src/lib/embryo_amx.c
new file mode 100644
index 0000000..55423b4
--- /dev/null
+++ b/src/lib/embryo_amx.c
@@ -0,0 +1,1995 @@
+/*  Abstract Machine for the Small compiler
+ *
+ *  Copyright (c) ITB CompuPhase, 1997-2003
+ *  Portions Copyright (c) Carsten Haitzler, 2004-2010 <raster@rasterman.com>
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+
+#define JUMPABS(base, ip)     ((Embryo_Cell *)(code + (*ip)))
+
+#ifdef WORDS_BIGENDIAN
+static void _embryo_byte_swap_16 (unsigned short *v);
+static void _embryo_byte_swap_32 (unsigned int *v);
+#endif
+static int  _embryo_native_call  (Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params);
+static int  _embryo_func_get     (Embryo_Program *ep, int idx, char *funcname);
+static int  _embryo_var_get      (Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr);
+static int  _embryo_program_init (Embryo_Program *ep, void *code);
+
+#ifdef WORDS_BIGENDIAN
+static void
+_embryo_byte_swap_16(unsigned short *v)
+{
+   unsigned char *s, t;
+
+   s = (unsigned char *)v;
+   t = s[0]; s[0] = s[1]; s[1] = t;
+}
+
+static void
+_embryo_byte_swap_32(unsigned int *v)
+{
+   unsigned char *s, t;
+
+   s = (unsigned char *)v;
+   t = s[0]; s[0] = s[3]; s[3] = t;
+   t = s[1]; s[1] = s[2]; s[2] = t;
+}
+#endif
+
+static int
+_embryo_native_call(Embryo_Program *ep, Embryo_Cell idx, Embryo_Cell *result, Embryo_Cell *params)
+{
+   Embryo_Header    *hdr;
+   Embryo_Func_Stub *func_entry;
+   Embryo_Native     f;
+
+   hdr = (Embryo_Header *)ep->base;
+   func_entry = GETENTRY(hdr, natives, idx);
+   if ((func_entry->address <= 0) ||
+       (func_entry->address > ep->native_calls_size))
+     {
+	ep->error = EMBRYO_ERROR_CALLBACK;
+	return ep->error;
+     }
+   f = ep->native_calls[func_entry->address - 1];
+   if (!f)
+     {
+	ep->error = EMBRYO_ERROR_CALLBACK;
+	return ep->error;
+     }
+   ep->error = EMBRYO_ERROR_NONE;
+   *result = f(ep, params);
+   return ep->error;
+}
+
+static int
+_embryo_func_get(Embryo_Program *ep, int idx, char *funcname)
+{
+   Embryo_Header    *hdr;
+   Embryo_Func_Stub *func;
+
+   hdr = (Embryo_Header *)ep->code;
+   if (idx >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+     return EMBRYO_ERROR_INDEX;
+
+   func = GETENTRY(hdr, publics, idx);
+   strcpy(funcname, GETENTRYNAME(hdr, func));
+   return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_var_get(Embryo_Program *ep, int idx, char *varname, Embryo_Cell *ep_addr)
+{
+
+  Embryo_Header    *hdr;
+  Embryo_Func_Stub *var;
+
+  hdr=(Embryo_Header *)ep->base;
+  if (idx >= (Embryo_Cell)NUMENTRIES(hdr, pubvars, tags))
+     return EMBRYO_ERROR_INDEX;
+
+  var = GETENTRY(hdr, pubvars, idx);
+  strcpy(varname, GETENTRYNAME(hdr, var));
+  *ep_addr = var->address;
+  return EMBRYO_ERROR_NONE;
+}
+
+static int
+_embryo_program_init(Embryo_Program *ep, void *code)
+{
+   Embryo_Header    *hdr;
+
+   if ((ep->flags & EMBRYO_FLAG_RELOC)) return 1;
+   ep->code = (unsigned char *)code;
+   hdr = (Embryo_Header *)ep->code;
+#ifdef WORDS_BIGENDIAN
+   embryo_swap_32((unsigned int *)&hdr->size);
+   embryo_swap_16((unsigned short *)&hdr->magic);
+   embryo_swap_16((unsigned short *)&hdr->flags);
+   embryo_swap_16((unsigned short *)&hdr->defsize);
+   embryo_swap_32((unsigned int *)&hdr->cod);
+   embryo_swap_32((unsigned int *)&hdr->dat);
+   embryo_swap_32((unsigned int *)&hdr->hea);
+   embryo_swap_32((unsigned int *)&hdr->stp);
+   embryo_swap_32((unsigned int *)&hdr->cip);
+   embryo_swap_32((unsigned int *)&hdr->publics);
+   embryo_swap_32((unsigned int *)&hdr->natives);
+   embryo_swap_32((unsigned int *)&hdr->libraries);
+   embryo_swap_32((unsigned int *)&hdr->pubvars);
+   embryo_swap_32((unsigned int *)&hdr->tags);
+   embryo_swap_32((unsigned int *)&hdr->nametable);
+#endif
+
+   if (hdr->magic != EMBRYO_MAGIC) return 0;
+   if ((hdr->file_version < MIN_FILE_VERSION) ||
+      (hdr->ep_version > CUR_FILE_VERSION)) return 0;
+   if ((hdr->defsize != sizeof(Embryo_Func_Stub)) &&
+      (hdr->defsize != (2 * sizeof(unsigned int)))) return 0;
+   if (hdr->defsize == (2 * sizeof(unsigned int)))
+     {
+	unsigned short *len;
+
+	len = (unsigned short*)((unsigned char*)ep->code + hdr->nametable);
+#ifdef WORDS_BIGENDIAN
+	embryo_swap_16((unsigned short *)len);
+#endif
+	if (*len > sNAMEMAX) return 0;
+     }
+   if (hdr->stp <= 0) return 0;
+   if ((hdr->flags & EMBRYO_FLAG_COMPACT)) return 0;
+
+#ifdef WORDS_BIGENDIAN
+     {
+	Embryo_Func_Stub *fs;
+	int i, num;
+
+	/* also align all addresses in the public function, public variable and */
+	/* public tag tables */
+	fs = GETENTRY(hdr, publics, 0);
+	num = NUMENTRIES(hdr, publics, natives);
+	for (i = 0; i < num; i++)
+	  {
+	     embryo_swap_32(&(fs->address));
+	     fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+	  }
+
+	fs = GETENTRY(hdr, pubvars, 0);
+	num = NUMENTRIES(hdr, pubvars, tags);
+	for (i = 0; i < num; i++)
+	  {
+	     embryo_swap_32(&(fs->address));
+	     fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+	  }
+
+	fs = GETENTRY(hdr, tags, 0);
+	num = NUMENTRIES(hdr, tags, nametable);
+	for (i = 0; i < num; i++)
+	  {
+	     embryo_swap_32(&(fs->address));
+	     fs = (Embryo_Func_Stub *)((unsigned char *)fs + hdr->defsize);
+	  }
+     }
+#endif
+   ep->flags = EMBRYO_FLAG_RELOC;
+
+     {
+	Embryo_Cell cip, code_size, cip_end;
+	Embryo_Cell *code;
+
+	code_size = hdr->dat - hdr->cod;
+	code = (Embryo_Cell *)((unsigned char *)ep->code + (int)hdr->cod);
+        cip_end = code_size / sizeof(Embryo_Cell);
+	for (cip = 0; cip < cip_end; cip++)
+	  {
+/* move this here - later we probably want something that verifies opcodes
+ * are valid and ok...
+ */
+#ifdef WORDS_BIGENDIAN
+	     embryo_swap_32(&(code[cip]));
+#endif
+
+	  }
+     }
+   /* init native api for handling floating point - default in embryo */
+   _embryo_args_init(ep);
+   _embryo_fp_init(ep);
+   _embryo_rand_init(ep);
+   _embryo_str_init(ep);
+   _embryo_time_init(ep);
+   return 1;
+}
+
+/*** EXPORTED CALLS ***/
+
+EAPI Embryo_Program *
+embryo_program_new(void *data, int size)
+{
+   Embryo_Program *ep;
+   void *code_data;
+
+   if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+   ep = calloc(1, sizeof(Embryo_Program));
+   if (!ep) return NULL;
+
+   code_data = malloc(size);
+   if (!code_data)
+     {
+	free(ep);
+	return NULL;
+     }
+   memcpy(code_data, data, size);
+   if (_embryo_program_init(ep, code_data)) return ep;
+   free(code_data);
+   free(ep);
+   return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_const_new(void *data, int size)
+{
+   Embryo_Program *ep;
+
+   if (size < (int)sizeof(Embryo_Header)) return NULL;
+
+   ep = calloc(1, sizeof(Embryo_Program));
+   if (!ep) return NULL;
+
+   if (_embryo_program_init(ep, data))
+     {
+	ep->dont_free_code = 1;
+	return ep;
+     }
+   free(ep);
+   return NULL;
+}
+
+EAPI Embryo_Program *
+embryo_program_load(const char *file)
+{
+   Embryo_Program *ep;
+   Embryo_Header   hdr;
+   FILE *f;
+   void *program = NULL;
+   int program_size = 0;
+
+   f = fopen(file, "rb");
+   if (!f) return NULL;
+   fseek(f, 0, SEEK_END);
+   program_size = ftell(f);
+   fseek(f, 0L, SEEK_SET);
+   if (program_size < (int)sizeof(Embryo_Header))
+     {
+	fclose(f);
+	return NULL;
+     }
+   if (fread(&hdr, sizeof(Embryo_Header), 1, f) != 1)
+     {
+	fclose(f);
+	return NULL;
+     }
+   fseek(f, 0L, SEEK_SET);
+#ifdef WORDS_BIGENDIAN
+   embryo_swap_32((unsigned int *)(&hdr.size));
+#endif
+   if ((int)hdr.size < program_size) program_size = hdr.size;
+   program = malloc(program_size);
+   if (!program)
+     {
+	fclose(f);
+	return NULL;
+     }
+   if (fread(program, program_size, 1, f) != 1)
+     {
+	free(program);
+	fclose(f);
+	return NULL;
+     }
+   ep = embryo_program_new(program, program_size);
+   free(program);
+   fclose(f);
+   return ep;
+}
+
+EAPI void
+embryo_program_free(Embryo_Program *ep)
+{
+   int i;
+
+   if (ep->base) free(ep->base);
+   if ((!ep->dont_free_code) && (ep->code)) free(ep->code);
+   if (ep->native_calls) free(ep->native_calls);
+   for (i = 0; i < ep->params_size; i++)
+     {
+	if (ep->params[i].string) free(ep->params[i].string);
+	if (ep->params[i].cell_array) free(ep->params[i].cell_array);
+     }
+   if (ep->params) free(ep->params);
+   free(ep);
+}
+
+
+EAPI void
+embryo_program_native_call_add(Embryo_Program *ep, const char *name, Embryo_Cell (*func) (Embryo_Program *ep, Embryo_Cell *params))
+{
+   Embryo_Func_Stub *func_entry;
+   Embryo_Header    *hdr;
+   int               i, num;
+
+   if ((!ep ) || (!name) || (!func)) return;
+   if (strlen(name) > sNAMEMAX) return;
+
+   hdr = (Embryo_Header *)ep->code;
+   if (hdr->defsize < 1) return;
+   num = NUMENTRIES(hdr, natives, libraries);
+   if (num <= 0) return;
+
+   ep->native_calls_size++;
+   if (ep->native_calls_size > ep->native_calls_alloc)
+     {
+	Embryo_Native *calls;
+
+	ep->native_calls_alloc += 32;
+	calls = realloc(ep->native_calls,
+			ep->native_calls_alloc * sizeof(Embryo_Native));
+	if (!calls)
+	  {
+	     ep->native_calls_size--;
+	     ep->native_calls_alloc -= 32;
+	     return;
+	  }
+	ep->native_calls = calls;
+     }
+   ep->native_calls[ep->native_calls_size - 1] = func;
+
+   func_entry = GETENTRY(hdr, natives, 0);
+   for (i = 0; i < num; i++)
+     {
+	if (func_entry->address == 0)
+	  {
+	     char *entry_name;
+
+	     entry_name = GETENTRYNAME(hdr, func_entry);
+	     if ((entry_name) && (!strcmp(entry_name, name)))
+	       {
+		  func_entry->address = ep->native_calls_size;
+		  /* FIXME: embryo_cc is putting in multiple native */
+		  /* function call entries - so we need to fill in all */
+		  /* of them!!! */
+		  /* return; */
+	       }
+	  }
+	func_entry =
+	  (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+     }
+}
+
+
+EAPI void
+embryo_program_vm_reset(Embryo_Program *ep)
+{
+   Embryo_Header *hdr;
+
+   if ((!ep) || (!ep->base)) return;
+   hdr = (Embryo_Header *)ep->code;
+   memcpy(ep->base, hdr, hdr->size);
+   *(Embryo_Cell *)(ep->base + (int)hdr->stp - sizeof(Embryo_Cell)) = 0;
+
+   ep->hlw = hdr->hea - hdr->dat; /* stack and heap relative to data segment */
+   ep->stp = hdr->stp - hdr->dat - sizeof(Embryo_Cell);
+   ep->hea = ep->hlw;
+   ep->stk = ep->stp;
+}
+
+EAPI void
+embryo_program_vm_push(Embryo_Program *ep)
+{
+   Embryo_Header *hdr;
+
+   if (!ep) return;
+   ep->pushes++;
+   if (ep->pushes > 1)
+     {
+	embryo_program_vm_reset(ep);
+	return;
+     }
+   hdr = (Embryo_Header *)ep->code;
+   ep->base = calloc(1, hdr->stp);
+   if (!ep->base)
+     {
+	ep->pushes = 0;
+	return;
+     }
+   embryo_program_vm_reset(ep);
+}
+
+EAPI void
+embryo_program_vm_pop(Embryo_Program *ep)
+{
+   if ((!ep) || (!ep->base)) return;
+   ep->pushes--;
+   if (ep->pushes >= 1) return;
+   free(ep->base);
+   ep->base = NULL;
+}
+
+
+EAPI void
+embryo_swap_16(unsigned short *v
+#ifndef WORDS_BIGENDIAN
+               __UNUSED__
+#endif               
+              )
+{
+#ifdef WORDS_BIGENDIAN
+   _embryo_byte_swap_16(v);
+#endif
+}
+
+EAPI void
+embryo_swap_32(unsigned int *v
+#ifndef WORDS_BIGENDIAN
+               __UNUSED__
+#endif
+               )
+{
+#ifdef WORDS_BIGENDIAN
+   _embryo_byte_swap_32(v);
+#endif
+}
+
+EAPI Embryo_Function
+embryo_program_function_find(Embryo_Program *ep, const char *name)
+{
+   int            first, last, mid, result;
+   char           pname[sNAMEMAX + 1];
+   Embryo_Header *hdr;
+
+   if (!ep) return EMBRYO_FUNCTION_NONE;
+   hdr = (Embryo_Header *)ep->code;
+   last = NUMENTRIES(hdr, publics, natives) - 1;
+   first = 0;
+   /* binary search */
+   while (first <= last)
+     {
+	mid = (first + last) / 2;
+	if (_embryo_func_get(ep, mid, pname) == EMBRYO_ERROR_NONE)
+	  result = strcmp(pname, name);
+	else
+	  return EMBRYO_FUNCTION_NONE;
+/*	  result = -1;*/
+	if (result > 0) last = mid - 1;
+	else if (result < 0) first = mid + 1;
+	else return mid;
+     }
+   return EMBRYO_FUNCTION_NONE;
+}
+
+
+EAPI Embryo_Cell
+embryo_program_variable_find(Embryo_Program *ep, const char *name)
+{
+   int            first, last, mid, result;
+   char           pname[sNAMEMAX + 1];
+   Embryo_Cell    paddr;
+   Embryo_Header *hdr;
+
+   if (!ep) return EMBRYO_CELL_NONE;
+   if (!ep->base) return EMBRYO_CELL_NONE;
+   hdr = (Embryo_Header *)ep->base;
+   last = NUMENTRIES(hdr, pubvars, tags) - 1;
+   first = 0;
+   /* binary search */
+   while (first <= last)
+     {
+	mid = (first + last) / 2;
+	if (_embryo_var_get(ep, mid, pname, &paddr) == EMBRYO_ERROR_NONE)
+	  result = strcmp(pname, name);
+	else
+	  return EMBRYO_CELL_NONE;
+/*	  result = -1;*/
+	if (result > 0) last = mid - 1;
+	else if (result < 0) first = mid + 1;
+	else return paddr;
+     }
+   return EMBRYO_CELL_NONE;
+}
+
+EAPI int
+embryo_program_variable_count_get(Embryo_Program *ep)
+{
+   Embryo_Header *hdr;
+
+   if (!ep) return 0;
+   if (!ep->base) return 0;
+   hdr = (Embryo_Header *)ep->base;
+   return NUMENTRIES(hdr, pubvars, tags);
+}
+
+EAPI Embryo_Cell
+embryo_program_variable_get(Embryo_Program *ep, int num)
+{
+   Embryo_Cell    paddr;
+   char           pname[sNAMEMAX + 1];
+
+   if (!ep) return EMBRYO_CELL_NONE;
+   if (!ep->base) return EMBRYO_CELL_NONE;
+   if (_embryo_var_get(ep, num, pname, &paddr) == EMBRYO_ERROR_NONE)
+     return paddr;
+   return EMBRYO_CELL_NONE;
+}
+
+
+EAPI void
+embryo_program_error_set(Embryo_Program *ep, Embryo_Error error)
+{
+   if (!ep) return;
+   ep->error = error;
+}
+
+EAPI Embryo_Error
+embryo_program_error_get(Embryo_Program *ep)
+{
+   if (!ep) return EMBRYO_ERROR_NONE;
+   return ep->error;
+}
+
+
+EAPI void
+embryo_program_data_set(Embryo_Program *ep, void *data)
+{
+   if (!ep) return;
+   ep->data = data;
+}
+
+EAPI void *
+embryo_program_data_get(Embryo_Program *ep)
+{
+   if (!ep) return NULL;
+   return ep->data;
+}
+
+EAPI const char *
+embryo_error_string_get(Embryo_Error error)
+{
+   const char *messages[] =
+     {
+	/* EMBRYO_ERROR_NONE      */ "(none)",
+	  /* EMBRYO_ERROR_EXIT      */ "Forced exit",
+	  /* EMBRYO_ERROR_ASSERT    */ "Assertion failed",
+	  /* EMBRYO_ERROR_STACKERR  */ "Stack/heap collision (insufficient stack size)",
+	  /* EMBRYO_ERROR_BOUNDS    */ "Array index out of bounds",
+	  /* EMBRYO_ERROR_MEMACCESS */ "Invalid memory access",
+	  /* EMBRYO_ERROR_INVINSTR  */ "Invalid instruction",
+	  /* EMBRYO_ERROR_STACKLOW  */ "Stack underflow",
+	  /* EMBRYO_ERROR_HEAPLOW   */ "Heap underflow",
+	  /* EMBRYO_ERROR_CALLBACK  */ "No (valid) native function callback",
+	  /* EMBRYO_ERROR_NATIVE    */ "Native function failed",
+	  /* EMBRYO_ERROR_DIVIDE    */ "Divide by zero",
+	  /* EMBRYO_ERROR_SLEEP     */ "(sleep mode)",
+	  /* 13 */                     "(reserved)",
+	  /* 14 */                     "(reserved)",
+	  /* 15 */                     "(reserved)",
+	  /* EMBRYO_ERROR_MEMORY    */ "Out of memory",
+	  /* EMBRYO_ERROR_FORMAT    */ "Invalid/unsupported P-code file format",
+	  /* EMBRYO_ERROR_VERSION   */ "File is for a newer version of the Embryo_Program",
+	  /* EMBRYO_ERROR_NOTFOUND  */ "Native/Public function is not found",
+	  /* EMBRYO_ERROR_INDEX     */ "Invalid index parameter (bad entry point)",
+	  /* EMBRYO_ERROR_DEBUG     */ "Debugger cannot run",
+	  /* EMBRYO_ERROR_INIT      */ "Embryo_Program not initialized (or doubly initialized)",
+	  /* EMBRYO_ERROR_USERDATA  */ "Unable to set user data field (table full)",
+	  /* EMBRYO_ERROR_INIT_JIT  */ "Cannot initialize the JIT",
+	  /* EMBRYO_ERROR_PARAMS    */ "Parameter error",
+     };
+   if (((int)error < 0) || 
+       ((int)error >= (int)(sizeof(messages) / sizeof(messages[0]))))
+     return (const char *)"(unknown)";
+   return messages[error];
+}
+
+
+EAPI int
+embryo_data_string_length_get(Embryo_Program *ep, Embryo_Cell *str_cell)
+{
+   int            len;
+   Embryo_Header *hdr;
+
+   if ((!ep) || (!ep->base)) return 0;
+   hdr = (Embryo_Header *)ep->base;
+   if ((!str_cell) ||
+       ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+       ((void *)str_cell < (void *)ep->base))
+     return 0;
+   for (len = 0; str_cell[len] != 0; len++);
+   return len;
+}
+
+EAPI void
+embryo_data_string_get(Embryo_Program *ep, Embryo_Cell *str_cell, char *dst)
+{
+   int            i;
+   Embryo_Header *hdr;
+
+   if (!dst) return;
+   if ((!ep) || (!ep->base))
+     {
+	dst[0] = 0;
+	return;
+     }
+   hdr = (Embryo_Header *)ep->base;
+   if ((!str_cell) ||
+       ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+       ((void *)str_cell < (void *)ep->base))
+     {
+	dst[0] = 0;
+	return;
+     }
+   for (i = 0; str_cell[i] != 0; i++)
+     {
+#ifdef WORDS_BIGENDIAN
+	  {
+	     Embryo_Cell tmp;
+
+	     tmp = str_cell[i];
+	     _embryo_byte_swap_32(&tmp);
+	     dst[i] = tmp;
+	  }
+#else
+	dst[i] = str_cell[i];
+#endif
+     }
+   dst[i] = 0;
+}
+
+EAPI void
+embryo_data_string_set(Embryo_Program *ep, const char *src, Embryo_Cell *str_cell)
+{
+   int            i;
+   Embryo_Header *hdr;
+
+   if (!ep) return;
+   if (!ep->base) return;
+   hdr = (Embryo_Header *)ep->base;
+   if ((!str_cell) ||
+       ((void *)str_cell >= (void *)(ep->base + hdr->stp)) ||
+       ((void *)str_cell < (void *)ep->base))
+     return;
+   if (!src)
+     {
+	str_cell[0] = 0;
+	return;
+     }
+   for (i = 0; src[i] != 0; i++)
+     {
+	if ((void *)(&(str_cell[i])) >= (void *)(ep->base + hdr->stp)) return;
+	else if ((void *)(&(str_cell[i])) == (void *)(ep->base + hdr->stp - 1))
+	  {
+	     str_cell[i] = 0;
+	     return;
+	  }
+#ifdef WORDS_BIGENDIAN
+	  {
+	     Embryo_Cell tmp;
+
+	     tmp = src[i];
+	     _embryo_byte_swap_32(&tmp);
+	     str_cell[i] = tmp;
+	  }
+#else
+	str_cell[i] = src[i];
+#endif
+     }
+   str_cell[i] = 0;
+}
+
+EAPI Embryo_Cell *
+embryo_data_address_get(Embryo_Program *ep, Embryo_Cell addr)
+{
+   Embryo_Header *hdr;
+   unsigned char *data;
+
+   if ((!ep) || (!ep->base)) return NULL;
+   hdr = (Embryo_Header *)ep->base;
+   data = ep->base + (int)hdr->dat;
+   if ((addr < 0) || (addr >= hdr->stp)) return NULL;
+   return (Embryo_Cell *)(data + (int)addr);
+}
+
+
+EAPI Embryo_Cell
+embryo_data_heap_push(Embryo_Program *ep, int cells)
+{
+   Embryo_Header *hdr;
+   Embryo_Cell    addr;
+
+   if ((!ep) || (!ep->base)) return EMBRYO_CELL_NONE;
+   hdr = (Embryo_Header *)ep->base;
+   if (ep->stk - ep->hea - (cells * sizeof(Embryo_Cell)) < STKMARGIN)
+     return EMBRYO_CELL_NONE;
+   addr = ep->hea;
+   ep->hea += (cells * sizeof(Embryo_Cell));
+   return addr;
+}
+
+EAPI void
+embryo_data_heap_pop(Embryo_Program *ep, Embryo_Cell down_to)
+{
+   if (!ep) return;
+   if (down_to < 0) down_to = 0;
+   if (ep->hea > down_to) ep->hea = down_to;
+}
+
+
+EAPI int
+embryo_program_recursion_get(Embryo_Program *ep)
+{
+   return ep->run_count;
+}
+
+#ifdef __GNUC__
+#if 1
+#define EMBRYO_EXEC_JUMPTABLE
+#endif
+#endif
+
+/* jump table optimization - only works for gcc though */
+#ifdef EMBRYO_EXEC_JUMPTABLE
+#define SWITCH(x) while (1) { goto *switchtable[x];
+#define SWITCHEND break; }
+#define CASE(x) SWITCHTABLE_##x:
+#define BREAK break;
+#else
+#define SWITCH(x) switch (x) {
+#define SWITCHEND }
+#define CASE(x) case x:
+#define BREAK break
+#endif
+
+EAPI Embryo_Status
+embryo_program_run(Embryo_Program *ep, Embryo_Function fn)
+{
+   Embryo_Header    *hdr;
+   Embryo_Func_Stub *func;
+   unsigned char    *code, *data;
+   Embryo_Cell      pri, alt, stk, frm, hea, hea_start;
+   Embryo_Cell      reset_stk, reset_hea, *cip;
+   Embryo_UCell     codesize;
+   int              i;
+   unsigned char    op;
+   Embryo_Cell      offs;
+   int              num;
+   int              max_run_cycles;
+   int              cycle_count;
+#ifdef EMBRYO_EXEC_JUMPTABLE
+   /* we limit the jumptable to 256 elements. why? above we forced "op" to be
+    * a unsigned char - that means 256 max values. we limit opcode overflow
+    * here, so eliminating crashes on table lookups with bad/corrupt bytecode.
+    * no need to atuall do compares, branches etc. the datatype does the work
+    * for us. so that means EXCESS elements are all declared as OP_NONE to
+    * keep them innocuous.
+    */
+   static const void *switchtable[256] =
+     {
+	   &&SWITCHTABLE_EMBRYO_OP_NONE,
+	       &&SWITCHTABLE_EMBRYO_OP_LOAD_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_LOAD_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_LOAD_S_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_LOAD_S_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_LREF_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_LREF_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_LREF_S_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_LREF_S_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_LOAD_I,
+	       &&SWITCHTABLE_EMBRYO_OP_LODB_I,
+	       &&SWITCHTABLE_EMBRYO_OP_CONST_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_CONST_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_ADDR_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_ADDR_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_STOR_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_STOR_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_STOR_S_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_STOR_S_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_SREF_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SREF_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_SREF_S_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SREF_S_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_STOR_I,
+	       &&SWITCHTABLE_EMBRYO_OP_STRB_I,
+	       &&SWITCHTABLE_EMBRYO_OP_LIDX,
+	       &&SWITCHTABLE_EMBRYO_OP_LIDX_B,
+	       &&SWITCHTABLE_EMBRYO_OP_IDXADDR,
+	       &&SWITCHTABLE_EMBRYO_OP_IDXADDR_B,
+	       &&SWITCHTABLE_EMBRYO_OP_ALIGN_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_ALIGN_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_LCTRL,
+	       &&SWITCHTABLE_EMBRYO_OP_SCTRL,
+	       &&SWITCHTABLE_EMBRYO_OP_MOVE_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_MOVE_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_XCHG,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH_R,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH_C,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSH_S,
+	       &&SWITCHTABLE_EMBRYO_OP_POP_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_POP_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_STACK,
+	       &&SWITCHTABLE_EMBRYO_OP_HEAP,
+	       &&SWITCHTABLE_EMBRYO_OP_PROC,
+	       &&SWITCHTABLE_EMBRYO_OP_RET,
+	       &&SWITCHTABLE_EMBRYO_OP_RETN,
+	       &&SWITCHTABLE_EMBRYO_OP_CALL,
+	       &&SWITCHTABLE_EMBRYO_OP_CALL_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_JUMP,
+	       &&SWITCHTABLE_EMBRYO_OP_JREL,
+	       &&SWITCHTABLE_EMBRYO_OP_JZER,
+	       &&SWITCHTABLE_EMBRYO_OP_JNZ,
+	       &&SWITCHTABLE_EMBRYO_OP_JEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_JNEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_JLESS,
+	       &&SWITCHTABLE_EMBRYO_OP_JLEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_JGRTR,
+	       &&SWITCHTABLE_EMBRYO_OP_JGEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_JSLESS,
+	       &&SWITCHTABLE_EMBRYO_OP_JSLEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_JSGRTR,
+	       &&SWITCHTABLE_EMBRYO_OP_JSGEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_SHL,
+	       &&SWITCHTABLE_EMBRYO_OP_SHR,
+	       &&SWITCHTABLE_EMBRYO_OP_SSHR,
+	       &&SWITCHTABLE_EMBRYO_OP_SHL_C_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SHL_C_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_SHR_C_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SHR_C_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_SMUL,
+	       &&SWITCHTABLE_EMBRYO_OP_SDIV,
+	       &&SWITCHTABLE_EMBRYO_OP_SDIV_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_UMUL,
+	       &&SWITCHTABLE_EMBRYO_OP_UDIV,
+	       &&SWITCHTABLE_EMBRYO_OP_UDIV_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_ADD,
+	       &&SWITCHTABLE_EMBRYO_OP_SUB,
+	       &&SWITCHTABLE_EMBRYO_OP_SUB_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_AND,
+	       &&SWITCHTABLE_EMBRYO_OP_OR,
+	       &&SWITCHTABLE_EMBRYO_OP_XOR,
+	       &&SWITCHTABLE_EMBRYO_OP_NOT,
+	       &&SWITCHTABLE_EMBRYO_OP_NEG,
+	       &&SWITCHTABLE_EMBRYO_OP_INVERT,
+	       &&SWITCHTABLE_EMBRYO_OP_ADD_C,
+	       &&SWITCHTABLE_EMBRYO_OP_SMUL_C,
+	       &&SWITCHTABLE_EMBRYO_OP_ZERO_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_ZERO_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_ZERO,
+	       &&SWITCHTABLE_EMBRYO_OP_ZERO_S,
+	       &&SWITCHTABLE_EMBRYO_OP_SIGN_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SIGN_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_EQ,
+	       &&SWITCHTABLE_EMBRYO_OP_NEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_LESS,
+	       &&SWITCHTABLE_EMBRYO_OP_LEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_GRTR,
+	       &&SWITCHTABLE_EMBRYO_OP_GEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_SLESS,
+	       &&SWITCHTABLE_EMBRYO_OP_SLEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_SGRTR,
+	       &&SWITCHTABLE_EMBRYO_OP_SGEQ,
+	       &&SWITCHTABLE_EMBRYO_OP_EQ_C_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_EQ_C_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_INC_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_INC_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_INC,
+	       &&SWITCHTABLE_EMBRYO_OP_INC_S,
+	       &&SWITCHTABLE_EMBRYO_OP_INC_I,
+	       &&SWITCHTABLE_EMBRYO_OP_DEC_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_DEC_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_DEC,
+	       &&SWITCHTABLE_EMBRYO_OP_DEC_S,
+	       &&SWITCHTABLE_EMBRYO_OP_DEC_I,
+	       &&SWITCHTABLE_EMBRYO_OP_MOVS,
+	       &&SWITCHTABLE_EMBRYO_OP_CMPS,
+	       &&SWITCHTABLE_EMBRYO_OP_FILL,
+	       &&SWITCHTABLE_EMBRYO_OP_HALT,
+	       &&SWITCHTABLE_EMBRYO_OP_BOUNDS,
+	       &&SWITCHTABLE_EMBRYO_OP_SYSREQ_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SYSREQ_C,
+	       &&SWITCHTABLE_EMBRYO_OP_FILE,
+	       &&SWITCHTABLE_EMBRYO_OP_LINE,
+	       &&SWITCHTABLE_EMBRYO_OP_SYMBOL,
+	       &&SWITCHTABLE_EMBRYO_OP_SRANGE,
+	       &&SWITCHTABLE_EMBRYO_OP_JUMP_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SWITCH,
+	       &&SWITCHTABLE_EMBRYO_OP_CASETBL,
+	       &&SWITCHTABLE_EMBRYO_OP_SWAP_PRI,
+	       &&SWITCHTABLE_EMBRYO_OP_SWAP_ALT,
+	       &&SWITCHTABLE_EMBRYO_OP_PUSHADDR,
+	       &&SWITCHTABLE_EMBRYO_OP_NOP,
+	       &&SWITCHTABLE_EMBRYO_OP_SYSREQ_D,
+	       &&SWITCHTABLE_EMBRYO_OP_SYMTAG,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE,
+	  &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE, &&SWITCHTABLE_EMBRYO_OP_NONE
+     };
+#endif
+   if (!ep) return EMBRYO_PROGRAM_FAIL;
+   if (!(ep->flags & EMBRYO_FLAG_RELOC))
+     {
+	ep->error = EMBRYO_ERROR_INIT;
+	return EMBRYO_PROGRAM_FAIL;
+     }
+   if (!ep->base)
+     {
+	ep->error = EMBRYO_ERROR_INIT;
+	return EMBRYO_PROGRAM_FAIL;
+     }
+   if (ep->run_count > 0)
+     {
+	/* return EMBRYO_PROGRAM_BUSY; */
+	/* FIXME: test C->vm->C->vm recursion more fully */
+	/* it seems to work... just fine!!! - strange! */
+     }
+
+   /* set up the registers */
+   hdr = (Embryo_Header *)ep->base;
+   codesize = (Embryo_UCell)(hdr->dat - hdr->cod);
+   code = ep->base + (int)hdr->cod;
+   data = ep->base + (int)hdr->dat;
+   hea_start = hea = ep->hea;
+   stk = ep->stk;
+   reset_stk = stk;
+   reset_hea = hea;
+   frm = alt = pri = 0;
+
+   /* get the start address */
+   if (fn == EMBRYO_FUNCTION_MAIN)
+     {
+	if (hdr->cip < 0)
+	  {
+	     ep->error = EMBRYO_ERROR_INDEX;
+	     return EMBRYO_PROGRAM_FAIL;
+	  }
+	cip = (Embryo_Cell *)(code + (int)hdr->cip);
+     }
+   else if (fn == EMBRYO_FUNCTION_CONT)
+     {
+	/* all registers: pri, alt, frm, cip, hea, stk, reset_stk, reset_hea */
+	frm = ep->frm;
+	stk = ep->stk;
+	hea = ep->hea;
+	pri = ep->pri;
+	alt = ep->alt;
+	reset_stk = ep->reset_stk;
+	reset_hea = ep->reset_hea;
+	cip = (Embryo_Cell *)(code + (int)ep->cip);
+     }
+   else if (fn < 0)
+     {
+	ep->error = EMBRYO_ERROR_INDEX;
+	return EMBRYO_PROGRAM_FAIL;
+     }
+   else
+     {
+	if (fn >= (Embryo_Cell)NUMENTRIES(hdr, publics, natives))
+	  {
+	     ep->error = EMBRYO_ERROR_INDEX;
+	     return EMBRYO_PROGRAM_FAIL;
+	  }
+	func = GETENTRY(hdr, publics, fn);
+	cip = (Embryo_Cell *)(code + (int)func->address);
+     }
+   /* check values just copied */
+   CHKSTACK();
+   CHKHEAP();
+
+   if (fn != EMBRYO_FUNCTION_CONT)
+     {
+	int i;
+
+	for (i = ep->params_size - 1; i >= 0; i--)
+	  {
+	     Embryo_Param *pr;
+
+	     pr = &(ep->params[i]);
+	     if (pr->string)
+	       {
+		  int len;
+		  Embryo_Cell ep_addr, *addr;
+
+		  len = strlen(pr->string);
+		  ep_addr = embryo_data_heap_push(ep, len + 1);
+		  if (ep_addr == EMBRYO_CELL_NONE)
+		    {
+		       ep->error = EMBRYO_ERROR_HEAPLOW;
+		       return EMBRYO_PROGRAM_FAIL;
+		    }
+		  addr = embryo_data_address_get(ep, ep_addr);
+		  if (addr)
+		    embryo_data_string_set(ep, pr->string, addr);
+		  else
+		    {
+		       ep->error = EMBRYO_ERROR_HEAPLOW;
+		       return EMBRYO_PROGRAM_FAIL;
+		    }
+		  PUSH(ep_addr);
+		  free(pr->string);
+	       }
+	     else if (pr->cell_array)
+	       {
+		  int len;
+		  Embryo_Cell ep_addr, *addr;
+
+		  len = pr->cell_array_size;
+		  ep_addr = embryo_data_heap_push(ep, len + 1);
+		  if (ep_addr == EMBRYO_CELL_NONE)
+		    {
+		       ep->error = EMBRYO_ERROR_HEAPLOW;
+		       return EMBRYO_PROGRAM_FAIL;
+		    }
+		  addr = embryo_data_address_get(ep, ep_addr);
+		  if (addr)
+		    memcpy(addr, pr->cell_array,
+			   pr->cell_array_size * sizeof(Embryo_Cell));
+		  else
+		    {
+		       ep->error = EMBRYO_ERROR_HEAPLOW;
+		       return EMBRYO_PROGRAM_FAIL;
+		    }
+		  PUSH(ep_addr);
+		  free(pr->cell_array);
+	       }
+	     else
+	       {
+		  PUSH(pr->cell);
+	       }
+	  }
+	PUSH(ep->params_size * sizeof(Embryo_Cell));
+	PUSH(0);
+	if (ep->params)
+	  {
+	     free(ep->params);
+	     ep->params = NULL;
+	  }
+	ep->params_size = ep->params_alloc = 0;
+     }
+   /* check stack/heap before starting to run */
+   CHKMARGIN();
+
+   /* track recursion depth */
+   ep->run_count++;
+
+   max_run_cycles = ep->max_run_cycles;
+   /* start running */
+   for (cycle_count = 0;;)
+     {
+	if (max_run_cycles > 0)
+	  {
+	     if (cycle_count >= max_run_cycles)
+	       {
+		  TOOLONG(ep);
+	       }
+	     cycle_count++;
+	  }
+	op = (Embryo_Opcode)*cip++;
+	SWITCH(op);
+	CASE(EMBRYO_OP_LOAD_PRI);
+	GETPARAM(offs);
+	pri = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LOAD_ALT);
+	GETPARAM(offs);
+	alt = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LOAD_S_PRI);
+	GETPARAM(offs);
+	pri = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LOAD_S_ALT);
+	GETPARAM(offs);
+	alt = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LREF_PRI);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)offs);
+	pri = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LREF_ALT);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)offs);
+	alt = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LREF_S_PRI);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	pri = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LREF_S_ALT);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	alt = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LOAD_I);
+	CHKMEM(pri);
+	pri = *(Embryo_Cell *)(data + (int)pri);
+	BREAK;
+	CASE(EMBRYO_OP_LODB_I);
+	GETPARAM(offs);
+	CHKMEM(pri);
+	switch (offs)
+	  {
+	   case 1:
+	     pri = *(data + (int)pri);
+	     break;
+	   case 2:
+	     pri = *(unsigned short *)(data + (int)pri);
+	     break;
+	   case 4:
+	     pri = *(unsigned int *)(data + (int)pri);
+	     break;
+	   default:
+	     ABORT(ep, EMBRYO_ERROR_INVINSTR);
+	     break;
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_CONST_PRI);
+	GETPARAM(pri);
+	BREAK;
+	CASE(EMBRYO_OP_CONST_ALT);
+	GETPARAM(alt);
+	BREAK;
+	CASE(EMBRYO_OP_ADDR_PRI);
+	GETPARAM(pri);
+	pri += frm;
+	BREAK;
+	CASE(EMBRYO_OP_ADDR_ALT);
+	GETPARAM(alt);
+	alt += frm;
+	BREAK;
+	CASE(EMBRYO_OP_STOR_PRI);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)offs) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_STOR_ALT);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)offs) = alt;
+	BREAK;
+	CASE(EMBRYO_OP_STOR_S_PRI);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)frm + (int)offs) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_STOR_S_ALT);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)frm + (int)offs) = alt;
+	BREAK;
+	CASE(EMBRYO_OP_SREF_PRI);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)offs);
+	*(Embryo_Cell *)(data + (int)offs) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_SREF_ALT);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)offs);
+	*(Embryo_Cell *)(data + (int)offs) = alt;
+	BREAK;
+	CASE(EMBRYO_OP_SREF_S_PRI);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	*(Embryo_Cell *)(data + (int)offs) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_SREF_S_ALT);
+	GETPARAM(offs);
+	offs = *(Embryo_Cell *)(data + (int)frm + (int)offs);
+	*(Embryo_Cell *)(data + (int)offs) = alt;
+	BREAK;
+	CASE(EMBRYO_OP_STOR_I);
+	CHKMEM(alt);
+	*(Embryo_Cell *)(data + (int)alt) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_STRB_I);
+	GETPARAM(offs);
+	CHKMEM(alt);
+	switch (offs)
+	  {
+	   case 1:
+	     *(data + (int)alt) = (unsigned char)pri;
+	     break;
+	   case 2:
+	     *(unsigned short *)(data + (int)alt) = (unsigned short)pri;
+	     break;
+	   case 4:
+	     *(unsigned int *)(data + (int)alt) = (unsigned int)pri;
+	     break;
+	   default:
+	     ABORT(ep, EMBRYO_ERROR_INVINSTR);
+	     break;
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_LIDX);
+	offs = (pri * sizeof(Embryo_Cell)) + alt;
+	CHKMEM(offs);
+	pri = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_LIDX_B);
+	GETPARAM(offs);
+	offs = (pri << (int)offs) + alt;
+	CHKMEM(offs);
+	pri = *(Embryo_Cell *)(data + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_IDXADDR);
+	pri = (pri * sizeof(Embryo_Cell)) + alt;
+	BREAK;
+	CASE(EMBRYO_OP_IDXADDR_B);
+	GETPARAM(offs);
+	pri = (pri << (int)offs) + alt;
+	BREAK;
+	CASE(EMBRYO_OP_ALIGN_PRI);
+	GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+	if ((size_t)offs < sizeof(Embryo_Cell))
+	  pri ^= sizeof(Embryo_Cell) - offs;
+#endif
+	BREAK;
+	CASE(EMBRYO_OP_ALIGN_ALT);
+	GETPARAM(offs);
+#ifdef WORDS_BIGENDIAN
+	if ((size_t)offs < sizeof(Embryo_Cell))
+	  alt ^= sizeof(Embryo_Cell) - offs;
+#endif
+	BREAK;
+	CASE(EMBRYO_OP_LCTRL);
+	GETPARAM(offs);
+	switch (offs)
+	  {
+	   case 0:
+	     pri = hdr->cod;
+	     break;
+	   case 1:
+	     pri = hdr->dat;
+	     break;
+	   case 2:
+	     pri = hea;
+	     break;
+	   case 3:
+	     pri = ep->stp;
+	     break;
+	   case 4:
+	     pri = stk;
+	     break;
+	   case 5:
+	     pri = frm;
+	     break;
+	   case 6:
+	     pri = (Embryo_Cell)((unsigned char *)cip - code);
+	     break;
+	   default:
+	     ABORT(ep, EMBRYO_ERROR_INVINSTR);
+	     break;
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_SCTRL);
+	GETPARAM(offs);
+	switch (offs)
+	  {
+	   case 0:
+	   case 1:
+	   case 2:
+	     hea = pri;
+	     break;
+	   case 3:
+	     /* cannot change these parameters */
+	     break;
+	   case 4:
+	     stk = pri;
+	     break;
+	   case 5:
+	     frm = pri;
+	     break;
+	   case 6:
+	     cip = (Embryo_Cell *)(code + (int)pri);
+	     break;
+	   default:
+	     ABORT(ep, EMBRYO_ERROR_INVINSTR);
+	     break;
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_MOVE_PRI);
+	pri = alt;
+	BREAK;
+	CASE(EMBRYO_OP_MOVE_ALT);
+	alt = pri;
+	BREAK;
+	CASE(EMBRYO_OP_XCHG);
+	offs = pri;         /* offs is a temporary variable */
+	pri = alt;
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_PUSH_PRI);
+	PUSH(pri);
+	BREAK;
+	CASE(EMBRYO_OP_PUSH_ALT);
+	PUSH(alt);
+	BREAK;
+	CASE(EMBRYO_OP_PUSH_C);
+	GETPARAM(offs);
+	PUSH(offs);
+	BREAK;
+	CASE(EMBRYO_OP_PUSH_R);
+	GETPARAM(offs);
+	while (offs--) PUSH(pri);
+	BREAK;
+	CASE(EMBRYO_OP_PUSH);
+	GETPARAM(offs);
+	PUSH(*(Embryo_Cell *)(data + (int)offs));
+	BREAK;
+	CASE(EMBRYO_OP_PUSH_S);
+	GETPARAM(offs);
+	PUSH(*(Embryo_Cell *)(data + (int)frm + (int)offs));
+	BREAK;
+	CASE(EMBRYO_OP_POP_PRI);
+	POP(pri);
+	BREAK;
+	CASE(EMBRYO_OP_POP_ALT);
+	POP(alt);
+	BREAK;
+	CASE(EMBRYO_OP_STACK);
+	GETPARAM(offs);
+	alt = stk;
+	stk += offs;
+	CHKMARGIN();
+	CHKSTACK();
+	BREAK;
+	CASE(EMBRYO_OP_HEAP);
+	GETPARAM(offs);
+	alt = hea;
+	hea += offs;
+	CHKMARGIN();
+	CHKHEAP();
+	BREAK;
+	CASE(EMBRYO_OP_PROC);
+	PUSH(frm);
+	frm = stk;
+	CHKMARGIN();
+	BREAK;
+	CASE(EMBRYO_OP_RET);
+	POP(frm);
+	POP(offs);
+	if ((Embryo_UCell)offs >= codesize)
+	  ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+	cip = (Embryo_Cell *)(code + (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_RETN);
+	POP(frm);
+	POP(offs);
+	if ((Embryo_UCell)offs >= codesize)
+	  ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+	cip = (Embryo_Cell *)(code + (int)offs);
+	stk += *(Embryo_Cell *)(data + (int)stk) + sizeof(Embryo_Cell); /* remove parameters from the stack */
+	ep->stk = stk;
+	BREAK;
+	CASE(EMBRYO_OP_CALL);
+	PUSH(((unsigned char *)cip - code) + sizeof(Embryo_Cell));/* skip address */
+	cip = JUMPABS(code, cip); /* jump to the address */
+	BREAK;
+	CASE(EMBRYO_OP_CALL_PRI);
+	PUSH((unsigned char *)cip - code);
+	cip = (Embryo_Cell *)(code + (int)pri);
+	BREAK;
+	CASE(EMBRYO_OP_JUMP);
+	/* since the GETPARAM() macro modifies cip, you cannot
+	 * do GETPARAM(cip) directly */
+	cip = JUMPABS(code, cip);
+	BREAK;
+	CASE(EMBRYO_OP_JREL);
+	offs = *cip;
+	cip = (Embryo_Cell *)((unsigned char *)cip + (int)offs + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JZER);
+	if (pri == 0)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JNZ);
+	if (pri != 0)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JEQ);
+	if (pri==alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JNEQ);
+	if (pri != alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JLESS);
+	if ((Embryo_UCell)pri < (Embryo_UCell)alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JLEQ);
+	if ((Embryo_UCell)pri <= (Embryo_UCell)alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JGRTR);
+	if ((Embryo_UCell)pri > (Embryo_UCell)alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JGEQ);
+	if ((Embryo_UCell)pri >= (Embryo_UCell)alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JSLESS);
+	if (pri < alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JSLEQ);
+	if (pri <= alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JSGRTR);
+	if (pri > alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_JSGEQ);
+	if (pri >= alt)
+	  cip = JUMPABS(code, cip);
+	else
+	  cip = (Embryo_Cell *)((unsigned char *)cip + sizeof(Embryo_Cell));
+	BREAK;
+	CASE(EMBRYO_OP_SHL);
+	pri <<= alt;
+	BREAK;
+	CASE(EMBRYO_OP_SHR);
+	pri = (Embryo_UCell)pri >> (int)alt;
+	BREAK;
+	CASE(EMBRYO_OP_SSHR);
+	pri >>= alt;
+	BREAK;
+	CASE(EMBRYO_OP_SHL_C_PRI);
+	GETPARAM(offs);
+	pri <<= offs;
+	BREAK;
+	CASE(EMBRYO_OP_SHL_C_ALT);
+	GETPARAM(offs);
+	alt <<= offs;
+	BREAK;
+	CASE(EMBRYO_OP_SHR_C_PRI);
+	GETPARAM(offs);
+	pri = (Embryo_UCell)pri >> (int)offs;
+	BREAK;
+	CASE(EMBRYO_OP_SHR_C_ALT);
+	GETPARAM(offs);
+	alt = (Embryo_UCell)alt >> (int)offs;
+	BREAK;
+	CASE(EMBRYO_OP_SMUL);
+	pri *= alt;
+	BREAK;
+	CASE(EMBRYO_OP_SDIV);
+	if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+	/* divide must always round down; this is a bit
+	 * involved to do in a machine-independent way.
+	 */
+	offs = ((pri % alt) + alt) % alt; /* true modulus */
+	pri = (pri - offs) / alt;         /* division result */
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_SDIV_ALT);
+	if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+	/* divide must always round down; this is a bit
+	 * involved to do in a machine-independent way.
+	 */
+	offs = ((alt % pri) + pri) % pri; /* true modulus */
+	pri = (alt - offs) / pri;         /* division result */
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_UMUL);
+	pri = (Embryo_UCell)pri * (Embryo_UCell)alt;
+	BREAK;
+	CASE(EMBRYO_OP_UDIV);
+	if (alt == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+	offs = (Embryo_UCell)pri % (Embryo_UCell)alt; /* temporary storage */
+	pri = (Embryo_UCell)pri / (Embryo_UCell)alt;
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_UDIV_ALT);
+	if (pri == 0) ABORT(ep, EMBRYO_ERROR_DIVIDE);
+	offs = (Embryo_UCell)alt % (Embryo_UCell)pri; /* temporary storage */
+	pri = (Embryo_UCell)alt / (Embryo_UCell)pri;
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_ADD);
+	pri += alt;
+	BREAK;
+	CASE(EMBRYO_OP_SUB);
+	pri -= alt;
+	BREAK;
+	CASE(EMBRYO_OP_SUB_ALT);
+	pri = alt - pri;
+	BREAK;
+	CASE(EMBRYO_OP_AND);
+	pri &= alt;
+	BREAK;
+	CASE(EMBRYO_OP_OR);
+	pri |= alt;
+	BREAK;
+	CASE(EMBRYO_OP_XOR);
+	pri ^= alt;
+	BREAK;
+	CASE(EMBRYO_OP_NOT);
+	pri = !pri;
+	BREAK;
+	CASE(EMBRYO_OP_NEG);
+	pri = -pri;
+	BREAK;
+	CASE(EMBRYO_OP_INVERT);
+	pri = ~pri;
+	BREAK;
+	CASE(EMBRYO_OP_ADD_C);
+	GETPARAM(offs);
+	pri += offs;
+	BREAK;
+	CASE(EMBRYO_OP_SMUL_C);
+	GETPARAM(offs);
+	pri *= offs;
+	BREAK;
+	CASE(EMBRYO_OP_ZERO_PRI);
+	pri = 0;
+	BREAK;
+	CASE(EMBRYO_OP_ZERO_ALT);
+	alt = 0;
+	BREAK;
+	CASE(EMBRYO_OP_ZERO);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)offs) = 0;
+	BREAK;
+	CASE(EMBRYO_OP_ZERO_S);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)frm + (int)offs) = 0;
+	BREAK;
+	CASE(EMBRYO_OP_SIGN_PRI);
+	if ((pri & 0xff) >= 0x80) pri |= ~(Embryo_UCell)0xff;
+	BREAK;
+	CASE(EMBRYO_OP_SIGN_ALT);
+	if ((alt & 0xff) >= 0x80) alt |= ~(Embryo_UCell)0xff;
+	BREAK;
+	CASE(EMBRYO_OP_EQ);
+	pri = (pri == alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_NEQ);
+	pri = (pri != alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_LESS);
+	pri = ((Embryo_UCell)pri < (Embryo_UCell)alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_LEQ);
+	pri = ((Embryo_UCell)pri <= (Embryo_UCell)alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_GRTR);
+	pri = ((Embryo_UCell)pri > (Embryo_UCell)alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_GEQ);
+	pri = ((Embryo_UCell)pri >= (Embryo_UCell)alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_SLESS);
+	pri = (pri < alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_SLEQ);
+	pri = (pri <= alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_SGRTR);
+	pri = (pri > alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_SGEQ);
+	pri = (pri >= alt) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_EQ_C_PRI);
+	GETPARAM(offs);
+	pri = (pri == offs) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_EQ_C_ALT);
+	GETPARAM(offs);
+	pri = (alt == offs) ? 1 : 0;
+	BREAK;
+	CASE(EMBRYO_OP_INC_PRI);
+	pri++;
+	BREAK;
+	CASE(EMBRYO_OP_INC_ALT);
+	alt++;
+	BREAK;
+	CASE(EMBRYO_OP_INC);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)offs) += 1;
+	BREAK;
+	CASE(EMBRYO_OP_INC_S);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)frm + (int)offs) += 1;
+	BREAK;
+	CASE(EMBRYO_OP_INC_I);
+	*(Embryo_Cell *)(data + (int)pri) += 1;
+	BREAK;
+	CASE(EMBRYO_OP_DEC_PRI);
+	pri--;
+	BREAK;
+	CASE(EMBRYO_OP_DEC_ALT);
+	alt--;
+	BREAK;
+	CASE(EMBRYO_OP_DEC);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)offs) -= 1;
+	BREAK;
+	CASE(EMBRYO_OP_DEC_S);
+	GETPARAM(offs);
+	*(Embryo_Cell *)(data + (int)frm + (int)offs) -= 1;
+	BREAK;
+	CASE(EMBRYO_OP_DEC_I);
+	*(Embryo_Cell *)(data + (int)pri) -= 1;
+	BREAK;
+	CASE(EMBRYO_OP_MOVS);
+	GETPARAM(offs);
+	CHKMEM(pri);
+	CHKMEM(pri + offs);
+	CHKMEM(alt);
+	CHKMEM(alt + offs);
+	memcpy(data+(int)alt, data+(int)pri, (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_CMPS);
+	GETPARAM(offs);
+	CHKMEM(pri);
+	CHKMEM(pri + offs);
+	CHKMEM(alt);
+	CHKMEM(alt + offs);
+	pri = memcmp(data + (int)alt, data + (int)pri, (int)offs);
+	BREAK;
+	CASE(EMBRYO_OP_FILL);
+	GETPARAM(offs);
+	CHKMEM(alt);
+	CHKMEM(alt + offs);
+	for (i = (int)alt;
+	     (size_t)offs >= sizeof(Embryo_Cell);
+	     i += sizeof(Embryo_Cell), offs -= sizeof(Embryo_Cell))
+	  *(Embryo_Cell *)(data + i) = pri;
+	BREAK;
+	CASE(EMBRYO_OP_HALT);
+	GETPARAM(offs);
+	ep->retval = pri;
+	/* store complete status */
+	ep->frm = frm;
+	ep->stk = stk;
+	ep->hea = hea;
+	ep->pri = pri;
+	ep->alt = alt;
+	ep->cip = (Embryo_Cell)((unsigned char*)cip - code);
+	if (offs == EMBRYO_ERROR_SLEEP)
+	  {
+	     ep->reset_stk = reset_stk;
+	     ep->reset_hea = reset_hea;
+	     ep->run_count--;
+	     return EMBRYO_PROGRAM_SLEEP;
+	  }
+	OK(ep, (int)offs);
+	CASE(EMBRYO_OP_BOUNDS);
+	GETPARAM(offs);
+	if ((Embryo_UCell)pri > (Embryo_UCell)offs)
+	  ABORT(ep, EMBRYO_ERROR_BOUNDS);
+	BREAK;
+	CASE(EMBRYO_OP_SYSREQ_PRI);
+	/* save a few registers */
+	ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+	ep->hea = hea;
+	ep->frm = frm;
+	ep->stk = stk;
+	num = _embryo_native_call(ep, pri, &pri, (Embryo_Cell *)(data + (int)stk));
+	if (num != EMBRYO_ERROR_NONE)
+	  {
+	     if (num == EMBRYO_ERROR_SLEEP)
+	       {
+		  ep->pri = pri;
+		  ep->alt = alt;
+		  ep->reset_stk = reset_stk;
+		  ep->reset_hea = reset_hea;
+		  ep->run_count--;
+		  return EMBRYO_PROGRAM_SLEEP;
+	       }
+	     ABORT(ep, num);
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_SYSREQ_C);
+	GETPARAM(offs);
+	/* save a few registers */
+	ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+	ep->hea = hea;
+	ep->frm = frm;
+	ep->stk = stk;
+	num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+	if (num != EMBRYO_ERROR_NONE)
+	  {
+	     if (num == EMBRYO_ERROR_SLEEP)
+	       {
+		  ep->pri = pri;
+		  ep->alt = alt;
+		  ep->reset_stk = reset_stk;
+		  ep->reset_hea = reset_hea;
+		  ep->run_count--;
+		  return EMBRYO_PROGRAM_SLEEP;
+	       }
+	       {
+		  Embryo_Header    *hdr;
+		  int i, num;
+		  Embryo_Func_Stub *func_entry;
+
+		  hdr = (Embryo_Header *)ep->code;
+		  num = NUMENTRIES(hdr, natives, libraries);
+		  func_entry = GETENTRY(hdr, natives, 0);
+		  for (i = 0; i < num; i++)
+		    {
+		       char *entry_name;
+
+		       entry_name = GETENTRYNAME(hdr, func_entry);
+		       if (i == offs)
+			 printf("EMBRYO: CALL [%i] %s() non-existent!\n", i, entry_name);
+		       func_entry =
+			 (Embryo_Func_Stub *)((unsigned char *)func_entry + hdr->defsize);
+		    }
+	       }
+	     ABORT(ep, num);
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_SYSREQ_D);
+	GETPARAM(offs);
+	/* save a few registers */
+	ep->cip = (Embryo_Cell)((unsigned char *)cip - code);
+	ep->hea = hea;
+	ep->frm = frm;
+	ep->stk = stk;
+	num = _embryo_native_call(ep, offs, &pri, (Embryo_Cell *)(data + (int)stk));
+	if (num != EMBRYO_ERROR_NONE)
+	  {
+	     if (num == EMBRYO_ERROR_SLEEP)
+	       {
+		  ep->pri = pri;
+		  ep->alt = alt;
+		  ep->reset_stk = reset_stk;
+		  ep->reset_hea = reset_hea;
+		  ep->run_count--;
+		  return EMBRYO_PROGRAM_SLEEP;
+	       }
+	     ABORT(ep, ep->error);
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_JUMP_PRI);
+	cip = (Embryo_Cell *)(code + (int)pri);
+	BREAK;
+	CASE(EMBRYO_OP_SWITCH);
+	  {
+	     Embryo_Cell *cptr;
+
+	     /* +1, to skip the "casetbl" opcode */
+	     cptr = (Embryo_Cell *)(code + (*cip)) + 1;
+	     /* number of records in the case table */
+	     num = (int)(*cptr);
+	     /* preset to "none-matched" case */
+	     cip = (Embryo_Cell *)(code + *(cptr + 1));
+	     for (cptr += 2;
+		  (num > 0) && (*cptr != pri);
+		  num--, cptr += 2);
+	     /* case found */
+	     if (num > 0)
+	       cip = (Embryo_Cell *)(code + *(cptr + 1));
+	  }
+	BREAK;
+	CASE(EMBRYO_OP_SWAP_PRI);
+	offs = *(Embryo_Cell *)(data + (int)stk);
+	*(Embryo_Cell *)(data + (int)stk) = pri;
+	pri = offs;
+	BREAK;
+	CASE(EMBRYO_OP_SWAP_ALT);
+	offs = *(Embryo_Cell *)(data + (int)stk);
+	*(Embryo_Cell *)(data + (int)stk) = alt;
+	alt = offs;
+	BREAK;
+	CASE(EMBRYO_OP_PUSHADDR);
+	GETPARAM(offs);
+	PUSH(frm + offs);
+	BREAK;
+	CASE(EMBRYO_OP_NOP);
+	BREAK;
+	CASE(EMBRYO_OP_NONE);
+	CASE(EMBRYO_OP_FILE);
+	CASE(EMBRYO_OP_LINE);
+	CASE(EMBRYO_OP_SYMBOL);
+	CASE(EMBRYO_OP_SRANGE);
+	CASE(EMBRYO_OP_CASETBL);
+	CASE(EMBRYO_OP_SYMTAG);
+	BREAK;
+#ifndef EMBRYO_EXEC_JUMPTABLE
+      default:
+	ABORT(ep, EMBRYO_ERROR_INVINSTR);
+#endif
+	SWITCHEND;
+     }
+   ep->max_run_cycles = max_run_cycles;
+   ep->run_count--;
+   ep->hea = hea_start;
+   return EMBRYO_PROGRAM_OK;
+}
+
+EAPI Embryo_Cell
+embryo_program_return_value_get(Embryo_Program *ep)
+{
+   if (!ep) return 0;
+   return ep->retval;
+}
+
+EAPI void
+embryo_program_max_cycle_run_set(Embryo_Program *ep, int max)
+{
+   if (!ep) return;
+   if (max < 0) max = 0;
+   ep->max_run_cycles = max;
+}
+
+EAPI int
+embryo_program_max_cycle_run_get(Embryo_Program *ep)
+{
+   if (!ep) return 0;
+   return ep->max_run_cycles;
+}
+
+
+EAPI int
+embryo_parameter_cell_push(Embryo_Program *ep, Embryo_Cell cell)
+{
+   Embryo_Param *pr;
+
+   ep->params_size++;
+   if (ep->params_size > ep->params_alloc)
+     {
+	ep->params_alloc += 8;
+	pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+	if (!pr) return 0;
+	ep->params = pr;
+     }
+   pr = &(ep->params[ep->params_size - 1]);
+   pr->string = NULL;
+   pr->cell_array = NULL;
+   pr->cell_array_size = 0;
+   pr->cell = 0;
+   pr->cell = cell;
+   return 1;
+}
+
+EAPI int
+embryo_parameter_string_push(Embryo_Program *ep, const char *str)
+{
+   Embryo_Param *pr;
+   char *str_dup;
+
+   if (!str)
+     return embryo_parameter_string_push(ep, "");
+   str_dup = strdup(str);
+   if (!str_dup) return 0;
+   ep->params_size++;
+   if (ep->params_size > ep->params_alloc)
+     {
+	ep->params_alloc += 8;
+	pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+	if (!pr)
+	  {
+	     free(str_dup);
+	     return 0;
+	  }
+	ep->params = pr;
+     }
+   pr = &(ep->params[ep->params_size - 1]);
+   pr->string = NULL;
+   pr->cell_array = NULL;
+   pr->cell_array_size = 0;
+   pr->cell = 0;
+   pr->string = str_dup;
+   return 1;
+}
+
+EAPI int
+embryo_parameter_cell_array_push(Embryo_Program *ep, Embryo_Cell *cells, int num)
+{
+   Embryo_Param *pr;
+   Embryo_Cell *cell_array;
+
+   if ((!cells) || (num <= 0))
+     return embryo_parameter_cell_push(ep, 0);
+   cell_array = malloc(num * sizeof(Embryo_Cell));
+   ep->params_size++;
+   if (ep->params_size > ep->params_alloc)
+     {
+	ep->params_alloc += 8;
+	pr = realloc(ep->params, ep->params_alloc * sizeof(Embryo_Param));
+	if (!pr)
+	  {
+	     free(cell_array);
+	     return 0;
+	  }
+	ep->params = pr;
+     }
+   pr = &(ep->params[ep->params_size - 1]);
+   pr->string = NULL;
+   pr->cell_array = NULL;
+   pr->cell_array_size = 0;
+   pr->cell = 0;
+   pr->cell_array = cell_array;
+   pr->cell_array_size = num;
+   memcpy(pr->cell_array, cells, num * sizeof(Embryo_Cell));
+   return 1;
+}
diff --git a/src/lib/embryo_args.c b/src/lib/embryo_args.c
new file mode 100644
index 0000000..0c0089e
--- /dev/null
+++ b/src/lib/embryo_args.c
@@ -0,0 +1,128 @@
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif defined __GNUC__
+# define alloca __builtin_alloca
+#elif defined _AIX
+# define alloca __alloca
+#elif defined _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+#else
+# include <stddef.h>
+# ifdef  __cplusplus
+extern "C"
+# endif
+void *alloca (size_t);
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRSET(ep, par, str) { \
+   Embryo_Cell *___cptr; \
+   if ((___cptr = embryo_data_address_get(ep, par))) { \
+      embryo_data_string_set(ep, str, ___cptr); \
+   } }
+
+/* exported args api */
+
+static Embryo_Cell
+_embryo_args_numargs(Embryo_Program *ep, Embryo_Cell *params __UNUSED__)
+{
+   Embryo_Header *hdr;
+   unsigned char *data;
+   Embryo_Cell bytes;
+
+   hdr = (Embryo_Header *)ep->base;
+   data = ep->base + (int)hdr->dat;
+   bytes = *(Embryo_Cell *)(data + (int)ep->frm +
+			    (2 * sizeof(Embryo_Cell)));
+   return bytes / sizeof(Embryo_Cell);
+}
+
+static Embryo_Cell
+_embryo_args_getarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+   Embryo_Header *hdr;
+   unsigned char *data;
+   Embryo_Cell val;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   hdr = (Embryo_Header *)ep->base;
+   data = ep->base + (int)hdr->dat;
+   val = *(Embryo_Cell *)(data + (int)ep->frm +
+			  (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+   val += params[2] * sizeof(Embryo_Cell);
+   val = *(Embryo_Cell *)(data + (int)val);
+   return val;
+}
+
+static Embryo_Cell
+_embryo_args_setarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+   Embryo_Header *hdr;
+   unsigned char *data;
+   Embryo_Cell val;
+
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   hdr = (Embryo_Header *)ep->base;
+   data = ep->base + (int)hdr->dat;
+   val = *(Embryo_Cell *)(data + (int)ep->frm +
+			  (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+   val += params[2] * sizeof(Embryo_Cell);
+   if ((val < 0) || ((val >= ep->hea) && (val < ep->stk))) return 0;
+   *(Embryo_Cell *)(data + (int)val) = params[3];
+   return 1;
+}
+
+static Embryo_Cell
+_embryo_args_getsarg(Embryo_Program *ep, Embryo_Cell *params)
+{
+   Embryo_Header *hdr;
+   unsigned char *data;
+   Embryo_Cell base_cell;
+   char *s;
+   int i = 0;
+
+   /* params[1] = arg_no */
+   /* params[2] = buf */
+   /* params[3] = buflen */
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] <= 0) return 0; /* buflen must be > 0 */
+   hdr = (Embryo_Header *)ep->base;
+   data = ep->base + (int)hdr->dat;
+   base_cell = *(Embryo_Cell *)(data + (int)ep->frm +
+			  (((int)params[1] + 3) * sizeof(Embryo_Cell)));
+
+   s = alloca(params[3]);
+
+   while (i < params[3])
+     {
+	int offset = base_cell + (i * sizeof(Embryo_Cell));
+
+	s[i] = *(Embryo_Cell *)(data + offset);
+	if (!s[i++]) break;
+     }
+
+   s[i - 1] = 0;
+   STRSET(ep, params[2], s);
+
+   return i - 1; /* characters written minus terminator */
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_args_init(Embryo_Program *ep)
+{
+   embryo_program_native_call_add(ep, "numargs",  _embryo_args_numargs);
+   embryo_program_native_call_add(ep, "getarg", _embryo_args_getarg);
+   embryo_program_native_call_add(ep, "setarg", _embryo_args_setarg);
+   embryo_program_native_call_add(ep, "getfarg", _embryo_args_getarg);
+   embryo_program_native_call_add(ep, "setfarg", _embryo_args_setarg);
+   embryo_program_native_call_add(ep, "getsarg", _embryo_args_getsarg);
+}
diff --git a/src/lib/embryo_float.c b/src/lib/embryo_float.c
new file mode 100644
index 0000000..ffaa87d
--- /dev/null
+++ b/src/lib/embryo_float.c
@@ -0,0 +1,480 @@
+/*  Float arithmetic for the Small AMX engine
+ *
+ *  Copyright (c) Artran, Inc. 1999
+ *  Written by Greg Garner (gmg@artran.com)
+ *  Portions Copyright (c) Carsten Haitzler, 2004 <raster@rasterman.com>
+ *
+ *  This software is provided "as-is", without any express or implied warranty.
+ *  In no event will the authors be held liable for any damages arising from
+ *  the use of this software.
+ *
+ *  Permission is granted to anyone to use this software for any purpose,
+ *  including commercial applications, and to alter it and redistribute it
+ *  freely, subject to the following restrictions:
+ *
+ *  1.  The origin of this software must not be misrepresented; you must not
+ *      claim that you wrote the original software. If you use this software in
+ *      a product, an acknowledgment in the product documentation would be
+ *      appreciated but is not required.
+ *  2.  Altered source versions must be plainly marked as such, and must not be
+ *      misrepresented as being the original software.
+ *  3.  This notice may not be removed or altered from any source distribution.
+ */
+
+/* CHANGES -
+ * 2002-08-27: Basic conversion of source from C++ to C by Adam D. Moss
+ *             <adam@gimp.org> <aspirin@icculus.org>
+ * 2003-08-29: Removal of the dynamic memory allocation and replacing two
+ *             type conversion functions by macros, by Thiadmer Riemersma
+ * 2003-09-22: Moved the type conversion macros to AMX.H, and simplifications
+ *             of some routines, by Thiadmer Riemersma
+ * 2003-11-24: A few more native functions (geometry), plus minor modifications,
+ *             mostly to be compatible with dynamically loadable extension
+ *             modules, by Thiadmer Riemersma
+ * 2004-03-20: Cleaned up and reduced size for Embryo, Modified to conform to
+ *             E coding style. Added extra parameter checks.
+ *             Carsten Haitzler, <raster@rasterman.com>
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+#include <math.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define PI  3.1415926535897932384626433832795f
+#ifndef MAXFLOAT
+#define MAXFLOAT 3.40282347e+38f
+#endif
+
+/* internally useful calls */
+
+static float
+_embryo_fp_degrees_to_radians(float angle, int radix)
+{
+   switch (radix)
+     {
+      case 1: /* degrees, sexagesimal system (technically: degrees/minutes/seconds) */
+	return (angle * PI / 180.0f);
+      case 2: /* grades, centesimal system */
+	return (angle * PI / 200.0f);
+      default: /* assume already radian */
+	break;
+     }
+   return angle;
+}
+
+/* exported float api */
+
+static Embryo_Cell
+_embryo_fp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = long value to convert to a float */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = (float)params[1];
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_str(Embryo_Program *ep, Embryo_Cell *params)
+{
+   /* params[1] = virtual string address to convert to a float */
+   char buf[64];
+   Embryo_Cell *str;
+   float f;
+   int len;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   str = embryo_data_address_get(ep, params[1]);
+   len = embryo_data_string_length_get(ep, str);
+   if ((len == 0) || (len >= (int)sizeof(buf))) return 0;
+   embryo_data_string_get(ep, str, buf);
+   f = (float)atof(buf);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_mul(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 */
+   /* params[2] = float operand 2 */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]) * EMBRYO_CELL_TO_FLOAT(params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_div(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float dividend (top) */
+   /* params[2] = float divisor (bottom) */
+   float f, ff;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   if (ff == 0.0)
+     {
+        if (f == 0.0)
+          return EMBRYO_FLOAT_TO_CELL(0.0f);
+        else if (f < 0.0)
+          return EMBRYO_FLOAT_TO_CELL(-MAXFLOAT);
+        else
+          return EMBRYO_FLOAT_TO_CELL(MAXFLOAT);
+     }
+   f = f / ff;
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_add(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 */
+   /* params[2] = float operand 2 */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]) + EMBRYO_CELL_TO_FLOAT(params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sub(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 */
+   /* params[2] = float operand 2 */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]) - EMBRYO_CELL_TO_FLOAT(params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return fractional part of float */
+static Embryo_Cell
+_embryo_fp_fract(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f -= (floorf(f));
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* Return integer part of float, rounded */
+static Embryo_Cell
+_embryo_fp_round(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   /* params[2] = Type of rounding (cell) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   switch (params[2])
+     {
+      case 1: /* round downwards (truncate) */
+	f = (floorf(f));
+	break;
+      case 2: /* round upwards */
+	f = (ceilf(f));
+	break;
+      case 3: /* round towards zero */
+	if (f >= 0.0) f = (floorf(f));
+	else          f = (ceilf(f));
+	break;
+      default: /* standard, round to nearest */
+	f = (floorf(f + 0.5));
+	break;
+     }
+    return (Embryo_Cell)f;
+}
+
+static Embryo_Cell
+_embryo_fp_cmp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 */
+   /* params[2] = float operand 2 */
+   float f, ff;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   if (f == ff) return 0;
+   else if (f > ff) return 1;
+   return -1;
+}
+
+static Embryo_Cell
+_embryo_fp_sqroot(Embryo_Program *ep, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = sqrtf(f);
+   if (f < 0)
+     {
+	embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+	return 0;
+     }
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_power(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 */
+   /* params[2] = float operand 2 */
+   float f, ff;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   f = powf(f, ff);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log(Embryo_Program *ep, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (value) */
+   /* params[2] = float operand 2 (base) */
+   float f, ff, tf;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   if ((f <= 0.0) || (ff <= 0.0))
+     {
+	embryo_program_error_set(ep, EMBRYO_ERROR_DOMAIN);
+	return 0;
+     }
+    if (ff == 10.0) f = log10f(f);
+    else if (ff == 2.0) f = log2f(f);
+    else
+     {
+        tf = logf(ff);
+        if (tf == 0.0) f = 0.0;
+        else f = (logf(f) / tf);
+     }
+    return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_sin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   f = sinf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   f = cosf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_tan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   f = tanf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_abs(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = (f >= 0) ? f : -f;
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_asin(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = sinf(f);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_acos(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = cosf(f);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (angle) */
+   /* params[2] = float operand 2 (radix) */
+   float f;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = tanf(f);
+   f = _embryo_fp_degrees_to_radians(f, params[2]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_atan2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand 1 (y) */
+   /* params[2] = float operand 2 (x) */
+   /* params[3] = float operand 3 (radix) */
+   float f, ff;
+
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   f = atan2f(f, ff);
+   f = _embryo_fp_degrees_to_radians(f, params[3]);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_log1p(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = log1pf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_cbrt(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = cbrtf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = expf(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_exp2(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f;
+
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   f = exp2f(f);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_fp_hypot(Embryo_Program *ep __UNUSED__, Embryo_Cell *params)
+{
+   /* params[1] = float operand */
+   float f, ff;
+
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   f = EMBRYO_CELL_TO_FLOAT(params[1]);
+   ff = EMBRYO_CELL_TO_FLOAT(params[2]);
+   f = hypotf(f, ff);
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_fp_init(Embryo_Program *ep)
+{
+   embryo_program_native_call_add(ep, "float",     _embryo_fp);
+   embryo_program_native_call_add(ep, "atof",      _embryo_fp_str);
+   embryo_program_native_call_add(ep, "float_mul", _embryo_fp_mul);
+   embryo_program_native_call_add(ep, "float_div", _embryo_fp_div);
+   embryo_program_native_call_add(ep, "float_add", _embryo_fp_add);
+   embryo_program_native_call_add(ep, "float_sub", _embryo_fp_sub);
+   embryo_program_native_call_add(ep, "fract",     _embryo_fp_fract);
+   embryo_program_native_call_add(ep, "round",     _embryo_fp_round);
+   embryo_program_native_call_add(ep, "float_cmp", _embryo_fp_cmp);
+   embryo_program_native_call_add(ep, "sqrt",      _embryo_fp_sqroot);
+   embryo_program_native_call_add(ep, "pow",       _embryo_fp_power);
+   embryo_program_native_call_add(ep, "log",       _embryo_fp_log);
+   embryo_program_native_call_add(ep, "sin",       _embryo_fp_sin);
+   embryo_program_native_call_add(ep, "cos",       _embryo_fp_cos);
+   embryo_program_native_call_add(ep, "tan",       _embryo_fp_tan);
+   embryo_program_native_call_add(ep, "abs",       _embryo_fp_abs);
+   /* Added in embryo 1.2 */
+   embryo_program_native_call_add(ep, "asin",      _embryo_fp_asin);
+   embryo_program_native_call_add(ep, "acos",      _embryo_fp_acos);
+   embryo_program_native_call_add(ep, "atan",      _embryo_fp_atan);
+   embryo_program_native_call_add(ep, "atan2",     _embryo_fp_atan2);
+   embryo_program_native_call_add(ep, "log1p",     _embryo_fp_log1p);
+   embryo_program_native_call_add(ep, "cbrt",      _embryo_fp_cbrt);
+   embryo_program_native_call_add(ep, "exp",       _embryo_fp_exp);
+   embryo_program_native_call_add(ep, "exp2",      _embryo_fp_exp2);
+   embryo_program_native_call_add(ep, "hypot",     _embryo_fp_hypot);
+}
diff --git a/src/lib/embryo_main.c b/src/lib/embryo_main.c
new file mode 100644
index 0000000..3c57ec7
--- /dev/null
+++ b/src/lib/embryo_main.c
@@ -0,0 +1,42 @@
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+static Embryo_Version _version = { VMAJ, VMIN, VMIC, VREV };
+EAPI Embryo_Version *embryo_version = &_version;
+
+static int _embryo_init_count = 0;
+
+/*** EXPORTED CALLS ***/
+
+EAPI int
+embryo_init(void)
+{
+   if (++_embryo_init_count != 1)
+     return _embryo_init_count;
+
+   srand(time(NULL));
+
+   return _embryo_init_count;
+}
+
+EAPI int
+embryo_shutdown(void)
+{
+   if (_embryo_init_count <= 0)
+     {
+        printf("%s:%i Init count not greater than 0 in shutdown.", __FUNCTION__, __LINE__);
+        return 0;
+     }
+   if (--_embryo_init_count != 0)
+     return _embryo_init_count;
+
+   return _embryo_init_count;
+}
diff --git a/src/lib/embryo_private.h b/src/lib/embryo_private.h
new file mode 100644
index 0000000..a4205e1
--- /dev/null
+++ b/src/lib/embryo_private.h
@@ -0,0 +1,298 @@
+#ifndef _EMBRYO_PRIVATE_H
+#define _EMBRYO_PRIVATE_H
+
+
+#ifdef __GNUC__
+# if __GNUC__ >= 4
+// BROKEN in gcc 4 on amd64
+//#  pragma GCC visibility push(hidden)
+# endif
+#endif
+
+typedef enum _Embryo_Opcode Embryo_Opcode;
+
+enum _Embryo_Opcode
+{
+   EMBRYO_OP_NONE,
+     EMBRYO_OP_LOAD_PRI,
+     EMBRYO_OP_LOAD_ALT,
+     EMBRYO_OP_LOAD_S_PRI,
+     EMBRYO_OP_LOAD_S_ALT,
+     EMBRYO_OP_LREF_PRI,
+     EMBRYO_OP_LREF_ALT,
+     EMBRYO_OP_LREF_S_PRI,
+     EMBRYO_OP_LREF_S_ALT,
+     EMBRYO_OP_LOAD_I,
+     EMBRYO_OP_LODB_I,
+     EMBRYO_OP_CONST_PRI,
+     EMBRYO_OP_CONST_ALT,
+     EMBRYO_OP_ADDR_PRI,
+     EMBRYO_OP_ADDR_ALT,
+     EMBRYO_OP_STOR_PRI,
+     EMBRYO_OP_STOR_ALT,
+     EMBRYO_OP_STOR_S_PRI,
+     EMBRYO_OP_STOR_S_ALT,
+     EMBRYO_OP_SREF_PRI,
+     EMBRYO_OP_SREF_ALT,
+     EMBRYO_OP_SREF_S_PRI,
+     EMBRYO_OP_SREF_S_ALT,
+     EMBRYO_OP_STOR_I,
+     EMBRYO_OP_STRB_I,
+     EMBRYO_OP_LIDX,
+     EMBRYO_OP_LIDX_B,
+     EMBRYO_OP_IDXADDR,
+     EMBRYO_OP_IDXADDR_B,
+     EMBRYO_OP_ALIGN_PRI,
+     EMBRYO_OP_ALIGN_ALT,
+     EMBRYO_OP_LCTRL,
+     EMBRYO_OP_SCTRL,
+     EMBRYO_OP_MOVE_PRI,
+     EMBRYO_OP_MOVE_ALT,
+     EMBRYO_OP_XCHG,
+     EMBRYO_OP_PUSH_PRI,
+     EMBRYO_OP_PUSH_ALT,
+     EMBRYO_OP_PUSH_R,
+     EMBRYO_OP_PUSH_C,
+     EMBRYO_OP_PUSH,
+     EMBRYO_OP_PUSH_S,
+     EMBRYO_OP_POP_PRI,
+     EMBRYO_OP_POP_ALT,
+     EMBRYO_OP_STACK,
+     EMBRYO_OP_HEAP,
+     EMBRYO_OP_PROC,
+     EMBRYO_OP_RET,
+     EMBRYO_OP_RETN,
+     EMBRYO_OP_CALL,
+     EMBRYO_OP_CALL_PRI,
+     EMBRYO_OP_JUMP,
+     EMBRYO_OP_JREL,
+     EMBRYO_OP_JZER,
+     EMBRYO_OP_JNZ,
+     EMBRYO_OP_JEQ,
+     EMBRYO_OP_JNEQ,
+     EMBRYO_OP_JLESS,
+     EMBRYO_OP_JLEQ,
+     EMBRYO_OP_JGRTR,
+     EMBRYO_OP_JGEQ,
+     EMBRYO_OP_JSLESS,
+     EMBRYO_OP_JSLEQ,
+     EMBRYO_OP_JSGRTR,
+     EMBRYO_OP_JSGEQ,
+     EMBRYO_OP_SHL,
+     EMBRYO_OP_SHR,
+     EMBRYO_OP_SSHR,
+     EMBRYO_OP_SHL_C_PRI,
+     EMBRYO_OP_SHL_C_ALT,
+     EMBRYO_OP_SHR_C_PRI,
+     EMBRYO_OP_SHR_C_ALT,
+     EMBRYO_OP_SMUL,
+     EMBRYO_OP_SDIV,
+     EMBRYO_OP_SDIV_ALT,
+     EMBRYO_OP_UMUL,
+     EMBRYO_OP_UDIV,
+     EMBRYO_OP_UDIV_ALT,
+     EMBRYO_OP_ADD,
+     EMBRYO_OP_SUB,
+     EMBRYO_OP_SUB_ALT,
+     EMBRYO_OP_AND,
+     EMBRYO_OP_OR,
+     EMBRYO_OP_XOR,
+     EMBRYO_OP_NOT,
+     EMBRYO_OP_NEG,
+     EMBRYO_OP_INVERT,
+     EMBRYO_OP_ADD_C,
+     EMBRYO_OP_SMUL_C,
+     EMBRYO_OP_ZERO_PRI,
+     EMBRYO_OP_ZERO_ALT,
+     EMBRYO_OP_ZERO,
+     EMBRYO_OP_ZERO_S,
+     EMBRYO_OP_SIGN_PRI,
+     EMBRYO_OP_SIGN_ALT,
+     EMBRYO_OP_EQ,
+     EMBRYO_OP_NEQ,
+     EMBRYO_OP_LESS,
+     EMBRYO_OP_LEQ,
+     EMBRYO_OP_GRTR,
+     EMBRYO_OP_GEQ,
+     EMBRYO_OP_SLESS,
+     EMBRYO_OP_SLEQ,
+     EMBRYO_OP_SGRTR,
+     EMBRYO_OP_SGEQ,
+     EMBRYO_OP_EQ_C_PRI,
+     EMBRYO_OP_EQ_C_ALT,
+     EMBRYO_OP_INC_PRI,
+     EMBRYO_OP_INC_ALT,
+     EMBRYO_OP_INC,
+     EMBRYO_OP_INC_S,
+     EMBRYO_OP_INC_I,
+     EMBRYO_OP_DEC_PRI,
+     EMBRYO_OP_DEC_ALT,
+     EMBRYO_OP_DEC,
+     EMBRYO_OP_DEC_S,
+     EMBRYO_OP_DEC_I,
+     EMBRYO_OP_MOVS,
+     EMBRYO_OP_CMPS,
+     EMBRYO_OP_FILL,
+     EMBRYO_OP_HALT,
+     EMBRYO_OP_BOUNDS,
+     EMBRYO_OP_SYSREQ_PRI,
+     EMBRYO_OP_SYSREQ_C,
+     EMBRYO_OP_FILE,
+     EMBRYO_OP_LINE,
+     EMBRYO_OP_SYMBOL,
+     EMBRYO_OP_SRANGE,
+     EMBRYO_OP_JUMP_PRI,
+     EMBRYO_OP_SWITCH,
+     EMBRYO_OP_CASETBL,
+     EMBRYO_OP_SWAP_PRI,
+     EMBRYO_OP_SWAP_ALT,
+     EMBRYO_OP_PUSHADDR,
+     EMBRYO_OP_NOP,
+     EMBRYO_OP_SYSREQ_D,
+     EMBRYO_OP_SYMTAG,
+     /* ----- */
+     EMBRYO_OP_NUM_OPCODES
+};
+
+#define NUMENTRIES(hdr, field, nextfield) \
+(int)(((hdr)->nextfield - (hdr)->field) / (hdr)->defsize)
+#define GETENTRY(hdr, table, index) \
+(Embryo_Func_Stub *)((unsigned char*)(hdr) + \
+(int)(hdr)->table + index * (hdr)->defsize)
+#ifdef WORDS_BIGENDIAN
+static int __inline __entryswap32(int v)
+{int vv; vv = v; embryo_swap_32((unsigned int *)&vv); return vv;}
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + \
+__entryswap32(*((unsigned int *)(entry) + 1))) \
+: (entry)->name)
+#else
+# define GETENTRYNAME(hdr, entry) \
+(((hdr)->defsize == 2 * sizeof(unsigned int)) \
+? (char *)((unsigned char*)(hdr) + *((unsigned int *)(entry) + 1)) \
+: (entry)->name)
+#endif
+
+#define CUR_FILE_VERSION    7      /* current file version; also the current Embryo_Program version */
+#define MIN_FILE_VERSION    7      /* lowest supported file format version for the current Embryo_Program version */
+#define MIN_AMX_VERSION     7      /* minimum Embryo_Program version needed to support the current file format */
+#define sEXPMAX             19     /* maximum name length for file version <= 6 */
+#define sNAMEMAX            31     /* maximum name length of symbol name */
+#define EMBRYO_MAGIC        0xf1e0 /* magic byte pattern */
+#define EMBRYO_FLAG_COMPACT 0x04   /* compact encoding */
+#define EMBRYO_FLAG_RELOC   0x8000 /* jump/call addresses relocated */
+#define GETPARAM(v)         (v = *(Embryo_Cell *)cip++)
+#define PUSH(v)             (stk -= sizeof(Embryo_Cell), *(Embryo_Cell *)(data + (int)stk) = v)
+#define POP(v)              (v = *(Embryo_Cell *)(data + (int)stk), stk += sizeof(Embryo_Cell))
+#define ABORT(ep,v)         {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_FAIL;}
+#define OK(ep,v)            {(ep)->stk = reset_stk; (ep)->hea = reset_hea; (ep)->run_count--; ep->error = v; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_OK;}
+#define TOOLONG(ep)         {(ep)->pri = pri; (ep)->cip = (Embryo_Cell)((unsigned char *)cip - code); (ep)->alt = alt; (ep)->frm = frm; (ep)->stk = stk; (ep)->hea = hea; (ep)->reset_stk = reset_stk; (ep)->reset_hea = reset_hea; (ep)->run_count--; (ep)->max_run_cycles = max_run_cycles; return EMBRYO_PROGRAM_TOOLONG;}
+#define STKMARGIN           ((Embryo_Cell)(16 * sizeof(Embryo_Cell)))
+#define CHKMARGIN()         if ((hea + STKMARGIN) > stk) {ep->error = EMBRYO_ERROR_STACKERR; return 0;}
+#define CHKSTACK()          if (stk > ep->stp) {ep->run_count--; ep->error = EMBRYO_ERROR_STACKLOW; return 0;}
+#define CHKHEAP()           if (hea < ep->hlw) {ep->run_count--; ep->error = EMBRYO_ERROR_HEAPLOW; return 0;}
+#define CHKMEM(x)           if ((((x) >= hea) && ((x) < stk)) || ((Embryo_UCell)(x) >= (Embryo_UCell)ep->stp)) ABORT(ep, EMBRYO_ERROR_MEMACCESS);
+
+typedef struct _Embryo_Param        Embryo_Param;
+typedef struct _Embryo_Header       Embryo_Header;
+typedef struct _Embryo_Func_Stub    Embryo_Func_Stub;
+
+typedef Embryo_Cell (*Embryo_Native)(Embryo_Program *ep, Embryo_Cell *params);
+
+struct _Embryo_Param
+{
+   char        *string;
+   Embryo_Cell *cell_array;
+   int          cell_array_size;
+   Embryo_Cell  cell;
+};
+
+struct _Embryo_Program
+{
+   unsigned char *base; /* points to the Embryo_Program header ("ephdr") plus the code, optionally also the data */
+   int pushes; /* number of pushes - pops */
+   /* for external functions a few registers must be accessible from the outside */
+   Embryo_Cell cip; /* instruction pointer: relative to base + ephdr->cod */
+   Embryo_Cell frm; /* stack frame base: relative to base + ephdr->dat */
+   Embryo_Cell hea; /* top of the heap: relative to base + ephdr->dat */
+   Embryo_Cell hlw; /* bottom of the heap: relative to base + ephdr->dat */
+   Embryo_Cell stk; /* stack pointer: relative to base + ephdr->dat */
+   Embryo_Cell stp; /* top of the stack: relative to base + ephdr->dat */
+   int flags; /* current status  */
+   /* native functions can raise an error */
+   int error;
+   /* the sleep opcode needs to store the full Embryo_Program status */
+   Embryo_Cell pri;
+   Embryo_Cell alt;
+   Embryo_Cell reset_stk;
+   Embryo_Cell reset_hea;
+   Embryo_Cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
+
+   /* extended stuff */
+   Embryo_Native *native_calls;
+   int            native_calls_size;
+   int            native_calls_alloc;
+
+   unsigned char *code;
+   unsigned char  dont_free_code : 1;
+   Embryo_Cell    retval;
+
+   Embryo_Param  *params;
+   int            params_size;
+   int            params_alloc;
+
+   int            run_count;
+
+   int            max_run_cycles;
+
+   void          *data;
+};
+
+#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack(1)
+# define EMBRYO_STRUCT_PACKED
+#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
+# define EMBRYO_STRUCT_PACKED __attribute__((packed))
+#else
+# define EMBRYO_STRUCT_PACKED
+#endif
+
+struct _Embryo_Func_Stub
+{
+   int  address;
+   char name[sEXPMAX+1];
+} EMBRYO_STRUCT_PACKED;
+
+struct _Embryo_Header
+{
+   unsigned int size; /* size of the "file" */
+   unsigned short magic; /* signature */
+   char file_version; /* file format version */
+   char ep_version; /* required version of the Embryo_Program */
+   short flags;
+   short defsize; /* size of a definition record */
+   int cod; /* initial value of COD - code block */
+   int dat; /* initial value of DAT - data block */
+   int hea; /* initial value of HEA - start of the heap */
+   int stp; /* initial value of STP - stack top */
+   int cip; /* initial value of CIP - the instruction pointer */
+   int publics; /* offset to the "public functions" table */
+   int natives; /* offset to the "native functions" table */
+   int libraries; /* offset to the table of libraries */
+   int pubvars; /* the "public variables" table */
+   int tags; /* the "public tagnames" table */
+   int nametable; /* name table, file version 7 only */
+} EMBRYO_STRUCT_PACKED;
+
+#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
+# pragma pack()
+#endif
+
+void _embryo_args_init(Embryo_Program *ep);
+void _embryo_fp_init(Embryo_Program *ep);
+void _embryo_rand_init(Embryo_Program *ep);
+void _embryo_str_init(Embryo_Program *ep);
+void _embryo_time_init(Embryo_Program *ep);
+
+#endif
diff --git a/src/lib/embryo_rand.c b/src/lib/embryo_rand.c
new file mode 100644
index 0000000..627f7ed
--- /dev/null
+++ b/src/lib/embryo_rand.c
@@ -0,0 +1,36 @@
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <stdlib.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported random number api */
+
+static Embryo_Cell
+_embryo_rand_rand(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+   return (Embryo_Cell)(rand() & 0xffff);
+}
+
+static Embryo_Cell
+_embryo_rand_randf(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+   double r;
+   float f;
+
+   r = (double)(rand() & 0xffff) / 65535.0;
+   f = (float)r;
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_rand_init(Embryo_Program *ep)
+{
+   embryo_program_native_call_add(ep, "rand",  _embryo_rand_rand);
+   embryo_program_native_call_add(ep, "randf", _embryo_rand_randf);
+}
diff --git a/src/lib/embryo_str.c b/src/lib/embryo_str.c
new file mode 100644
index 0000000..0c2faa2
--- /dev/null
+++ b/src/lib/embryo_str.c
@@ -0,0 +1,498 @@
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_ALLOCA_H
+# include <alloca.h>
+#elif !defined alloca
+# ifdef __GNUC__
+#  define alloca __builtin_alloca
+# elif defined _AIX
+#  define alloca __alloca
+# elif defined _MSC_VER
+#  include <malloc.h>
+#  define alloca _alloca
+# elif !defined HAVE_ALLOCA
+#  ifdef  __cplusplus
+extern "C"
+#  endif
+void *alloca (size_t);
+# endif
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <fnmatch.h>
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+#define STRGET(ep, str, par) { \
+   Embryo_Cell *___cptr; \
+   str = NULL; \
+   if ((___cptr = embryo_data_address_get(ep, par))) { \
+	int ___l; \
+	___l = embryo_data_string_length_get(ep, ___cptr); \
+	(str) = alloca(___l + 1); \
+	if (str) embryo_data_string_get(ep, ___cptr, str); \
+     } }
+#define STRSET(ep, par, str) { \
+   Embryo_Cell *___cptr; \
+   if ((___cptr = embryo_data_address_get(ep, par))) { \
+      embryo_data_string_set(ep, str, ___cptr); \
+   } }
+
+/* exported string api */
+
+static Embryo_Cell
+_embryo_str_atoi(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1;
+
+   /* params[1] = str */
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   if (!s1) return 0;
+   return (Embryo_Cell)atoi(s1);
+}
+
+static Embryo_Cell
+_embryo_str_fnmatch(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2;
+
+   /* params[1] = glob */
+   /* params[2] = str */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   return (Embryo_Cell)fnmatch(s1, s2, 0);
+}
+
+static Embryo_Cell
+_embryo_str_strcmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2;
+
+   /* params[1] = str1 */
+   /* params[2] = str2 */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return -1;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   return (Embryo_Cell)strcmp(s1, s2);
+}
+
+static Embryo_Cell
+_embryo_str_strncmp(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2;
+
+   /* params[1] = str1 */
+   /* params[2] = str2 */
+   /* params[3] = n */
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] < 0) params[3] = 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   return (Embryo_Cell)strncmp(s1, s2, (size_t)params[3]);
+}
+
+static Embryo_Cell
+_embryo_str_strcpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[2]);
+   if (!s1) return 0;
+   STRSET(ep, params[1], s1);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncpy(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1;
+   int l;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   /* params[3] = n */
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] < 0) params[3] = 0;
+   STRGET(ep, s1, params[2]);
+   if (!s1) return 0;
+   l = strlen(s1);
+   if (l > params[3]) s1[params[3]] = 0;
+   STRSET(ep, params[1], s1);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strlen(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1;
+
+   /* params[1] = str */
+   if (params[0] != (1 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   if (!s1) return 0;
+   return (Embryo_Cell)strlen(s1);
+}
+
+static Embryo_Cell
+_embryo_str_strcat(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *s3;
+
+   /* params[1] = dsr */
+   /* params[2] = str */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return 0;
+   s3 = alloca(strlen(s1) + strlen(s2) + 1);
+   if (!s3) return 0;
+   strcpy(s3, s1);
+   strcat(s3, s2);
+   STRSET(ep, params[1], s3);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strncat(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *s3;
+   int l1, l2;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   /* params[3] = n */
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] < 0) params[3] = 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return 0;
+   l1 = strlen(s1);
+   l2 = strlen(s2);
+   s3 = alloca(l1 + l2 + 1);
+   if (!s3) return 0;
+   strcpy(s3, s1);
+   strncat(s3, s2, params[3]);
+   if (l2 >= params[3]) s3[l1 + params[3]] = 0;
+   STRSET(ep, params[1], s3);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *s3;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return 0;
+   s3 = alloca(strlen(s1) + strlen(s2) + 1);
+   if (!s3) return 0;
+   strcpy(s3, s2);
+   strcat(s3, s1);
+   STRSET(ep, params[1], s3);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strnprep(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *s3;
+   int l1, l2;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   /* params[3] = n */
+   if (params[0] != (3 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] < 0) params[3] = 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return 0;
+   l1 = strlen(s1);
+   l2 = strlen(s2);
+   s3 = alloca(l1 + l2 + 1);
+   if (!s3) return 0;
+   strncpy(s3, s2, params[3]);
+   if (params[3] <= l2) s3[params[3]] = 0;
+   strcat(s3, s1);
+   STRSET(ep, params[1], s3);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_strcut(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2;
+   int l1;
+
+   /* params[1] = dst */
+   /* params[2] = str */
+   /* params[3] = n */
+   /* params[4] = n2 */
+   if (params[0] != (4 * sizeof(Embryo_Cell))) return 0;
+   if (params[3] < 0) params[3] = 0;
+   if (params[4] < params[3]) params[4] = params[3];
+   STRGET(ep, s1, params[2]);
+   if (!s1) return 0;
+   l1 = strlen(s1);
+   if (params[3] >= l1) params[3] = l1;
+   if (params[4] >= l1) params[4] = l1;
+   if (params[4] == params[3])
+     {
+	STRSET(ep, params[1], "");
+	return 0;
+     }
+   s2 = alloca(params[4] - params[3] + 1);
+   strncpy(s2, s1 + params[3], params[4] - params[3]);
+   s2[params[4] - params[3]] = 0;
+   STRSET(ep, params[1], s2);
+   return 0;
+}
+
+static Embryo_Cell
+_embryo_str_snprintf(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2;
+   int i, o;
+   int inesc = 0;
+   int insub = 0;
+   int p, pnum;
+
+   /* params[1] = buf */
+   /* params[2] = bufsize */
+   /* params[3] = format_string */
+   /* params[4] = first arg ... */
+   if (params[0] < (Embryo_Cell)(3 * sizeof(Embryo_Cell))) return 0;
+   if (params[2] <= 0) return 0;
+   STRGET(ep, s1, params[3]);
+   if (!s1) return -1;
+   s2 = alloca(params[2] + 1);
+   if (!s2) return -1;
+   s2[0] = 0;
+   pnum = (params[0] / sizeof(Embryo_Cell)) - 3;
+   for (p = 0, o = 0, i = 0; (s1[i]) && (o < (params[2] - 1)) && (p < (pnum + 1)); i++)
+     {
+	if ((!inesc) && (!insub))
+	  {
+	     if      (s1[i] == '\\') inesc = 1;
+	     else if (s1[i] == '%')  insub = 1;
+	     if ((!inesc) && (!insub))
+	       {
+		  s2[o] = s1[i];
+		  o++;
+	       }
+	  }
+	else
+	  {
+	     Embryo_Cell *cptr;
+
+	     if (inesc)
+	       {
+		  switch (s1[i])
+		    {
+		     case 't':
+		       s2[o] = '\t';
+		       o++;
+		       break;
+		     case 'n':
+		       s2[o] = '\n';
+		       o++;
+		       break;
+		     default:
+		       s2[o] = s1[i];
+		       o++;
+		       break;
+		    }
+		  inesc = 0;
+	       }
+	     if ((insub) && (s1[i] == '%')) pnum++;
+	     if ((insub) && (p < pnum))
+	       {
+		  switch (s1[i])
+		    {
+		     case '%':
+		       s2[o] = '%';
+		       o++;
+		       break;
+		     case 'c':
+		       cptr = embryo_data_address_get(ep, params[4 + p]);
+		       if (cptr) s2[o] = (char)(*cptr);
+		       p++;
+		       o++;
+		       break;
+		     case 'i':
+		     case 'd':
+		     case 'x':
+		     case 'X':
+			 {
+			    char fmt[10] = "";
+			    char tmp[256] = "";
+			    int l;
+
+			    if      (s1[i] == 'i') strcpy(fmt, "%i");
+			    else if (s1[i] == 'd') strcpy(fmt, "%d");
+			    else if (s1[i] == 'x') strcpy(fmt, "%x");
+			    else if (s1[i] == 'X') strcpy(fmt, "%08x");
+			    cptr = embryo_data_address_get(ep, params[4 + p]);
+			    if (cptr) snprintf(tmp, sizeof(tmp), fmt, (int)(*cptr));
+			    l = strlen(tmp);
+			    if ((o + l) > (params[2] - 1))
+			      {
+				 l = params[2] - 1 - o;
+				 if (l < 0) l = 0;
+				 tmp[l] = 0;
+			      }
+			    strcpy(s2 + o, tmp);
+			    o += l;
+			    p++;
+			 }
+		       break;
+		     case 'f':
+			 {
+			    char tmp[256] = "";
+			    int l;
+
+			    cptr = embryo_data_address_get(ep, params[4 + p]);
+			    if (cptr) snprintf(tmp, sizeof(tmp), "%f", (double)EMBRYO_CELL_TO_FLOAT(*cptr));
+			    l = strlen(tmp);
+			    if ((o + l) > (params[2] - 1))
+			      {
+				 l = params[2] - 1 - o;
+				 if (l < 0) l = 0;
+				 tmp[l] = 0;
+			      }
+			    strcpy(s2 + o, tmp);
+			    o += l;
+			    p++;
+			 }
+		       break;
+		     case 's':
+			 {
+			    char *tmp;
+			    int l;
+
+			    STRGET(ep, tmp, params[4 + p]);
+			    l = strlen(tmp);
+			    if ((o + l) > (params[2] - 1))
+			      {
+				 l = params[2] - 1 - o;
+				 if (l < 0) l = 0;
+				 tmp[l] = 0;
+			      }
+			    strcpy(s2 + o, tmp);
+			    o += l;
+			    p++;
+			 }
+		       break;
+		     default:
+		       break;
+		    }
+		  insub = 0;
+	       }
+	     else if (insub)
+	       insub = 0;
+	  }
+     }
+   s2[o] = 0;
+
+   STRSET(ep, params[1], s2);
+   return o;
+}
+
+static Embryo_Cell
+_embryo_str_strstr(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *p;
+
+   /* params[1] = str */
+   /* params[2] = ndl */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   p = strstr(s1, s2);
+   if (!p) return -1;
+   return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *p;
+
+   /* params[1] = str */
+   /* params[2] = ch */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   p = strchr(s1, s2[0]);
+   if (!p) return -1;
+   return (Embryo_Cell)(p - s1);
+}
+
+static Embryo_Cell
+_embryo_str_strrchr(Embryo_Program *ep, Embryo_Cell *params)
+{
+   char *s1, *s2, *p;
+
+   /* params[1] = str */
+   /* params[2] = ch */
+   if (params[0] != (2 * sizeof(Embryo_Cell))) return 0;
+   STRGET(ep, s1, params[1]);
+   STRGET(ep, s2, params[2]);
+   if ((!s1) || (!s2)) return -1;
+   p = strrchr(s1, s2[0]);
+   if (!p) return -1;
+   return (Embryo_Cell)(p - s1);
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_str_init(Embryo_Program *ep)
+{
+   embryo_program_native_call_add(ep, "atoi",     _embryo_str_atoi);
+   embryo_program_native_call_add(ep, "fnmatch",  _embryo_str_fnmatch);
+   embryo_program_native_call_add(ep, "strcmp",   _embryo_str_strcmp);
+   embryo_program_native_call_add(ep, "strncmp",  _embryo_str_strncmp);
+   embryo_program_native_call_add(ep, "strcpy",   _embryo_str_strcpy);
+   embryo_program_native_call_add(ep, "strncpy",  _embryo_str_strncpy);
+   embryo_program_native_call_add(ep, "strlen",   _embryo_str_strlen);
+   embryo_program_native_call_add(ep, "strcat",   _embryo_str_strcat);
+   embryo_program_native_call_add(ep, "strncat",  _embryo_str_strncat);
+   embryo_program_native_call_add(ep, "strprep",  _embryo_str_strprep);
+   embryo_program_native_call_add(ep, "strnprep", _embryo_str_strnprep);
+   embryo_program_native_call_add(ep, "strcut",   _embryo_str_strcut);
+   embryo_program_native_call_add(ep, "snprintf", _embryo_str_snprintf);
+   embryo_program_native_call_add(ep, "strstr",   _embryo_str_strstr);
+   embryo_program_native_call_add(ep, "strchr",   _embryo_str_strchr);
+   embryo_program_native_call_add(ep, "strrchr",  _embryo_str_strrchr);
+}
diff --git a/src/lib/embryo_time.c b/src/lib/embryo_time.c
new file mode 100644
index 0000000..90c14cf
--- /dev/null
+++ b/src/lib/embryo_time.c
@@ -0,0 +1,97 @@
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifndef EFL_HAVE_GETTIMEOFDAY
+# error "Your platform isn't supported yet"
+#endif
+
+#include <sys/time.h>
+#include <time.h>
+
+#ifdef _MSC_VER
+# include <winsock2.h>
+#endif
+
+#ifdef HAVE_EVIL
+# include <Evil.h>
+#endif
+
+#ifdef HAVE_EXOTIC
+# include <Exotic.h>
+#endif
+
+#include "Embryo.h"
+#include "embryo_private.h"
+
+/* exported time api */
+
+static Embryo_Cell
+_embryo_time_seconds(Embryo_Program *ep __UNUSED__, Embryo_Cell *params __UNUSED__)
+{
+   struct timeval      timev;
+   double t;
+   float  f;
+
+   gettimeofday(&timev, NULL);
+   t = (double)(timev.tv_sec - ((timev.tv_sec / (60 * 60 * 24)) * (60 * 60 * 24)))
+     + (((double)timev.tv_usec) / 1000000);
+   f = (float)t;
+   return EMBRYO_FLOAT_TO_CELL(f);
+}
+
+static Embryo_Cell
+_embryo_time_date(Embryo_Program *ep, Embryo_Cell *params)
+{
+   static time_t       last_tzset = 0;
+   struct timeval      timev;
+   struct tm          *tm;
+   time_t              tt;
+
+   if (params[0] != (8 * sizeof(Embryo_Cell))) return 0;
+   gettimeofday(&timev, NULL);
+   tt = (time_t)(timev.tv_sec);
+   if ((tt > (last_tzset + 1)) ||
+       (tt < (last_tzset - 1)))
+     {
+	last_tzset = tt;
+	tzset();
+     }
+   tm = localtime(&tt);
+   if (tm)
+     {
+	Embryo_Cell *cptr;
+	double t;
+	float  f;
+
+	cptr = embryo_data_address_get(ep, params[1]);
+	if (cptr) *cptr = tm->tm_year + 1900;
+	cptr = embryo_data_address_get(ep, params[2]);
+	if (cptr) *cptr = tm->tm_mon + 1;
+	cptr = embryo_data_address_get(ep, params[3]);
+	if (cptr) *cptr = tm->tm_mday;
+	cptr = embryo_data_address_get(ep, params[4]);
+	if (cptr) *cptr = tm->tm_yday;
+	cptr = embryo_data_address_get(ep, params[5]);
+	if (cptr) *cptr = (tm->tm_wday + 6) % 7;
+	cptr = embryo_data_address_get(ep, params[6]);
+	if (cptr) *cptr = tm->tm_hour;
+	cptr = embryo_data_address_get(ep, params[7]);
+	if (cptr) *cptr = tm->tm_min;
+	cptr = embryo_data_address_get(ep, params[8]);
+	t = (double)tm->tm_sec + (((double)timev.tv_usec) / 1000000);
+	f = (float)t;
+	if (cptr) *cptr = EMBRYO_FLOAT_TO_CELL(f);
+
+     }
+   return 0;
+}
+
+/* functions used by the rest of embryo */
+
+void
+_embryo_time_init(Embryo_Program *ep)
+{
+   embryo_program_native_call_add(ep, "seconds", _embryo_time_seconds);
+   embryo_program_native_call_add(ep, "date",    _embryo_time_date);
+}
author	raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33>	2012-08-30 09:54:57 +0000
committer	raster <raster@7cbeb6ba-43b4-40fd-8cce-4c39aea84d33>	2012-08-30 09:54:57 +0000
commit	124ac58c553c1435bf6a33f6ca77e7363bfa4d1d (patch)
tree	b3beb0fb39eb8693de0c4288454887d51432ec98 /src
download	embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.gz embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.tar.bz2 embryo-124ac58c553c1435bf6a33f6ca77e7363bfa4d1d.zip