--- gforth/engine/engine.c	2002/08/19 07:38:16	1.43
+++ gforth/engine/engine.c	2002/12/28 17:18:27	1.54
@@ -19,8 +19,6 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 */
 
-undefine(`symbols')
-
 #include "config.h"
 #include "forth.h"
 #include <ctype.h>
@@ -66,6 +64,14 @@ undefine(`symbols')
 #define SEEK_SET 0
 #endif
 
+#ifndef HAVE_FSEEKO
+#define fseeko fseek
+#endif
+
+#ifndef HAVE_FTELLO
+#define ftello ftell
+#endif
+
 #define IOR(flag)	((flag)? -512-errno : 0)
 
 struct F83Name {
@@ -84,14 +90,6 @@ struct Longname {
 
 #define LONGNAME_COUNT(np)	((np)->countetc & (((~((UCell)0))<<3)>>3))
 
-Cell *SP;
-Float *FP;
-Address UP=NULL;
-
-#if 0
-/* not used currently */
-int emitcounter;
-#endif
 #define NULLC '\0'
 
 #ifdef MEMCMP_AS_SUBROUTINE
@@ -99,120 +97,8 @@ extern int gforth_memcmp(const char * s1
 #define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n)
 #endif
 
-#ifdef HAS_FILE
-char *cstr(Char *from, UCell size, int clear)
-/* return a C-string corresponding to the Forth string ( FROM SIZE ).
-   the C-string lives until the next call of cstr with CLEAR being true */
-{
-  static struct cstr_buffer {
-    char *buffer;
-    size_t size;
-  } *buffers=NULL;
-  static int nbuffers=0;
-  static int used=0;
-  struct cstr_buffer *b;
-
-  if (buffers==NULL)
-    buffers=malloc(0);
-  if (clear)
-    used=0;
-  if (used>=nbuffers) {
-    buffers=realloc(buffers,sizeof(struct cstr_buffer)*(used+1));
-    buffers[used]=(struct cstr_buffer){malloc(0),0};
-    nbuffers=used+1;
-  }
-  b=&buffers[used];
-  if (size+1 > b->size) {
-    b->buffer = realloc(b->buffer,size+1);
-    b->size = size+1;
-  }
-  memcpy(b->buffer,from,size);
-  b->buffer[size]='\0';
-  used++;
-  return b->buffer;
-}
-
-char *tilde_cstr(Char *from, UCell size, int clear)
-/* like cstr(), but perform tilde expansion on the string */
-{
-  char *s1,*s2;
-  int s1_len, s2_len;
-  struct passwd *getpwnam (), *user_entry;
-
-  if (size<1 || from[0]!='~')
-    return cstr(from, size, clear);
-  if (size<2 || from[1]=='/') {
-    s1 = (char *)getenv ("HOME");
-    if(s1 == NULL)
-      s1 = "";
-    s2 = from+1;
-    s2_len = size-1;
-  } else {
-    UCell i;
-    for (i=1; i<size && from[i]!='/'; i++)
-      ;
-    if (i==2 && from[1]=='+') /* deal with "~+", i.e., the wd */
-      return cstr(from+3, size<3?0:size-3,clear);
-    {
-      char user[i];
-      memcpy(user,from+1,i-1);
-      user[i-1]='\0';
-      user_entry=getpwnam(user);
-    }
-    if (user_entry==NULL)
-      return cstr(from, size, clear);
-    s1 = user_entry->pw_dir;
-    s2 = from+i;
-    s2_len = size-i;
-  }
-  s1_len = strlen(s1);
-  if (s1_len>1 && s1[s1_len-1]=='/')
-    s1_len--;
-  {
-    char path[s1_len+s2_len];
-    memcpy(path,s1,s1_len);
-    memcpy(path+s1_len,s2,s2_len);
-    return cstr(path,s1_len+s2_len,clear);
-  }
-}
-#endif
-
-DCell timeval2us(struct timeval *tvp)
-{
-#ifndef BUGGY_LONG_LONG
-  return (tvp->tv_sec*(DCell)1000000)+tvp->tv_usec;
-#else
-  DCell d2;
-  DCell d1=mmul(tvp->tv_sec,1000000);
-  d2.lo = d1.lo+tvp->tv_usec;
-  d2.hi = d1.hi + (d2.lo<d1.lo);
-  return d2;
-#endif
-}
-
 #define NEWLINE	'\n'
 
-#ifndef HAVE_RINT
-#define rint(x)	floor((x)+0.5)
-#endif
-
-#ifdef HAS_FILE
-static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
-static char* pfileattr[6]={"r","r","r+","r+","w","w"};
-
-#ifndef O_BINARY
-#define O_BINARY 0
-#endif
-#ifndef O_TEXT
-#define O_TEXT 0
-#endif
-
-static int ufileattr[6]= {
-  O_RDONLY|O_BINARY, O_RDONLY|O_BINARY,
-  O_RDWR  |O_BINARY, O_RDWR  |O_BINARY,
-  O_WRONLY|O_BINARY, O_WRONLY|O_BINARY };
-#endif
-
 /* conversion on fetch */
 
 #define vm_Cell2f(_cell,_x)		((_x)=(Bool)(_cell))
@@ -249,6 +135,12 @@ static int ufileattr[6]= {
 
 #define vm_Cell2Cell(_x,_y)		(_y=_x)
 
+#ifdef NO_IP
+#define IMM_ARG(access,value)		(VARIANT(value))
+#else
+#define IMM_ARG(access,value)		(access)
+#endif
+
 /* if machine.h has not defined explicit registers, define them as implicit */
 #ifndef IPREG
 #define IPREG
@@ -296,14 +188,6 @@ static int ufileattr[6]= {
 #endif
 #define SUPER_CONTINUE
 
-#ifdef GFORTH_DEBUGGING
-/* define some VM registers as global variables, so they survive exceptions;
-   global register variables are not up to the task (according to the 
-   GNU C manual) */
-Xt *ip;
-Cell *rp;
-#endif
-
 #ifdef DEBUG
 #define CFA_TO_NAME(__cfa) \
       Cell len, i; \
@@ -318,28 +202,46 @@ Cell *rp;
       }
 #endif
 
-Xt *primtable(Label symbols[], Cell size)
-     /* used in primitive primtable for peephole optimization */
-{
-  Xt *xts = (Xt *)malloc(size*sizeof(Xt));
-  Cell i;
+#if !defined(ENGINE)
+/* normal engine */
+#define VARIANT(v)	(v)
+#define JUMP(target)	goto I_noop
+#define LABEL(name) J_##name: asm(""); I_##name:
+
+#elif ENGINE==2
+/* variant with padding between VM instructions for finding out
+   cross-inst jumps (for dynamic code) */
+#define engine engine2
+#define VARIANT(v)	(v)
+#define JUMP(target)	goto I_noop
+#define LABEL(name) J_##name: SKIP16; I_##name:
+#define IN_ENGINE2
 
-  for (i=0; i<size; i++)
-    xts[i] = &symbols[i];
-  return xts;
-}
+#elif ENGINE==3
+/* variant with different immediate arguments for finding out
+   immediate arguments (for native code) */
+#define engine engine3
+#define VARIANT(v)	((v)^0xffffffff)
+#define JUMP(target)	goto K_lit
+#define LABEL(name) J_##name: asm(""); I_##name:
+#else
+#error illegal ENGINE value
+#endif /* ENGINE */
 
+#define LABEL2(name) K_##name:
 
-define(enginerest,
-`(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
+
+Label *engine(Xt *ip0, Cell *sp0, Cell *rp0, Float *fp0, Address lp0)
 /* executes code at ip, if ip!=NULL
    returns array of machine code labels (for use in a loader), if ip==NULL
 */
 {
 #ifndef GFORTH_DEBUGGING
-  register Xt *ip IPREG;
   register Cell *rp RPREG;
 #endif
+#ifndef NO_IP
+  register Xt *ip IPREG = ip0;
+#endif
   register Cell *sp SPREG = sp0;
   register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;
@@ -368,30 +270,30 @@ define(enginerest,
     /* the following entry is normally unused;
        it is there because its index indicates a does-handler */
     CPU_DEP1,
-#define INST_ADDR(name) (Label)&&I_##name
+#define INST_ADDR(name) (Label)&&I_##name,
 #include "prim_lab.i"
 #undef INST_ADDR
     (Label)&&after_last,
     (Label)0,
-#ifdef IN_ENGINE2
-#define INST_ADDR(name) (Label)&&J_##name
+#define INST_ADDR(name) (Label)&&K_##name,
+#include "prim_lab.i"
+#undef INST_ADDR
+#define INST_ADDR(name) (Label)&&J_##name,
 #include "prim_lab.i"
 #undef INST_ADDR
-#endif
   };
 #ifdef CPU_DEP2
   CPU_DEP2
 #endif
 
-  ip = ip0;
   rp = rp0;
 #ifdef DEBUG
   fprintf(stderr,"ip=%x, sp=%x, rp=%x, fp=%x, lp=%x, up=%x\n",
-          (unsigned)ip,(unsigned)sp,(unsigned)rp,
+          (unsigned)ip0,(unsigned)sp,(unsigned)rp,
 	  (unsigned)fp,(unsigned)lp,(unsigned)up);
 #endif
 
-  if (ip == NULL) {
+  if (ip0 == NULL) {
 #if defined(DOUBLY_INDIRECT)
 #define CODE_OFFSET (26*sizeof(Cell))
 #define XT_OFFSET (22*sizeof(Cell))
@@ -417,10 +319,13 @@ define(enginerest,
   IF_spTOS(spTOS = sp[0]);
   IF_fpTOS(fpTOS = fp[0]);
 /*  prep_terminal(); */
+#ifdef NO_IP
+  goto *(*(Label *)ip0);
+#else
   SET_IP(ip);
   SUPER_END; /* count the first block, too */
   NEXT;
-
+#endif
 
 #ifdef CPU_DEP3
   CPU_DEP3
@@ -428,6 +333,10 @@ define(enginerest,
   
  docol:
   {
+#ifdef NO_IP
+    *--rp = next_code;
+    goto **(Label *)PFA1(cfa);
+#else
 #ifdef DEBUG
     {
       CFA_TO_NAME(cfa);
@@ -453,6 +362,7 @@ define(enginerest,
       NEXT_P2;
     }
 #endif
+#endif
   }
 
  docon:
@@ -467,8 +377,12 @@ define(enginerest,
     *--sp = *(Cell *)PFA1(cfa);
 #endif
   }
+#ifdef NO_IP
+  goto *next_code;
+#else
   NEXT_P0;
   NEXT;
+#endif
   
  dovar:
   {
@@ -482,8 +396,12 @@ define(enginerest,
     *--sp = (Cell)PFA1(cfa);
 #endif
   }
+#ifdef NO_IP
+  goto *next_code;
+#else
   NEXT_P0;
   NEXT;
+#endif
   
  douser:
   {
@@ -497,8 +415,12 @@ define(enginerest,
     *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
 #endif
   }
+#ifdef NO_IP
+  goto *next_code;
+#else
   NEXT_P0;
   NEXT;
+#endif
   
  dodefer:
   {
@@ -516,8 +438,12 @@ define(enginerest,
 #endif
     spTOS += *(Cell*)PFA1(cfa);
   }
+#ifdef NO_IP
+  goto *next_code;
+#else
   NEXT_P0;
   NEXT;
+#endif
 
  dodoes:
   /* this assumes the following structure:
@@ -537,6 +463,13 @@ define(enginerest,
      pfa:
      
      */
+#ifdef NO_IP
+  *--rp = next_code;
+  IF_spTOS(spTOS = sp[0]);
+  sp--;
+  spTOS = (Cell)PFA(cfa);
+  goto **(Label *)DOES_CODE1(cfa);
+#else
   {
     /*    fprintf(stderr, "Got CFA %08lx at doescode %08lx/%08lx: does: %08lx\n",cfa,(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));*/
 #ifdef DEBUG
@@ -556,22 +489,9 @@ define(enginerest,
     /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
   }
   NEXT;
-
-#ifndef IN_ENGINE2
-#define LABEL(name) I_##name:
-#else
-#define LABEL(name) J_##name: asm(".skip 16"); I_##name:
 #endif
-#define LABEL2(name)
+
 #include "prim.i"
-#undef LABEL
   after_last: return (Label *)0;
   /*needed only to get the length of the last primitive */
-}'
-)
-
-Label *engine enginerest
-
-#define IN_ENGINE2
-Label *engine2 enginerest
-
+}