gforth/engine/engine.c - diff

Return to engine.c CVS log

Up to [gforth] / gforth / engine

Diff for /gforth/engine/engine.c between versions 1.26 and 1.31

version 1.26, 2001/02/06 16:53:07	version 1.31, 2001/04/08 13:48:12
Line 20	Line 20
*/	*/

#include "config.h"	#include "config.h"
	#include "forth.h"
#include <ctype.h>	#include <ctype.h>
#include <stdio.h>	#include <stdio.h>
#include <string.h>	#include <string.h>
Line 27	Line 28
#include <assert.h>	#include <assert.h>
#include <stdlib.h>	#include <stdlib.h>
#include <errno.h>	#include <errno.h>
#include "forth.h"
#include "io.h"	#include "io.h"
#include "threaded.h"	#include "threaded.h"
#ifndef STANDALONE	#ifndef STANDALONE
Line 244 static int ufileattr[6]= {	Line 244 static int ufileattr[6]= {
#define vm_longname2Cell(x) ((Cell)(x))	#define vm_longname2Cell(x) ((Cell)(x))
#define vm_r2Float(x) (x)	#define vm_r2Float(x) (x)

	#define vm_Cell2Cell(x) (x)

/* if machine.h has not defined explicit registers, define them as implicit */	/* if machine.h has not defined explicit registers, define them as implicit */
#ifndef IPREG	#ifndef IPREG
#define IPREG	#define IPREG
Line 285 static int ufileattr[6]= {	Line 287 static int ufileattr[6]= {
#define DOCFA Xt cfa; GETCFA(cfa)	#define DOCFA Xt cfa; GETCFA(cfa)
#endif	#endif

	/* instructions containing these 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
	to write it, write it after IP points to the next instruction.
	Used for profiling. Don't write it in a word containing SET_IP, or
	the following block will be counted twice. */
	#ifdef VM_PROFILING
	#define SUPER_END vm_count_block(IP)
	#else
	#define SUPER_END
	#endif

#ifdef GFORTH_DEBUGGING	#ifdef GFORTH_DEBUGGING
/* define some VM registers as global variables, so they survive exceptions;	/* define some VM registers as global variables, so they survive exceptions;
global register variables are not up to the task (according to the	global register variables are not up to the task (according to the
Line 293 Xt *ip;	Line 308 Xt *ip;
Cell *rp;	Cell *rp;
#endif	#endif

	Xt *primtable(Label symbols[], Cell size)
	{
	#ifdef DIRECT_THREADED
	return symbols;
	#else /* !defined(DIRECT_THREADED) */
	Xt xts = (Xt )malloc(size*sizeof(Xt));
	Cell i;

	for (i=0; i<size; i++)
	xts[i] = &symbols[i];
	return xts;
	#endif /* !defined(DIRECT_THREADED) */
	}

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 317 Label engine(Xt ip0, Cell sp0, Cell	Line 346 Label engine(Xt ip0, Cell sp0, Cell
#if defined(DOUBLY_INDIRECT)	#if defined(DOUBLY_INDIRECT)
static Label *symbols;	static Label *symbols;
static void *routines[]= {	static void *routines[]= {
	#define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
#else /* !defined(DOUBLY_INDIRECT) */	#else /* !defined(DOUBLY_INDIRECT) */
static Label symbols[]= {	static Label symbols[]= {
	#define MAX_SYMBOLS (sizeof(symbols)/sizeof(symbols[0]))
#endif /* !defined(DOUBLY_INDIRECT) */	#endif /* !defined(DOUBLY_INDIRECT) */
(Label)&&docol,	(Label)&&docol,
(Label)&&docon,	(Label)&&docon,
Line 347 Label engine(Xt ip0, Cell sp0, Cell	Line 378 Label engine(Xt ip0, Cell sp0, Cell

if (ip == NULL) {	if (ip == NULL) {
#if defined(DOUBLY_INDIRECT)	#if defined(DOUBLY_INDIRECT)
#define MAX_SYMBOLS (sizeof(routines)/sizeof(routines[0]))
#define CODE_OFFSET (22*sizeof(Cell))	#define CODE_OFFSET (22*sizeof(Cell))
int i;	int i;
Cell code_offset = offset_image? CODE_OFFSET : 0;	Cell code_offset = offset_image? CODE_OFFSET : 0;
Line 370 Label engine(Xt ip0, Cell sp0, Cell	Line 400 Label engine(Xt ip0, Cell sp0, Cell
IF_fpTOS(fpTOS = fp[0]);	IF_fpTOS(fpTOS = fp[0]);
/* prep_terminal(); */	/* prep_terminal(); */
SET_IP(ip);	SET_IP(ip);
	SUPER_END; /* count the first block, too */
NEXT;	NEXT;


Line 387 Label engine(Xt ip0, Cell sp0, Cell	Line 418 Label engine(Xt ip0, Cell sp0, Cell
/* this is the simple version */	/* this is the simple version */
*--rp = (Cell)ip;	*--rp = (Cell)ip;
SET_IP((Xt *)PFA1(cfa));	SET_IP((Xt *)PFA1(cfa));
	SUPER_END;
NEXT;	NEXT;
#else	#else
/* this one is important, so we help the compiler optimizing */	/* this one is important, so we help the compiler optimizing */
Line 394 Label engine(Xt ip0, Cell sp0, Cell	Line 426 Label engine(Xt ip0, Cell sp0, Cell
DEF_CA	DEF_CA
rp[-1] = (Cell)ip;	rp[-1] = (Cell)ip;
SET_IP((Xt *)PFA1(cfa));	SET_IP((Xt *)PFA1(cfa));
	SUPER_END;
NEXT_P1;	NEXT_P1;
rp--;	rp--;
NEXT_P2;	NEXT_P2;
Line 455 Label engine(Xt ip0, Cell sp0, Cell	Line 488 Label engine(Xt ip0, Cell sp0, Cell
#ifdef DEBUG	#ifdef DEBUG
fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));	fprintf(stderr,"%08lx: defer: %08lx\n",(Cell)ip,(Cell)PFA1(cfa));
#endif	#endif
	SUPER_END;
EXEC((Xt )PFA1(cfa));	EXEC((Xt )PFA1(cfa));
}	}

Line 504 Label engine(Xt ip0, Cell sp0, Cell	Line 538 Label engine(Xt ip0, Cell sp0, Cell
*--sp = (Cell)PFA(cfa);	*--sp = (Cell)PFA(cfa);
#endif	#endif
SET_IP(DOES_CODE1(cfa));	SET_IP(DOES_CODE1(cfa));
	SUPER_END;
/* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/	/* fprintf(stderr,"TOS = %08lx, IP=%08lx\n", spTOS, IP);*/
}	}
NEXT;	NEXT;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.26
changed lines
	Added in v.1.31