File:  [gforth] / gforth / Attic / engine.c
Revision 1.22: download - view: text, annotated - select for diffs
Tue Jan 10 18:57:42 1995 UTC (26 years, 6 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Changes to make creation of info files possible
more documentation
included unistd.h in engine.c

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

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