File:  [gforth] / gforth / Attic / engine.c
Revision 1.7: download - view: text, annotated - select for diffs
Wed Jun 1 10:05:15 1994 UTC (27 years, 4 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
added an experimental hash table (search/order.fs)
allowed the user to select caps-stored names or even case-
sensitive search.
Made gforth.texi compilable.

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

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