Return to engine.c CVS log

Up to [gforth] / gforth

cleaned up NEXT macros; provided for CISC (united) and RISC (split) versions
cstr is now a function that can process arbitrarily long strings

    1: /*
    2:   $Id: engine.c,v 1.14 1994/09/08 17:20:05 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 <time.h>
   16: #include <sys/time.h>
   17: #include "forth.h"
   18: #include "io.h"
   19: 
   20: typedef union {
   21:   struct {
   22: #ifdef BIG_ENDIAN
   23:     Cell high;
   24:     Cell low;
   25: #else
   26:     Cell low;
   27:     Cell high;
   28: #endif;
   29:   } cells;
   30:   DCell dcell;
   31: } Double_Store;
   32: 
   33: typedef struct F83Name {
   34:   struct F83Name	*next;  /* the link field for old hands */
   35:   char			countetc;
   36:   Char			name[0];
   37: } F83Name;
   38: 
   39: /* are macros for setting necessary? */
   40: #define F83NAME_COUNT(np)	((np)->countetc & 0x1f)
   41: #define F83NAME_SMUDGE(np)	(((np)->countetc & 0x40) != 0)
   42: #define F83NAME_IMMEDIATE(np)	(((np)->countetc & 0x20) != 0)
   43: 
   44: /* NEXT and NEXT1 are split into several parts to help scheduling,
   45:    unless CISC_NEXT is defined */
   46: #ifdef CISC_NEXT
   47: #define NEXT1_P1
   48: #define NEXT_P1
   49: #define DEF_CA
   50: #ifdef DIRECT_THREADED
   51: #define NEXT1_P2 ({goto *cfa;})
   52: #else
   53: #define NEXT1_P2 ({goto **cfa;})
   54: #endif /* DIRECT_THREADED */
   55: #define NEXT_P2 ({cfa = *ip++; NEXT1_P2;})
   56: #else /* CISC_NEXT */
   57: #ifdef DIRECT_THREADED
   58: #define NEXT1_P1
   59: #define NEXT1_P2 ({goto *cfa;})
   60: #define DEF_CA
   61: #else /* DIRECT_THREADED */
   62: #define NEXT1_P1 ({ca = *cfa;})
   63: #define NEXT1_P2 ({goto *ca;})
   64: #define DEF_CA	Label ca;
   65: #endif /* DIRECT_THREADED */
   66: #define NEXT_P1 ({cfa=*ip++; NEXT1_P1;})
   67: #define NEXT_P2 NEXT1_P2
   68: #endif /* CISC_NEXT */
   69: 
   70: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
   71: #define NEXT ({DEF_CA NEXT_P1; NEXT_P2;})
   72: 
   73: #ifdef USE_TOS
   74: #define IF_TOS(x) x
   75: #else
   76: #define IF_TOS(x)
   77: #define TOS (sp[0])
   78: #endif
   79: 
   80: #ifdef USE_FTOS
   81: #define IF_FTOS(x) x
   82: #else
   83: #define IF_FTOS(x)
   84: #define FTOS (fp[0])
   85: #endif
   86: 
   87: int emitcounter;
   88: #define NULLC '\0'
   89: 
   90: char *cstr(Char *from, UCell size, int clear)
   91: /* if clear is true, scratch can be reused, otherwise we want more of
   92:    the same */
   93: {
   94:   static char *scratch=NULL;
   95:   static unsigned scratchsize=0;
   96:   static char *nextscratch;
   97:   char *oldnextscratch;
   98: 
   99:   if (clear)
  100:     nextscratch=scratch;
  101:   if (scratch==NULL) {
  102:     scratch=malloc(size+1);
  103:     nextscratch=scratch;
  104:     scratchsize=size;
  105:   }
  106:   else if (nextscratch+size>scratch+scratchsize) {
  107:     char *oldscratch=scratch;
  108:     scratch = realloc(scratch, (nextscratch-scratch)+size+1);
  109:     nextscratch=scratch+(nextscratch-oldscratch);
  110:     scratchsize=size;
  111:   }
  112:   memcpy(nextscratch,from,size);
  113:   nextscratch[size]='\0';
  114:   oldnextscratch = nextscratch;
  115:   nextscratch += size+1;
  116:   return oldnextscratch;
  117: }
  118: 
  119: #define NEWLINE	'\n'
  120: 
  121: 
  122: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
  123: 
  124: static Address up0=NULL;
  125: 
  126: #if defined(i386) && defined(FORCE_REG)
  127: #  define REG(reg) __asm__(reg)
  128: 
  129: Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)
  130: {
  131:    register Xt *ip REG("%esi")=ip0;
  132:    register Cell *sp REG("%edi")=sp0;
  133: 
  134: #else
  135: #  define REG(reg)
  136: 
  137: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
  138: {
  139: #endif
  140: /* executes code at ip, if ip!=NULL
  141:    returns array of machine code labels (for use in a loader), if ip==NULL
  142: */
  143:   register Xt cfa
  144: #ifdef i386
  145: #  ifdef USE_TOS
  146:    REG("%ecx")
  147: #  else
  148:    REG("%edx")
  149: #  endif
  150: #endif
  151:    ;
  152:   Address up=up0;
  153:   static Label symbols[]= {
  154:     &&docol,
  155:     &&docon,
  156:     &&dovar,
  157:     &&douser,
  158:     &&dodefer,
  159:     &&dodoes,
  160:     &&dodoes,  /* dummy for does handler address */
  161: #include "prim_labels.i"
  162:   };
  163:   IF_TOS(register Cell TOS;)
  164:   IF_FTOS(Float FTOS;)
  165: #ifdef CPU_DEP
  166:   CPU_DEP;
  167: #endif
  168: 
  169:   if (ip == NULL)
  170:     return symbols;
  171: 
  172:   IF_TOS(TOS = sp[0]);
  173:   IF_FTOS(FTOS = fp[0]);
  174:   prep_terminal();
  175:   NEXT;
  176:   
  177:  docol:
  178: #ifdef DEBUG
  179:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  180: #endif
  181: #ifdef i386
  182:   /* this is the simple version */
  183:   *--rp = (Cell)ip;
  184:   ip = (Xt *)PFA1(cfa);
  185:   NEXT;
  186: #endif
  187:   /* this one is important, so we help the compiler optimizing
  188:      The following version may be better (for scheduling), but probably has
  189:      problems with code fields employing calls and delay slots
  190:   */
  191:   {
  192:     DEF_CA
  193:     Xt *current_ip = (Xt *)PFA1(cfa);
  194:     cfa = *current_ip;
  195:     NEXT1_P1;
  196:     *--rp = (Cell)ip;
  197:     ip = current_ip+1;
  198:     NEXT1_P2;
  199:   }
  200:   
  201:  docon:
  202: #ifdef DEBUG
  203:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
  204: #endif
  205: #ifdef USE_TOS
  206:   *sp-- = TOS;
  207:   TOS = *(Cell *)PFA1(cfa);
  208: #else
  209:   *--sp = *(Cell *)PFA1(cfa);
  210: #endif
  211:   NEXT;
  212:   
  213:  dovar:
  214: #ifdef DEBUG
  215:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  216: #endif
  217: #ifdef USE_TOS
  218:   *sp-- = TOS;
  219:   TOS = (Cell)PFA1(cfa);
  220: #else
  221:   *--sp = (Cell)PFA1(cfa);
  222: #endif
  223:   NEXT;
  224:   
  225:   /* !! user? */
  226:   
  227:  douser:
  228: #ifdef DEBUG
  229:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  230: #endif
  231: #ifdef USE_TOS
  232:   *sp-- = TOS;
  233:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
  234: #else
  235:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
  236: #endif
  237:   NEXT;
  238:   
  239:  dodefer:
  240: #ifdef DEBUG
  241:   printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  242: #endif
  243:   cfa = *(Xt *)PFA1(cfa);
  244:   NEXT1;
  245: 
  246:  dodoes:
  247:   /* this assumes the following structure:
  248:      defining-word:
  249:      
  250:      ...
  251:      DOES>
  252:      (possible padding)
  253:      possibly handler: jmp dodoes
  254:      (possible branch delay slot(s))
  255:      Forth code after DOES>
  256:      
  257:      defined word:
  258:      
  259:      cfa: address of or jump to handler OR
  260:           address of or jump to dodoes, address of DOES-code
  261:      pfa:
  262:      
  263:      */
  264: #ifdef DEBUG
  265:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
  266:   fflush(stdout);
  267: #endif
  268:   *--rp = (Cell)ip;
  269:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
  270:   ip = DOES_CODE1(cfa);
  271: #ifdef USE_TOS
  272:   *sp-- = TOS;
  273:   TOS = (Cell)PFA(cfa);
  274: #else
  275:   *--sp = (Cell)PFA(cfa);
  276: #endif
  277:   NEXT;
  278:   
  279: #include "primitives.i"
  280: }