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.25 and 1.35

version 1.25, 2001/01/27 20:14:55	version 1.35, 2001/12/25 16:55:10
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 196 DCell timeval2us(struct timeval *tvp)	Line 196 DCell timeval2us(struct timeval *tvp)

#ifdef HAS_FILE	#ifdef HAS_FILE
static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};	static char* fileattr[6]={"rb","rb","r+b","r+b","wb","wb"};
	static char* pfileattr[6]={"r","r","r+","r+","w","w"};

#ifndef O_BINARY	#ifndef O_BINARY
#define O_BINARY 0	#define O_BINARY 0
Line 210 static int ufileattr[6]= {	Line 211 static int ufileattr[6]= {
O_WRONLY\|O_BINARY, O_WRONLY\|O_BINARY };	O_WRONLY\|O_BINARY, O_WRONLY\|O_BINARY };
#endif	#endif

	/* conversion on fetch */

	#define vm_Cell2f(x) ((Bool)(x))
	#define vm_Cell2c(x) ((Char)(x))
	#define vm_Cell2n(x) ((Cell)x)
	#define vm_Cell2w(x) ((Cell)x)
	#define vm_Cell2u(x) ((UCell)(x))
	#define vm_Cell2a_(x) ((Cell *)(x))
	#define vm_Cell2c_(x) ((Char *)(x))
	#define vm_Cell2f_(x) ((Float *)(x))
	#define vm_Cell2df_(x) ((DFloat *)(x))
	#define vm_Cell2sf_(x) ((SFloat *)(x))
	#define vm_Cell2xt(x) ((Xt)(x))
	#define vm_Cell2f83name(x) ((struct F83Name *)(x))
	#define vm_Cell2longname(x) ((struct Longname *)(x))
	#define vm_Float2r(x) (x)

	/* conversion on store */

	#define vm_f2Cell(x) ((Cell)(x))
	#define vm_c2Cell(x) ((Cell)(x))
	#define vm_n2Cell(x) ((Cell)(x))
	#define vm_w2Cell(x) ((Cell)(x))
	#define vm_u2Cell(x) ((Cell)(x))
	#define vm_a_2Cell(x) ((Cell)(x))
	#define vm_c_2Cell(x) ((Cell)(x))
	#define vm_f_2Cell(x) ((Cell)(x))
	#define vm_df_2Cell(x) ((Cell)(x))
	#define vm_sf_2Cell(x) ((Cell)(x))
	#define vm_xt2Cell(x) ((Cell)(x))
	#define vm_f83name2Cell(x) ((Cell)(x))
	#define vm_longname2Cell(x) ((Cell)(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 251 static int ufileattr[6]= {	Line 288 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
	#define SUPER_CONTINUE

#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 259 Xt *ip;	Line 310 Xt *ip;
Cell *rp;	Cell *rp;
#endif	#endif

Label engine(Xt ip0, Cell sp0, Cell rp0, Float *fp0, Address lp0)	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) */
	}


	define(enginerest,
	`(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 283 Label engine(Xt ip0, Cell sp0, Cell	Line 350 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 294 Label engine(Xt ip0, Cell sp0, Cell	Line 363 Label engine(Xt ip0, Cell sp0, Cell
(Label)&&dofield,	(Label)&&dofield,
(Label)&&dodoes,	(Label)&&dodoes,
/* the following entry is normally unused;	/* the following entry is normally unused;
it's there because its index indicates a does-handler */	it is there because its index indicates a does-handler */
CPU_DEP1,	CPU_DEP1,
	#define INST_ADDR(name) (Label)&&I_##name
	#include "prim_lab.i"
	#undef INST_ADDR
	(Label)&&after_last,
	(Label)0,
	#ifdef IN_ENGINE2
	#define INST_ADDR(name) (Label)&&J_##name
#include "prim_lab.i"	#include "prim_lab.i"
(Label)0	#undef INST_ADDR
	#endif
};	};
#ifdef CPU_DEP2	#ifdef CPU_DEP2
CPU_DEP2	CPU_DEP2
Line 313 Label engine(Xt ip0, Cell sp0, Cell	Line 390 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 336 Label engine(Xt ip0, Cell sp0, Cell	Line 412 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 353 Label engine(Xt ip0, Cell sp0, Cell	Line 430 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 360 Label engine(Xt ip0, Cell sp0, Cell	Line 438 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 421 Label engine(Xt ip0, Cell sp0, Cell	Line 500 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 470 Label engine(Xt ip0, Cell sp0, Cell	Line 550 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;

	#ifndef IN_ENGINE2
	#define LABEL(name) I_##name
	#else
	#define LABEL(name) J_##name: asm(".skip 16"); I_##name
	#endif
#include "prim.i"	#include "prim.i"
}	#undef LABEL
	after_last: return (Label *)0;
	/needed only to get the length of the last primitive /
	}'
	)

	Label *engine enginerest

	#define IN_ENGINE2
	Label *engine2 enginerest

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

Removed from v.1.25
changed lines
	Added in v.1.35