File:  [gforth] / gforth / Attic / engine.c
Revision 1.6: download - view: text, annotated - select for diffs
Wed May 18 17:29:52 1994 UTC (27 years, 2 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Fixed problem with ?dup
Deleted noop output like sp+=0 from prims2x.fs
Made wordinfo.fs work with DTC on i386
Added a faster (???) relocater

    1: /*
    2:   $Id: engine.c,v 1.6 1994/05/18 17:29:52 pazsan Exp $
    3:   Copyright 1992 by the ANSI figForth Development Group
    4: */
    5: 
    6: #include <ctype.h>
    7: #include <stdio.h>
    8: #include <string.h>
    9: #include <math.h>
   10: #include <sys/types.h>
   11: #include <sys/stat.h>
   12: #include <fcntl.h>
   13: #include <assert.h>
   14: #include <stdlib.h>
   15: #include <time.h>
   16: #include <sys/time.h>
   17: #include "forth.h"
   18: #include "io.h"
   19: 
   20: #ifndef unlink
   21: 	extern unlink(char *);
   22: #endif
   23: #ifndef ftruncate
   24: 	extern ftruncate(int, int);
   25: #endif
   26: 
   27: typedef union {
   28:   struct {
   29: #ifdef BIG_ENDIAN
   30:     Cell high;
   31:     Cell low;
   32: #else
   33:     Cell low;
   34:     Cell high;
   35: #endif;
   36:   } cells;
   37:   DCell dcell;
   38: } Double_Store;
   39: 
   40: typedef struct F83Name {
   41:   struct F83Name	*next;  /* the link field for old hands */
   42:   char			countetc;
   43:   Char			name[0];
   44: } F83Name;
   45: 
   46: /* are macros for setting necessary? */
   47: #define F83NAME_COUNT(np)	((np)->countetc & 0x1f)
   48: #define F83NAME_SMUDGE(np)	(((np)->countetc & 0x40) != 0)
   49: #define F83NAME_IMMEDIATE(np)	(((np)->countetc & 0x20) != 0)
   50: 
   51: /* NEXT and NEXT1 are split into several parts to help scheduling */
   52: #ifdef DIRECT_THREADED
   53: #	define NEXT1_P1 
   54: #	define NEXT1_P2 ({goto *cfa;})
   55: #	define DEF_CA
   56: #else
   57: #	define NEXT1_P1 ({ca = *cfa;})
   58: #	define NEXT1_P2 ({goto *ca;})
   59: #	define DEF_CA	Label ca;
   60: #endif
   61: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
   62: 
   63: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
   64: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
   65: 
   66: #ifdef USE_TOS
   67: #define IF_TOS(x) x
   68: #else
   69: #define IF_TOS(x)
   70: #define TOS (sp[0])
   71: #endif
   72: 
   73: #ifdef USE_FTOS
   74: #define IF_FTOS(x) x
   75: #else
   76: #define IF_FTOS(x)
   77: #define FTOS (fp[0])
   78: #endif
   79: 
   80: int emitcounter;
   81: #define NULLC '\0'
   82: 
   83: #define cstr(to,from,size)\
   84: 	{	memcpy(to,from,size);\
   85: 		to[size]=NULLC;}
   86: #define NEWLINE	'\n'
   87: 
   88: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
   89: 
   90: #if ~defined(select) && defined(DOS)
   91: /* select replacement for DOS computers for ms only */
   92: void select(int n, int a, int b, int c, struct timeval * timeout)
   93: {
   94:    struct timeval time1;
   95:    struct timeval time2;
   96:    struct timezone zone1;
   97: 
   98:    gettimeofday(&time1,&zone1);
   99:    time1.tv_sec += timeout->tv_sec;
  100:    time1.tv_usec += timeout->tv_usec;
  101:    while(time1.tv_usec >= 1000000)
  102:      {
  103: 	time1.tv_usec -= 1000000;
  104: 	time1.tv_sec++;
  105:      }
  106:    do
  107:      {
  108: 	gettimeofday(&time2,&zone1);
  109:      }
  110:    while(time2.tv_usec < time1.tv_usec || time2.tv_sec < time1.tv_sec);
  111: }
  112: #endif
  113: 
  114: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
  115: /* executes code at ip, if ip!=NULL
  116:    returns array of machine code labels (for use in a loader), if ip==NULL
  117: */
  118: {
  119:   Xt cfa;
  120:   Address up=NULL;
  121:   static Label symbols[]= {
  122:     &&docol,
  123:     &&docon,
  124:     &&dovar,
  125:     &&douser,
  126:     &&dodoes,
  127:     &&dodoes,  /* dummy for does handler address */
  128: #include "prim_labels.i"
  129:   };
  130:   IF_TOS(register Cell TOS;)
  131:   IF_FTOS(Float FTOS;)
  132: #ifdef CPU_DEP
  133:   CPU_DEP;
  134: #endif
  135: 
  136:   if (ip == NULL)
  137:     return symbols;
  138:   
  139:   IF_TOS(TOS = sp[0]);
  140:   IF_FTOS(FTOS = fp[0]);
  141:   prep_terminal();
  142:   NEXT;
  143:   
  144:  docol:
  145: #ifdef DEBUG
  146:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  147: #endif
  148: #ifdef undefined
  149:   /* this is the simple version */
  150:   *--rp = (Cell)ip;
  151:   ip = (Xt *)PFA1(cfa);
  152:   NEXT;
  153: #endif
  154:   /* this one is important, so we help the compiler optimizing
  155:      The following version may be better (for scheduling), but probably has
  156:      problems with code fields employing calls and delay slots
  157:   */
  158:   {
  159:     DEF_CA
  160:     Xt *current_ip = (Xt *)PFA1(cfa);
  161:     cfa = *current_ip;
  162:     NEXT1_P1;
  163:     *--rp = (Cell)ip;
  164:     ip = current_ip+1;
  165:     NEXT1_P2;
  166:   }
  167:   
  168:  docon:
  169: #ifdef DEBUG
  170:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
  171: #endif
  172: #ifdef USE_TOS
  173:   *sp-- = TOS;
  174:   TOS = *(Cell *)PFA1(cfa);
  175: #else
  176:   *--sp = *(Cell *)PFA1(cfa);
  177: #endif
  178:   NEXT;
  179:   
  180:  dovar:
  181: #ifdef DEBUG
  182:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  183: #endif
  184: #ifdef USE_TOS
  185:   *sp-- = TOS;
  186:   TOS = (Cell)PFA1(cfa);
  187: #else
  188:   *--sp = (Cell)PFA1(cfa);
  189: #endif
  190:   NEXT;
  191:   
  192:   /* !! user? */
  193:   
  194:  douser:
  195: #ifdef DEBUG
  196:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  197: #endif
  198: #ifdef USE_TOS
  199:   *sp-- = TOS;
  200:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
  201: #else
  202:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
  203: #endif
  204:   NEXT;
  205:   
  206:  dodoes:
  207:   /* this assumes the following structure:
  208:      defining-word:
  209:      
  210:      ...
  211:      DOES>
  212:      (possible padding)
  213:      possibly handler: jmp dodoes
  214:      (possible branch delay slot(s))
  215:      Forth code after DOES>
  216:      
  217:      defined word:
  218:      
  219:      cfa: address of or jump to handler OR
  220:           address of or jump to dodoes, address of DOES-code
  221:      pfa:
  222:      
  223:      */
  224: #ifdef DEBUG
  225:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
  226:   fflush(stdout);
  227: #endif
  228:   *--rp = (Cell)ip;
  229:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
  230: #ifdef USE_TOS
  231:   *sp-- = TOS;
  232:   TOS = (Cell)PFA(cfa);
  233: #else
  234:   *--sp = (Cell)PFA(cfa);
  235: #endif
  236:   ip = DOES_CODE1(cfa);
  237:   NEXT;
  238:   
  239: #include "primitives.i"
  240: }

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