--- gforth/engine/engine.c	1998/03/21 21:37:50	1.2
+++ gforth/engine/engine.c	2000/05/16 09:51:21	1.16
@@ -1,6 +1,6 @@
 /* Gforth virtual machine (aka inner interpreter)
 
-  Copyright (C) 1995 Free Software Foundation, Inc.
+  Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
   This file is part of Gforth.
 
@@ -24,23 +24,30 @@
 #include <stdio.h>
 #include <string.h>
 #include <math.h>
+#include <assert.h>
+#include <stdlib.h>
+#include <errno.h>
+#include "forth.h"
+#include "io.h"
+#include "threaded.h"
+#ifndef STANDALONE
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <fcntl.h>
-#include <assert.h>
-#include <stdlib.h>
 #include <time.h>
 #include <sys/time.h>
 #include <unistd.h>
-#include <errno.h>
 #include <pwd.h>
-#include "forth.h"
-#include "io.h"
-#include "threaded.h"
+#else
+#include "systypes.h"
+#endif
 
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) /* what else? */
 #include <dlfcn.h>
 #endif
+#if defined(_WIN32)
+#include <windows.h>
+#endif
 #ifdef hpux
 #include <dl.h>
 #endif
@@ -52,11 +59,11 @@
 
 #define IOR(flag)	((flag)? -512-errno : 0)
 
-typedef struct F83Name {
-  struct F83Name	*next;  /* the link field for old hands */
-  char			countetc;
-  Char			name[0];
-} F83Name;
+struct F83Name {
+  struct F83Name *next;  /* the link field for old hands */
+  char		countetc;
+  char		name[0];
+};
 
 /* are macros for setting necessary? */
 #define F83NAME_COUNT(np)	((np)->countetc & 0x1f)
@@ -73,6 +80,12 @@ int emitcounter;
 #endif
 #define NULLC '\0'
 
+#ifdef MEMCMP_AS_SUBROUTINE
+extern int gforth_memcmp(const char * s1, const char * s2, size_t n);
+#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 */
@@ -124,6 +137,8 @@ char *tilde_cstr(Char *from, UCell size,
     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);
@@ -146,7 +161,7 @@ char *tilde_cstr(Char *from, UCell size,
     return cstr(path,s1_len+s2_len,clear);
   }
 }
-   
+#endif
 
 #define NEWLINE	'\n'
 
