Return to engine.c CVS log

Up to [gforth] / gforth

Reorganized configuration: configure is now created by autoconf from
configure.in; I still left it in the CVS repository because not
everyone has autoconf. decstation.h renamed to mips.h and apollo68k to
m68k. Added general 32bit.h description, which the other machine
descriptions use. Created/copied replacement files install-sh memcmp.c
memmove.c select.c (carved out from ecvt.c) strtol.c
strtoul.c. Bytesex is now handled by configure.

Deciding the threading method is now done in machine.h, this should
also be done for USE_TOS and USE_FTOS.

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