Rapid Euphoria programming language, version 3.1.1: 32-bit to 64-bit

Hi,

My name is Shian, I maintain a website which is dedicated to the Euphoria programming language version 3.1.1. A 32-bit language for Windows, DOS (using protected mode), Linux and FreeBSD.

Euphoria 3.1.1 is written in C language.

The website address is:
The Euphoria Programming Language

I am looking for an experienced C or C++ programmer, who is interested in creating a 64-bit version of Euphoria 3.1.1.

It mainly means to use 80-bit double instead of 64-bit double, and 64-bit integer instead of 32-bit integer.

Yet, unlike many other cases, the main goal is to create a 64-bit version of the language which is fully compatible with the 32-bit version. i.e. from the user's perspective, everything must remain the same... 31-bit signed Euphoria integer type (NOT 63-bit signed Euphoria integer), and basically, from the user perspective, the language should remain a 32-bit language.

Being fully compatible with 32-bit code means that the documentation, the libraries, the archive, and any previous code - will work and behave exactly the same on a 64-bit system (server or PC), which is the main goal.

Personally I continue to develop the standard library of Euphoria 3.1.1, in a project that I call: Lib2. As any other Euphoria 3.1.1 library, it is a 32-bit library (therefore it will work the same on DOS operating system as well).

Rapid Euphoria 3.1.1 is a very unique programming language, very powerful - yet extremely minimalist and simple, and undoubtedly an interesting language.

I wish that I could do the work by myself, but I'm not an experienced C programmer.

It is possible to do it, and fairly straightforward, especially if you already know Euphoria 3.1.1 (which is very easy to learn).

No new features are required - it is enough that the interpreter for (Windows and) Linux (especially Linux, for servers), will run on a 64-bit system without i386 libraries. 64-bit interpreter for Linux, exu, is the most important goal.

Thank you,
Shian.

The Euphoria Programming Language

Quote:

---

Originally Posted by shian

Hi,

My name is Shian, I maintain a website which is dedicated to the Euphoria programming language version 3.1.1. A 32-bit language for Windows, DOS (using protected mode), Linux and FreeBSD.

Euphoria 3.1.1 is written in C language.

The website address is:
The Euphoria Programming Language

I am looking for an experienced C or C++ programmer, who is interested in creating a 64-bit version of Euphoria 3.1.1.

It mainly means to use 80-bit double instead of 64-bit double, and 64-bit integer instead of 32-bit integer.

Yet, unlike many other cases, the main goal is to create a 64-bit version of the language which is fully compatible with the 32-bit version. i.e. from the user's perspective, everything must remain the same... 31-bit signed Euphoria integer type (NOT 63-bit signed Euphoria integer), and basically, from the user perspective, the language should remain a 32-bit language.

Being fully compatible with 32-bit code means that the documentation, the libraries, the archive, and any previous code - will work and behave exactly the same on a 64-bit system (server or PC), which is the main goal.

Personally I continue to develop the standard library of Euphoria 3.1.1, in a project that I call: Lib2. As any other Euphoria 3.1.1 library, it is a 32-bit library (therefore it will work the same on DOS operating system as well).

Rapid Euphoria 3.1.1 is a very unique programming language, very powerful - yet extremely minimalist and simple, and undoubtedly an interesting language.

I wish that I could do the work by myself, but I'm not an experienced C programmer.

It is possible to do it, and fairly straightforward, especially if you already know Euphoria 3.1.1 (which is very easy to learn).

No new features are required - it is enough that the interpreter for (Windows and) Linux (especially Linux, for servers), will run on a 64-bit system without i386 libraries. 64-bit interpreter for Linux, exu, is the most important goal.

Thank you,
Shian.

The Euphoria Programming Language

---

No source code for the compiler?

When you download Euphoria 3.1.1 from the Download page at:
Download Euphoria 3.1.1
it includes the entire source code (interpreter, binder, translator, everything).

Quote:

---

Originally Posted by shian

When you download Euphoria 3.1.1 from the Download page at:
Download Euphoria 3.1.1
it includes the entire source code (interpreter, binder, translator, everything).

---

Why do you have to run a binary to install it though? The way it's usually done is use a makefile to build the binary. It's difficult to examine and verify the integrity of executable formats. The bin directory should be empty until the user types `make`.

Quote:

---

Originally Posted by Sir Galahad

Why do you have to run a binary to install it though? The way it's usually done is use a makefile to build the binary. It's difficult to examine and verify the integrity of executable formats. The bin directory should be empty until the user types `make`.

---

The files are compressed .zip, .tgz or .tar (also for DOS/Windows). The complete source code is in a single directory called 'source' - this is the way it was done in 2007...

By the way, on Linux, gcc version 6.0+ will probably not compile the source code without modifications to the command line arguments or 'make' file. (Rapid Euphoria code is from 2007).

Before anyone may wonder... I must say that Open Euphoria programming language is practically NOT a successor for Rapid Euphoria, nor Phix programming language; And one cannot and must not rely on these two programming languages to run Rapid Euphoria code correctly or safely.

It is suffice to mention that 64-bit Open Euphoria will treat a 31-bit Rapid Euphoria integer type as an unsigned number, as a result for many calculations. But of course the incompatibility is way bigger then this.

Doesn't the programming language have some kind community that you can reach out to for help? I mean, it looks like you're asking for a volunteer on an open source project, in which case the volunteer very likely must love the Euphoria programming language to be willing to work on it for free. It's far more likely that you'll find a Euphoria programmer who knows C than you'll find a C programmer who loves Euphoria.

Until the year 2007 there was a worldwide enthusiastic community for Rapid Euphoria. When Euphoria became an open source (2007), the Open Euphoria group continued to develop the Euphoria programming language, at this point most (or all) the enthusiastic users left. Open Euphoria is, from my perspective, just a forum, not a programming language with community of users.

I personally dislike anything about Open Euphoria's strategy, to say the least. And I am not alone in this matter. Therefore I could not get help from them, and I would not like to get any help from them.

I've already contacted anyone that I know, yet most of the users left and their email address is no longer active, so it is impossible to find someone and ask for help. As I said before, I am not going to ask help from Open Euphoria group, and it is not a personal matter; most, if not all users of Rapid Euphoria, would not do it, and there are many good reasons for that.

You are right, yet I did all that I could, including getting the author of Rapid Euphoria advice, but I could not find someone to ask for help.

I wish to revive Rapid Euphoria and at the moment I am the community. (Me and 'useful').

In that case, it seems to me that you should learn to program in C. Why would a C programmer want to work on what you've described as a dead programming language unless you pay them satisfactorily for their time?

You may have to become a proficient C programmer yourself, make the updates you've described, and then hopefully the signs of life you're putting into Euphoria will attract programmers, some of whom might be C programmers who will join your effort.

I've left C and Assembly a long time ago, many years ago, for doing what I have to do for living. It wasn't really my will or my choice, it was a reasonable decision.

Life is a circle, and as we move forward many people start to look back. Because 'New' does not mean 'Better'.
Some skilled C programmers will find Rapid Euphoria again, and will realize, soon or later, that it is still a much better language then Python or Ruby or many other popular languages; it just lack of libraries.

I still don't see the source code for `exu`. Searched for exu.c and exu.e but found neither. And the current bin/exu seems to be a linux binary.

Quote:

---

Originally Posted by Sir Galahad

I still don't see the source code for `exu`. Searched for exu.c and exu.e but found neither. And the current bin/exu seems to be a linux binary.

---

Sorry, you should find the complete source code in euphoria/source directory (not in euphoria/bin).

[It includes the source code for the interpreter, binder and translator.
The interpreter for Linux is the most important goal.]

Quote:

---

Originally Posted by shian

Sorry, you should find the complete source code in euphoria/source directory (not in euphoria/bin).

[It includes the source code for the interpreter, binder and translator.
The interpreter for Linux is the most important goal.]

---

Again, the C files are incomplete. The rest of the source files are coded in Euphoria itself. All else in that directory are shell scripts that call the binaries `ex`, `exu`, docs, text files, et cetera.

Quote:

---

Originally Posted by Sir Galahad

Again, the C files are incomplete. The rest of the source files are coded in Euphoria itself. All else in that directory are shell scripts that call the binaries `ex`, `exu`, docs, text files, et cetera.

---

Everything is in euphoria/source (please read also the readme.txt file).

To make sure it works, I just compiled it all on Linux Mint 17.3 (In VirtualBox, Linux kernel 3.19.0-32-generic #37~14.04.1-Ubuntu i686 GNU/Linux), using gcc version 4.8.4 (Ubuntu 4.8.4-2ubuntu1~14.04.4).

These are the steps to compile everything, the interpreter (exu), the translator (ecu + ecu.a), and the backend (backendu):

• Download the compressed file for Linux from Download Euphoria 3.1.1.
• Decompress the euphoria directory (and its sub-directories) in /home/yourname.
• Define two environment variables in /home/yourname/.profile :

Code:

---

EUDIR=/home/yourname/euphoria
PATH=$EUDIR/bin:$PATH
export EUDIR PATH

---

• Log out and log in again for .profile file to take effect. Now you can actually start programming in Euphoria 3.1.1.
• Open the terminal in directory /home/yourname/euphoria/source, and run: ./buildu (build everything).

You should get similar output:

Code:

---

shian@shian-VirtualBox ~/euphoria/source $ ./buildu
Translator library
-rw-r--r-- 1 shian shian 104674 Nov  2 19:25 ecu.a
moving translator library to euphoria/bin
Interpreter

21 .c files were created.
To build your executable file, type: ./emake
compiling front-end
compiling backend - for FreeBSD add -DEBSD
linking - for FreeBSD remove -ldl
-rwxr-xr-x 1 shian shian 361709 Nov  2 19:25 exu
Back-end for binding
rm: cannot remove ‘*.o’: No such file or directory

9 .c files were created.
To build your executable file, type: ./emake
linking - for FreeBSD omit -ldl
./bmakeu: line 31: /home/shian/upx: No such file or directory
-rwxr-xr-x 1 shian shian 166422 Nov  2 19:25 backendu
Translator

40 .c files were created.
To build your executable file, type: ./emake
compiling with GNU C
main-.c
main-0.c
ec.c
misc.c
wildcard.c
global.c
error.c
machine.c
c_out.c
symtab.c
symtab_0.c
scanner.c
scanne_0.c
file.c
sort.c
emit.c
emit_0.c
emit_1.c
parser.c
parser_0.c
parser_1.c
c_decl.c
c_dec0.c
c_dec1.c
compile.c
compil_0.c
compil_1.c
compil_2.c
compil_3.c
compil_4.c
compil_5.c
compil_6.c
compil_7.c
compil_8.c
compil_9.c
traninit.c
get.c
main.c
pathopen.c
init-.c
linking
you can now execute: ./ec
-rwxr-xr-x 1 shian shian 846488 Nov  2 19:26 ecu
moving programs to euphoria/bin
shian@shian-VirtualBox ~/euphoria/source $

---

• That is all. Remember that Euphoria 3.1.1 must be installed correctly before you run any of the build files (see source/readme.txt), and the two environment variables (EUDIR and PATH) must be set correctly.

.bash_profile:

Code:

---

EUDIR=~/euphoria
PATH=$EUDIR/bin:$PATH
export PATH EUDIR

---

Code:

---

@~/euphoria $ rm bin/exu
@~/euphoria $ cd source
@~/euphoria/source $ make
exu ec.ex int.ex
make: exu: Command not found
make: *** [makefile:168: main-.o] Error 127

---

Quote:

---

Originally Posted by Sir Galahad

.bash_profile:

Code:

---

EUDIR=~/euphoria
PATH=$EUDIR/bin:$PATH
export PATH EUDIR

---

Code:

---

@~/euphoria $ rm bin/exu
@~/euphoria $ cd source
@~/euphoria/source $ make
exu ec.ex int.ex
make: exu: Command not found
make: *** [makefile:168: main-.o] Error 127

---

---

I'm sorry, these are not the steps that I've mentioned previously.

And also, make sure that you are compiling on a 32-bit Linux (it's not going to work on a 64-bit system, the build files are for i386).

Also, I'm not sure, yet it might be better to set EUDIR with the full path (not with ~, just in case).

Quote:

---

Originally Posted by shian

I'm sorry, these are not the steps that I've mentioned previously.

And also, make sure that you are compiling on a 32-bit Linux (it's not going to work on a 64-bit system, the build files are for i386).

Also, I'm not sure, yet it might be better to set EUDIR with the full path (not with ~, just in case).

---

Sorry yeah the project has an unconventional layout. The x86 limitation is a real issue though. I wonder why inline assembly was used? That part would obviously need to be ported for this to be a useful tool.

Quote:

---

Originally Posted by Sir Galahad

The x86 limitation is a real issue though. I wonder why inline assembly was used? That part would obviously need to be ported for this to be a useful tool.

---

To be fair, that is what shian is hoping to overcome with this request for a volunteer, after all. Are you volunteering? :D

Quote:

---

Originally Posted by laserlight

To be fair, that is what shian is hoping to overcome with this request for a volunteer, after all. Are you volunteering? :D

---

Silly me. Well I get a ton of errors anyway. Long road of debugging for whoever picks up that torch. Besides that, much of the code is almost maddening to read. Hard to follow...

Quote:

---

Originally Posted by Sir Galahad

Sorry yeah the project has an unconventional layout. The x86 limitation is a real issue though. I wonder why inline assembly was used? That part would obviously need to be ported for this to be a useful tool.

---

The C macro for assembly push and pop is only a 'trick' which is required for accessing .DLL and .so files (or machine code) from within Euphoria 3.1.1, as far as I know. You could comment it out, it's only few lines, and compile 'exu' without this feature at the beginning (I assume).

The unconventional layout of the C code is part of the C language.
Euphoria 3.1.1 runs on DOS/Linux/FreeBSD/Windows and supports about 6 or 7 different compilers, from the beginning of the 90's.
Of course, now you may only use gcc, especially for Linux.

Quote:

---

Originally Posted by Sir Galahad

Silly me. Well I get a ton of errors anyway. Long road of debugging for whoever picks up that torch. Besides that, much of the code is almost maddening to read. Hard to follow...

---

I guess that it's hard to follow the code because of lots preprocessor statements which were needed to support all the different compilers and operating systems. Frankly, you could comment out most of it and leave what's relevant for Linux, then it could look less intimidating...

Remember that I only need to change the double and long size from 64 to 80 bit and from 32 to 64 bit - I don't request any new feature or other changes to the existing code. The long type should be 64 bit for fast and native pointer and integer arithmetic (not for changing the actual Euphoria integer size, which is signed 31-bit. Euphoria double, called atom, will obviously support higher precision, which is just fine).

Quote:

---

Originally Posted by laserlight

To be fair, that is what shian is hoping to overcome with this request for a volunteer, after all. Are you volunteering? :D

---

Thank you for your support.

Quote:

---

Originally Posted by Sir Galahad

I wonder why inline assembly was used? That part would obviously need to be ported for this to be a useful tool.

---

From euphoria/source/readme.txt:

Quote:

---

WARNING: Tricky Bits
--------------------
There are places where small bits of machine code are inserted
without the full knowledge of the C compiler. One place is where
a Euphoria program calls a C routine and must push data onto the
C call stack. The machine language PUSH instruction is inserted.
Another place is where the Translator library must switch C call-stacks
when a transition is made from running one task to running another.
The hardware stack pointer is made to point at a new place.

After building, if you find that things basically work, except
for calls to C, and/or multitasking of translated programs, you'll
need to roll up your sleeves and make some adjustments to hardware
stack offsets. How to do this is described in the C back-end source files
be_callc.c and be_task.c

---

Since I am focusing mainly on the interpreter for Linux, exu, the Translator part is irrelevant now.
And basically, as it says in readme.txt, you could compile exu only and find out that calling C shared file .so (from within Euphoria 3.1.1) does not work or leads to some kind of crash, this is the worst scenario.

To focus and compile only the interpreter exu for Linux, using gcc, you would use the command: ./imakeu as it says in source/readme.txt.

Quote:

---

Originally Posted by shian

From euphoria/source/readme.txt:



Since I am focusing mainly on the interpreter for Linux, exu, the Translator part is irrelevant now.
And basically, as it says in readme.txt, you could compile exu only and find out that calling C shared file .so (from within Euphoria 3.1.1) does not work or leads to some kind of crash, this is the worst scenario.

To focus and compile only the interpreter exu for Linux, using gcc, you would use the command: ./imakeu as it says in source/readme.txt.

---

Just look at it!

Code:

---

/*****************************************************************************/
/*      (c) Copyright 2007 Rapid Deployment Software - See License.txt      */
/*****************************************************************************/
/*                                                                          */
/*                The Interpreter Back-end Main Program                    */
/*                (not linked by user translated code)                      */
/*                                                                          */
/*****************************************************************************/

/* Some rules that must be followed:
 *
 *  - pc must be in ESI, ECX (or some other) register
 *  - watch out for instructions that the compiler places after a thread()
 *    - they won't be executed. e.g. increments of pc
 *  - top, a, obj_ptr, sym should be in registers (almost all references)
 *    avoid using * / (double) with these vars
 *  - must do tpc = pc before calling any subroutine - for error reporting
 *    and profiling
 *  - must inc PC (sometimes have to use inc3pc() or thread4()) before jumping
 *    to next op
 *  - code is generally: operator
 *                      operand1
 *                      operand2
 *                      target
 *    operator is address of the C code that performs this operation
 *    operands are generally addresses of vars or temps containing the
 *    value to be manipulated, target is the address of the var or temp to
 *    store the result into
 *  - must deref any target pointer (double or sequence) that is overwritten
 *    e.g. temp or var location, or sequence element containing
 *    non-ATOM_INT_NV. Use DeRefx when tpc=pc has not been done already
 *    in the op, to have accurate time profile of de_reference
 *  - avoid passing more than 3 arguments to any routine - it results in
 *    poor code quality throughout do_exec()
 */

/******************/
/* Included files */
/******************/
#include <stdio.h>
#include <time.h>
#ifdef ELINUX
#include <sys/times.h>
#else
#ifdef EDJGPP
#include <go32.h>
#endif
#ifdef EWATCOM
#include <graph.h>
#endif
#include <conio.h>
#endif
#include <math.h>
#ifdef EXTRA_CHECK
#include <malloc.h>
#endif
#ifdef EWINDOWS
#include <windows.h>
#endif
#include "alldefs.h"
#include "alloc.h"
#include <signal.h>

/******************/
/* Local defines  */
/******************/
#define POINT5 0.5
#define HUGE_LINE 1000000000

/* took out:    || (fp)->_flag&_UNGET \ 
  added:      tpc = pc */
#ifdef ORIGINALWATCOM
#define getc(fp) \
        ((fp)->_cnt<=0 \
        || (fp)->_flag&_UNGET \
        || (*(fp)->_ptr)=='\x0d' \
        || (*(fp)->_ptr)=='\x1a' \
        ? fgetc(fp) \
        : ((fp)->_cnt--,*(fp)->_ptr++))
#endif

#if defined(EWATCOM) || defined(ELINUX)
// a bit faster:
#define mygetc(fp) \
        ((fp)->_cnt<=0 \
        || (*(fp)->_ptr)=='\x0d' \
        || (*(fp)->_ptr)=='\x1a' \
        ? (tpc = pc , fgetc(fp)) \
        : ((fp)->_cnt--,*(fp)->_ptr++))
#else
#define mygetc(fp) getc(fp)
#endif

#define STORE_TOP_I  a = *obj_ptr;                  \
                      *obj_ptr = top;                \
                      pc += 4;                      \
                      if (IS_ATOM_INT_NV(a)) {      \
                          thread();                  \
                      }                              \
                      else {                        \
                          DeRefDSx(a);              \
                      }

#define START_BIN_OP  a = *(object_ptr)pc[1];        \
                      top = *(object_ptr)pc[2];      \
                      obj_ptr = (object_ptr)pc[3];  \
                      if (IS_ATOM_INT(a) && IS_ATOM_INT(top)) {

#define END_BIN_OP(x)    STORE_TOP_I                \
                      }                              \
                      else {                        \
                          tpc = pc;                  \
                          top = binary_op(x, a, top);\
                          a = *obj_ptr;              \
                          *obj_ptr = top;            \
                          pc += 4;                  \
                          DeRef(a);                  \
                      }

#define END_BIN_OP_IFW(x)  {                          \
                                ;                    \
                          }                          \
                          else {                    \
                              pc = (int *)pc[3];    \
                              BREAK;                \
                          }                          \
                          thread4();            \
                          BREAK;                \
                      }                              \
                      else {                        \
                          tpc = pc;                  \
                          top = binary_op(x, a, top);  \
                          pc++;                      \
                          goto if_check;            \
                      }                         

#define END_BIN_OP_IFW_I  {                          \
                                ;                    \
                          }                          \
                          else {                    \
                              pc = (int *)pc[3];    \
                              BREAK;                \
                          }                          \
                          thread4();            \
                          BREAK;                \