@@ -154,7 +169,8 @@ char *tilde_cstr(Char *from, UCell size,
 #define rint(x)	floor((x)+0.5)
 #endif
 
-static char* fileattr[6]={"r","rb","r+","r+b","w","wb"};
+#ifdef HAS_FILE
+static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
 
 #ifndef O_BINARY
 #define O_BINARY 0
@@ -164,9 +180,10 @@ static char* fileattr[6]={"r","rb","r+",
 #endif
 
 static int ufileattr[6]= {
-  O_RDONLY|O_TEXT, O_RDONLY|O_BINARY,
-  O_RDWR  |O_TEXT, O_RDWR  |O_BINARY,
-  O_WRONLY|O_TEXT, O_WRONLY|O_BINARY };
+  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
 
 /* if machine.h has not defined explicit registers, define them as implicit */
 #ifndef IPREG
@@ -203,25 +220,38 @@ static int ufileattr[6]= {
 
 /* declare and compute cfa for certain threading variants */
 /* warning: this is nonsyntactical; it will not work in place of a statement */
-#ifdef CFA_NEXT
+#ifndef GETCFA
 #define DOCFA
 #else
 #define DOCFA	Xt cfa; GETCFA(cfa)
 #endif
 
+#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
+
 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
 */
 {
-  register Xt *ip IPREG = ip0;
+#ifndef GFORTH_DEBUGGING
+  register Xt *ip IPREG;
+  register Cell *rp RPREG;
+#endif
   register Cell *sp SPREG = sp0;
-  register Cell *rp RPREG = rp0;
   register Float *fp FPREG = fp0;
   register Address lp LPREG = lp0;
 #ifdef CFA_NEXT
   register Xt cfa CFAREG;
 #endif
+#ifdef MORE_VARS
+  MORE_VARS
+#endif
   register Address up UPREG = UP;
   IF_TOS(register Cell TOS TOSREG;)
   IF_FTOS(register Float FTOS FTOSREG;)
@@ -231,23 +261,25 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
 #else /* !defined(DOUBLY_INDIRECT) */
   static Label symbols[]= {
 #endif /* !defined(DOUBLY_INDIRECT) */
-    &&docol,
-    &&docon,
-    &&dovar,
-    &&douser,
-    &&dodefer,
-    &&dofield,
-    &&dodoes,
+    (Label)&&docol,
+    (Label)&&docon,
+    (Label)&&dovar,
+    (Label)&&douser,
+    (Label)&&dodefer,
+    (Label)&&dofield,
+    (Label)&&dodoes,
     /* the following entry is normally unused;
        it's there because its index indicates a does-handler */
     CPU_DEP1,
 #include "prim_lab.i"
-    0
+    (Label)0
   };
 #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,
@@ -256,11 +288,12 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
 
   if (ip == NULL) {
 #if defined(DOUBLY_INDIRECT)
-#define MAX_SYMBOLS 1000
+#define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
+#define CODE_OFFSET (22*sizeof(Cell))
     int i;
-    Cell code_offset = offset_image? 22*sizeof(Cell) : 0;
+    Cell code_offset = offset_image? CODE_OFFSET : 0;
 
-    symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+code_offset)+code_offset);
+    symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset);
     for (i=0; i<DOESJUMP+1; i++)
       symbols[i] = (Label)routines[i];
     for (; routines[i]!=0; i++) {
@@ -277,9 +310,10 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
   IF_TOS(TOS = sp[0]);
   IF_FTOS(FTOS = fp[0]);
 /*  prep_terminal(); */
-  NEXT_P0;
+  SET_IP(ip);
   NEXT;
 
+
 #ifdef CPU_DEP3
   CPU_DEP3
 #endif
@@ -293,22 +327,17 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
 #ifdef CISC_NEXT
     /* this is the simple version */
     *--rp = (Cell)ip;
-    ip = (Xt *)PFA1(cfa);
-    NEXT_P0;
+    SET_IP((Xt *)PFA1(cfa));
     NEXT;
 #else
-    /* this one is important, so we help the compiler optimizing
-       The following version may be better (for scheduling), but probably has
-       problems with code fields employing calls and delay slots
-       */
+    /* this one is important, so we help the compiler optimizing */
     {
       DEF_CA
-      Xt *current_ip = (Xt *)PFA1(cfa);
-      cfa = *current_ip;
-      NEXT1_P1;
-      *--rp = (Cell)ip;
-      ip = current_ip+1;
-      NEXT1_P2;
+      rp[-1] = (Cell)ip;
+      SET_IP((Xt *)PFA1(cfa));
+      NEXT_P1;
+      rp--;
+      NEXT_P2;
     }
 #endif
   }
@@ -376,7 +405,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
 #ifdef DEBUG
     fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
 #endif
-    TOS += *(Cell*)PFA1(cfa); 
+    TOS += *(Cell*)PFA1(cfa);
   }
   NEXT_P0;
   NEXT;
@@ -409,16 +438,15 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
 #endif
     *--rp = (Cell)ip;
     /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
-    ip = DOES_CODE1(cfa);
 #ifdef USE_TOS
     *sp-- = TOS;
     TOS = (Cell)PFA(cfa);
 #else
     *--sp = (Cell)PFA(cfa);
 #endif
+    SET_IP(DOES_CODE1(cfa));
     /*    fprintf(stderr,"TOS = %08lx, IP=%08lx\n", TOS, IP);*/
   }
-  NEXT_P0;
   NEXT;
 
 #include "prim.i"