--- gforth/engine/engine.c 2005/01/23 09:55:12 1.78 +++ gforth/engine/engine.c 2005/12/31 15:46:13 1.87 @@ -1,6 +1,6 @@ /* Gforth virtual machine (aka inner interpreter) - Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc. + Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc. This file is part of Gforth. @@ -71,6 +71,10 @@ #include #endif +#ifdef HAS_LIBFFI +#include +#endif + #ifndef SEEK_SET /* should be defined in stdio.h, but some systems don't have it */ #define SEEK_SET 0 @@ -151,6 +155,9 @@ extern int gforth_memcmp(const char * s1 #ifndef LPREG #define LPREG #endif +#ifndef CAREG +#define CAREG +#endif #ifndef CFAREG #define CFAREG #endif @@ -166,6 +173,21 @@ extern int gforth_memcmp(const char * s1 #ifndef spcREG #define spcREG #endif +#ifndef spdREG +#define spdREG +#endif +#ifndef speREG +#define speREG +#endif +#ifndef spfREG +#define spfREG +#endif +#ifndef spgREG +#define spgREG +#endif +#ifndef sphREG +#define sphREG +#endif #ifndef FTOSREG #define FTOSREG #endif @@ -219,16 +241,16 @@ extern int gforth_memcmp(const char * s1 } #endif -#ifdef HAS_FFCALL -#define SAVE_REGS IF_spTOS(sp[0]=spTOS); IF_fpTOS(fp[0]=fpTOS); SP=sp; FP=fp; RP=rp; LP=lp; -#define REST_REGS sp=SP; fp=FP; rp=RP; lp=LP; IF_spTOS(spTOS=sp[0]); IF_fpTOS(fpTOS=fp[0]); +#if defined(HAS_FFCALL) || defined(HAS_LIBFFI) +#define SAVE_REGS IF_fpTOS(fp[0]=fpTOS); SP=sp; FP=fp; RP=rp; LP=lp; +#define REST_REGS sp=SP; fp=FP; rp=RP; lp=LP; IF_fpTOS(fpTOS=fp[0]); #endif #if !defined(ENGINE) /* normal engine */ #define VARIANT(v) (v) #define JUMP(target) goto I_noop -#define LABEL(name) H_##name: I_##name: +#define LABEL(name) H_##name: asm(""); I_##name: #elif ENGINE==2 /* variant with padding between VM instructions for finding out @@ -237,7 +259,6 @@ extern int gforth_memcmp(const char * s1 #define VARIANT(v) (v) #define JUMP(target) goto I_noop #define LABEL(name) H_##name: SKIP16; I_##name: -#define IN_ENGINE2 #elif ENGINE==3 /* variant with different immediate arguments for finding out @@ -245,7 +266,7 @@ extern int gforth_memcmp(const char * s1 #define engine engine3 #define VARIANT(v) ((v)^0xffffffff) #define JUMP(target) goto K_lit -#define LABEL(name) H_##name: I_##name: +#define LABEL(name) H_##name: asm(""); I_##name: #else #error illegal ENGINE value #endif /* ENGINE */ @@ -269,7 +290,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * register Float *fp FPREG = fp0; register Address lp LPREG = lp0; register Xt cfa CFAREG; - register Label real_ca; + register Label real_ca CAREG; #ifdef MORE_VARS MORE_VARS #endif @@ -282,10 +303,20 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * long long llrv; void * prv; #endif +#ifdef HAS_LIBFFI + extern void * ritem; + extern void ** clist; + extern void ffi_callback(ffi_cif * cif, void * resp, void ** args, Xt * ip); +#endif register Address up UPREG = UP; - IF_spTOS(register Cell MAYBE_UNUSED spTOS TOSREG;) + register Cell MAYBE_UNUSED spTOS TOSREG; register Cell MAYBE_UNUSED spb spbREG; register Cell MAYBE_UNUSED spc spcREG; + register Cell MAYBE_UNUSED spd spdREG; + register Cell MAYBE_UNUSED spe speREG; + register Cell MAYBE_UNUSED spf speREG; + register Cell MAYBE_UNUSED spg speREG; + register Cell MAYBE_UNUSED sph speREG; IF_fpTOS(register Float fpTOS FTOSREG;) #if defined(DOUBLY_INDIRECT) static Label *symbols; @@ -347,15 +378,29 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * return symbols; } - IF_spTOS(spTOS = sp[0]); +#if !(defined(GFORTH_DEBUGGING) || defined(INDIRECT_THREADED) || defined(DOUBLY_INDIRECT) || defined(VM_PROFILING)) + sp += STACK_CACHE_DEFAULT-1; + /* some of those registers are dead, but its simpler to initialize them all */ spTOS = sp[0]; + spb = sp[-1]; + spc = sp[-2]; + spd = sp[-3]; + spe = sp[-4]; + spf = sp[-5]; + spg = sp[-6]; + sph = sp[-7]; +#endif + IF_fpTOS(fpTOS = fp[0]); /* prep_terminal(); */ #ifdef NO_IP goto *(*(Label *)ip0); + before_goto: + goto *real_ca; + after_goto:; #else SET_IP(ip); SUPER_END; /* count the first block, too */ - NEXT; + FIRST_NEXT; #endif #ifdef CPU_DEP3 @@ -366,8 +411,5 @@ Label *engine(Xt *ip0, Cell *sp0, Cell * after_last: return (Label *)0; /*needed only to get the length of the last primitive */ - before_goto: - goto *real_ca; - after_goto: return (Label *)0; }