#define START_BIN_OP_I  a = *(object_ptr)pc[1];      \
                      top = *(object_ptr)pc[2];      \
                      obj_ptr = (object_ptr)pc[3];  \
         
#define END_BIN_OP_I      *obj_ptr = top;            \
                          pc += 4;                  \
                          thread();                  \

#define START_UNARY_OP  top = *(object_ptr)pc[1]; \
                        obj_ptr = (object_ptr)pc[2]; \
                        a = *obj_ptr;            \
                        if (IS_ATOM_INT(top)) { 

#define END_UNARY_OP(x)    inc3pc();              \
                            *obj_ptr = top;      \
                            if (IS_ATOM_INT_NV(a))    \
                                thread();        \
                            else                  \
                                DeRefDSx(a);      \
                        }                        \
                        else {                    \
                            tpc = pc;            \
                            *obj_ptr = unary_op(x, top); \
                            inc3pc();              \
                            DeRef(a);            \
                        }

/**********************/
/* Imported variables */
/**********************/
extern int clk_tck;
extern int current_task;
extern struct tcb *tcb;
extern char *file_name_entered;
extern int traced_lines;
extern struct op_info optable[];
extern unsigned cache_size;
extern int align4;
extern int clocks_per_sec;
extern unsigned char TempBuff[];
extern int TraceOn;
extern int in_from_keyb;
extern int trace_enabled;
extern int *TraceLineBuff;     
extern int TraceLineSize;
extern int TraceLineNext;
extern symtab_ptr TopLevelSub;
extern object last_w_file_no;
extern FILE *last_w_file_ptr;
extern object last_r_file_no;
extern FILE *last_r_file_ptr;
extern long bytes_allocated;
extern int current_screen;
extern d_ptr d_list;
extern int color_trace;
extern int file_trace;
extern symtab_ptr *e_routine;
extern int e_routine_next;
extern char *type_error_msg;
extern object_ptr rhs_slice_target;  /* avoids 4th arg for RHS_Slice() */
extern s1_ptr *assign_slice_seq;
extern int *profile_sample;
#ifdef EWINDOWS
extern unsigned default_heap;
#endif

/**********************/
/* Declared functions */
/**********************/
void INT_Handler(int);
unsigned long good_rand();
void RHS_Slice();
object user(), Command_Line(), EOpen(), Repeat();
object machine();
object unary_op(), binary_op(), binary_op_a(), Date(), Time(),
      NewDouble();

object add(), minus(), uminus(), e_sqrt(), Random(), multiply(), divide(),
    equals(), less(), greater(), noteq(), greatereq(), lesseq(),
    and(), or(), xor(), not(), e_sin(), e_cos(), e_tan(), e_arctan(),
    e_log(), e_floor(), eremainder(), and_bits(), or_bits(),
    xor_bits(), not_bits(), power();

object Dadd(), Dminus(), Duminus(), De_sqrt(), DRandom(), Dmultiply(), Ddivide(),
    Dequals(), Dless(), Dgreater(), Dnoteq(), Dgreatereq(), Dlesseq(),
    Dand(), Dor(), Dxor(), Dnot(), De_sin(), De_cos(), De_tan(), De_arctan(),
    De_log(), De_floor(), Dremainder(), Dand_bits(), Dor_bits(),
    Dxor_bits(), Dnot_bits(), Dpower();

object x(); /* error */
symtab_ptr PrivateVar();
long find(), e_match();
FILE *which_file();
char *EMalloc();
object_ptr BiggerStack();
void do_exec();
s1_ptr NewS1();
double current_time();
void Machine_Handler();
long find_from();
long e_match_from();
/**********************/
/* Exported variables */
/**********************/
object_ptr expr_stack;  // runtime call stack
object_ptr expr_max;    // top limit of call stack
object_ptr expr_limit;  // don't start a new routine above this
int stack_size;        // current size of call stack
object_ptr expr_top;    // expression stack pointer
int SymTabLen;          // avoid > 3 args
int start_line;        // line number set by STARTLINE
int TraceBeyond;        // continue tracing after this line
int TraceStack;        // stack level when down-arrow was pressed
int Executing = FALSE;  // TRUE if user program is executing
int ProfileOn;          // TRUE if profile/profile_time is turned on

/* Euphoria program counter needed for traceback */
int *tpc;

/*******************/
/* Local variables */
/*******************/
#ifdef EXTRA_CHECK
static int *watch_point = (int *)0x3aa41c;
static int watch_value = 1948266795;
static int watch_count = 1;
#endif

/*********************/
/* Defined functions */
/*********************/
static void trace_command(object x)
// perform trace(x)
{
    int i;             
               
    if (IS_ATOM_INT(x)) {
        i = x;
    }
    else if (IS_ATOM(x)) {
        i = (int)DBL_PTR(x)->dbl;
    }
    else
        RTFatal("argument to trace() must be an atom");
#ifdef EWINDOWS
        if (i != 3) {
            show_console();
        }
#endif

#ifndef BACKEND
        if (i == 0) {
            TraceOn = FALSE;
            file_trace = FALSE;
            if (current_screen != MAIN_SCREEN)
                MainScreen();
        }
        else if (i == 1) {
            TraceOn = trace_enabled;
            color_trace = TRUE;
        }
        else if (i == 2) {
            TraceOn = trace_enabled;
            color_trace = FALSE;
        }
        else if (i == 3) {
            file_trace = TRUE;
        }
        else
            RTFatal("argument to trace() must be 0, 1, 2 or 3");
#endif
}

static void profile_command(object x)
// perform profile(x)
{
    int i;
   
    if (IS_ATOM_INT(x)) {
        i = x;
    }
    else if (IS_ATOM(x)) {
        i = (int)DBL_PTR(x)->dbl;
    }
    else
        RTFatal("argument to profile() must be an atom");
    if (i == 0) {
        ProfileOn = FALSE;
    }
    else if (i == 1) {
        ProfileOn = TRUE;
    }
    else
        RTFatal("argument to profile() must be 0 or 1");
}

static object do_peek4(object a, int b, int *pc)
// peek4u, peek4s
// moved it here because it was causing bad code generation for WIN32
{
    int i;             
    unsigned long *peek4_addr;
    object top;
    s1_ptr s1;
    object_ptr obj_ptr;
               
    /* check address */
    if (IS_ATOM_INT(a)) {
        peek4_addr = (unsigned long *)a;
    }
    else if (IS_ATOM(a)) {
        peek4_addr = (unsigned long *)(unsigned long)(DBL_PTR(a)->dbl);
    }
    else {
        /* a sequence: {addr, nbytes} */
        s1 = SEQ_PTR(a);                                       
        i = s1->length;
        if (i != 2) {
            RTFatal("argument to peek() must be an atom or a 2-element sequence");
        }
        peek4_addr = (unsigned long *)get_pos_int("peek4s/peek4u", *(s1->base+1));
#ifdef EDOS                   
        if (current_screen != MAIN_SCREEN &&
            (unsigned)peek4_addr >= (unsigned)0xA0000 &&
            (unsigned)peek4_addr < (unsigned)0xC0000)
            MainScreen();
#endif                 
        i = get_pos_int("peek4s/peek4u", *(s1->base+2));/* length*/
        if (i < 0)
            RTFatal("number of bytes to peek is less than 0");
        s1 = NewS1(i);
        obj_ptr = s1->base;
        if (b) {
            // unsigned
            while (--i >= 0) {
#ifdef EDJGPP                     
                if ((unsigned)peek4_addr <= LOW_MEMORY_MAX)
                    top = _farpeekl(_go32_info_block.selector_for_linear_memory,
                                      (unsigned)peek4_addr++);
                else   
#endif                     
                    top = (object)*peek4_addr++;
                if ((unsigned)top > (unsigned)MAXINT)
                    top = NewDouble((double)(unsigned long)top);
                *(++obj_ptr) = top;
            }
        }
        else {
            // signed
            while (--i >= 0) {
#ifdef EDJGPP                     
                if ((unsigned)peek4_addr <= LOW_MEMORY_MAX)
                    top = _farpeekl(_go32_info_block.selector_for_linear_memory,
                                                (unsigned)peek4_addr++);
                else   
#endif                     
                    top = (object)*peek4_addr++;
                if (top < MININT || top > MAXINT)
                    top = NewDouble((double)(long)top);
                *(++obj_ptr) = top;
            }
        }
        return (object)MAKE_SEQ(s1);
    }
#ifdef EDOS
    if (current_screen != MAIN_SCREEN &&
        (unsigned)peek4_addr >= (unsigned)0xA0000 &&
        (unsigned)peek4_addr < (unsigned)0xC0000)
        MainScreen();
#endif             
#ifdef EDJGPP                     
    if ((unsigned)peek4_addr <= LOW_MEMORY_MAX)
        top = _farpeekl(_go32_info_block.selector_for_linear_memory,
                                                  (unsigned)peek4_addr);
    else   
#endif                     
        top = (object)*peek4_addr;
    if (b) {
        // unsigned
        if ((unsigned)top > (unsigned)MAXINT)
            top = NewDouble((double)(unsigned long)top);
    }
    else {
        // signed
        if (top < MININT || top > MAXINT)
            top = NewDouble((double)(long)top);
    }
   
    return top;
}


static void do_poke4(object a, object top)
// moved it here because it was causing bad code generation for WIN32
{
    unsigned long *poke4_addr;
    double temp_dbl;
    s1_ptr s1;
    object_ptr obj_ptr;
       
    /* determine the address to be poked */
    if (IS_ATOM_INT(a)) {
        poke4_addr = (unsigned long *)INT_VAL(a);
    }
    else if (IS_ATOM(a)) {
        poke4_addr = (unsigned long *)(unsigned long)(DBL_PTR(a)->dbl);
    }
    else {
        RTFatal("first argument to poke4 must be an atom");
    }
#ifdef EDOS
    if (current_screen != MAIN_SCREEN &&
        (unsigned)poke4_addr >= (unsigned)0xA0000 &&
        (unsigned)poke4_addr < (unsigned)0xC0000)
        MainScreen();
#endif
    /* look at the value to be poked */
    if (IS_ATOM_INT(top)) {
#ifdef EDJGPP     
        if ((unsigned)poke4_addr <= LOW_MEMORY_MAX)
            _farpokel(_go32_info_block.selector_for_linear_memory,
                      (unsigned long)poke4_addr, (unsigned long)INT_VAL(top));
        else
#endif     
            *poke4_addr = (unsigned long)INT_VAL(top);
    }
    else if (IS_ATOM(top)) {
        temp_dbl = DBL_PTR(top)->dbl;
        if (temp_dbl < MIN_BITWISE_DBL || temp_dbl > MAX_BITWISE_DBL)
            RTFatal("poke4 is limited to 32-bit numbers");
#ifdef EDJGPP     
        if ((unsigned)poke4_addr <= LOW_MEMORY_MAX)
            _farpokel(_go32_info_block.selector_for_linear_memory,
                      (unsigned long)poke4_addr, (unsigned long)temp_dbl);
        else
#endif     
            *poke4_addr = (unsigned long)temp_dbl;
    }
    else {
        /* second arg is sequence */
        s1 = SEQ_PTR(top);
        obj_ptr = s1->base;
        while (TRUE) {
            top = *(++obj_ptr);
            if (IS_ATOM_INT(top)) {
#ifdef EDJGPP     
                if ((unsigned)poke4_addr <= LOW_MEMORY_MAX)
                    _farpokel(_go32_info_block.selector_for_linear_memory,
                      (unsigned long)poke4_addr++, (unsigned long)INT_VAL(top));
                else
#endif     
                    *poke4_addr++ = (unsigned long)INT_VAL(top);
            }
            else if (IS_ATOM(top)) {
                if (top == NOVALUE)
                    break;
                temp_dbl = DBL_PTR(top)->dbl;
                if (temp_dbl < MIN_BITWISE_DBL || temp_dbl > MAX_BITWISE_DBL)
                    RTFatal("poke4 is limited to 32-bit numbers");
#ifdef EDJGPP     
                if ((unsigned)poke4_addr <= LOW_MEMORY_MAX)
                    _farpokel(_go32_info_block.selector_for_linear_memory,
                      (unsigned long)poke4_addr++, (unsigned long)temp_dbl);
                else
#endif     
                    *poke4_addr++ = (unsigned long)temp_dbl;
            }
            else {
                RTFatal("sequence to be poked must only contain atoms");
            }
        }
    }
}

// WATCOM does not completely understand thread().
// When it inserts a jump machine instruction, it will
// sometimes move code after the thread()
// and the code will not be executed.

#ifdef INT_CODES
#define thread() goto loop_top
#define thread2() {pc += 2; goto loop_top;}
#define thread4() {pc += 4; goto loop_top;}
#define thread5() {pc += 5; goto loop_top;}
#define threadpc3() {pc = (int *)pc[3]; goto loop_top;}
#define inc3pc() pc += 3
#include "redef.h"
#include "opnames.h"
#define BREAK break

#else
// THREADED CODE - implemented in various ways

#define FP_EMULATION_NEEDED // FOR WATCOM/DOS to run on old 486/386 without f.p.

#if defined(EWINDOWS) || (defined(EDOS) && defined(EWATCOM) && !defined(FP_EMULATION_NEEDED))
// #pragma aux thread aborts; does nothing

#pragma aux thread = \
        "jmp [ECX]" \
        modify [EAX EBX EDX];

void thread2(void);
#pragma aux thread2 = \
        "ADD ECX, 8" \
        "jmp [ECX]" \
        modify [EAX EBX EDX];

void thread4(void);
#pragma aux thread4 = \
        "ADD ECX, 16" \
        "jmp [ECX]" \
        modify [EAX EBX EDX];

void thread5(void);
#pragma aux thread5 = \
        "ADD ECX, 20" \
        "jmp [ECX]" \
        modify [EAX EBX EDX];

/* have to hide this from WATCOM or it will generate stupid code
  at the top of the switch */
#pragma aux inc3pc = \
        "ADD ECX, 12" \
        modify [];

void threadpc3(void);
#pragma aux threadpc3 = \
        "MOV ECX, EDI" \
        "jmp [ECX]"    \
        modify [EAX EBX ECX EDX];
       
#define BREAK break
#include "redef.h"
#endif

#if defined(EDOS) && defined(EWATCOM) && defined(FP_EMULATION_NEEDED)
// WATCOM:
// #pragma aux thread aborts; does nothing
// modify [...] seems to do very little, works no matter what regs are
// specified or even if modify is removed

void thread(void);
#pragma aux thread = "jmp [ESI]"  \
                    modify [EAX EBX EDX];

void thread2(void);
#pragma aux thread2 = "ADD ESI, 8" \
                      "jmp [ESI]" \
                      modify [EAX EBX EDX];

void thread4(void);
#pragma aux thread4 = "ADD ESI, 16" \
                      "jmp [ESI]" \
                      modify [EAX EBX EDX];

void thread5(void);
#pragma aux thread5 = "ADD ESI, 20" \
                      "jmp [ESI]" \
                      modify [EAX EBX EDX];

/* have to hide this from WATCOM or it will generate stupid code
  at the top of the switch */
#pragma aux inc3pc = \
        "ADD ESI, 12" \
        modify [];
#define BREAK break
#include "redef.h"
#endif

#if defined(ELINUX) || defined(EDJGPP)
// these GNU-based compilers support dynamic labels,
// so threading is much easier
#define thread() goto *((void *)*pc)
#define thread2() {pc += 2; goto *((void *)*pc);}
#define thread4() {pc += 4; goto *((void *)*pc);}
#define thread5() {pc += 5; goto *((void *)*pc);}
#define inc3pc() pc += 3
#define BREAK goto *((void *)*pc)
#endif

#endif  // threaded code

#pragma aux nop = \
        "nop" \
        modify[];

static int recover_rhs_subscript(object subscript, s1_ptr s)
/* rhs subscript failed initial check, but might be ok */
{
    int subscripti;
   
    if (IS_ATOM_INT(subscript)) {
        RangeReading(subscript, s->length);
    }
    else if (IS_ATOM_DBL(subscript)) {
        subscripti = (long)(DBL_PTR(subscript)->dbl);
        if ((unsigned long)(subscripti - 1) < s->length)
            return subscripti;
        else
            RangeReading(subscript, s->length);
    }
    else {
        /* SEQUENCE */
        RTFatal("subscript must be an atom\n(reading an element of a sequence)");
    }
    return 0; // not reached
}

static void wrong_arg_count(symtab_ptr sub, object a)
// report wrong arg count in call via routine id
{
    sprintf(TempBuff,
          "call to %s() via routine-id should pass %d argument%s, not %d",
          sub->name, sub->u.subp.num_args,
          (sub->u.subp.num_args == 1) ? "" :"s",
          ((s1_ptr)a)->length);
    RTFatal(TempBuff);
}

static int recover_lhs_subscript(object subscript, s1_ptr s)
/* lhs subscript failed initial check, but might be ok */
{
    int subscripti;
   
    if (IS_ATOM_INT(subscript)) {
        BadSubscript(subscript, s->length);
    }
    else if (IS_ATOM_DBL(subscript))  {
        subscripti = (long)(DBL_PTR(subscript)->dbl);
        if ((unsigned long)(subscripti - 1) < s->length)
            return subscripti;
        else
            BadSubscript(subscript, s->length);
    }
    else {
        /* SEQUENCE */
        SubsNotAtom();
    }
    return 0; // not reached
}

void InitStack(int size, int toplevel)
// called to create the initial call stack for a task
{
    stack_size = size;
    expr_stack = (object_ptr) EMalloc(stack_size * sizeof(object));
    expr_stack[toplevel] = TopLevelSub; 
    expr_top = &expr_stack[toplevel+1];  /* next available place on expr stack */
 
    /* must allow for a few extra words */
    expr_max = expr_stack + (stack_size - 5);
    expr_limit = expr_max - 3; // we only push two items per call
}

void InitExecute()
{
    // signal(SIGFPE, FPE_Handler)  // generate inf and nan instead
    signal(SIGINT, INT_Handler);
    // SIG_IGN=> still see ^C echoed, but it has no effect other
    // than messing up the screen. INT_Handler lets us do
    // a bit of cleanup - tick rate, profile, active page etc.

#ifndef EDOS      // doesn't work on DOS
#ifndef ERUNTIME  // dll shouldn't take handler away from main program
    signal(SIGILL,  Machine_Handler);
    signal(SIGSEGV, Machine_Handler);
#endif
#endif

    TraceOn = FALSE;
    ProfileOn = TRUE;
    TraceBeyond = HUGE_LINE;
   
    // Create Call Stack
    InitStack(EXPR_SIZE, 1);
   
    // create first task (task 0)
    InitTask();
    TopLevelSub->u.subp.resident_task = current_task;
}

void Execute(int *);

#ifndef INT_CODES
#if defined(ELINUX) || defined(EDJGPP)
int **jumptab; // initialized in do_exec()
#else
/* Important! The offset below is based on the object code WATCOM
 * generates for x.c. It is the address of the internal jump table
 * generated by the compiler for the main switch statement in x.c.
 * It needs to be kept up-to-date or nothing will work.
 */
#ifdef EXTRA_CHECK
// address of big switch table minus address of Execute(), divided by 4
int **jumptab = ((int **)Execute)+53;
#else
int **jumptab = ((int **)Execute)+4;
#endif

#endif
#endif //not INT_CODES


/* IL data passed from the front end */
struct IL fe;

#define SET_OPERAND(word) ((int *)(((word) == 0) ? 0 : (&fe.st[(int)(word)])))

#define SET_JUMP(word) ((int *)(&code[(int)(word)]))

