Return to engine.c CVS log

Up to [gforth] / gforth

Initial revision

    1: /*
    2:   $Id: engine.c,v 1.1 1994/02/11 16:30:46 anton 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 "forth.h"
   16: #include "io.h"
   17: 
   18: extern unlink(char *);
   19: extern ftruncate(int, int);
   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: #else
   50: #define NEXT1_P1 ({ca = *cfa;})
   51: #define NEXT1_P2 ({goto *ca;})
   52: #endif
   53: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
   54: 
   55: #define NEXT1 ({NEXT1_P1; NEXT1_P2;})
   56: #define NEXT ({NEXT_P1; NEXT1_P2;})
   57: 
   58: #ifdef USE_TOS
   59: #define IF_TOS(x) x
   60: #else
   61: #define IF_TOS(x)
   62: #define TOS (sp[0])
   63: #endif
   64: 
   65: #ifdef USE_FTOS
   66: #define IF_FTOS(x) x
   67: #else
   68: #define IF_FTOS(x)
   69: #define FTOS (fp[0])
   70: #endif
   71: 
   72: #define DODOES	(symbols[3])
   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)
   85: /* executes code at ip, if ip!=NULL
   86:    returns array of machine code labels (for use in a loader), if ip==NULL
   87:    This is very preliminary, as the bootstrap architecture is not yet decided
   88: */
   89: {
   90:   Xt cfa;
   91:   Address lp=NULL;
   92:   static Label symbols[]= {
   93:     &&docol,
   94:     &&docon,
   95:     &&dovar,
   96:     &&dodoes,
   97: #include "prim_labels.i"
   98:   };
   99: #ifndef DIRECT_THREADED
  100:   Label ca;
  101: #endif
  102:   IF_TOS(register Cell TOS;)
  103:   IF_FTOS(Float FTOS;)
  104: #ifdef CPU_DEP
  105:   CPU_DEP;
  106: #endif
  107: 
  108:   if (ip == NULL)
  109:     return symbols;
  110:   
  111:   IF_TOS(TOS = sp[0]);
  112:   IF_FTOS(FTOS = fp[0]);
  113:   prep_terminal();
  114:   NEXT;
  115:   
  116:  docol:
  117: #ifdef DEBUG
  118:   printf("col: %x\n",(Cell)PFA1(cfa));
  119: #endif
  120: #ifdef undefined
  121:   /* this is the simple version */
  122:   *--rp = (Cell)ip;
  123:   ip = (Xt *)PFA1(cfa);
  124:   NEXT;
  125: #endif
  126:   /* this one is important, so we help the compiler optimizing
  127:      The following version may be better (for scheduling), but probably has
  128:      problems with code fields employing calls and delay slots
  129:   */
  130:   {
  131:     Xt *current_ip = (Xt *)PFA1(cfa);
  132:     cfa = *current_ip;
  133:     NEXT1_P1;
  134:     *--rp = (Cell)ip;
  135:     ip = current_ip+1;
  136:   }
  137:   NEXT1_P2;
  138:   
  139:  docon:
  140: #ifdef DEBUG
  141:   printf("con: %x\n",*(Cell*)PFA1(cfa));
  142: #endif
  143: #ifdef USE_TOS
  144:   *sp-- = TOS;
  145:   TOS = *(Cell *)PFA1(cfa);
  146: #else
  147:   *--sp = *(Cell *)PFA1(cfa);
  148: #endif
  149:   NEXT;
  150:   
  151:  dovar:
  152: #ifdef DEBUG
  153:   printf("var: %x\n",(Cell)PFA1(cfa));
  154: #endif
  155: #ifdef USE_TOS
  156:   *sp-- = TOS;
  157:   TOS = (Cell)PFA1(cfa);
  158: #else
  159:   *--sp = (Cell)PFA1(cfa);
  160: #endif
  161:   NEXT;
  162:   
  163:   /* !! user? */
  164:   
  165:  dodoes:
  166:   /* this assumes the following structure:
  167:      defining-word:
  168:      
  169:      ...
  170:      DOES>
  171:      (possible padding)
  172:      possibly handler: jmp dodoes
  173:      (possible branch delay slot(s))
  174:      Forth code after DOES>
  175:      
  176:      defined word:
  177:      
  178:      cfa: address of or jump to handler OR
  179:           address of or jump to dodoes, address of DOES-code
  180:      pfa:
  181:      
  182:      */
  183: #ifdef DEBUG
  184:   printf("does: %x\n",(Cell)PFA(cfa));
  185: #endif
  186:   *--rp = (Cell)ip;
  187:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
  188: #ifdef USE_TOS
  189:   *sp-- = TOS;
  190:   TOS = (Cell)PFA(cfa);
  191: #else
  192:   *--sp = (Cell)PFA(cfa);
  193: #endif
  194:   ip = DOES_CODE1(cfa);
  195:   NEXT;
  196:   
  197: #include "primitives.i"
  198: }