--- gforth/engine/engine.c 2002/12/31 15:05:58 1.55
+++ gforth/engine/engine.c 2003/08/20 09:23:46 1.65
@@ -1,6 +1,6 @@
/* Gforth virtual machine (aka inner interpreter)
- Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
+ Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc.
This file is part of Gforth.
@@ -59,6 +59,11 @@
#include
#endif
+#ifdef HAS_FFCALL
+#include
+#include
+#endif
+
#ifndef SEEK_SET
/* should be defined in stdio.h, but some systems don't have it */
#define SEEK_SET 0
@@ -72,24 +77,6 @@
#define ftello ftell
#endif
-#define IOR(flag) ((flag)? -512-errno : 0)
-
-struct F83Name {
- struct F83Name *next; /* the link field for old hands */
- char countetc;
- char name[0];
-};
-
-#define F83NAME_COUNT(np) ((np)->countetc & 0x1f)
-
-struct Longname {
- struct Longname *next; /* the link field for old hands */
- Cell countetc;
- char name[0];
-};
-
-#define LONGNAME_COUNT(np) ((np)->countetc & (((~((UCell)0))<<3)>>3))
-
#define NULLC '\0'
#ifdef MEMCMP_AS_SUBROUTINE
@@ -174,7 +161,7 @@ extern int gforth_memcmp(const char * s1
# define CPU_DEP1 0
#endif
-/* instructions containing these must be the last instruction of a
+/* instructions containing SUPER_END must be the last instruction of a
super-instruction (e.g., branches, EXECUTE, and other instructions
ending the basic block). Instructions containing SET_IP get this
automatically, so you usually don't have to write it. If you have
@@ -202,6 +189,11 @@ 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]);
+#endif
+
#if !defined(ENGINE)
/* normal engine */
#define VARIANT(v) (v)
@@ -230,7 +222,6 @@ extern int gforth_memcmp(const char * s1
#define LABEL2(name) K_##name:
-
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
@@ -249,6 +240,15 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
#ifdef MORE_VARS
MORE_VARS
#endif
+#ifdef HAS_FFCALL
+ av_alist alist;
+ extern va_alist clist;
+ float frv;
+ int irv;
+ double drv;
+ long long llrv;
+ void * prv;
+#endif
register Address up UPREG = UP;
IF_spTOS(register Cell spTOS TOSREG;)
IF_fpTOS(register Float fpTOS FTOSREG;)
@@ -260,20 +260,9 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
static Label symbols[]= {
#define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0]))
#endif /* !defined(DOUBLY_INDIRECT) */
- (Label)&&docol,
- (Label)&&docon,
- (Label)&&dovar,
- (Label)&&douser,
- (Label)&&dodefer,
- (Label)&&dofield,
- (Label)&&dodoes,
- /* 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)
#include "prim_lab.i"
#undef INST_ADDR
- (Label)&&after_last,
(Label)0,
#define INST_ADDR(name) ((Label)&&K_##name)
#include "prim_lab.i"
@@ -281,6 +270,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
#define INST_ADDR(name) ((Label)&&J_##name)
#include "prim_lab.i"
#undef INST_ADDR
+ (Label)&&after_last
};
#ifdef CPU_DEP2
CPU_DEP2
@@ -307,7 +297,7 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
xts[i] = symbols[i] = (Label)routines[i];
for (; routines[i]!=0; i++) {
if (i>=MAX_SYMBOLS) {
- fprintf(stderr,"gforth-ditc: more than %d primitives\n",MAX_SYMBOLS);
+ fprintf(stderr,"gforth-ditc: more than %ld primitives\n",(long)MAX_SYMBOLS);
exit(1);
}
xts[i] = symbols[i] = &routines[i];
@@ -330,166 +320,6 @@ Label *engine(Xt *ip0, Cell *sp0, Cell *
#ifdef CPU_DEP3
CPU_DEP3
#endif
-
- docol:
- {
-#ifdef NO_IP
- *--rp = next_code;
- goto **(Label *)PFA1(cfa);
-#else
-#ifdef DEBUG
- {
- CFA_TO_NAME(cfa);
- fprintf(stderr,"%08lx: col: %08lx %.*s\n",(Cell)ip,(Cell)PFA1(cfa),
- len,name);
- }
-#endif
-#ifdef CISC_NEXT
- /* this is the simple version */
- *--rp = (Cell)ip;
- SET_IP((Xt *)PFA1(cfa));
- SUPER_END;
- NEXT;
-#else
- /* this one is important, so we help the compiler optimizing */
- {
- DEF_CA
- rp[-1] = (Cell)ip;
- SET_IP((Xt *)PFA1(cfa));
- SUPER_END;
- NEXT_P1;
- rp--;
- NEXT_P2;
- }
-#endif
-#endif
- }
-
- docon:
- {
-#ifdef DEBUG
- fprintf(stderr,"%08lx: con: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
-#endif
-#ifdef USE_TOS
- *sp-- = spTOS;
- spTOS = *(Cell *)PFA1(cfa);
-#else
- *--sp = *(Cell *)PFA1(cfa);
-#endif
- }
-#ifdef NO_IP
- goto *next_code;
-#else
- NEXT_P0;
- NEXT;
-#endif
-
- dovar:
- {
-#ifdef DEBUG
- fprintf(stderr,"%08lx: var: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
-#endif
-#ifdef USE_TOS
- *sp-- = spTOS;
- spTOS = (Cell)PFA1(cfa);
-#else
- *--sp = (Cell)PFA1(cfa);
-#endif
- }
-#ifdef NO_IP
- goto *next_code;
-#else
- NEXT_P0;
- NEXT;
-#endif
-
- douser:
- {
-#ifdef DEBUG
- fprintf(stderr,"%08lx: user: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
-#endif
-#ifdef USE_TOS
- *sp-- = spTOS;
- spTOS = (Cell)(up+*(Cell*)PFA1(cfa));
-#else
- *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
-#endif
- }
-#ifdef NO_IP
- goto *next_code;
-#else
- NEXT_P0;
- NEXT;
-#endif
-
- dodefer:
- {
-#ifdef DEBUG
- fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,*(Cell*)PFA1(cfa));
-#endif
- SUPER_END;
- EXEC(*(Xt *)PFA1(cfa));
- }
-
- dofield:
- {
-#ifdef DEBUG
- fprintf(stderr,"%08lx: field: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
-#endif
- spTOS += *(Cell*)PFA1(cfa);
- }
-#ifdef NO_IP
- goto *next_code;
-#else
- NEXT_P0;
- NEXT;
-#endif
-
- dodoes:
- /* this assumes the following structure:
- defining-word:
-
- ...
- DOES>
- (possible padding)
- possibly handler: jmp dodoes
- (possible branch delay slot(s))
- Forth code after DOES>
-
- defined word:
-
- cfa: address of or jump to handler OR
- address of or jump to dodoes, address of DOES-code
- 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
- fprintf(stderr,"%08lx/%08lx: does: %08lx\n",(Cell)ip,(Cell)PFA(cfa),(Cell)DOES_CODE1(cfa));
- fflush(stderr);
-#endif
- *--rp = (Cell)ip;
- /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
-#ifdef USE_TOS
- *sp-- = spTOS;
- spTOS = (Cell)PFA(cfa);
-#else
- *--sp = (Cell)PFA(cfa);
-#endif
- SET_IP(DOES_CODE1(cfa));
- SUPER_END;
- /* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
- }
- NEXT;
-#endif
#include "prim.i"
after_last: return (Label *)0;