void code_set_pointers(int **code)
/* adjust code pointers, changing some indexes into pointers */
{
    int len, i, j, n, sub, word;
   
    char msg[100];
   
    len = (int)code[0];
    i = 1;
    while (i <= len) {
        word = (int)code[i];
       
        if (word > MAX_OPCODE || word < 1) {
            sprintf(msg, "BAD IL OPCODE: i is %d, word is %d, len is %d",
                    i, word, len);
            RTFatal(msg);
        }
       
        code[i] = (int *)opcode(word);
       
        //sprintf(msg, "word is %d", word);
        //debug_msg(msg);
       
        switch (word) {
            case TYPE_CHECK:
            case CALL_BACK_RETURN:
            case BADRETURNF:
            case RETURNT:
            case CLEAR_SCREEN:
            case UPDATE_GLOBALS:
            case NOP1:
            case TASK_CLOCK_STOP:
            case TASK_CLOCK_START:
            case TASK_YIELD:
            case NOPWHILE:  // translator only
                // no operands follow
                i += 1;
                break;
           
            case GLOBAL_INIT_CHECK:
            case PRIVATE_INIT_CHECK:
            case INTEGER_CHECK:
            case ATOM_CHECK:
            case SEQUENCE_CHECK:
            case RETURNP:
            case DATE:
            case TIME:
            case SPACE_USED:
            case CALL:
            case CLOSE:
            case GET_KEY:
            case COMMAND_LINE:
            case TRACE:
            case PROFILE:
            case DISPLAY_VAR:
            case ERASE_PRIVATE_NAMES:
            case ERASE_SYMBOL:
            case ABORT:
            case PLATFORM: 
            case TASK_SELF:
            case TASK_SUSPEND:
            case TASK_LIST:
                // one operand
                code[i+1] = SET_OPERAND(code[i+1]);
                i += 2;
                break;

            case NOP2:
            case STARTLINE:
                i += 2;
                break;

            case ENDWHILE:
            case ELSE:
            case EXIT:
                code[i+1] = SET_JUMP(code[i+1]);
                i += 2;
                break;
               
            case NOT:
            case IS_AN_ATOM:
            case IS_A_SEQUENCE:
            case UMINUS:
            case GETS:
            case GETC:
            case SQRT:
            case LENGTH:
            case PLENGTH:
            case ARCTAN:
            case LOG:
            case SIN:
            case COS:
            case TAN:
            case RAND:
            case PEEK:
            case FLOOR:
            case ASSIGN_I:
            case ASSIGN:
            case IS_AN_INTEGER:
            case IS_AN_OBJECT:
            case NOT_BITS:
            case CALL_PROC:
            case RETURNF:
            case POSITION:
            case PEEK4S:
            case PEEK4U:
            case PIXEL:
            case GET_PIXEL:
            case SYSTEM:
            case PUTS:
            case QPRINT:
            case PRINT:
            case GETENV:
            case MACHINE_PROC:
            case POKE4:
            case POKE:
            case SC2_AND:
            case SC2_OR:
            case TASK_SCHEDULE:
            case TASK_STATUS:
                // 2 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                i += 3;
                break;

            case NOT_IFW:
            case IF:
            case WHILE:
                // 2 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_JUMP(code[i+2]);
                i += 3;
                break;

            case LESS:
            case GREATEREQ:
            case EQUALS:
            case NOTEQ:
            case LESSEQ:
            case GREATER:
            case AND:
            case OR:
            case MINUS:
            case PLUS:
            case MULTIPLY:
            case DIVIDE:
            case CONCAT:
            case REMAINDER:
            case POWER:
            case OR_BITS:
            case XOR_BITS:
            case APPEND:
            case REPEAT:
            case OPEN:
            case PREPEND:
            case COMPARE:
            case FIND:
            case MATCH:
            case XOR:
            case AND_BITS:
            case EQUAL:
            case RHS_SUBS:
            case RHS_SUBS_CHECK:
            case RHS_SUBS_I:
            case ASSIGN_OP_SUBS:
            case PASSIGN_OP_SUBS:
            case ASSIGN_SUBS:
            case ASSIGN_SUBS_CHECK:
            case ASSIGN_SUBS_I:
            case PASSIGN_SUBS:
            case PLUS1:
            case PLUS1_I:
            case RIGHT_BRACE_2:
            case PLUS_I:
            case MINUS_I:
            case DIV2:
            case FLOOR_DIV2:
            case FLOOR_DIV:
            case MEM_COPY:
            case MEM_SET:
            case SYSTEM_EXEC:
            case PRINTF:
            case SPRINTF:
            case MACHINE_FUNC:
            case CALL_FUNC:
            case C_PROC:
            case TASK_CREATE:
                // 3 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_OPERAND(code[i+3]);
                i += 4;
                break;

            case SC1_AND_IF:
            case SC1_OR_IF:
            case SC1_AND:
            case SC1_OR:
                // 3 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_JUMP(code[i+3]);
                i += 4;
                break;

            case LESS_IFW_I:
            case GREATEREQ_IFW_I:
            case EQUALS_IFW_I:
            case NOTEQ_IFW_I:
            case LESSEQ_IFW_I:
            case GREATER_IFW_I:
            case LESS_IFW:
            case GREATEREQ_IFW:
            case EQUALS_IFW:
            case NOTEQ_IFW:
            case LESSEQ_IFW:
            case GREATER_IFW:
                // 2 operands and a branch follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_JUMP(code[i+3]);
                i += 4;
                break;
               
            case ASSIGN_OP_SLICE:
            case PASSIGN_OP_SLICE:
            case ASSIGN_SLICE:
            case PASSIGN_SLICE:
            case RHS_SLICE:
            case LHS_SUBS:
            case LHS_SUBS1:
            case LHS_SUBS1_COPY:
            case C_FUNC:
            case FIND_FROM:
            case MATCH_FROM:
                // 4 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_OPERAND(code[i+3]);
                code[i+4] = SET_OPERAND(code[i+4]);
                i += 5;
                break;

            case ROUTINE_ID:
                // 5 operands follow - #2 and #4 are integers
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+3] = SET_OPERAND(code[i+3]);
                code[i+5] = SET_OPERAND(code[i+5]);
                i += 6;
                break;

            case ENDFOR_INT_UP1:
            case ENDFOR_INT_DOWN1:
            case ENDFOR_INT_UP:
            case ENDFOR_INT_DOWN:
            case ENDFOR_UP:
            case ENDFOR_DOWN:
            case ENDFOR_GENERAL:
                // 4 operands follow
                code[i+1] = SET_JUMP(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_OPERAND(code[i+3]);
                code[i+4] = SET_OPERAND(code[i+4]);
                i += 5;
                break;
               
            case FOR:
            case FOR_I:
                // 6 operands follow
                code[i+1] = SET_OPERAND(code[i+1]);
                code[i+2] = SET_OPERAND(code[i+2]);
                code[i+3] = SET_OPERAND(code[i+3]);
                code[i+4] = SET_OPERAND(code[i+4]);
                code[i+5] = SET_OPERAND(code[i+5]);
                code[i+6] = SET_JUMP(code[i+6]);
                i += 7;
                break;
               
        // special cases: variable number of operands
       
            case PROC:
                sub = (int)code[i+1];
                code[i+1] = SET_OPERAND(sub);
               
                // we must look at the symbol table to know
                // how many arguments follow, and whether the
                // routine being called is a function or not
                n = fe.st[sub].u.subp.num_args;
               
                for (j = 2; j <= n+1; j++) {
                    code[i+j] = SET_OPERAND(code[i+j]);
                }
               
                if (fe.st[sub].token != PROC) {
                    code[i+2+n] = SET_OPERAND(code[i+2+n]);
                    i += 1;
                }

                i += 2 + n;
                break;
               
            case RIGHT_BRACE_N:
                n = (int)code[i+1];
                for (j = 1; j <= n+1; j++) {
                    word = (int)code[i+1+j];
                    code[i+1+j] = SET_OPERAND(word);
                }
               
                // more
                i += n + 3;
                break;
               
            case CONCAT_N:
                n = (int)code[i+1];
                for (j = 1; j <= n; j++) {
                    word = (int)code[i+1+j];
                    code[i+1+j] = SET_OPERAND(word);
                }
                word = (int)code[i+n+2];
                code[i+n+2] = SET_OPERAND(word);
               
                i += n + 3;
                break;
               
            default:
                RTFatal("UNKNOWN IL OPCODE");
        }
    }
}

// Compressed format of Euphoria objects
//
// First byte:
//          0..248  // immediate small integer, -9 to 239
                    // since small negative integers -9..-1 might be common
#define I2B 249  // 2-byte signed integer follows
#define I3B 250  // 3-byte signed integer follows
#define I4B 251  // 4-byte signed integer follows
#define F4B 252  // 4-byte f.p. number follows
#define F8B 253  // 8-byte f.p. number follows
#define S1B 254  // sequence, 1-byte length follows, then elements
#define S4B 255  // sequence, 4-byte length follows, then elements

#define MIN1B (-2)
#define MIN2B (-0x00008000)
#define MIN3B (-0x00800000)
#define MIN4B (-0x80000000)

static unsigned char *string_ptr;

object decompress(unsigned int c)
// read a compressed Euphoria object
// if c is set, then c is not <= 248   
{
    s1_ptr s;
    object_ptr obj_ptr;
    unsigned int len, i;
    int x;
    double d;
   
    if (c == 0) {
        c = *string_ptr++;
        if (c < I2B) {
            return c + MIN1B;
        }
    }
   
    if (c == I2B) {
        i = (*string_ptr++);
        i = i + 256 * (*string_ptr++);
        return i + MIN2B;
    }
   
    else if (c == I3B) {
        i = *string_ptr++;
        i = i + 256 * (*string_ptr++);
        i = i + 65536 * (*string_ptr++);
        return i + MIN3B;
    }
   
    else if (c == I4B) {
        i = *(unsigned int *)string_ptr;
        string_ptr += 4;
        return i + MIN4B;
    }
   
    else if (c == F4B) {
        d = (double)*(float *)string_ptr;
        string_ptr += 4;
        return NewDouble(d);
    }
   
    else if (c == F8B) {
        d = *(double *)string_ptr;
        string_ptr += 8;
        return NewDouble(d);
    }
   
    else {
        // sequence
        if (c == S1B) {
            len = *string_ptr++;
        }
        else {
            len = *(unsigned int *)string_ptr;
            string_ptr += 4;
        }
        s = NewS1(len);
        obj_ptr = s->base;
        obj_ptr++;
        for (i = 1; i <= len; i++) {
            // inline small integer for greater speed on strings
            c = *string_ptr++;
            if (c < I2B) {
                *obj_ptr = c + MIN1B;
            }
            else {
                *obj_ptr = decompress(c);
            }
            obj_ptr++;
        }
        return MAKE_SEQ(s);
    }
}

void symtab_set_pointers()
/* set some symbol table fields to absolute pointers, rather than indexes */
{
    int i, len;
    struct symtab_entry *s;
    int **code;
   
    s = fe.st;
    len = *(int *)s;  // number of entries
   
    s++;  // point to first real entry
    for (i = 1; i <= len; i++) {
        s->next = (symtab_ptr)SET_OPERAND(s->next);
       
        if (s->mode == M_NORMAL) {
            // normal variables, routines
            s->obj = NOVALUE;

            if (s->token == PROC ||
                s->token == FUNC ||
                s->token == TYPE) {

                code = (int **)s->u.subp.code;
                if (code != NULL) {
                    code_set_pointers(code);
                }
                s->u.subp.code = (int *)code+1; // skip length
               
                s->u.subp.temps = (symtab_ptr)SET_OPERAND(s->u.subp.temps);
               
                s->u.subp.resident_task = -1;
                s->u.subp.saved_privates = NULL;
               
                if (s->name[0] == '_' && strcmp(s->name, "_toplevel_") == 0) {
                    TopLevelSub = s;
                }
            }
        }
        else if (s->mode == M_CONSTANT && s->obj) {
            // namespaces, literal values only - vars declared as "constant" are left as 0
            string_ptr = (unsigned char *)s->obj;
            s->obj = decompress(0);
        }
       
        else {
            // M_TEMP - temps
            // leave obj as 0
        }
        s++;
    }
}

struct sline *slist;

/* Front-end variables passed via miscellaneous fe.misc */
char **file_name;
extern int warning_count;
extern char **warning_list;
int max_stack_per_call;
int AnyTimeProfile;
int AnyStatementProfile;
int sample_size;
int gline_number;  /* last global line number in program */
int il_file;      /* we are processing a separate .il file */

void fe_set_pointers()
{
    symtab_set_pointers();

    slist = fe.sl;
   
    max_stack_per_call = fe.misc[0];
    AnyTimeProfile    = fe.misc[1];
    AnyStatementProfile= fe.misc[2];
    sample_size        = fe.misc[3];
   
#ifdef EDOS
    if (sample_size > 0) {
        profile_sample = (int *)EMalloc(sample_size * sizeof(int));
        lock_region(profile_sample, sample_size * sizeof(int));
        tick_rate(100);
    }
#endif 
    gline_number = fe.misc[4];
    il_file      = fe.misc[5];
   
    warning_count = fe.misc[6];
    file_name = (char **)&fe.misc[7];
    file_name_entered = (char *)fe.misc[8+fe.misc[7]];
    warning_list = (char **)&fe.misc[9+fe.misc[7]];
   
    // string containing all literals and constants in compressed form:
    free(fe.lit);
}

static object *save_private_block(symtab_ptr routine)
// Save block for resident task on the private list for this routine.
// Save in last-in, first-out order.
// We use a linked list. The data is filled in by the caller after the call.
{ 
    struct private_block *entry;
    int size, task;
   
    size = routine->u.subp.stack_space;
    task = routine->u.subp.resident_task;
    entry = (struct private_block *)
            EMalloc(sizeof(struct private_block) + size * sizeof(object));
   
    entry->task_number = task;
   
    // insert block at front of list
    entry->next = routine->u.subp.saved_privates;
    routine->u.subp.saved_privates = entry;
   
    return (object *)&(entry->block); //private data will be filled in by caller
}


static load_private_block(symtab_ptr routine, int task)
// Retrieve a private block and remove it from the list for this routine.
// We know that the block will be there, often near the start of the list.
{ 
    struct private_block *p;
    struct private_block *prev_p;
    struct private_block *defunct;
    object *block;
    symtab_ptr sym;
   
    p = routine->u.subp.saved_privates; // won't be NULL
    prev_p = NULL;
   
    while (TRUE) {
        if (p->task_number == task) {
            block = (object *)&(p->block);
           
            // unlink it
            if (prev_p == NULL) {
                routine->u.subp.saved_privates = p->next;
            }
            else {   
                prev_p->next = p->next;
            }

            // N.B. must read temps and privates *before* freeing p
           
            // private vars
            sym = routine->next;
            while (sym != NULL && sym->scope <= S_PRIVATE) {
                sym->obj = *block++;
                sym = sym->next;
            }
           
            // temps
            sym = routine->u.subp.temps;
            while (sym != NULL) {
                sym->obj = *block++;
                sym = sym->next;
            }
           
            EFree(p);
            return;
        }
        prev_p = p;
        p = p->next;
    }
}

void restore_privates(symtab_ptr this_routine)
// kick out the current private data and
// restore the private data for the current task
{ 
    symtab_ptr sym;
    object *block;
   
    if (this_routine != NULL &&
        this_routine->u.subp.resident_task != current_task) {
        // get new private data
       
        if (this_routine->u.subp.resident_task != -1) {
            // calling routine was taken over by another task
           
            // save the other task's private data
            block = save_private_block(this_routine);
           
            // private vars
            sym = this_routine->next;
            while (sym != NULL && sym->scope <= S_PRIVATE) {
                *block++ = sym->obj;
                sym = sym->next;
            }
       
            // temps
            sym = this_routine->u.subp.temps;
            while (sym != NULL) {
                *block++ = sym->obj;
                sym = sym->next;
            }
        }
       
        // restore the current task's private data (will always be there)

        load_private_block(this_routine, current_task);

        this_routine->u.subp.resident_task = current_task;
    }
}

void Execute(int *start_index)
/* top level executor */
/* CAREFUL: any change to this routine might affect the offset to
  the big opccode switch table - see jumptab */
{
    do_exec(start_index);
       
    Executing = FALSE;
}

#ifndef INT_CODES
#if defined(ELINUX) || defined(EDJGPP)
// don't use switch/case - use special jump to label feature
#define case
#endif
#endif //not INT_CODES


