File:  [gforth] / gforth / Attic / engine.c
Revision 1.18: download - view: text, annotated - select for diffs
Mon Oct 3 18:24:01 1994 UTC (27 years, 1 month ago) by anton
Branches: MAIN
CVS tags: HEAD
Updated ToDo and INSTALL; Wrote README; Lifted COPYING and getopt*
from other packages;  removed $Id$ lines from some files

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

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