Path: utzoo!attcan!uunet!lll-winken!lll-lcc!ames!mailrus!eecae!bio-image!rsl
From: rsl@bio-image.UUCP (Bob Lippert)
Newsgroups: comp.lang.forth
Subject: Re: FORTH for unix?
Summary: A forth in C starter kit.
Keywords: FORTHinC
Message-ID: <105@bio-image.UUCP>
Date: 26 Jul 88 14:07:42 GMT
References: <ZMLEB@SCFVM> <8807211846.AA27919@jade.berkeley.edu>
Reply-To: rsl@bio-image.UUCP (Bob Lippert)
Organization: BioImage - A Kodak company -
Lines: 148

In article <8807211846.AA27919@jade.berkeley.edu> Forth Interest Group International List <FIGI-L%SCFVM.bitnet@jade.berkeley.edu> writes:
>A few comments from someone who's only had a little experience.
>
>Most of the time xxx for unix implys xxx in C.  I've played around with forth
>written in C and the problem I've always had is getting C to have a "Jump"
>table for quick vectoring of the "CODE" words (which are actually written in
>C).  A few (MANY?) C compilers can support pointers to functions which would
>seem to work if you had an array of pointers to functions, but just using a
>large switch statement would seem to be quite slow.

I have provided the following code as an example of how I have set things
up for a Forth written in C implementation which I call FORTHinC. If anyone
can come up with a faster or better way of doing this I would be interested.
I'm currently re-structuring FORTHinC to make sure that it will run on UNIX
(it was originally written for an IBM/PC) and will test it on UNIX and then
release it to the public (in around 2 weeks from now).
								Cognetics , Inc.
								Robert S. Lippert
								1275 N. Silo Ridge Dr.
								Ann Arbor, Mi. 48104

/*---------------------- FORTHinC starter edition -----------------------

This code is provided as an example of how FORTHinC is designed and can
be used as a starting point for any compiler or emulator written in C.
This example will process a double nested looping structure and provides
an indication of the processing speed of the inner loop relative to other
languages. The following relative performance times are approximations.
The actual times you get will depend upon your computer and C compiler:

     C Language = 1       FORTHinC = 9            BASIC = 19
-------------------------------------------------------------------------*/
#define DO      0
#define DOEND   1
#define NUMBER  2
#define FINISH  3
#define CALL    4
#define CRET    5
#define LITERAL 6
#define RNUMBER 7
#define MAXTOP 64

unsigned  *pc, code[256]={NUMBER,30,DO,CALL,0,DOEND,FINISH,
            /*example called routine */  NUMBER,30000,DO,DOEND,CRET};
unsigned  *calls[32] ={&code[7]};
unsigned  doi;                     /* the do loop count */

/*----- define the stacks -----*/
unsigned  *tstk[MAXTOP],ttop = -1;  /* the call stack */
int       istk[MAXTOP], itop = -1;  /* the forth stack */
unsigned  dostk[MAXTOP],dotop = -1;  /* the do loop stack */
/*---------------------------------------------------------*/
void call()
{ unsigned *newpc;
    newpc = calls[ *pc++ ];    /* call routine */
    tstk[++ttop] = pc;    /* push return address */
    pc = newpc;
}
/*---------------------------------------------------------*/
void cret()
{
    pc = tstk[ttop--];
}
/*---------------------------------------------------------*/
void walk (bump,dbump,end1,end2) /* walk forward thru code */

  int bump,dbump,end1,end2;
{ int level,value;

    value = *pc;   level=0;
    while( (value!=end1  &&  value!=end2)  || level!=0 )
     {
     if ( value==bump )  level += 1;
     if ( value==dbump ) level -= 1;
     switch (value)
         { /* skip over any literal areas that are found */
         case  CRET:    pc=tstk[ttop--]; break;
         case  LITERAL: pc++; pc += *pc; break;
         case  NUMBER:  pc += 2;         break;
         case  RNUMBER: pc += 3;         break;
         default: pc++;                  break;
         } 
     value = *pc;
     }
}
/*-------------------------------------------------------*/
int pop( )
{
    if ( itop<0 )        printf("Stack Underflow!");
     else                return( istk[ itop--]);
}
/*-------------------------------------------------------*/
void push(ent)
 int ent;
{
      if ( itop  >=  MAXTOP )
        { printf("\nStack Overflow!");
          itop=MAXTOP;
        }
      istk[ ++itop] = ent;
}
/*---------------------------------------------------------*/
void do_op()
{ int iv1;
      dostk[++dotop]= doi; /* save previous doi */
      iv1=pop();
      if ( iv1<1 )
         {
         doi=dostk[dotop--];
         walk ( DO, DOEND, DOEND, -999);
         pc++;
         }
      else
         {
         doi=(unsigned)iv1;
         tstk[++ttop]=pc;       /* also save start of do */
         }
}
/*--------------------------------------------------------*/
void doend()
{
         if (--doi>0)
		     pc = tstk[ttop];
		 else
          {  ttop--;                /* throw away do start */
             doi=dostk[dotop--];    /* and get previous doi */
		  }
}
/*-------------------------------------------------------*/
void number()
{
          push ( (int)*pc++ );
}
/*-------------------------------------------------------*/
void finish()
{printf("\nExiting!FORTHinC");
 exit(1);
}
/*-------------------------------------------------------*/
void (*dsp[200])()={ do_op,doend,number,finish,call,cret};

/************************* main *********************************/
main()
{
pc=code;      /* start at first location in code */
innerloop:
  (*dsp[*pc++])();  /*dispatch to FORTHinC code*/
  goto innerloop;
}