void do_exec(int *start_pc)
/* execute code, starting at start_pc */
{
    /* WATCOM keeps pc in a register, and usually top, a, obj_ptr */

    /* address registers: (3 max) */
    register int *pc;              /* program counter, kept in a register */
    register object_ptr obj_ptr;    /* general pointer to an object */

    /* data registers: (5 max) */
    register object a;            /* another object */
    volatile object v;            /* get compiler to do the right thing! */
    register object top;          /* an object - hopefully kept in a register */
    /*register*/ int i;          /* loop counter */
   
    double temp_dbl;
    struct d temp_d;
    unsigned char *poke_addr;
    void (*sub_addr)();
    int nvars; 
    int *iptr;
    int file_no;
    int going_up;
    object_ptr result_ptr;
    object result_val;
    int cf;
    opcode_type *patch;
    object b, c;
    symtab_ptr sym, sub, caller;
    int c0;
    s1_ptr s1;
    object *block;
   
#if defined(ELINUX) || defined(EDJGPP)
#ifndef INT_CODES
    static void *localjumptab[MAX_OPCODE] = {
  &&L_LESS, &&L_GREATEREQ, &&L_EQUALS, &&L_NOTEQ, &&L_LESSEQ, &&L_GREATER,
  &&L_NOT, &&L_AND, &&L_OR, &&L_MINUS,
/* 10 */ 
  &&L_PLUS, &&L_UMINUS, &&L_MULTIPLY, &&L_DIVIDE, &&L_CONCAT, &&L_ASSIGN_SUBS,
  &&L_GETS, &&L_ASSIGN, &&L_PRINT, &&L_IF,
/* 20 */ 
  &&L_FOR, &&L_ENDWHILE, &&L_ELSE, &&L_OR_BITS, &&L_RHS_SUBS, &&L_XOR_BITS,
  &&L_PROC, &&L_RETURNF, &&L_RETURNP, &&L_PRIVATE_INIT_CHECK,
/* 30 */ 
  &&L_RIGHT_BRACE_N, &&L_REPEAT, &&L_GETC, &&L_RETURNT, &&L_APPEND,
  &&L_QPRINT, &&L_OPEN, &&L_PRINTF, &&L_ENDFOR_GENERAL, &&L_IS_AN_OBJECT,
/* 40 */ 
  &&L_SQRT, &&L_LENGTH, &&L_BADRETURNF, &&L_PUTS, &&L_ASSIGN_SLICE,
  &&L_RHS_SLICE, &&L_WHILE, &&L_ENDFOR_INT_UP, &&L_ENDFOR_UP, &&L_ENDFOR_DOWN,
/* 50 */ 
  &&L_NOT_BITS, &&L_ENDFOR_INT_DOWN, &&L_SPRINTF, &&L_ENDFOR_INT_UP1,
  &&L_ENDFOR_INT_DOWN1, &&L_AND_BITS, &&L_PREPEND, &&L_STARTLINE,
  &&L_CLEAR_SCREEN, &&L_POSITION,
/* 60 */ 
  &&L_EXIT, &&L_RAND, &&L_FLOOR_DIV, &&L_TRACE, &&L_TYPE_CHECK,
  &&L_FLOOR_DIV2, &&L_IS_AN_ATOM, &&L_IS_A_SEQUENCE, &&L_DATE, &&L_TIME,
/* 70 */ 
  &&L_REMAINDER, &&L_POWER, &&L_ARCTAN, &&L_LOG, NULL, &&L_COMPARE,
  &&L_FIND, &&L_MATCH, &&L_GET_KEY, &&L_SIN,
/* 80 */ 
  &&L_COS, &&L_TAN, &&L_FLOOR, &&L_ASSIGN_SUBS_CHECK, &&L_RIGHT_BRACE_2,
  &&L_CLOSE, &&L_DISPLAY_VAR, &&L_ERASE_PRIVATE_NAMES, &&L_UPDATE_GLOBALS,
  &&L_ERASE_SYMBOL,
/* 90 */ 
  &&L_GETENV, &&L_RHS_SUBS_CHECK, &&L_PLUS1, &&L_IS_AN_INTEGER,
  &&L_LHS_SUBS, &&L_INTEGER_CHECK, &&L_SEQUENCE_CHECK, &&L_DIV2,
  &&L_SYSTEM, &&L_COMMAND_LINE,
/* 100 */ 
  &&L_ATOM_CHECK, &&L_LESS_IFW, &&L_GREATEREQ_IFW, &&L_EQUALS_IFW,
  &&L_NOTEQ_IFW, &&L_LESSEQ_IFW, &&L_GREATER_IFW, &&L_NOT_IFW,
  &&L_GLOBAL_INIT_CHECK, &&L_NOP2,
/* 110 */ 
  &&L_MACHINE_FUNC, &&L_MACHINE_PROC, &&L_ASSIGN_I, &&L_RHS_SUBS_I,
  &&L_PLUS_I, &&L_MINUS_I, &&L_PLUS1_I, &&L_ASSIGN_SUBS_I, &&L_LESS_IFW_I,
  &&L_GREATEREQ_IFW_I,
/* 120 */ 
  &&L_EQUALS_IFW_I, &&L_NOTEQ_IFW_I, &&L_LESSEQ_IFW_I, &&L_GREATER_IFW_I,
  &&L_FOR_I, &&L_ABORT, &&L_PEEK, &&L_POKE, &&L_CALL, &&L_PIXEL,
/* 130 */ 
  &&L_GET_PIXEL, &&L_MEM_COPY, &&L_MEM_SET, &&L_C_PROC, &&L_C_FUNC,
  &&L_ROUTINE_ID, &&L_CALL_BACK_RETURN, &&L_CALL_PROC, &&L_CALL_FUNC,
  &&L_POKE4,
/* 140 */ 
  &&L_PEEK4S, &&L_PEEK4U, &&L_SC1_AND, &&L_SC2_AND, &&L_SC1_OR,
  &&L_SC2_OR, NULL, &&L_SC1_AND_IF, &&L_SC1_OR_IF, NULL,
/* 150 */ 
  &&L_ASSIGN_OP_SUBS, &&L_ASSIGN_OP_SLICE, &&L_PROFILE, &&L_XOR, &&L_EQUAL,
  &&L_SYSTEM_EXEC,
  &&L_PLATFORM /* PLATFORM not always emitted*/,
  NULL /* END_PARAM_CHECK not emitted */,
  &&L_CONCAT_N,
  NULL, /* L_NOPWHILE not emitted */
  NULL, /* L_NOP1 not emitted */
  &&L_PLENGTH,
  &&L_LHS_SUBS1,
  &&L_PASSIGN_SUBS, &&L_PASSIGN_SLICE, &&L_PASSIGN_OP_SUBS,
  &&L_PASSIGN_OP_SLICE,
  &&L_LHS_SUBS1_COPY, &&L_TASK_CREATE, &&L_TASK_SCHEDULE, &&L_TASK_YIELD,
  &&L_TASK_SELF, &&L_TASK_SUSPEND, &&L_TASK_LIST,
  &&L_TASK_STATUS, &&L_TASK_CLOCK_STOP,
/* 178 */ &&L_TASK_CLOCK_START, &&L_FIND_FROM, &&L_MATCH_FROM
  };
#endif
#endif
    if (start_pc == NULL) {
#if defined(ELINUX) || defined(EDJGPP)
#ifndef INT_CODES
        jumptab = (int **)localjumptab;
#endif
#endif
        return;
    }

    /* Initialize run-time data structures: */
    result_ptr = NULL;
    cf = FALSE;
    tpc = start_pc;
    pc = tpc;

    Executing = TRUE;

    do {
#ifdef INT_CODES
      loop_top:

        if (*pc < 1 || *pc > MAX_OPCODE) {
            tpc = pc;
            sprintf(TempBuff, "Runtime bad opcode (%d) at %lx", *pc, pc);
            RTFatal(TempBuff);
        }
       
        //{
        //char dm[100];
        //sprintf(dm, "%d: %s", *pc, opnames[*pc]);
        //debug_msg(dm);
        //}
       
        switch(*pc) {
#else
// threaded code
        thread();
#if !defined(ELINUX) && !defined(EDJGPP)
        switch((int)pc) {                                     
#endif

#endif
            case L_RHS_SUBS_CHECK:
                if (!IS_SEQUENCE(*(object_ptr)pc[1])) {
                    goto subsfail;
                }
                /* FALL THROUGH */
            case L_RHS_SUBS: /* rhs subscript of a sequence */
                top = *(object_ptr)pc[2];  /* the subscript */
                obj_ptr = (object_ptr)SEQ_PTR(*(object_ptr)pc[1]);/* the sequence */
                if ((unsigned long)(top-1) >= ((s1_ptr)obj_ptr)->length) {
                    tpc = pc;
                    top = recover_rhs_subscript(top, (s1_ptr)obj_ptr);
                }
                top = (object)*(top + ((s1_ptr)obj_ptr)->base);
                a = pc[3];
                pc += 4;
                if (IS_ATOM_INT(top)) {
                    if (IS_ATOM_INT_NV(*(object_ptr)a)) {
                        *(object_ptr)a = top;
                        thread();
                        BREAK;
                    }
                    else {
                        DeRefDSx(*(object_ptr)a);
                        *(object_ptr)a = top;
                        thread();
                        BREAK;
                    }
                }
                else {
                    RefDS(top);
                    DeRefx(*(object_ptr)a);
                    *(object_ptr)a = top;
                    thread();
                    BREAK;
                }

            case L_RHS_SUBS_I: /* rhs subscript of a known-to-be sequence */
                /* the target is an integer variable - no DeRef,
                  TypeCheck failure if assigned non-integer */
                top = *(object_ptr)pc[2];  /* the subscript */
                obj_ptr = (object_ptr)SEQ_PTR(*(object_ptr)pc[1]);/* the sequence */
                if ((unsigned long)(top-1) >= ((s1_ptr)obj_ptr)->length) {
                    /* possibly bad subscript */
                    tpc = pc;
                    top = recover_rhs_subscript(top, (s1_ptr)obj_ptr);
                } 
                top = (object)*(top + ((s1_ptr)obj_ptr)->base);
                a = pc[3];
                pc += 4;
                *(object_ptr)a = top;
                if (IS_ATOM_INT(top)) {
                    thread();
                    BREAK;
                }
                else {
                    if (IS_ATOM_DBL(top)) {
                        tpc = pc;
                        top = DoubleToInt(top);
                        if (IS_ATOM_INT(top)) {
                            *(object_ptr)a = top;
                            BREAK;
                        }
                    }
                    RTFatalType(pc-1);
                    BREAK;
                }
       
            case L_PASSIGN_OP_SUBS:
                // temp has pointer to sequence
                top = **(object_ptr *)pc[1];
                goto aos;
                               
            case L_ASSIGN_OP_SUBS:  /* var[subs] op= expr */
                top = *(object_ptr)pc[1];
              aos: 
                if (!IS_SEQUENCE(top)) {  //optimize better
                    goto subsfail;
                }
                obj_ptr = (object_ptr)SEQ_PTR(top);/* the sequence */
                top = *(object_ptr)pc[2];  /* the subscript */
                pc[9] = pc[1]; // store in ASSIGN_SUBS op after length-4 binop
                if ((unsigned long)(top-1) >= ((s1_ptr)obj_ptr)->length) {
                    /* possibly bad subscript */
                    tpc = pc;
                    top = recover_rhs_subscript(top, (s1_ptr)obj_ptr);
                }
                top = (object)*(top + ((s1_ptr)obj_ptr)->base);
                a = pc[3];
                pc += 4;
                if (IS_ATOM_INT(top)) {
                    if (IS_ATOM_INT_NV(*(object_ptr)a)) {
                        *(object_ptr)a = top;
                        thread();
                        BREAK;
                    }
                    else {
                        DeRefDSx(*(object_ptr)a);
                        *(object_ptr)a = top;
                        thread();
                        BREAK;
                    }
                }
                else {
                    RefDS(top);
                    DeRefx(*(object_ptr)a);
                    *(object_ptr)a = top;
                    thread();
                    BREAK;
                }
               
            case L_PASSIGN_SUBS:
                // temp has pointer to sequence
                top = *(object_ptr)pc[3];  /* the rhs value */
                Ref(top); /* do before UNIQUE check - avoids circularity */
                obj_ptr = (object_ptr)SEQ_PTR(**(object_ptr **)pc[1]);
                if (!UNIQUE(obj_ptr)) {
                    /* make it single-ref */
                    tpc = pc;
                    obj_ptr = (object_ptr)SequenceCopy((s1_ptr)obj_ptr);
                    **(object_ptr *)pc[1] = MAKE_SEQ(obj_ptr);
                } 
                *(object_ptr)pc[1] = 0; // to preclude DeRef of C pointer
                goto as;
               
            case L_ASSIGN_SUBS_CHECK:
                if (!IS_SEQUENCE(*(object_ptr)pc[1])) {
                    goto asubsfail;
                }
                /* FALL THROUGH */
           
            case L_ASSIGN_SUBS:  /* final subscript and assignment */
                /* the var sequence */
                top = *(object_ptr)pc[3];  /* the rhs value */
                Ref(top); /* do before UNIQUE check - avoids circularity */
                obj_ptr = (object_ptr)SEQ_PTR(*(object_ptr *)pc[1]);
                if (!UNIQUE(obj_ptr)) {
                    /* make it single-ref */
                    tpc = pc;
                    obj_ptr = (object_ptr)SequenceCopy((s1_ptr)obj_ptr);
                    *(object_ptr)pc[1] = MAKE_SEQ(obj_ptr);
                } 
              as: 
                a = *(object_ptr)pc[2]; /* the subscript */
                if ((unsigned long)(a-1) >= ((s1_ptr)obj_ptr)->length) {
                    /* subscript out of bounds (or it's a double) */
                    tpc = pc;
                    a = recover_lhs_subscript(a, (s1_ptr)obj_ptr);
                } 
                obj_ptr = a + ((s1_ptr)obj_ptr)->base;
                a = *obj_ptr;
                *obj_ptr = top;
                pc += 4;
                if (IS_ATOM_INT_NV(a)) {
                    thread();
                    BREAK;
                }
                else {
                    DeRefDSx(a);
                    thread();
                    BREAK;
                }

            case L_ASSIGN_SUBS_I:  /* final subscript and assignment */
                /* we know that the rhs value to be assigned is an integer */
                obj_ptr = (object_ptr)SEQ_PTR(*(object_ptr *)pc[1]);/* the sequence */
                if (!UNIQUE(obj_ptr)) {
                    /* make it single-ref */
                    tpc = pc;
                    obj_ptr = (object_ptr)SequenceCopy((s1_ptr)obj_ptr);
                    *(object_ptr)pc[1] = MAKE_SEQ(obj_ptr);
                }
                top = *(object_ptr)pc[2]; /* the subscript */
                if ((unsigned long)(top-1) >= ((s1_ptr)obj_ptr)->length) {
                    /* subscript out of bounds (or it's a double) */
                    tpc = pc;
                    top = recover_lhs_subscript(top, (s1_ptr)obj_ptr);
                }
                obj_ptr = top + ((s1_ptr)obj_ptr)->base;
                top = *obj_ptr;  // the previous value
                pc += 4;
                *obj_ptr = *(object_ptr)pc[-1]; // the RHS value
                if (IS_ATOM_INT_NV(top)) {
                    thread();
                    BREAK;
                }
                else {
                    DeRefDSx(top);
                    thread();
                    BREAK;
                }

            case L_ENDFOR_INT_UP1:
                obj_ptr = (object_ptr)pc[3]; /* loop var */
                top = *obj_ptr + 1;
                if (top <= *(object_ptr)pc[2]) {  /* limit */
                    *obj_ptr = top;
                    pc = (int *)pc[1];  /* loop again */
                    thread();
                }
                else {
                    thread5();  /* exit loop */
                }
                BREAK;

            case L_ENDFOR_INT_UP:
                obj_ptr = (object_ptr)pc[3]; /* loop var */
                top = *obj_ptr + *(object_ptr)pc[4]; /* increment */
                if (top <= *(object_ptr)pc[2]) { /* limit */
                    *obj_ptr = top;
                    pc = (int *)pc[1]; /* loop again */
                    thread();
                }
                else {
                    thread5();  /* exit loop */
                }
                BREAK;


            case L_EXIT:
            case L_ENDWHILE:
            case L_ELSE:
                pc = (int *)pc[1];
                thread();
                BREAK;

            case L_PLUS1:
                a = (object)pc[3];
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    top++;
                    if (top > MAXINT) {
                        b = top;
                        top = NewDouble((double)(INT_VAL(b)));
                    }
                    if (IS_ATOM_INT_NV(*(object_ptr)a)) {
                        *(object_ptr)a = top;
                        thread4(); /* common case */
                    }
                }
                else {
                    tpc = pc;
                    top = binary_op(PLUS, ATOM_1, top);
                }
                DeRefx(*(object_ptr)a);
                *(object_ptr)a = top;
                thread4();
                BREAK;

            case L_PLUS1_I:
                /* target must be integer var - type check */
                top = *(object_ptr)pc[1];
                a = (object)pc[3];
                pc += 4;
                if (IS_ATOM_INT(top)) {
                    top++;
                    if (top <= MAXINT) {
                        *(object_ptr)a = top;
                        thread();  /* common case */
                        BREAK;
                    }
                    b = top;
                    tpc = pc - 4;
                    *(object_ptr)a = NewDouble((double)(INT_VAL(b)));
                }
                else {
                    tpc = pc - 4;
                    top = binary_op(PLUS, ATOM_1, top);
                    if (IS_ATOM_DBL(top)) {
                        b = DoubleToInt(top);
                        if (IS_ATOM_INT(b)) {
                            DeRefDS(top);
                            *(object_ptr)a = b;
                            BREAK;
                        }
                    }
                    *(object_ptr)a = top;
                }
                RTFatalType(pc-1); /* point at dest var */
                BREAK;

            case L_WHILE:
                top = *(object_ptr)pc[1];
                if (top >= ATOM_1) {  /* works with new representation */
                    inc3pc();
                    thread();
                    pc++; /* dummy */
                    BREAK;
                }
                goto if_check;
         
            case L_IF:
                top = *(object_ptr)pc[1];
            if_check:
                if (top == ATOM_0) {
                    pc = (int *)pc[2];
                    thread();
                    pc++; /* DUMMY ! */
                }
                else if (IS_ATOM_INT(top)) {
                    inc3pc();
                    thread();
                    pc += 9; /* DUMMY ! */
                }
                else {
                    if (IS_SEQUENCE(top)) {
                        tpc = pc;
                        atom_condition();
                    }
                    if (DBL_PTR(top)->dbl == 0.0) {
                        pc = (int *)pc[2];
                    }
                    else
                        inc3pc();
                    thread();
                }
                BREAK;

            case L_ASSIGN_I:
                /* source & destination are known to be integers */
                *(object_ptr)pc[2] = *(object_ptr)pc[1];
                inc3pc();
                thread();
                BREAK;

            case L_ASSIGN:
                obj_ptr = (object_ptr)pc[2];
                top = *obj_ptr;
                *obj_ptr = *(object_ptr)pc[1];
                Ref(*obj_ptr);
                if (IS_ATOM_INT_NV(top)) {
                    inc3pc();
                    thread();
                    BREAK;
                }
                else {         
                    DeRefDSx(top);
                    inc3pc();
                    thread();
                    BREAK;
                }
             
            case L_LHS_SUBS:
                // temp contains a pointer to the sequence
                obj_ptr = (object_ptr)*(object_ptr)pc[1];
                b = 0;
                goto ls;

            case L_LHS_SUBS1_COPY:
                // copy base sequence into a temp, then use the temp
                obj_ptr = (object_ptr)pc[4];
                a = *(object_ptr)pc[1];
                Ref(a);
                DeRef(*obj_ptr);
                *obj_ptr = a;
                b = 1;
                goto ls;
               
            case L_LHS_SUBS1: 
                /* left hand side, first subscript of multiple lhs subscripts */
                // sequence var:
                obj_ptr = (object_ptr)pc[1];
                b = 1;
              ls: 
                // subscript:
                a = *(object_ptr)pc[2];
                top = *obj_ptr;
                if (!IS_SEQUENCE(top)) {
                    goto asubsfail;
                }
                top = (object)SEQ_PTR(top);
                if (!UNIQUE(top)) {
                    tpc = pc;
                    top = (object)SequenceCopy((s1_ptr)top);
                    *obj_ptr = MAKE_SEQ(top);
                }
                obj_ptr = (object_ptr)top;
                if ((unsigned long)(a-1) >= ((s1_ptr)obj_ptr)->length) {
                    tpc = pc;
                    a = recover_lhs_subscript(a, (s1_ptr)obj_ptr);
                }
                obj_ptr = a + ((s1_ptr)obj_ptr)->base;
               
                // error-check for sequence
                if (IS_SEQUENCE(*obj_ptr)) {
                    top = pc[3]; // target temp
                    if (b) {
                        DeRef(*(object_ptr)top); // only SUBS1
                    }
                    *((object_ptr)top) = (object)obj_ptr; // storing a C pointer
                    thread5();
                }
                goto asubsfail;
                BREAK;

            case L_PASSIGN_OP_SLICE:
                // temp has pointer to sequence
                top = *(object_ptr)pc[1];
                goto aosl;
               
            case L_ASSIGN_OP_SLICE:  /* var[i..j] op= expr */
                top = pc[1];
            aosl: 
                pc[10] = pc[1];
                rhs_slice_target = (object_ptr)pc[4];
                tpc = pc;
                RHS_Slice((s1_ptr)*(object_ptr)top,
                          *(object_ptr)pc[2],
                          *(object_ptr)pc[3]);
                thread5();
                BREAK;
           
            case L_PASSIGN_SLICE:
                // temp contains pointer to sequence
                assign_slice_seq = (s1_ptr *)*(object_ptr)pc[1];
                *(object_ptr)pc[1] = 0; // preclude DeRef of C pointer
                goto las;
               
            case L_ASSIGN_SLICE: /* var[i..j] = expr */
                assign_slice_seq = (s1_ptr *)pc[1]; /* extra parameter */
              las: 
                tpc = pc;
                AssignSlice(*(object_ptr)pc[2],
                            *(object_ptr)pc[3],  /* 3 args max for good code */
                            (s1_ptr)*(object_ptr)pc[4]);
                thread5();
                BREAK;
           
            case L_RHS_SLICE: /* rhs slice of a sequence a[i..j] */
                tpc = pc;
                rhs_slice_target = (object_ptr)pc[4];
                RHS_Slice((s1_ptr)*(object_ptr)pc[1],
                          *(object_ptr)pc[2],
                          *(object_ptr)pc[3]);
                thread5();
                BREAK;

            case L_RIGHT_BRACE_N: /* form a sequence of any length */
                nvars = pc[1];
                pc += 2;
                tpc = pc;
                s1 = NewS1((long)nvars);
                obj_ptr = s1->base + nvars;
                for (a = 1; a <= nvars; a++) {
                    /* the last one comes first */
                    *obj_ptr = *((object_ptr)pc[0]);
                    Ref(*obj_ptr);
                    pc++;
                    obj_ptr--;
                }
                DeRef(*(object_ptr)pc[0]); 
                *(object_ptr)pc[0] = MAKE_SEQ(s1);
                pc++;
                thread();
                BREAK;

            case L_RIGHT_BRACE_2: /* form a sequence of length 2 */
                tpc = pc;
                s1 = NewS1((long)2);
                obj_ptr = s1->base;
                /* the second one comes first */
                obj_ptr[1] = *((object_ptr)pc[2]);
                Ref(obj_ptr[1]);
                obj_ptr[2] = *((object_ptr)pc[1]);
                Ref(obj_ptr[2]);
                DeRef(*(object_ptr)pc[3]); 
                *(object_ptr)pc[3] = MAKE_SEQ(s1);
                pc += 4;
                thread();
                BREAK;

            case L_TYPE_CHECK: /* top has TRUE/FALSE */
                /* type check for a user-defined type */
                /* this always follows a type-call */
                top = *(object_ptr)pc[-1];
                pc += 1;
                if (top == ATOM_1) {
                    thread();
                    BREAK;  /* usual case L_*/
                }
                else if (IS_ATOM_INT(top)) {
                    if (top == ATOM_0)
                        RTFatalType(pc-3);
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl == 0.0)
                        RTFatalType(pc-3);
                }
                else  {/* sequence */
                    type_error_msg =
                        "\ntype_check failure (type returned a sequence!), ";
                    RTFatalType(pc-3);
                }
                BREAK;

            case L_NOP2:
                thread2();
                BREAK;
           
            case L_GLOBAL_INIT_CHECK:
                pc += 2;
                if (*(object_ptr)pc[-1] != NOVALUE) {
                    *(pc - 2) = (int)opcode(NOP2);
                    thread();
                    BREAK;
                }
                tpc = pc;
                NoValue((symtab_ptr)pc[-1]);
                BREAK;

            case L_PRIVATE_INIT_CHECK:
                pc += 2;
                if (*(object_ptr)pc[-1] != NOVALUE) {
                    thread();
                    BREAK;
                }
                tpc = pc;
                NoValue((symtab_ptr)pc[-1]);
                BREAK;

            case L_INTEGER_CHECK:
                top = *(object_ptr)pc[1];
                pc += 2;
                if (IS_ATOM_INT(top)) {
                    thread();
                    BREAK;
                }
                else if (IS_ATOM_DBL(top)) {
                    tpc = pc;
                    a = DoubleToInt(top);
                    if (IS_ATOM_INT(a)) {
                        DeRefDS(top);
                        *(object_ptr)pc[-1] = a;
                        BREAK;
                    }
                }
                RTFatalType(pc-1);
                BREAK;

            case L_ATOM_CHECK:
                pc += 2;
                if (IS_ATOM(*(object_ptr)pc[-1])) {
                    thread();
                    BREAK;
                }
                RTFatalType(pc-1);
                BREAK;

            case L_SEQUENCE_CHECK:
                pc += 2;
                if (IS_SEQUENCE(*(object_ptr)pc[-1])) {
                    thread();
                    BREAK;
                }
                RTFatalType(pc-1);
                BREAK;

            case L_IS_AN_INTEGER:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top))
                    top = ATOM_1;
                else if (IS_ATOM_DBL(top)) {
                    tpc = pc;
                    top = DoubleToInt(top);
                    if (IS_ATOM_INT(top))
                        top = ATOM_1;
                    else
                        top = ATOM_0;
                }
                else {
                    top = ATOM_0;
                }
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;

            case L_IS_AN_ATOM:
                top = *(object_ptr)pc[1];
                if (IS_ATOM(top))
                    top = ATOM_1;
                else
                    top = ATOM_0;
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;
               
            case L_IS_A_SEQUENCE:
                top = *(object_ptr)pc[1];
                if (IS_SEQUENCE(top))
                    top = ATOM_1;
                else
                    top = ATOM_0;
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                BREAK;
           
            case L_IS_AN_OBJECT:
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = ATOM_1;
                inc3pc();
                BREAK;

            case L_PLENGTH:
                /* *pc[1] contains a pointer to the sequence */
                top = (object)**(object_ptr **)pc[1];
                goto len;

            case L_LENGTH:
                /* *pc[1] is a sequence */
                top = *(object_ptr)pc[1];
              len: 
                if (IS_SEQUENCE(top)) {
                    top = SEQ_PTR(top)->length;
                    obj_ptr = (object_ptr)pc[2];
                    DeRefx(*obj_ptr);
                    *obj_ptr = top;
                    inc3pc();
                    thread();
                }
                else {
                    tpc = pc;
                    RTFatal("length of an atom is not defined");
                }
                BREAK;

                /* ---------- start of unary ops ----------------- */

            case L_SQRT:
                a = SQRT;
                goto unary;
            case L_SIN:
                a = SIN;
                goto unary;
            case L_COS:
                a = COS;
                goto unary;
            case L_TAN:
                a = TAN;
                goto unary;
            case L_ARCTAN:
                a = ARCTAN;
                goto unary;
            case L_LOG:
                a = LOG;
                goto unary;
            case L_NOT_BITS:
                a = NOT_BITS;
                goto unary;
           
            case L_FLOOR:
                top = *(object_ptr)pc[1];
                if (!IS_ATOM_INT(top)) {
                    tpc = pc;
                    top = unary_op(FLOOR, top);
                }
                DeRef(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;
           
            unary:
                top = *(object_ptr)pc[1];
                tpc = pc;
                if (IS_ATOM_INT(top))
                    top = (*optable[a].intfn)(INT_VAL(top));
                else
                    top = unary_op(a, top);
                DeRef(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;

            case L_NOT:         
                START_UNARY_OP
                if (top == ATOM_0)
                    top++;
                else
                    top = ATOM_0;
                END_UNARY_OP(NOT)
                thread();
                BREAK;

            case L_NOT_IFW:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    if (top == ATOM_0) {
                        inc3pc();
                        thread();
                        pc++; /* dummy */
                        BREAK;
                    }
                    else {
                        pc = (int *)pc[2];
                        thread();
                        BREAK;
                    }
                }
                else {
                    tpc = pc;
                    top = unary_op(NOT, top);
                    goto if_check;
                }
                BREAK;

            case L_UMINUS:
                START_UNARY_OP
                if (top == MININT) {
                    tpc = pc;
                    top = (object)NewDouble((double)-MININT_VAL);
                }
                else
                    top = -top;
                END_UNARY_OP(UMINUS)
                thread();
                BREAK;

            case L_RAND:
                START_UNARY_OP
                tpc = pc;
                if (INT_VAL(top) <= 0) {
                    RTFatal("argument to rand() must be >= 1");
                }
                top = MAKE_INT((good_rand() % ((unsigned)INT_VAL(top))) + 1);
                END_UNARY_OP(RAND)
                thread();
                BREAK;


                /* --------- start of binary ops ----------*/
            case L_PLUS:   
                START_BIN_OP
                    /* INT:INT case */
                    top = INT_VAL(a) + INT_VAL(top);
                    // mwl: gcc 4.1 doesn't do this right unless you do the unsigned casts:
                    if ((long)((unsigned long)top + (unsigned long)HIGH_BITS) >= 0) {
                        goto dblplus;
                    }
                contplus:
                    STORE_TOP_I
                }
                else {
                    /* non INT:INT cases */
                    tpc = pc;
                    if (IS_ATOM_INT(a) && IS_ATOM_DBL(top)) {
                        v = a;
                        temp_d.dbl = (double)INT_VAL(v);
                        top = Dadd(&temp_d, DBL_PTR(top));
                        goto aresult;
                    }
                    else if (IS_ATOM_DBL(a)) { // true if a is INT - careful!
                        if (IS_ATOM_INT(top)) {
                            v = top;
                            temp_d.dbl = (double)INT_VAL(v);
                            top = Dadd(DBL_PTR(a), &temp_d);
                            goto aresult;
                        }
                        else if (IS_ATOM_DBL(top)) {
                            top = Dadd(DBL_PTR(a), DBL_PTR(top));
                            goto aresult;
                        }
                    }
                    /* a is a sequence */
                    top = binary_op(PLUS, a, top);

                aresult:
                    /* store result and DeRef */
                    a = *obj_ptr;
                    *obj_ptr = top;
                    pc += 4;
                    if (IS_ATOM_INT_NV(a))
                        thread();
                   
                    else { 
                        DeRefDS(a); 
                    }
                }   
                BREAK;

            case L_PLUS_I:   
                /* we know that the inputs and the output must be integers */
                START_BIN_OP_I
                top = INT_VAL(a) + INT_VAL(top);
                if ((long)((unsigned long)top + (unsigned long)HIGH_BITS) >= 0) {
                    goto dblplus_i;
                }
            contplus_i: 
                END_BIN_OP_I
                BREAK;

            case L_MINUS:
                START_BIN_OP
                    /* INT:INT case L_*/
                    top = INT_VAL(a) - INT_VAL(top);
                    if ((long)((unsigned long)top + (unsigned long)HIGH_BITS) >= 0) {
                        tpc = pc;
                        v = top;
                        top = NewDouble((double)v);
                    }
                    STORE_TOP_I
                }
                else {
                    /* non INT:INT cases */
                    tpc = pc;
                    if (IS_ATOM_INT(a) && IS_ATOM_DBL(top)) {
                        v = a;
                        temp_d.dbl = (double)INT_VAL(v);
                        top = Dminus(&temp_d, DBL_PTR(top));
                        goto aresult;
                    }
                    else if (IS_ATOM_DBL(a)) {
                        if (IS_ATOM_INT(top)) {
                            v = top;
                            temp_d.dbl = (double)INT_VAL(v);
                            top = Dminus(DBL_PTR(a), &temp_d);
                            goto aresult;
                        }
                        else if (IS_ATOM_DBL(top)) {
                            top = Dminus(DBL_PTR(a), DBL_PTR(top));
                            goto aresult;
                        }
                    }
                    /* a is a sequence */
                    top = binary_op(MINUS, a, top);
                    goto aresult;
                }
                BREAK;


            case L_MINUS_I:
                START_BIN_OP_I
                top = a - top;
                if ((long)((unsigned long)top + (unsigned long)HIGH_BITS) >= 0) {
                    tpc = pc;
                    b = top;
                    top = NewDouble((double)b);
                    *obj_ptr = top;
                    inc3pc();
                    RTFatalType(pc);
                }
                END_BIN_OP_I
                BREAK;
           
          case L_MULTIPLY:
                START_BIN_OP
                    /* INT:INT case L_*/
                    c = a;
                    b = top;
                   
                    if (c == (short)c) {
                        /* c is 16-bit */
                        if ((b <= INT15 && b >= -INT15) ||
                            (c == (char)c && b <= INT23 && b >= -INT23) ||
                            (b == (short)b && c <= INT15 && c >= -INT15)) {
                            top = MAKE_INT(c * b);
                        }
                        else {
                            tpc = pc;
                            top = (object)NewDouble(c * (double)b);
                        }
                    }
                    else if (b == (char)b && c <= INT23 && c >= -INT23) {
                        /* b is 8-bit, c is 23-bit */
                        top = MAKE_INT(c * b);
                    }
                    else {
                        tpc = pc;
                        top = (object)NewDouble(c * (double)b);
                    }
                    STORE_TOP_I
                }
                else {
                    /* non INT:INT cases
                      - what if a is int and top is sequence? */
                    tpc = pc;
                    if (IS_ATOM_INT(a) && IS_ATOM_DBL(top)) {
                        v = a;
                        temp_d.dbl = (double)INT_VAL(v);
                        top = Dmultiply(&temp_d, DBL_PTR(top));
                        goto aresult;
                    }
                    else if (IS_ATOM(a)) {  // was IS_ATOM_DBL
                        if (IS_ATOM_INT(top)) {
                            v = top;
                            temp_d.dbl = (double)INT_VAL(v);
                            top = Dmultiply(DBL_PTR(a), &temp_d);
                            goto aresult;
                        }
                        else if (IS_ATOM_DBL(top)) {
                            top = Dmultiply(DBL_PTR(a), DBL_PTR(top));
                            goto aresult;
                        }
                    }
                    /* a is a sequence */
                    top = binary_op(MULTIPLY, a, top);
                    goto aresult;
                }
                BREAK;

            case L_DIVIDE:
                START_BIN_OP
                c = INT_VAL(a);
                tpc = pc;
                if ((b = INT_VAL(top)) == 0)
                    RTFatal("attempt to divide by 0");
                if (c % b != 0) /* could try in-line DIV call here for speed */
                    top = (object)NewDouble((double)c / b);
                else
                    top = MAKE_INT(c / b);
                END_BIN_OP(DIVIDE)
                BREAK;


            case L_REMAINDER:
                START_BIN_OP
                if ((b = INT_VAL(top)) == 0) {
                    tpc = pc;
                    RTFatal("Can't get remainder of a number divided by 0");
                }
                else {
                    top = MAKE_INT(INT_VAL(a) % b); /* a used in divide ok? */
                }
                END_BIN_OP(REMAINDER)
                BREAK;
           
            case L_AND_BITS:
                START_BIN_OP
                top = MAKE_INT(INT_VAL(a) & INT_VAL(top));
                END_BIN_OP(AND_BITS)
                BREAK;
           
            case L_OR_BITS:
                START_BIN_OP
                top = MAKE_INT(INT_VAL(a) | INT_VAL(top));
                END_BIN_OP(OR_BITS)
                BREAK;
           
            case L_XOR_BITS:
                START_BIN_OP
                top = MAKE_INT(INT_VAL(a) ^ INT_VAL(top));
                END_BIN_OP(XOR_BITS)
                BREAK;
               
            case L_POWER:
                START_BIN_OP
                tpc = pc;
                top = power(INT_VAL(a), INT_VAL(top));
                END_BIN_OP(POWER)
                BREAK;


            case L_DIV2:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    b = top;
                    if (b & 1) {
                        /* odd */
                        tpc = pc;
                        top = NewDouble( (b >> 1) + POINT5 );
                                        /*-ves ok */
                    }
                    else
                        top = b >> 1;
                }
                else {
                    tpc = pc;
                    top = binary_op(DIVIDE, top, ATOM_2);
                }
                DeRefx(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                thread4();
                BREAK;
           
            case L_FLOOR_DIV2:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    b = top;
                    top = b >> 1;
                }
                else {
                    tpc = pc;
                    a = binary_op(DIVIDE, top, ATOM_2);
                    top = unary_op(FLOOR, a);
                    DeRef(a);
                }
                DeRefx(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                thread4();
                BREAK;

            case L_FLOOR_DIV:
                a = *(object_ptr)pc[1];  // numerator
                top = *(object_ptr)pc[2]; // denominator
                if (IS_ATOM_INT(top) && IS_ATOM_INT(a)) {
                    b = top; // get better code elsewhere
                    if (top > ATOM_0 && a >= ATOM_0)  {
                        /* v = a; doesn't help */
                        b = a / b;
                    }
                    else {
                        if (b == 0) {
                            tpc = pc;
                            RTFatal("attempt to divide by 0");
                        }
                        v = a;
                        temp_dbl = floor((double)v / (double)b);
                        if (fabs(temp_dbl) <= MAXINT_DBL)
                            b = (long)temp_dbl;
                        else
                            b = (object)NewDouble(temp_dbl);
                    }
                }
                else {
                    tpc = pc;
                    a = binary_op(DIVIDE, a, top);
                    b = unary_op(FLOOR, a);
                    DeRef(a);
                }
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = b;
                pc += 4;
                thread();
                BREAK;

            case L_EQUALS:
                START_BIN_OP
                if (a == top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(EQUALS)
                BREAK;

            case L_EQUALS_IFW:
                START_BIN_OP
                if (a == top)
                END_BIN_OP_IFW(EQUALS)
                BREAK;

            case L_EQUALS_IFW_I:
                START_BIN_OP_I
                if (a == top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_LESS:
                START_BIN_OP
                if (a < top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(LESS)
                BREAK;

            case L_LESS_IFW:
                START_BIN_OP
                if (a < top)
                END_BIN_OP_IFW(LESS)
                BREAK;

            case L_LESS_IFW_I:
                START_BIN_OP_I
                if (a < top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_GREATER:
                START_BIN_OP
                if (a > top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(GREATER)
                BREAK;

            case L_GREATER_IFW:
                START_BIN_OP
                if (a > top)
                END_BIN_OP_IFW(GREATER)
                BREAK;

            case L_GREATER_IFW_I:
                START_BIN_OP_I
                if (a > top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_NOTEQ:
                START_BIN_OP
                if (a != top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(NOTEQ)
                BREAK;

            case L_NOTEQ_IFW:
                START_BIN_OP
                if (a != top)
                END_BIN_OP_IFW(NOTEQ)
                BREAK;

            case L_NOTEQ_IFW_I:
                START_BIN_OP_I
                if (a != top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_LESSEQ:
                START_BIN_OP
                if (a <= top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(LESSEQ)
                BREAK;

            case L_LESSEQ_IFW:
                START_BIN_OP
                if (a <= top)
                END_BIN_OP_IFW(LESSEQ)
                BREAK;

            case L_LESSEQ_IFW_I:
                START_BIN_OP_I
                if (a <= top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_GREATEREQ:
                START_BIN_OP
                if (a >= top)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(GREATEREQ)
                BREAK;

            case L_GREATEREQ_IFW:
                START_BIN_OP
                if (a >= top)
                END_BIN_OP_IFW(GREATEREQ)
                BREAK;

            case L_GREATEREQ_IFW_I:
                START_BIN_OP_I
                if (a >= top)
                END_BIN_OP_IFW_I
                BREAK;

            case L_AND:
                START_BIN_OP
                if (a != ATOM_0 && top != ATOM_0)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(AND)
                BREAK;

            case L_SC1_AND:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    if (top == ATOM_0) {
                        DeRefx(*(object_ptr)pc[2]);
                        *(object_ptr)pc[2] = ATOM_0;
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    } 
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl == 0.0) {
                        DeRefx(*(object_ptr)pc[2]);
                        *(object_ptr)pc[2] = ATOM_0;               
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    }
                }
                else {
                    tpc = pc;
                    atom_condition();
                }
                thread4();
                BREAK;
           
            case L_SC1_AND_IF:  // no need to store ATOM_0
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    if (top == ATOM_0) {
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    } 
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl == 0.0) {
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    }
                }
                else {
                    tpc = pc;
                    atom_condition();
                }
                thread4();
                BREAK;
           
            case L_SC2_OR:
            case L_SC2_AND:
                top = *(object_ptr)pc[1];
                DeRefx(*(object_ptr)pc[2]);
                if (IS_ATOM_INT(top)) {
                    if (top == ATOM_0)
                        *(object_ptr)pc[2] = ATOM_0;
                    else   
                        *(object_ptr)pc[2] = ATOM_1;
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl == 0.0)
                        *(object_ptr)pc[2] = ATOM_0;
                    else   
                        *(object_ptr)pc[2] = ATOM_1;
                }
                else {
                    tpc = pc;
                    atom_condition();
                }
                inc3pc();
                thread();
                BREAK;
           
            case L_XOR:
                START_BIN_OP
                if ((a != ATOM_0) != (top != ATOM_0))
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(XOR)
                BREAK;

            case L_OR:
                START_BIN_OP
                if (a != ATOM_0 || top != ATOM_0)
                    top = ATOM_1;
                else
                    top = ATOM_0;
                END_BIN_OP(OR)
                BREAK;

            case L_SC1_OR:
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    if (top != ATOM_0) {
                        DeRefx(*(object_ptr)pc[2]);
                        *(object_ptr)pc[2] = ATOM_1;
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    } 
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl != 0.0) {
                        DeRefx(*(object_ptr)pc[2]);
                        *(object_ptr)pc[2] = ATOM_1;               
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    }
                }
                else {
                    tpc = pc;
                    atom_condition();
                }
                thread4();
                BREAK;
           
            case L_SC1_OR_IF: // no need to store ATOM_1
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    if (top != ATOM_0) {
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    } 
                }
                else if (IS_ATOM_DBL(top)) {
                    if (DBL_PTR(top)->dbl != 0.0) {
                        pc = (int *)pc[3];
                        thread();
                        BREAK;
                    }
                }
                else {
                    tpc = pc;
                    atom_condition();
                }
                thread4();
                BREAK;


/* end of binary ops */


            /* Note: we *must* always patch the endfor op, because it might
              actually be wrong as determined by the front-end */
            case L_FOR:
                obj_ptr = (object_ptr)pc[5]; /* loop var */
                top = *obj_ptr;
                c = *(object_ptr)pc[3]; /* initial value */
                *obj_ptr = c;
                Ref(c);
                DeRefx(top);
                top = *(object_ptr)pc[1];    /* inc */
                a = *(object_ptr)pc[2];      /* limit */
                if (IS_ATOM_INT(top) &&
                    IS_ATOM_INT(c) &&
                    IS_ATOM_INT(a))
                    goto intloop;
                else
                    goto general;

            case L_FOR_I:
                /* integer loop */
                obj_ptr = (object_ptr)pc[5]; /* loop var */
                c = *(object_ptr)pc[3]; /* initial value */
                *obj_ptr = c;
                top = *(object_ptr)pc[1];    /* inc */
                a = *(object_ptr)pc[2];      /* limit */
              intloop:
                if ((long)((unsigned long)a + (unsigned long)top + (unsigned long)HIGH_BITS) < 0) {
                    /* purely integer loop */
                    if ((top >= 0)) {
                        /* going up */
                        if (c > a) {
                            pc = (int *)pc[6];
                            thread();
                            BREAK;
                        }
                        if (top == ATOM_1) {
                            i = ENDFOR_INT_UP1;
                        }
                        else {       
                            i = ENDFOR_INT_UP;
                        }
                    }
                    else {
                        /* going down */
                        if (c < a) {
                            pc = (int *)pc[6];
                            thread();
                            BREAK;
                        }
                        if (top == ATOM_M1) {
                            i = ENDFOR_INT_DOWN1;
                        }
                        else {
                            i = ENDFOR_INT_DOWN;
                        }
                    }
                }
                else {
                  general:
                    /* general loop */
                    tpc = pc;
                    if (!IS_ATOM(c))
                        RTFatal("for-loop variable is not an atom");
                    if (!IS_ATOM(a))
                        RTFatal("for-loop limit is not an atom");
                    if (IS_ATOM_INT(top))
                        going_up = (INT_VAL(top) >= 0);
                    else if (IS_ATOM_DBL(top))
                        going_up = (DBL_PTR(top)->dbl >= 0.0);
                    else
                        RTFatal("for-loop increment is not an atom");
                    if (going_up)
                        b = binary_op_a(GREATER, c, a);
                    else
                        b = binary_op_a(LESS, c, a);
                    if (b == ATOM_1) {
                        pc = (int *)pc[6];  /* exit loop - 0 iterations */
                        BREAK;
                    }
                    else {
                        i = going_up ? ENDFOR_UP : ENDFOR_DOWN;
                        /* Ref(top); inc */
                        /* Ref(a);  limit */
                    }
                }
                /* we're going in - patch the ENDFOR opcode */
                patch = (opcode_type *) ((int *)pc[6] - 5);
                i = (int)opcode(i);
                pc += 7;  // so WATCOM will do it before thread()
                if (patch[0] != (opcode_type)i) {
                    // changing the endfor op from what it was
                    sub = (symtab_ptr)pc[-3];
                    if (sub->u.subp.saved_privates == NULL) {
                        /* no one else in here, safe to change the op */
                        patch[0] = (opcode_type)i;
                    }
                    else {
                        // don't upset other tasks or levels of recursion
                        patch[0] = opcode(ENDFOR_GENERAL);
                    }
                }
                thread();
                BREAK;


            case L_ENDFOR_INT_DOWN1:
                obj_ptr = (object_ptr)pc[3]; /* loop var */
                top = *obj_ptr - 1;
                if (top < *(object_ptr)pc[2]) {  /* limit */
                    thread5();  /* exit loop */
                }
                else {
                    *obj_ptr = top;
                    pc = (int *)pc[1];  /* loop again */
                    thread();
                }
                BREAK;

            case L_ENDFOR_INT_DOWN:
                obj_ptr = (object_ptr)pc[3];  /* loop var */
                top = *obj_ptr + *(object_ptr)pc[4]; /* increment */
                if (top < *(object_ptr)pc[2]) { /* limit */
                    thread5();  /* exit loop */
                }
                else {
                    *obj_ptr = top;
                    pc = (int *)pc[1]; /* loop again */
                    thread();
                }
                BREAK;

            case L_ENDFOR_GENERAL:
                /* totally general ENDFOR */
                top = *(object_ptr)pc[4]; /* increment */
                if (IS_ATOM_INT(top)) {
                    if (top < ATOM_0)
                        goto downloop;
                }
                else {
                    /* increment must be an atom (not a sequence) */
                    if (DBL_PTR(top)->dbl < 0.0) {
                        goto downloop;
                    }
                }
                /* fall-through */
            case L_ENDFOR_UP:
                /* add increment */
                obj_ptr = (object_ptr)pc[3]; /* loop var */
                a = *obj_ptr;
                tpc = pc;
                top = binary_op_a(PLUS, a, *(object_ptr)pc[4]); /* increment */
                /* compare with limit */
                if (binary_op_a(GREATER, top, *(object_ptr)pc[2]) == ATOM_1) {
                    DeRef(top); 
                    thread5();
                }
                else {
                    DeRef(*obj_ptr);
                    *obj_ptr = top;
                    pc = (int *)pc[1]; /* loop again */
                    thread();
                }
                BREAK;

            case L_ENDFOR_DOWN:
              downloop:
                obj_ptr = (object_ptr)pc[3]; /* loop var */
                a = *obj_ptr;
                tpc = pc;
                top = binary_op_a(PLUS, a, *(object_ptr)pc[4]); /* increment */
                if (binary_op_a(LESS, top, *(object_ptr)pc[2]) == ATOM_1) {
                    DeRef(top); 
                    thread5();  /* exit loop */
                }
                else {
                    DeRef(*obj_ptr);
                    *obj_ptr = top;
                    pc = (int *)pc[1]; /* loop again */
                    thread();
                }
                BREAK;


            // Call by handle to procedure, function or type
            case L_CALL_FUNC:
                cf = TRUE;
            case L_CALL_PROC:
                tpc = pc;
                if (expr_top >= expr_limit) {
                    expr_max = BiggerStack();
                    expr_limit = expr_max - 3;
                }
               
                // get the routine symtab_ptr:
                a = get_pos_int("call_proc/call_func", *(object_ptr)pc[1]);
                if ((unsigned)a >= e_routine_next) {
                    RTFatal("invalid routine id");
                }
                sub = e_routine[a];
               
                // get the argument sequence
                a = *(object_ptr)pc[2];
               
                // check for correct kind of routine
                if (cf) {
                    cf = FALSE;
                    pc++;
                    if (sub->token == PROC) {
                        sprintf(TempBuff, "%s() does not return a value",
                                sub->name);
                        RTFatal(TempBuff);
                    }
                }
                else {
                    if (sub->token != PROC) {
                        sprintf(TempBuff,
                          "the value returned by %s() must be assigned or used",
                                sub->name);
                        RTFatal(TempBuff);
                    }
                }
               
                if (IS_ATOM(a)) {
                    RTFatal("argument list must be a sequence");
                }
                a = (object)SEQ_PTR(a);
               
                // if length is huge it will be rejected here,
                // so max_stack_per_call will protect against stack overflow
                if (sub->u.subp.num_args != ((s1_ptr)a)->length) {
                    // must avoid > 3 arg calls to get better WATCOM code gen
                    wrong_arg_count(sub, a);
                }
                obj_ptr = ((s1_ptr)a)->base;
                sym = sub->next;
               
                if (sub->u.subp.resident_task != -1) {
                    /* someone is using the sub - save the privates and temps */

                    block = save_private_block(sub);
                   
                    /* save & copy the args */
                    while (TRUE) {
                        obj_ptr++;                     
                        a = *(object_ptr)obj_ptr;
                        if (!IS_ATOM_INT(a)) {
                            if (a == NOVALUE) { // sentinel
                                obj_ptr = (object_ptr)(pc + 3);
                                break;
                            }
                            RefDS(a);
                        }
                        *block++ = sym->obj;
                        sym->obj = a;
                        sym = sym->next;
                    }
                   
                    /* save the remaining privates and loop-vars &
                      set to NOVALUE */
                    while (sym && sym->scope <= S_PRIVATE) {
                        *block++ = sym->obj;
                        sym->obj = NOVALUE;
                        sym = sym->next;
                    }
               
                    /* save the temps & set to NOVALUE */
                    sym = sub->u.subp.temps;
                    while (sym != NULL) {
                        *block++ = sym->obj;
                        sym->obj = NOVALUE;
                        sym = sym->next;
                    }
                }
                else {
                    /* don't push */
                    /* save & copy the args */
                    while (TRUE) {
                        obj_ptr++;                     
                        a = *(object_ptr)obj_ptr;
                        if (!IS_ATOM_INT(a)) {
                            if (a == NOVALUE) { // sentinel
                                obj_ptr = (object_ptr)(pc + 3);
                                break;
                            }
                            RefDS(a);
                        }
                        sym->obj = a;
                        sym = sym->next;
                    }
                    /* the remaining privates and loop-vars will already
                      contain NOVALUE from the previous first-level return */
                }
               
                sub->u.subp.resident_task = current_task;
               
                *expr_top++ = (object)obj_ptr; // push return address
                *expr_top++ = sub;            // push sub symtab pointer
                pc = sub->u.subp.code;        // start executing the sub
                thread();
                BREAK;

            case L_PROC:  // Normal subroutine call
                /* make a procedure or function/type call */
                if (expr_top >= expr_limit) {
                    tpc = pc;
                    expr_max = BiggerStack();
                    expr_limit = expr_max - 3;
                }
                sub = (symtab_ptr)pc[1]; // subroutine
                sym = sub->next;

                // pc (ESI) is used for role of obj_ptr here and in loop
                obj_ptr = (object_ptr)(pc + 2); // list of argument addresses
               
                a = (object)(obj_ptr + sub->u.subp.num_args);
               
                if (sub->u.subp.resident_task != -1) {
                    /* someone is using the sub - save the privates and temps */
   
                    tpc = pc;
                   
                    block = save_private_block(sub);
                   
                    /* save & copy the args */
                    while (obj_ptr < (object_ptr)a) {
                        *block++ = sym->obj;
                        sym->obj = *(object_ptr)obj_ptr[0];
                        Ref(sym->obj);
                        sym = sym->next;
                        obj_ptr++;                     
                    }
   
                    /* save the remaining privates and loop-vars &
                      set to NOVALUE */
                    while (sym && sym->scope <= S_PRIVATE) {
                        *block++ = sym->obj;
                        sym->obj = NOVALUE;
                        sym = sym->next;
                    }
                   
                    /* save the temps & set to NOVALUE */
                    sym = sub->u.subp.temps;
                    while (sym != NULL) {
                        *block++ = sym->obj;
                        sym->obj = NOVALUE;
                        sym = sym->next;
                    }
                }
                else {
                    /* no need to save the privates or temps */
                   
                    /* just copy the args */
                    while (obj_ptr < (object_ptr)a) {
                        sym->obj = *(object_ptr)obj_ptr[0];
                        Ref(sym->obj);
                        sym = sym->next;
                        obj_ptr++;                     
                    }
   
                    /* the remaining privates and loop-vars will already
                      contain NOVALUE from the previous level-1 return */
                }
               
                sub->u.subp.resident_task = current_task;
               
                if (sub->token != PROC)
                    obj_ptr++; /* skip address for fn/type result */
               
                *expr_top++ = (object)obj_ptr; // push return address
                *expr_top++ = sub;            // push sub symtab pointer
                pc = sub->u.subp.code;        // start executing the sub
                thread();
                BREAK;

            case L_CALL_BACK_RETURN: /* return from a call-back */
                return;
           
            case L_RETURNT: /* end of execution - falling off the end */
                tpc = pc;  /* we need this to be different from CALL_BACK_RETURN */
                Cleanup(0);
                return;
               
            case L_BADRETURNF:  /* shouldn't reach here */
                tpc = pc;
                RTFatal("attempt to exit a function without returning a value");
                BREAK;

            case L_RETURNF: /* return from function */
                result_val = *(object_ptr)pc[2]; /* the return value */
                Ref(result_val);
                // record the place to put the return value
                result_ptr = (object_ptr)*((int *)expr_top[-2] - 1);

            case L_RETURNP: /* return from procedure */
                sub = ((symtab_ptr)pc[1]);
                sym = sub->next; /* first private var */
               
                /* free the privates and set to NOVALUE */
                while (sym && sym->scope <= S_PRIVATE) {
                    DeRef(sym->obj);
                    sym->obj = NOVALUE; // not actually needed for params
                    sym = sym->next;
                }
                   
                /* free the temps and set to NOVALUE */
                sym = sub->u.subp.temps;
                while (sym != NULL) {
                    DeRef(sym->obj);
                    sym->obj = NOVALUE;
                    sym = sym->next;
                }
               
                // vacating this routine
                sub->u.subp.resident_task = -1;

                tpc = pc;
                   
                if (expr_top > expr_stack+3) {
                    // stack is not empty
                    pc = (int *)expr_top[-2];
                    expr_top -= 2;
                    top = expr_top[-1];
                    restore_privates((symtab_ptr)top);

                    if (result_ptr != NULL) {
                        // store function result
                        top = *result_ptr;
                        *result_ptr = result_val; //was important not to use "a"
                        DeRef(top);
                        result_ptr = NULL;
                    }
                }
                else {
                    // stack is empty - this task is finished
                    terminate_task(current_task);
                    scheduler(current_time());
                    pc = tpc;
                }
                thread();
                BREAK;

            case L_ROUTINE_ID:
                top = (object)pc[1];    // CurrentSub
                a = *(object_ptr)pc[3]; // routine name sequence
                SymTabLen = pc[2]; // avoid > 3 args
                b = RoutineId((symtab_ptr)top, a, pc[4]);
                DeRefx(*(object_ptr)pc[5]);
                *(object_ptr)pc[5] = b;
                pc += 6;
                /*thread();*/
                BREAK;

            case L_APPEND:
                b = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                if (!IS_SEQUENCE(b)) {
                    tpc = pc;
                    RTFatal("first argument of append must be a sequence");
                }
      app_copy: 
                tpc = pc;
                Ref(top);
                Append((object_ptr)pc[3], b, top);
                thread4();
                BREAK;

            case L_PREPEND:
                b = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                if (!IS_SEQUENCE(b)) {
                    tpc = pc;
                    RTFatal("first argument of prepend must be a sequence");
                }
    prep_copy:
                tpc = pc;
                Ref(top);
                Prepend((object_ptr)pc[3], b, top);
                thread4();
                BREAK;

            case L_CONCAT:
                /* concatenate 2 items */
                b = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                if (IS_SEQUENCE(b) && IS_ATOM(top))
                    goto app_copy; /* append is faster */
                else if (IS_ATOM(b) && IS_SEQUENCE(top)) {
                    /* swap args */
                    a = top;
                    top = b;
                    b = a;
                    goto prep_copy; /* prepend is faster */
                }
                tpc = pc;
                Concat((object_ptr)pc[3], b, (s1_ptr)top);
                pc += 4;  // WATCOM thread() fails
                BREAK;
           
            case L_CONCAT_N:
                /* concatenate 3 or more items */
                nvars = pc[1];
                tpc = pc;
                Concat_Ni((object_ptr)pc[nvars+2], (object_ptr *)(pc+2), nvars);
                pc += nvars + 3; // WATCOM thread() fails
                BREAK;
           
            case L_REPEAT:
                tpc = pc;
                top = Repeat(*(object_ptr)pc[1], *(object_ptr)pc[2]);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;             
                pc += 4;
                thread();
                BREAK;

            case L_DATE:
                tpc = pc;
                top = Date();
                DeRef(*(object_ptr)pc[1]);
                *(object_ptr)pc[1] = top;
                pc += 2;
                BREAK;

            case L_TIME:
                tpc = pc;
                top = NewDouble(current_time());
                DeRef(*(object_ptr)pc[1]);
                *(object_ptr)pc[1] = top;
                pc += 2;
                thread();
                BREAK;


#ifdef HEAP_CHECK
            case L_SPACE_USED:
                top = MAKE_INT(bytes_allocated);
                DeRef(*(object_ptr)pc[1]);
                *(object_ptr)pc[1] = top;
                pc += 2;               
                BREAK;
#endif
            case L_POSITION:
                a = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                tpc = pc;
                if (!IS_ATOM(top)) {
                    RTFatal("second argument of position() is not an atom");
                }
                if (IS_ATOM(a)) {
                    Position(a, top);
                    inc3pc();
                    thread();
                }
                else {
                    RTFatal("first argument of position() is not an atom");
                }
                BREAK;
           
            case L_EQUAL:
                a = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                if (a == top) {
                    top = ATOM_1; // lucky case
                }
                else if (IS_ATOM_INT(a) && IS_ATOM_INT(top)) {
                    top = ATOM_0;
                }
                else {
                    tpc = pc;
                    top = MAKE_INT(compare(a, top));
                    top = (top == ATOM_0);
                }
                obj_ptr = (object_ptr)pc[3];
                DeRefx(*obj_ptr);
                pc += 4;
                *obj_ptr = top;             
                thread();
                BREAK;
               
            case L_COMPARE:
                a = *(object_ptr)pc[1];
                top = *(object_ptr)pc[2];
                if (IS_ATOM_INT(a) && IS_ATOM_INT(top)) {
                    top = (a < top) ? ATOM_M1: (a > top);
                }
                else {
                    tpc = pc;
                    top = compare(a, top);
                }
                obj_ptr = (object_ptr)pc[3];
                DeRefx(*obj_ptr);
                pc += 4;
                *obj_ptr = top;             
                thread();
                BREAK;

            case L_FIND:
                tpc = pc;
                a = find(*(object_ptr)pc[1], (s1_ptr)*(object_ptr)pc[2]);
                top = MAKE_INT(a);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;             
                pc += 4;
                thread();
                BREAK;

            case L_MATCH:
                tpc = pc;
                top = MAKE_INT(e_match((s1_ptr)*(object_ptr)pc[1],
                                    (s1_ptr)*(object_ptr)pc[2]));
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;             
                pc += 4;
                thread();
                BREAK;


            case L_PEEK4U:
                b = 1;
                goto peek4s1;
               
            case L_PEEK4S:
                b = 0;
            peek4s1:
                a = *(object_ptr)pc[1]; /* the address */
                tpc = pc;  // in case of machine exception
                top = do_peek4(a, b, pc);
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;

            case L_PEEK:
                a = *(object_ptr)pc[1]; /* the address */
                tpc = pc;  // in case of machine exception
               
                /* check address */
                if (IS_ATOM_INT(a)) {
                    poke_addr = (unsigned char *)INT_VAL(a);
                }
                else if (IS_ATOM(a)) {
                    poke_addr = (unsigned char *)(unsigned long)
                                (DBL_PTR(a)->dbl);
                }
                else {
                    /* a sequence: {addr, nbytes} */
                    s1 = SEQ_PTR(a);                                       
                    i = s1->length;
                    if (i != 2) {
                        RTFatal(
                  "argument to peek() must be an atom or a 2-element sequence");
                    }
                    poke_addr = (unsigned char *)get_pos_int("peek", *(s1->base+1));
#ifdef EDOS                   
                    if (current_screen != MAIN_SCREEN &&
                        (unsigned)poke_addr >= (unsigned)0xA0000 &&
                        (unsigned)poke_addr < (unsigned)0xC0000)
                        MainScreen();
#endif                 
                    i = get_pos_int("peek", *((s1->base)+2)); /* length */
                    if (i < 0)
                        RTFatal("number of bytes to peek is less than 0");
                    s1 = NewS1(i);
                    obj_ptr = s1->base;
                    while (--i >= 0) {
                        obj_ptr++;
#ifdef EDJGPP                     
                        if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                            *obj_ptr = _farpeekb(_go32_info_block.selector_for_linear_memory,
                                                  (unsigned)poke_addr);
                        else   
#endif                     
                            *obj_ptr = *poke_addr;
                        poke_addr++;
                    }
                    DeRef(*(object_ptr)pc[2]);
                    *(object_ptr)pc[2] = (object)MAKE_SEQ(s1);         
                    inc3pc();
                    thread();
                }
#ifdef EDOS
                if (current_screen != MAIN_SCREEN &&
                    (unsigned)poke_addr >= (unsigned)0xA0000 &&
                    (unsigned)poke_addr < (unsigned)0xC0000)
                    MainScreen();
#endif             
                DeRefx(*(object_ptr)pc[2]);
#ifdef EDJGPP                     
                if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                    *(object_ptr)pc[2] = _farpeekb(_go32_info_block.selector_for_linear_memory,
                                                  (unsigned)poke_addr);
                else   
#endif                     
                    *(object_ptr)pc[2] = *poke_addr;             
                inc3pc();
                thread();
                BREAK;
           
            case L_POKE4:
                a = *(object_ptr)pc[1];  /* address */
                top = *(object_ptr)pc[2]; /* byte value */
                tpc = pc;
                do_poke4(a, top);
                inc3pc();
                thread();
                BREAK;

            case L_POKE:
                a = *(object_ptr)pc[1];  /* address */
                top = *(object_ptr)pc[2]; /* byte value */
                tpc = pc;  // in case of machine exception

                /* check address */
                if (IS_ATOM_INT(a)) {
                    poke_addr = (unsigned char *)a;
                }
                else if (IS_ATOM(a)) {
                    poke_addr = (unsigned char *)(unsigned long)
                                (DBL_PTR(a)->dbl);
                }
                else {
                    tpc = pc;
                    RTFatal("first argument to poke must be an atom");
                }
#ifdef EDOS
                if (current_screen != MAIN_SCREEN &&
                    (unsigned)poke_addr >= (unsigned)0xA0000 &&
                    (unsigned)poke_addr < (unsigned)0xC0000)
                    MainScreen();
#endif             
                /* the following 6 lines bumped top out of a register */
                b = top;
               
                if (IS_ATOM_INT(b)) {
#ifdef EDJGPP     
                    if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                        _farpokeb(_go32_info_block.selector_for_linear_memory,
                          (unsigned long)poke_addr, (unsigned char)b);
                    else
#endif     
                        *poke_addr = (unsigned char)b;
                }
                else if (IS_ATOM(b)) {
#ifdef EDJGPP     
                    if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                        _farpokeb(_go32_info_block.selector_for_linear_memory,
                        (unsigned long)poke_addr, (unsigned char)DBL_PTR(b)->dbl);
                    else
#endif     
                        *poke_addr = (signed char)DBL_PTR(b)->dbl;
                }
                else {
                    /* second arg is sequence */
                    s1 = SEQ_PTR(b);
                    obj_ptr = s1->base;
                    while (TRUE) {
                        b = *(++obj_ptr);
                        if (IS_ATOM_INT(b)) {
#ifdef EDJGPP     
                            if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                                _farpokeb(_go32_info_block.selector_for_linear_memory,
                                (unsigned long)poke_addr++, (unsigned char)b);
                            else
#endif     
                                *poke_addr++ = (unsigned char)b;
                        }
                        else if (IS_ATOM(b)) {
                            if (b == NOVALUE)
                                break;
#ifdef EDJGPP     
                            if ((unsigned)poke_addr <= LOW_MEMORY_MAX)
                                _farpokeb(_go32_info_block.selector_for_linear_memory,
                                (unsigned long)poke_addr++, (unsigned char)DBL_PTR(b)->dbl);
                            else
#endif     
                                *poke_addr++ = (signed char)DBL_PTR(b)->dbl;
                        }
                        else {
                            RTFatal(
                            "sequence to be poked must only contain atoms");
                        }
                    }
                }
                inc3pc();
                thread();
                BREAK;

            case L_MEM_COPY:
                tpc = pc;
                memory_copy(*(object_ptr)pc[1],
                            *(object_ptr)pc[2],
                            *(object_ptr)pc[3]);
                pc += 4;               
                thread();
                BREAK;
           
            case L_MEM_SET:
                tpc = pc;
                memory_set(*(object_ptr)pc[1],
                          *(object_ptr)pc[2],
                          *(object_ptr)pc[3]);
                pc += 4;               
                thread();
                BREAK;
           
            case L_PIXEL:
                tpc = pc;
                Pixel(*(object_ptr)pc[1],
                      *(object_ptr)pc[2]);
                inc3pc();
                thread();
                BREAK;
           
            case L_GET_PIXEL:
                tpc = pc;
                a = Get_Pixel(*(object_ptr)pc[1]);
                DeRef(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = a;
                inc3pc();
                thread();
                BREAK;
         
            case L_CALL:
                a = *(object_ptr)pc[1];
                tpc = pc;  // for better profiling and machine exception
                /* check address */
                if (IS_ATOM_INT(a)) {
                    sub_addr = (void(*)())INT_VAL(a);
                }
                else if (IS_ATOM(a)) {
                    sub_addr = (void(*)())(unsigned long)(DBL_PTR(a)->dbl);
                }
                else {
                    RTFatal("argument to call() must be an atom");
                }
                if (current_screen != MAIN_SCREEN)
                    MainScreen();
                (*sub_addr)();
                pc += 2;
                /* thread(); */
                BREAK;

            case L_SYSTEM:
                tpc = pc;
                if (current_screen != MAIN_SCREEN)
                    MainScreen();
                system_call(*(object_ptr)pc[1], *(object_ptr)pc[2]);
                inc3pc();
                BREAK;
               
            case L_SYSTEM_EXEC:
                tpc = pc;
                if (current_screen != MAIN_SCREEN)
                    MainScreen();
                top = system_exec_call(*(object_ptr)pc[1], *(object_ptr)pc[2]);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                pc += 4;
                thread();
                BREAK;

               
                /* start of I/O routines */

            case L_OPEN:
                tpc = pc;
                top = EOpen(*(object_ptr)pc[1],
                            *(object_ptr)pc[2]);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                pc += 4;
                thread();
                BREAK;

            case L_CLOSE:
                tpc = pc;
                EClose(*(object_ptr)pc[1]);
                pc += 2;
                thread();
                BREAK;

            case L_GETC:  /* read a character from a file */
                top = *(object_ptr)pc[1];
                if (current_screen != MAIN_SCREEN && might_go_screen(top)) {
                    MainScreen(); // no error can happen, tpc needn't be set
                                  // time_profile not relevant if debugging
                }
                if (top != last_r_file_no) {
                    tpc = pc;
                    last_r_file_ptr = which_file(top, EF_READ);
                    if (IS_ATOM_INT(top))
                        last_r_file_no = top;
                    else
                        last_r_file_no = NOVALUE;
                }
#ifndef EDOS
                if (last_r_file_ptr == stdin) {
#ifdef EWINDOWS
                    // In WIN32 this is needed before
                    // in_from_keyb is set correctly
                    show_console(); 
#endif
                    if (in_from_keyb) {
#ifdef ELINUX
#ifdef EGPM
                        b = mgetch(TRUE); // echo the character
#else
                        echo_wait();
                        b = getc(stdin);
#endif                     
#else
                        b = wingetch();
#endif                 
                    }
                    else {
#ifdef ELINUX                     
                        b = getc(last_r_file_ptr);
#else                 
                        b = mygetc(last_r_file_ptr);
#endif
                    }
                }
                else
#endif
#ifdef ELINUX
                    b = getc(last_r_file_ptr);
#else
                    b = mygetc(last_r_file_ptr); /* don't use <a> ! */
#endif         
                DeRefx(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = b;    //top;
                inc3pc();
                thread();
                BREAK;

            case L_GETS:  /* read a line from a file */
                tpc = pc;
                top = EGets(*(object_ptr)pc[1]);
                DeRef(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;

            case L_PLATFORM: // only shrouded code needs this (for portability)
                DeRef(*(object_ptr)pc[1]);
#ifdef ELINUX
                top = 3;  // Linux
#endif
#ifdef EWINDOWS
                top = 2;  // WIN32
#endif
#ifdef EDOS
                top = 1;  // DOS32
#endif
               
                *(object_ptr)pc[1] = top;
                pc += 2;
                thread();
                BREAK;
           
            case L_GET_KEY: /* read an immediate key (if any) from the keyboard
                            or return -1 */
                tpc = pc;
#if defined(EWINDOWS)
                show_console();
#endif
                if (current_screen != MAIN_SCREEN) {
                    MainScreen();
                }
                top = MAKE_INT(get_key(FALSE));
                if (top == ATOM_M1 && TraceOn) {
#ifdef ELINUX
                    struct tms buf;
                    c0 = times(&buf) + 8 * clk_tck; // wait 8 real seconds
                    while (times(&buf)
#else
                    c0 = clock() + 8 * clocks_per_sec;
                    while (clock()
#endif                     
                        < c0 && top == ATOM_M1) {
                        top = MAKE_INT(get_key(FALSE));
                    }
                }
                DeRef(*(object_ptr)pc[1]);
                *(object_ptr)pc[1] = top;
                pc += 2;
                thread();
                BREAK;

            case L_CLEAR_SCREEN:
                tpc = pc++;
                if (current_screen != MAIN_SCREEN) {
                    tpc = pc;
                    MainScreen();
                }
                ClearScreen();
                BREAK;

            case L_PUTS:
                tpc = pc;
                EPuts(*(object_ptr)pc[1], *(object_ptr)pc[2]);
                inc3pc();
                tpc = pc;
                BREAK;

            case L_QPRINT:
                i = 1;
                goto nextp;
            case L_PRINT:
                i = 0;
            nextp:
                tpc = pc;
                a = *(object_ptr)pc[1];  /* file number */
                top = *(object_ptr)pc[2];
                StdPrint(a, top, i);
                inc3pc();
                BREAK;

            case L_PRINTF:
                /* file number, format string, value */
                tpc = pc;
                file_no = *(object_ptr)pc[1];
                EPrintf(file_no,
                        (s1_ptr)*(object_ptr)pc[2],
                        (s1_ptr)*(object_ptr)pc[3]);
                pc += 4;
                BREAK;

            case L_SPRINTF:
                /* format string, value */
                tpc = pc;
                top = EPrintf(DOING_SPRINTF,
                        (s1_ptr)*(object_ptr)pc[1],
                        (s1_ptr)*(object_ptr)pc[2]);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                pc += 4;
                thread();
                BREAK;

            case L_COMMAND_LINE:
                tpc = pc;
                top = Command_Line();
                DeRef(*(object_ptr)pc[1]);
                *(object_ptr)pc[1] = top;
                pc += 2;
                thread();
                BREAK;

            case L_GETENV:
                tpc = pc;
                top = EGetEnv((s1_ptr)*(object_ptr)pc[1]);
                DeRef(*(object_ptr)pc[2]);
                *(object_ptr)pc[2] = top;
                inc3pc();
                thread();
                BREAK;

            case L_MACHINE_FUNC:
                tpc = pc;
                top = machine(*(object_ptr)pc[1],
                              *(object_ptr)pc[2]);
                DeRef(*(object_ptr)pc[3]);
                *(object_ptr)pc[3] = top;
                pc += 4;
                thread();
                BREAK;

            case L_MACHINE_PROC:
                tpc = pc;
                machine(*(object_ptr)pc[1], *(object_ptr)pc[2]);
                inc3pc();
                thread();
                BREAK;
       
            case L_C_FUNC:
                tpc = pc;
                top = call_c(1, *(object_ptr)pc[1],
                                *(object_ptr)pc[2]);//callback could happen here
                restore_privates((symtab_ptr)pc[3]);
                DeRef(*(object_ptr)pc[4]);
                *(object_ptr)pc[4] = top;
                tpc = pc + 5;
                thread5();
                BREAK;
               
            case L_C_PROC:
                tpc = pc;
                top = call_c(0, *(object_ptr)pc[1],
                                *(object_ptr)pc[2]);//callback could happen here
                restore_privates((symtab_ptr)pc[3]);
                pc += 4;
                tpc = pc;
                thread();
                BREAK;

            /* Multitasking */
           
            case L_TASK_CREATE:
                tpc = pc;
                top = task_create(*(object_ptr)pc[1],
                                  *(object_ptr)pc[2]);
                a = pc[3];
                DeRef(*(object_ptr)a);
                *(object_ptr)a = top;
                pc += 4;
                thread();
                BREAK;
           
            case L_TASK_SCHEDULE:
                tpc = pc;
                task_schedule(*(object_ptr)pc[1],
                              *(object_ptr)pc[2]);
                inc3pc();
                thread();
                BREAK;
           
            case L_TASK_YIELD:
                tpc = pc;
                task_yield();
                pc = tpc;
                thread();
                BREAK;
           
            case L_TASK_SELF:
                top = (object)pc[1];
                DeRef(*(object_ptr)top);
                *(object_ptr)top = NewDouble(tcb[current_task].tid);
                pc += 2;
                thread();
                BREAK;
           
            case L_TASK_SUSPEND:
                tpc = pc;
                task_suspend(*(object_ptr)pc[1]);
                pc += 2;
                thread();
                BREAK;
           
            case L_TASK_LIST:
                tpc = pc;
                top = task_list();
                a = pc[1];
                DeRef(*(object_ptr)a);
                *(object_ptr)a = top;
                pc += 2;
                thread(); // causes problem? - ok now
                BREAK;
           
            case L_TASK_STATUS:
                tpc = pc;
                top = task_status(*(object_ptr)pc[1]);
                a = pc[2];
                DeRef(*(object_ptr)a);
                *(object_ptr)a = top;
                inc3pc();
                thread();
                BREAK;
           
            case L_TASK_CLOCK_STOP:
                tpc = pc;
                task_clock_stop();
                pc += 1;
                BREAK;
           
            case L_TASK_CLOCK_START:
                tpc = pc;
                task_clock_start();
                pc += 1;
                BREAK;


            /* tracing/profiling ops */

            case L_STARTLINE:
                top = pc[1];
                a = slist[top].options;
#ifndef BACKEND           
                if (a & OP_PROFILE_STATEMENT) {
                    if (ProfileOn) {
                        iptr = (int *)slist[top].src;
                        (*iptr)++;
                    }
                }
#endif
                pc += 2;
                tpc = pc;
             
#ifndef BACKEND           
                if (a & OP_TRACE) {
                    start_line = top;
                    if (file_trace) {
                        char one_line[120];

                        sprintf(one_line, "%.20s:%d\t%.80s",
                                name_ext(file_name[slist[top].file_no]),
                                slist[top].line,
                                (slist[top].options & (OP_PROFILE_STATEMENT |
                                                      OP_PROFILE_TIME)) ?
                                    slist[top].src+4 :
                                    slist[top].src);
                        b = TraceOn;
                        TraceOn = TRUE;
                        ctrace(one_line);
                        TraceOn = b;
                    }
                    traced_lines = TRUE;
                    TraceLineBuff[TraceLineNext++] = top;
                    if (TraceLineNext == TraceLineSize)
                        TraceLineNext = 0;
                    if (TraceBeyond == HUGE_LINE) {
                        b = 0;
                    }
                    else {
                        /* stop after down-arrow pressed */
                        i = expr_top - expr_stack;
                        b = top > TraceBeyond && i == TraceStack ||
                            i < TraceStack;
                    }
                    if (TraceOn || b) {
                        /* turn on tracing */
                        TraceOn = TRUE;
                        if (b) {
                            ShowDebug();
                            UpdateGlobals();
                        }
                       
                        TraceBeyond = HUGE_LINE;
                        DebugScreen();
                    }
                }
#endif
           
                thread();
                BREAK;

            case L_TRACE:
                tpc = pc;
                top = *(object_ptr)pc[1];
                trace_command(top);
                pc += 2;
                BREAK;

            case L_PROFILE:
                tpc = pc;
                top = *(object_ptr)pc[1];
                profile_command(top);
                pc += 2;
                BREAK;

            case L_DISPLAY_VAR: /* display variable name and value */
                if (TraceOn) {
                    tpc = pc;
#ifndef BACKEND               
                    ShowDebug();
                    DisplayVar((symtab_ptr)pc[1], FALSE);
#endif
                }
                pc += 2;
                BREAK;

            case L_ERASE_PRIVATE_NAMES: /* blank private vars on debug screen */
#ifndef BACKEND           
                if (TraceOn) {
                    tpc = pc;
                    ShowDebug();
                    ErasePrivates((symtab_ptr)pc[1]);
                }
#endif
                pc += 2;
                BREAK;

            case L_ERASE_SYMBOL:
#ifndef BACKEND           
                if (TraceOn) {
                    tpc = pc;
                    ShowDebug();
                    EraseSymbol((symtab_ptr)pc[1]);
                }
#endif
                pc += 2;
                BREAK;
               
            case L_UPDATE_GLOBALS:
                if (TraceOn) {
                    tpc = pc;
#ifndef BACKEND               
                    ShowDebug();
                    UpdateGlobals();
#endif
                }
                pc++;
                BREAK;

            case L_ABORT:
                tpc = pc;
                top = *(object_ptr)pc[1];
                if (IS_ATOM_INT(top)) {
                    i = top;
                }
                else if (IS_ATOM(top)) {
                    i = (int)DBL_PTR(top)->dbl;
                }
                else
                    RTFatal("argument to abort() must be an atom");
                UserCleanup(i); 
                BREAK;
               
                case L_FIND_FROM:
                        tpc = pc;
                        a = find_from(*(object_ptr)pc[1], (s1_ptr)*(object_ptr)pc[2], *(object_ptr)pc[3]);
                        top = MAKE_INT(a);
                        DeRef(*(object_ptr)pc[4]);
                        *(object_ptr)pc[4] = top;             
                        thread5();
                        BREAK;
                       
                case L_MATCH_FROM:
                        tpc = pc;
                        a = e_match_from((s1_ptr)*(object_ptr)pc[1], (s1_ptr)*(object_ptr)pc[2],
                                *(object_ptr) pc[3]);
                        top = MAKE_INT(a);
                        DeRef(*(object_ptr)pc[4]);
                        *(object_ptr)pc[4] = top;
                       
                        thread5();
                        BREAK;
                       
#ifdef INT_CODES
        }
#else
#if !defined(ELINUX) && !defined(EDJGPP)
        }
#endif
#endif
    } while(TRUE);

subsfail:
    tpc = pc;
    RTFatal("attempt to subscript an atom\n(reading from it)");

asubsfail:                 
    tpc = pc;
    SubsAtomAss();

dblplus:
    tpc = pc;
    v = top;
    top = NewDouble((double)v);
    goto contplus;

dblplus_i:
    tpc = pc;
    b = top;
    top = NewDouble((double)b);
    *obj_ptr = top;
    inc3pc();
    RTFatalType(pc);
    goto contplus_i;
}

void AfterExecute()
// Address of this routine is used by time profiler
{
}

---

That's some four thousand lines of spaghetti code. I wonder if it's even worth the effort.

Rapid Euphoria code example:

Code:

---

object p, var, x, y, z, peace, war

var = {0.5, "me", -9e2, "you"}
x = {-19, {20, 1}}
y = 4300
z = 20.5
peace = {x, y, z}
war = sin(peace)

p = power(2,
          {2, "abc", {log(0.2) * 11, var[2..3] * 2 & {x, y, z},
          {peace, {war}}}}
)

print(1, p)

-- p is:
-- {4, {1.58456325e+29, 3.169126501e+29, 6.338253001e+29},
-- {4.68403395e-06, {{4.212491667e+65, 6.427752177e+60}, 0,
-- {1.907348633e-06, {1048576,2}}, inf, 1482910.4},
-- {{{1.907348633e-06, {1048576,2}}, inf, 1482910.4}, {{{0.9013271729,
-- {1.882885474, 1.791876224}}, 1.675825415, 1.995609987}}}}}

---

• Rapid Euphoria 'sequence' is unlimited in power.

• Manipulating a sequence is lightning fast.

• Compare Rapid Euphoria power and speed with any product of Microsoft corporation or any other corporation - Rapid Euphoria wins.

That's why I maintain a website for it.

Quote:

---

Originally Posted by Sir Galahad

Just look at it!
...
That's some four thousand lines of spaghetti code. I wonder if it's even worth the effort.

---

To make this i386 code works on AMD64 - I'm not sure if you need to change here even a single line.

I'm not a C programmer, yet
I assume that what you do need to change is long type to long long,
and double type to long double,
and deal with lines (in other files) that using malloc()/dynamic memory allocation.

Quote:

---

Originally Posted by shian

To make this i386 code works on AMD64 - I'm not sure if you need to change here even a single line.

I'm not a C programmer, yet
I assume that what you do need to change is long type to long long,
and double type to long double,
and deal with lines (in other files) that using malloc()/dynamic memory allocation.

---

Well good luck with that. As I said I couldn't even get it to compile.

It may be a very useful language. But the codebase as it stands is problematic. Lots of hocus-pocus direct memory manipulation for example. Who's going to volunteer to audit that? Because you have to in order to ensure that buffer overflows and such aren't possible.

A decently structured program is usually easy to fix. All offsets are explicit and understandable. All constants are named and used where applicable. Not just magic numbers strewn about like that. What I mean to say is that whoever wrote that code apparently didn't have future maintainance in mind. Because if they had we'd be talking about probably half a dozen or less lines of code to edit nevermind any question about memory vulnerabilities.

Quote:

---

Originally Posted by Sir Galahad

Well good luck with that. As I said I couldn't even get it to compile.

It may be a very useful language. But the codebase as it stands is problematic. Lots of hocus-pocus direct memory manipulation for example. Who's going to volunteer to audit that? Because you have to in order to ensure that buffer overflows and such aren't possible.

A decently structured program is usually easy to fix. All offsets are explicit and understandable. All constants are named and used where applicable. Not just magic numbers strewn about like that. What I mean to say is that whoever wrote that code apparently didn't have future maintainance in mind. Because if they had we'd be talking about probably half a dozen or less lines of code to edit nevermind any question about memory vulnerabilities.

---

• Well, Open Euphoria group is still continue to develop it, but they have created a totally different product from it.
• If you can not compile the code, as a C programmer, while I can compile it without a problem, and I'm not a C programmer by no means - how can you talk about well defined offsets and constants? did you even read the 'readme.txt' or any other documentation?
• Robert Craig (Rapid Euphoria's author), as I know him, is a very profound programmer, very knowledgeable, very intelligent. He designed Rapid Euphoria the way he did for the purpose of creating a very high performance interpreter and translator. He could do it the easy way, but that means that it would be a slow and clumsy tool just like Python, PHP, Java, etc.
• I must assume that a super intelligent person like Robert Craig took in consideration future improvements, buffer overflow, using sizeof(), and lots of other details which the average C programmer may not be even aware of.
• The "hocus pocus" direct memory manipulation is used to avoid the bugs and delays which belongs to a standard Garbage collection mechanism. And for other reasons that make this code super fast and super dynamic.
• Some Rapid Euphoria interpreted commands are almost as fast (or just as fast) as compiled C or Assembly code, such as and_bits() and others, yet they provide much more powerful features.

To sum up:
You are talking about highly intelligent programmer, Robert Craig, which Google, Microsoft or NASA would have triple his salary just to hire him. Yet, he is too good to work for a corporation.

So please, do not underestimate his strategy and his decisions - he must know better then all of us what is a modular code and the benefits of constants and macros...

His "spaghetti code" was a conscious decision. Not an experiment of a high school student. (overhead gets only bigger and bigger as more features are added to the interpreter, he simply eliminated any current and future overhead).

Just look at Microsoft's QuickBasic for DOS - each BASIC statement calls so many routines, in C or Assembly, so only by this overhead the language becomes relatively so slow.

I could go on, yet to understand things better you need to see the overall picture:
what is Rapid Euphoria, what it does, and compare it to any other language that you know.
Only then you could have a more realistic opinion about the way that Robert Craig designed the code.

If you cannot think out-of-the-box, then don't bother to analyse this code. It'll be a waste of your time.

Quote:

---

Originally Posted by shian

If you can not compile the code, as a C programmer, while I can compile it without a problem, and I'm not a C programmer by no means - how can you talk about well defined offsets and constants? did you even read the 'readme.txt' or any other documentation?

---

I actually did read the docs. But seeing the prebuilt binary preoccupied my mind and I mistakenly invoked `make` instead of `imakeu`. My qualification to speak of offsets and constants are another matter of debate.

Quote:

---

Originally Posted by shian

I must assume that a super intelligent person like Robert Craig took in consideration future improvements, buffer overflow, using sizeof(), and lots of other details which the average C programmer may not be even aware of.
[...]
So please, do not underestimate his strategy and his decisions - he must know better then all of us what is a modular code and the benefits of constants and macros...

---

A lot of smart people are disorganized. What I'm talking about is writing programs with a low level of specificity. Generalizations and modularity lead to optimally compact representations of an idea which can thus be easily "proven" by examination. All software falls somewhere within the spectrum of these two extremes, disorder and order. This particular project is probably left of middle on that meter. But who knows? Maybe someday someone will come along who is willing to dedicate themselves to shoring it up.

Quote:

---

Originally Posted by shian

The "hocus pocus" direct memory manipulation is used to avoid the bugs and delays which belongs to a standard Garbage collection mechanism. And for other reasons that make this code super fast and super dynamic.
Some Rapid Euphoria interpreted commands are almost as fast (or just as fast) as compiled C or Assembly code, such as and_bits() and others, yet they provide much more powerful features.

---

Wonderful, it's fast. What I'm talking about is protecting users from malicious exploits. Unmaintained compilers, especially with a lot of memory-poking stuff going on, can be a major vector of just such attacks. What's needed are macros/functions which do all the bounds checking etc in a centralized fashion.

Quote:

---

Originally Posted by shian

His "spaghetti code" was a conscious decision. Not an experiment of a high school student. (overhead gets only bigger and bigger as more features are added to the interpreter, he simply eliminated any current and future overhead).

---

Macros eliminate overhead too though, they are after all basically "free".

Quote:

---

Originally Posted by shian

Only then you could have a more realistic opinion about the way that Robert Craig designed the code. If you cannot think out-of-the-box, then don't bother to analyse this code. It'll be a waste of your time.

---

Don't get me wrong. I don't dislike the guy. I do admire the scope of his project for example. Lots of cool features. But underneath the hood the code is rather fragile. Adding/removing/modifying features might prove difficult due to the interconnectedness of the parts.

The good news is that Rapid Euphoria programming language is exactly the opposite of its source code.
i.e. as much as the source code is coded as a long list of instructions - the result is probably the most simple, elegant and compact programming language.

It's easy to represent 100 lines of BASIC, Python, Jscript (not to mention C) code in just 1 line of Rapid Euphoria. Because a single Rapid Euphoria sequence can include any complex data type which may exist in those languages all together.

Another good news is that Rapid Euphoria is written by a perfectionist, Robert Craig, and the code is proven to be reliable and stable throughout the years.

About malicious attacks:
It is the same problem of environmental pollution - we create much more garbage then we can recycle, so the garbage is here to stay.
i.e. we create much more hardware and software then we can protect, so the malicious attacks are here to stay.

The most protected institutes in the world are hacked every day. Government and military institutes.

And IoT and G5 are the insurance policy for malicious attacks to get out of control for good.

So why bother?

Unix had a backdoor all those years that it was considered "safe". That backdoor was placed by request.

Any CPU in the last two or more decades includes non-documented circuits. The malicious activity is already hardwired in your CPU.

People fooling themselves with anti-virus software and daily updates, while their hardware and their operating systems are already include backdoors by request.

Do not forget that any advanced civil technology is a military technology, that was developed by the military for the military. That includes the Internet and any transmitter/receiver in the market. Just do 1 + 1.

Smartphone is enough vulnerable for elementary school kids to hack. It is the most vulnerable piece of hardware and software on planet Earth. Yet people are bother to protect their PC. (They have no idea whatsoever, what IoT will bring: no more private life).

What I like about Rapid Euphoria is not the speed, it is the beauty and the simplicity of its power.

Quote:

---

Originally Posted by shian

It's easy to represent 100 lines of BASIC, Python, Jscript (not to mention C) code in just 1 line of Rapid Euphoria. Because a single Rapid Euphoria sequence can include any complex data type which may exist in those languages all together.

---

Could you show an example of a 100 line Python program that can be written with a single line of Rapid Euphoria code?

Quote:

---

Originally Posted by shian

The good news is that Rapid Euphoria programming language is exactly the opposite of its source code.
i.e. as much as the source code is coded as a long list of instructions - the result is probably the most simple, elegant and compact programming language.
[...]
What I like about Rapid Euphoria is not the speed, it is the beauty and the simplicity of its power.

---

The syntax is definitely that of a well thought out higher level language. I'll give it that. But porting is still a serious issue. Already I get many compile errors from gcc. Maybe my environment variables just need some tweaking, I don't know, but not very encouraging.

Quote:

---

Originally Posted by shian

Another good news is that Rapid Euphoria is written by a perfectionist, Robert Craig, and the code is proven to be reliable and stable throughout the years.

---

Still an imperfect human and therefore also apt to make mistakes from time to time.

Quote:

---

Originally Posted by shian

About malicious attacks:
It is the same problem of environmental pollution - we create much more garbage then we can recycle, so the garbage is here to stay.
i.e. we create much more hardware and software then we can protect, so the malicious attacks are here to stay.

The most protected institutes in the world are hacked every day. Government and military institutes.

And IoT and G5 are the insurance policy for malicious attacks to get out of control for good.

So why bother?

Unix had a backdoor all those years that it was considered "safe". That backdoor was placed by request.

Any CPU in the last two or more decades includes non-documented circuits. The malicious activity is already hardwired in your CPU.

People fooling themselves with anti-virus software and daily updates, while their hardware and their operating systems are already include backdoors by request.

Do not forget that any advanced civil technology is a military technology, that was developed by the military for the military. That includes the Internet and any transmitter/receiver in the market. Just do 1 + 1.

Smartphone is enough vulnerable for elementary school kids to hack. It is the most vulnerable piece of hardware and software on planet Earth. Yet people are bother to protect their PC. (They have no idea whatsoever, what IoT will bring: no more private life).

---

Insecurities have indeed existed since the beginning. It's true. But that doesn't mean we shouldn't work towards a more manageable situation. Because most bugs ARE human error and in fact correctable in a mathematically verifiable sense. So there is hope.

Quote:

---

Originally Posted by laserlight

Could you show an example of a 100 line Python program that can be written with a single line of Rapid Euphoria code?

---

Just imagine a very simple QBASIC statement (very similar to C struct):

Code:

---

TYPE usertype
 name AS STRING * 20          ' first line
 number AS DOUBLE
 elementname AS typename     
 [elementname AS typename]
.
.
.                            ' 100 line
END TYPE

---

In Rapid Euphoria you use a singe sequence for the above 100 + 2 lines,
(the actual type of an element is handled in Rapid Euphoria in a much safer way):

Code:

---

s = {name, number, elementname, elementname, ...}

---

But it can get even better, since Euphoria handles dynamic sequences very efficiently:

Code:

---

s = repeat(0, 100)  -- prepare a place for 100 elements of any type
                      -- [1], [2], [3], ... [100]   
                      -- an element could be {{key, data}, {k, d}, ...}
                      -- or anything.

---

Or even much better:

Code:

---

s = {}    -- now do whatever you need to do with it at run time!
              -- It can hold unlimited different data types arbitrarily,
            -- also as deeply nested sub-sequences.

---

I can give many more examples, but it gets ridiculous.

Quote:

---

Originally Posted by shian

Just imagine a very simple QBASIC statement (very similar to C struct):

---

I'm afraid that I'm not familiar with QBASIC, which is why I asked for a Python example since you mentioned Python specifically.

Quote:

---

Originally Posted by shian

In Rapid Euphoria you use a singe sequence for the above 100 + 2 lines,

---

The same can be done in Python though: a single list of items of varying types.

No, I'm not going to argue that Python is better than Rapid Euphoria. I'm just more cautious in my evaluation of programming languages, and I was curious as to whether your claim with respect to Python was accurate or exaggerated, and from what I see it is the latter, but that doesn't mean that Rapid Euphoria doesn't have advantages over Python, or that Python isn't presently better than Rapid Euphoria in other ways (you yourself have cited an example: the lack of libraries for Rapid Euphoria).

My analysis of your situation remains: if you won't learn C yourself, and you have no community of Rapid Euphoria developers to fall back on, then you just have to wait for a C programmer to come along who loves Rapid Euphoria enough to work on it.

I am rather surprised though that Robert Craig never did implement Rapid Euphoria in Rapid Euphoria: if that had been done, maybe you could modify the code yourself for your goals.

Quote:

---

Originally Posted by Sir Galahad

The syntax is definitely that of a well thought out higher level language. I'll give it that. But porting is still a serious issue. Already I get many compile errors from gcc. Maybe my environment variables just need some tweaking, I don't know, but not very encouraging.
[ ... ]
Still an imperfect human and therefore also apt to make mistakes from time to time.
[ ... ]
Insecurities have indeed existed since the beginning. It's true. But that doesn't mean we shouldn't work towards a more manageable situation. Because most bugs ARE human error and in fact correctable in a mathematically verifiable sense. So there is hope.

---

• [not very encouraging] You should compile with gcc version less then 6.0. I've used gcc 4.8.4 with -Wall -Wpedantic without a single error or warning. I also commented out a C macro for Assembly PUSH/ADD which is needed to be recalculated for 64-bit CPU. (this macro adds a single feature to the language: calling a C shared library or machine code).
• [imperfect human] I guess that Jesus already mentioned it 2000 years ago. I cannot see your point.
• [So there is hope.] Actually not. Learn about it, starting with IoT and G5 technology (do not stop when it gets creepy - unfortunately that's when it gets real). And by the way, anyone can "fish" your paypal or google password using a "formal" email with a "formal link" to renew your password for your own safety. Millions will fall into this trap.

Quote:

---

Originally Posted by laserlight

I'm afraid that I'm not familiar with QBASIC, which is why I asked for a Python example since you mentioned Python specifically.
[ ... ]
The same can be done in Python though: a single list of items of varying types.
[ ... ]
No, I'm not going to argue that Python is better than Rapid Euphoria. I'm just more cautious in my evaluation of programming languages, and I was curious as to whether your claim with respect to Python was accurate or exaggerated, and from what I see it is the latter, but that doesn't mean that Rapid Euphoria doesn't have advantages over Python, or that Python isn't presently better than Rapid Euphoria in other ways (you yourself have cited an example: the lack of libraries for Rapid Euphoria).

My analysis of your situation remains: if you won't learn C yourself, and you have no community of Rapid Euphoria developers to fall back on, then you just have to wait for a C programmer to come along who loves Rapid Euphoria enough to work on it.

I am rather surprised though that Robert Craig never did implement Rapid Euphoria in Rapid Euphoria: if that had been done, maybe you could modify the code yourself for your goals.

---

• [not familiar with QBASIC] QBASIC TYPE is a high level equivalent to C struct. (Without bit-level and pointer features).
• I did not use Python since I dislike it and I almost forgot it. Yet, Python is way weaker then Rapid Euphoria when dealing with data types. Python is clumsy and not safe in this sense.
• Since Rapid Euphoria never become a commercial product, the lack of libraries is obvious. Yet libraries can be added to Rapid Euphoria using Euphoria or C, without any modification to the core.
• I do not think that I am exaggerating at all. I've used Microsoft's products, including OOP, and Rapid Euphoria, and I have a good reason for my claims. Most of the code that is dealing with data types in any other language is absent and not needed in Rapid Euphoria. And dealing with data types is the main madness (yea, madness) of almost any language. Python has a very poor way to deal with data types from my perspective, it's one good reason not to use it. As far as I remember Python.
• The interpreter of Rapid Euphoria is written in C and in Rapid Euphoria. So I actually already compiled a 64-bit version of the interpreter, exu64. Yet, it is not as fast as the C interpreter, and speed is something that I like about Rapid Euphoria, it allows me to do things that I could not do in Python, PHP, Ruby or BASIC, because these interpreters are much slower then Rapid Euphoria.
• If nobody want to help with this matter, I can still create a 32-bit product with Rapid Euphoria. Before 32-bit will be abandoned - I'll probably be dead. The future of the PC world and the Internet is on a crossroads anyway. And once the big corporations will become the exclusive landlords of the Internet, and it's going in this direction, you can expect the PC world to become a political entity. At this point, whatever we do will be meaningless. You don't have to believe me, time will tell.

Quote:

---

Originally Posted by shian

I do not think that I am exaggerating at all.

---

That is with respect to the specific claim that "It's easy to represent 100 lines of (...) Python, (...) code in just 1 line of Rapid Euphoria". According to the example that you gave, it isn't. For Rapid Euphoria advocacy, it might be better to stick to claims that you can prove, otherwise it will look like you're exaggerating everything about Rapid Euphoria, even when you aren't.

Quote:

---

Originally Posted by laserlight

That is with respect to the specific claim that "It's easy to represent 100 lines of (...) Python, (...) code in just 1 line of Rapid Euphoria". According to the example that you gave, it isn't. For Rapid Euphoria advocacy, it might be better to stick to claims that you can prove, otherwise it will look like you're exaggerating everything about Rapid Euphoria, even when you aren't.

---

I am sorry, I did these comparisons with Python and other languages a long time ago, then I just forgot about it. One "bad" thing about me is that I never keep unit testing or tests in general, so I have to keep reinventing the wheel whenever someone asks a similar question (and I am tired of it).

Yet, at the time, I found Python really clumsy compare to Rapid Euphoria. Also in its core (byte-string, 2-byte string, 4-byte string, and all that mess which I already forgot about. Rapid Euphoria does not have any string type at all).

It does not bother me that one may say that I am exaggerating, since normally it is not someone that ever code in Rapid Euphoria, therefore it is one's assumption as well.

Yet I could show some functions from Lib2 (which I am writing for Rapid Euphoria), a one-line functions that can easily manipulate any kind of complex data, with predictable results. And let others compare it to their favourite language.

For example a function that shift-left bits of a 32-bit integer or double, which could manipulate the most complex data structure that you could imagine, as well as a single value, and return only signed values in exactly the same structure:

Code:

---

global function shl_bits(object x, integer n)
    return or_bits(and_bits(x, M_LOW[n + 1]) * M_SHL[33 - n], #0)
end function

---

Out of topic, if I am not wrong, as someone who lives in Singapore your English is incredible. Just wondering.

Quote:

---

Originally Posted by shian

...
For example a function that shift-left bits of a 32-bit integer or double, which could manipulate the most complex data structure that you could imagine, as well as a single value, and return only signed values in exactly the same structure:

Code:

---

global function shl_bits(object x, integer n)
    return or_bits(and_bits(x, M_LOW[n + 1]) * M_SHL[33 - n], #0)
end function

---

---

"C++ Witch" - I've seen your website, sorry for "bashing" Python. I see that you're an expert for Python.
And by the way, you look more like an angel then a witch... personal opinion.

Anyway, just consider the example above, I'm not sure which language could accomplish this so easily or at all, for instance:

Code:

---

include machine2.e

object x, r, key, value


x = #FFCC0033 -- (hexadecimal)
r = shl_bits(x, 16)
-- r is #330000 -- (hexadecimal)


x = "https://www.rapideuphoria311.com/"
r = shl_bits(x, 21)
-- r is {218103808,243269632,243269632,234881024,241172480,121634816,98566144,98566144,249561088,249561088,249561088,96468992,239075328,203423744,234881024,220200960,209715200,211812352,245366784,234881024,218103808,232783872,239075328,220200960,203423744,106954752,102760448,102760448,96468992,207618048,232783872,228589568,98566144}


key = {11.4, -134, "Dust in the Wind"}
value = sqrt(abs(key))
x = {{key, value}, {"shian", {1, 3.5}}, {-3405.5, "Euphoria", 3.1}}
r = shl_bits(x, 4) -- shift-left x elements 4 bits
-- r is {{{176,-2144,{1088,1872,1840,1856,512,1680,1760,512,1856,1664,1616,512,1392,1680,1760,1600}},{48,176,{128,160,160,160,80,160,160,80,160,160,160,80,144,160,160,160}}},{{1840,1664,1680,1552,1760},{16,48}},{-54480,{1104,1872,1792,1664,1776,1824,1680,1552},48}}


x = {1.4, arctan("C++ Board"), {"C++ Angel", 100}}
x = xor_bits(append(repeat(x, 2), {30, 3e+6, {1, {2.2, {-3.3}}}}), #3F01CE3B)
r = shl_bits(x, 16)
-- r is {{-835059712,{-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712},{{-830996480,-837812224,-837812224,-837091328,-830865408,-833290240,-832831488,-832700416,-833159168},-832634880}},{-835059712,{-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712,-835059712},{{-830996480,-837812224,-837812224,-837091328,-830865408,-833290240,-832831488,-832700416,-833159168},-832634880}},{-836435968,150667264,{-835059712,{-835125248,{835059712}}}}}


-- And you could go on with *any* delusional data structure you can imagine.

---

That's why I've said that Rapid Euphoria could replace 100 lines of Python; as complex as the data type is, Python will probably need more lines of code to deal with it, while in Rapid Euphoria the word "complex" does not exist.
If I'm still exaggerating, please be kind and let me know.