version 1.109, 2008/07/15 16:11:49
|
version 1.119, 2012/07/15 12:03:07
|
Line 1
|
Line 1
|
/* Gforth virtual machine (aka inner interpreter) |
/* Gforth virtual machine (aka inner interpreter) |
|
|
Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. |
Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2010,2011 Free Software Foundation, Inc. |
|
|
This file is part of Gforth. |
This file is part of Gforth. |
|
|
Line 44
|
Line 44
|
#include <unistd.h> |
#include <unistd.h> |
#include <pwd.h> |
#include <pwd.h> |
#include <dirent.h> |
#include <dirent.h> |
|
#ifdef HAVE_WCHAR_H |
#include <wchar.h> |
#include <wchar.h> |
|
#endif |
#include <sys/resource.h> |
#include <sys/resource.h> |
#ifdef HAVE_FNMATCH_H |
#ifdef HAVE_FNMATCH_H |
#include <fnmatch.h> |
#include <fnmatch.h> |
Line 87
|
Line 89
|
|
|
#ifdef MEMCMP_AS_SUBROUTINE |
#ifdef MEMCMP_AS_SUBROUTINE |
extern int gforth_memcmp(const char * s1, const char * s2, size_t n); |
extern int gforth_memcmp(const char * s1, const char * s2, size_t n); |
|
extern Char *gforth_memmove(Char * dest, const Char* src, Cell n); |
|
extern Char *gforth_memset(Char * s, Cell c, UCell n); |
|
extern Char *gforth_memcpy(Char * dest, const Char* src, Cell n); |
#define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n) |
#define memcmp(s1,s2,n) gforth_memcmp(s1,s2,n) |
|
#define memmove(a,b,c) gforth_memmove(a,b,c) |
|
#define memset(a,b,c) gforth_memset(a,b,c) |
|
#define memcpy(a,b,c) gforth_memcpy(a,b,c) |
#endif |
#endif |
|
|
#define NEWLINE '\n' |
#define NEWLINE '\n' |
Line 200 extern int gforth_memcmp(const char * s1
|
Line 208 extern int gforth_memcmp(const char * s1
|
#ifndef FTOSREG |
#ifndef FTOSREG |
#define FTOSREG |
#define FTOSREG |
#endif |
#endif |
|
#ifndef OPREG |
|
#define OPREG |
|
#endif |
|
|
#ifndef CPU_DEP1 |
#ifndef CPU_DEP1 |
# define CPU_DEP1 0 |
# define CPU_DEP1 0 |
Line 228 extern int gforth_memcmp(const char * s1
|
Line 239 extern int gforth_memcmp(const char * s1
|
#define asmcomment(string) asm("") |
#define asmcomment(string) asm("") |
#endif |
#endif |
|
|
|
#define DEPTHOFF 4 |
#ifdef GFORTH_DEBUGGING |
#ifdef GFORTH_DEBUGGING |
#if DEBUG |
#if DEBUG |
#define NAME(string) { saved_ip=ip; asmcomment(string); fprintf(stderr,"%08lx depth=%3ld tos=%016lx: "string"\n",(Cell)ip,sp0+3-sp,sp[0]);} |
#define NAME(string) { saved_ip=ip; asmcomment(string); fprintf(stderr,"%08lx depth=%3ld tos=%016lx: "string"\n",(Cell)ip,sp0+DEPTHOFF-sp,sp[0]);} |
#else /* !DEBUG */ |
#else /* !DEBUG */ |
#define NAME(string) { saved_ip=ip; asm(""); } |
#define NAME(string) { saved_ip=ip; asm(""); } |
/* the asm here is to avoid reordering of following stuff above the |
/* the asm here is to avoid reordering of following stuff above the |
Line 240 extern int gforth_memcmp(const char * s1
|
Line 252 extern int gforth_memcmp(const char * s1
|
because the stack loads may already cause a stack underflow. */ |
because the stack loads may already cause a stack underflow. */ |
#endif /* !DEBUG */ |
#endif /* !DEBUG */ |
#elif DEBUG |
#elif DEBUG |
# define NAME(string) {Cell __depth=sp0+3-sp; int i; fprintf(stderr,"%08lx depth=%3ld: "string,(Cell)ip,sp0+3-sp); for (i=__depth-1; i>0; i--) fprintf(stderr, " $%lx",sp[i]); fprintf(stderr, " $%lx\n",spTOS); } |
# define NAME(string) {Cell __depth=sp0+DEPTHOFF-sp; int i; fprintf(stderr,"%08lx depth=%3ld: "string,(Cell)ip,sp0+DEPTHOFF-sp); for (i=__depth-1; i>0; i--) fprintf(stderr, " $%lx",sp[i]); fprintf(stderr, " $%lx\n",spTOS); } |
#else |
#else |
# define NAME(string) asmcomment(string); |
# define NAME(string) asmcomment(string); |
#endif |
#endif |
Line 260 extern int gforth_memcmp(const char * s1
|
Line 272 extern int gforth_memcmp(const char * s1
|
#endif |
#endif |
|
|
#ifdef STANDALONE |
#ifdef STANDALONE |
jmp_buf throw_jmp_buf; |
jmp_buf * throw_jmp_handler; |
|
|
void throw(int code) |
void throw(int code) |
{ |
{ |
longjmp(throw_jmp_buf,code); /* !! or use siglongjmp ? */ |
longjmp(*throw_jmp_handler,code); /* !! or use siglongjmp ? */ |
} |
} |
#endif |
#endif |
|
|
Line 328 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
Line 340 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
register Address lp LPREG = lp0; |
register Address lp LPREG = lp0; |
register Xt cfa CFAREG; |
register Xt cfa CFAREG; |
register Label real_ca CAREG; |
register Label real_ca CAREG; |
|
#ifdef HAS_OBJECTS |
|
register Char * op OPREG = NULL; |
|
#endif |
#ifdef MORE_VARS |
#ifdef MORE_VARS |
MORE_VARS |
MORE_VARS |
#endif |
#endif |
Line 347 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
Line 362 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
register Cell MAYBE_UNUSED spc spcREG; |
register Cell MAYBE_UNUSED spc spcREG; |
register Cell MAYBE_UNUSED spd spdREG; |
register Cell MAYBE_UNUSED spd spdREG; |
register Cell MAYBE_UNUSED spe speREG; |
register Cell MAYBE_UNUSED spe speREG; |
register Cell MAYBE_UNUSED spf speREG; |
register Cell MAYBE_UNUSED spf spfREG; |
register Cell MAYBE_UNUSED spg speREG; |
register Cell MAYBE_UNUSED spg spgREG; |
register Cell MAYBE_UNUSED sph speREG; |
register Cell MAYBE_UNUSED sph sphREG; |
IF_fpTOS(register Float fpTOS FTOSREG;) |
IF_fpTOS(register Float fpTOS FTOSREG;) |
#endif /* !defined(GFORTH_DEBUGGING) */ |
#endif /* !defined(GFORTH_DEBUGGING) */ |
#if defined(DOUBLY_INDIRECT) |
#if defined(DOUBLY_INDIRECT) |
Line 404 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
Line 419 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
|
|
symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset); |
symbols = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+CODE_OFFSET)+code_offset); |
xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset); |
xts = (Label *)(malloc(MAX_SYMBOLS*sizeof(Cell)+XT_OFFSET)+xt_offset); |
for (i=0; i<DOESJUMP+1; i++) |
for (i=0; i<DOER_MAX+1; i++) |
xts[i] = symbols[i] = (Label)routines[i]; |
xts[i] = symbols[i] = (Label)routines[i]; |
for (; routines[i]!=0; i++) { |
for (; routines[i]!=0; i++) { |
if (i>=MAX_SYMBOLS) { |
if (i>=MAX_SYMBOLS) { |
Line 421 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
Line 436 Label *gforth_engine(Xt *ip0, Cell *sp0,
|
#endif |
#endif |
} |
} |
|
|
#if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING)) |
#ifdef USE_TOS |
sp += STACK_CACHE_DEFAULT-1; |
sp += STACK_CACHE_DEFAULT-1; |
/* some of those registers are dead, but its simpler to initialize them all */ spTOS = sp[0]; |
/* some of those registers are dead, but its simpler to initialize them all */ spTOS = sp[0]; |
spb = sp[-1]; |
spb = sp[-1]; |