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

  1. #16
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90
    .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
    Last edited by Sir Galahad; 11-02-2019 at 01:01 PM.

  2. #17
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    .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).

  3. #18
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90
    Quote Originally Posted by shian View Post
    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.

  4. #19
    C++ Witch laserlight's Avatar
    Join Date
    Oct 2003
    Location
    Singapore
    Posts
    27,507
    Quote Originally Posted by Sir Galahad View Post
    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?
    Quote Originally Posted by Bjarne Stroustrup (2000-10-14)
    I get maybe two dozen requests for help with some sort of programming or design problem every day. Most have more sense than to send me hundreds of lines of code. If they do, I ask them to find the smallest example that exhibits the problem and send me that. Mostly, they then find the error themselves. "Finding the smallest program that demonstrates the error" is a powerful debugging tool.
    Look up a C++ Reference and learn How To Ask Questions The Smart Way

  5. #20
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90
    Quote Originally Posted by laserlight View Post
    To be fair, that is what shian is hoping to overcome with this request for a volunteer, after all. Are you volunteering?
    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...

  6. #21
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    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.

  7. #22
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    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).

  8. #23
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by laserlight View Post
    To be fair, that is what shian is hoping to overcome with this request for a volunteer, after all. Are you volunteering?
    Thank you for your support.

  9. #24
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    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:

    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.

  10. #25
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90
    Quote Originally Posted by shian View Post
    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.
    Last edited by Sir Galahad; 11-03-2019 at 09:35 AM.

  11. #26
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    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.

  12. #27
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    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.

  13. #28
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90

    Cool

    Quote Originally Posted by shian View Post
    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.

  14. #29
    Registered User shian's Avatar
    Join Date
    Oct 2019
    Location
    Israel
    Posts
    23
    Quote Originally Posted by Sir Galahad View Post
    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.

  15. #30
    Registered User Sir Galahad's Avatar
    Join Date
    Nov 2016
    Location
    The Round Table
    Posts
    90
    Quote Originally Posted by shian View Post
    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 View Post
    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 View Post
    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 View Post
    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 View Post
    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.
    Last edited by Sir Galahad; 11-04-2019 at 12:09 PM.

Popular pages Recent additions subscribe to a feed

Similar Threads

  1. Importance of english language in programming language
    By Lea Pi in forum General Discussions
    Replies: 10
    Last Post: 04-17-2015, 07:43 AM
  2. rapid histogramming
    By stabu in forum C Programming
    Replies: 6
    Last Post: 08-22-2008, 11:18 AM
  3. What's the Difference Between a Programming Language and a Scripting Language?
    By Krak in forum A Brief History of Cprogramming.com
    Replies: 23
    Last Post: 07-15-2005, 04:46 PM
  4. MS Windows Welsh Language Version Available
    By hk_mp5kpdw in forum A Brief History of Cprogramming.com
    Replies: 10
    Last Post: 12-03-2004, 04:59 PM
  5. ahhh help....rapid keypress detection
    By technoXavage in forum Game Programming
    Replies: 1
    Last Post: 12-18-2003, 01:00 PM

Tags for this Thread