Path: utzoo!utgpu!jarvis.csri.toronto.edu!mailrus!shadooby!samsung!rex!ames!amdahl!pacbell!noe!marc
From: marc@noe.UUCP (Marc de Groot)
Newsgroups: comp.lang.forth
Subject: Re:  Forth in C
Message-ID: <717@noe.UUCP>
Date: 17 Nov 89 09:48:32 GMT
References: <8911142050.AA16286@jade.berkeley.edu>
Sender: usenet@noe.UUCP
Reply-To: marc@noe.UUCP (Marc de Groot)
Organization: Noe Systems, San Francisco
Lines: 93

I wrote, about double indirect threaded Forth in C:
>> I only need one hack to make this work: I need to be able to
>> take the address of a label, i. e.

Mitch Bradley replied:
>What you are suggesting is the first thing that I thought of doing when
>I was writing C Forth 83, but I had to give up on that implementation
>strategy.  The two options that I know of are indirect subroutine calls
>(relatively slow) and a big switch with an integer selector (which is what
>C Forth 83 uses).

Here's a third way to do it that I just tried.  Thanks to Bob Kelley
(sequent!rjk) who gave me the idea.

I use the asm("..."); pseudo-op to assemble an indirect branch instruction.
This turns into some very efficient code, even with my awful pcc-derived
80286 C compiler.  This, of course, is "non-portable" in that it is
implementation-dependent.  On the other hand, the actual amount of effort
necessary to port this to another environment is minimal.  It's tantalizing...

^Marc

/*
 * Prototype Forth interpreter which REALLY uses a double-indirect jump.
 * Note that it is assumed that sizeof(cell) == sizeof(void *)
 */
typedef short cell;	/* typedef long cell for 32-bit pointers */
#include <setjmp.h>
jmp_buf jbuf;
#define NPRIMS	3	/* Number of primitives */
#define NSTK	50	/* Number of elements in each stack */
#define NDICT	50	/* Number of cells in the dictionary */
#define ONE	0
#define	DROP	1
#define	BRANCH	2
void *primaddr[NPRIMS];	/* Array of addresses of primitive code */
int naddr;		/* Subscript into primaddr[] */
cell stk[NSTK];		/* Parameter stack */
cell rstk[NSTK];	/* Return stack */
cell dict[NDICT];	/* The dictionary */

main()
{
	void **ip;	/* The interpreter pointer */
	void *w;	/* A scratch register used by next */
	cell *sp;	/* The stack pointer */
	cell *rp;	/* The return stack pointer */

	naddr = -1;
	setjmp(jbuf);	/* entry() inside the loop below calls longjmp() */

	/* This loop initializes the array primaddr[] with the addresses
	 * of primitive code.  The switch statement contains all of the code
	 * for primitives in the system.
	 */
	while (++naddr < NPRIMS) {
		switch(naddr) {
		case ONE:	entry(); *--sp = 1; goto next;
		case DROP:	entry(); sp++; goto next;
		case BRANCH:	entry(); ip += (cell)*ip; goto next;
		}
	}

	/* Now that the prim addrs are initialized, we build the
	 * equivalent of a colon definition's parameter field
	 * in the dictionary.
	 */
	 dict[0] = (cell)primaddr[ONE];		/* addr of "1" */
	 dict[1] = (cell)primaddr[DROP];	/* addr of "drop" */
	 dict[2] = (cell)primaddr[BRANCH];	/* addr of "branch" */
	 dict[3] = (cell)(-6);			/* branch offset */

	 /* Now we initialize Forth's registers */
	 ip = (void **)dict;		/* Point IP at the : def we built */
	 sp = &stk[NSTK];		/* Init param stack pointer */
	 rp = &rstk[NSTK];		/* Init return stack pointer */

	/* Here's the inner interpreter */
next:	w = *ip++;			/* W <- CFA */
next1:	asm("	jmp	*%ax");		/* JMP [W] */
}

entry()
{
	int i;
	primaddr[naddr] = (void *)(&i)[1];
	longjmp(jbuf, 1);
}
-- 
Marc de Groot (KG6KF)                   These ARE my employer's opinions!
Noe Systems, San Francisco
UUCP: uunet!hoptoad!noe!marc
Internet: marc@kg6kf.AMPR.ORG