version 1.57, 2003/01/20 17:07:40
|
version 1.64, 2003/08/15 14:07:04
|
Line 1
|
Line 1
|
/* Gforth virtual machine (aka inner interpreter) |
/* 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. |
This file is part of Gforth. |
|
|
Line 59
|
Line 59
|
#include <dl.h> |
#include <dl.h> |
#endif |
#endif |
|
|
|
#ifdef HAS_FFCALL |
|
#include <avcall.h> |
|
#include <callback.h> |
|
#endif |
|
|
#ifndef SEEK_SET |
#ifndef SEEK_SET |
/* should be defined in stdio.h, but some systems don't have it */ |
/* should be defined in stdio.h, but some systems don't have it */ |
#define SEEK_SET 0 |
#define SEEK_SET 0 |
Line 72
|
Line 77
|
#define ftello ftell |
#define ftello ftell |
#endif |
#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' |
#define NULLC '\0' |
|
|
#ifdef MEMCMP_AS_SUBROUTINE |
#ifdef MEMCMP_AS_SUBROUTINE |
Line 174 extern int gforth_memcmp(const char * s1
|
Line 161 extern int gforth_memcmp(const char * s1
|
# define CPU_DEP1 0 |
# define CPU_DEP1 0 |
#endif |
#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 |
super-instruction (e.g., branches, EXECUTE, and other instructions |
ending the basic block). Instructions containing SET_IP get this |
ending the basic block). Instructions containing SET_IP get this |
automatically, so you usually don't have to write it. If you have |
automatically, so you usually don't have to write it. If you have |
Line 202 extern int gforth_memcmp(const char * s1
|
Line 189 extern int gforth_memcmp(const char * s1
|
} |
} |
#endif |
#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) |
#if !defined(ENGINE) |
/* normal engine */ |
/* normal engine */ |
#define VARIANT(v) (v) |
#define VARIANT(v) (v) |
Line 230 extern int gforth_memcmp(const char * s1
|
Line 222 extern int gforth_memcmp(const char * s1
|
|
|
#define LABEL2(name) K_##name: |
#define LABEL2(name) K_##name: |
|
|
|
|
Label *engine(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 |
/* executes code at ip, if ip!=NULL |
returns array of machine code labels (for use in a loader), if ip==NULL |
returns array of machine code labels (for use in a loader), if ip==NULL |
Line 249 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 240 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
#ifdef MORE_VARS |
#ifdef MORE_VARS |
MORE_VARS |
MORE_VARS |
#endif |
#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; |
register Address up UPREG = UP; |
IF_spTOS(register Cell spTOS TOSREG;) |
IF_spTOS(register Cell spTOS TOSREG;) |
IF_fpTOS(register Float fpTOS FTOSREG;) |
IF_fpTOS(register Float fpTOS FTOSREG;) |
Line 281 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 281 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
#define INST_ADDR(name) ((Label)&&J_##name) |
#define INST_ADDR(name) ((Label)&&J_##name) |
#include "prim_lab.i" |
#include "prim_lab.i" |
#undef INST_ADDR |
#undef INST_ADDR |
|
(Label)&&after_last |
}; |
}; |
#ifdef CPU_DEP2 |
#ifdef CPU_DEP2 |
CPU_DEP2 |
CPU_DEP2 |
Line 307 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
Line 308 Label *engine(Xt *ip0, Cell *sp0, Cell *
|
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) { |
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); |
exit(1); |
} |
} |
xts[i] = symbols[i] = &routines[i]; |
xts[i] = symbols[i] = &routines[i]; |