Return to engine.c CVS log

Up to [gforth] / gforth

signals are now translated into THROWs
A number of bug fixes (make a diff of BUGS for details)
added assert.fs and debugging.fs
made .s nicer
keep names of included files (in loadfilename) and print them upon error

    1: /*
    2:   $Id: engine.c,v 1.10 1994/07/08 15:00:35 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: #ifdef DIRECT_THREADED
   46: #	define NEXT1_P1 
   47: #	define NEXT1_P2 ({goto *cfa;})
   48: #	define DEF_CA
   49: #else
   50: #	define NEXT1_P1 ({ca = *cfa;})
   51: #	define NEXT1_P2 ({goto *ca;})
   52: #	define DEF_CA	Label ca;
   53: #endif
   54: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
   55: 
   56: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
   57: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
   58: 
   59: #ifdef USE_TOS
   60: #define IF_TOS(x) x
   61: #else
   62: #define IF_TOS(x)
   63: #define TOS (sp[0])
   64: #endif
   65: 
   66: #ifdef USE_FTOS
   67: #define IF_FTOS(x) x
   68: #else
   69: #define IF_FTOS(x)
   70: #define FTOS (fp[0])
   71: #endif
   72: 
   73: int emitcounter;
   74: #define NULLC '\0'
   75: 
   76: #define cstr(to,from,size)\
   77: 	{	memcpy(to,from,size);\
   78: 		to[size]=NULLC;}
   79: #define NEWLINE	'\n'
   80: 
   81: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
   82: 
   83: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
   84: /* executes code at ip, if ip!=NULL
   85:    returns array of machine code labels (for use in a loader), if ip==NULL
   86: */
   87: {
   88:   Xt cfa;
   89:   Address up=NULL;
   90:   static Label symbols[]= {
   91:     &&docol,
   92:     &&docon,
   93:     &&dovar,
   94:     &&douser,
   95:     &&dodoes,
   96:     &&dodoes,  /* dummy for does handler address */
   97: #include "prim_labels.i"
   98:   };
   99:   int throw_code;
  100:   IF_TOS(register Cell TOS;)
  101:   IF_FTOS(Float FTOS;)
  102: #ifdef CPU_DEP
  103:   CPU_DEP;
  104: #endif
  105: 
  106:   if (ip == NULL)
  107:     return symbols;
  108:   
  109:   if ((throw_code=setjmp(throw_jmp_buf))) {
  110:     static Cell signal_data_stack[8];
  111: 
  112:      /* AFAIK, it's not guarateed that the registers have the right value
  113: 	after a longjump, so we avoid using the current values.
  114: 	If it were guaranteed that the registers keep their values, we could
  115: 	call a signal handler in Forth instead of doing the throw from C */
  116:     sp = &signal_data_stack[7];
  117:     TOS = throw_code;
  118:     ip = throw_ip;
  119:     NEXT;
  120:   }
  121: 
  122:   IF_TOS(TOS = sp[0]);
  123:   IF_FTOS(FTOS = fp[0]);
  124:   prep_terminal();
  125:   NEXT;
  126:   
  127:  docol:
  128: #ifdef DEBUG
  129:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  130: #endif
  131: #ifdef undefined
  132:   /* this is the simple version */
  133:   *--rp = (Cell)ip;
  134:   ip = (Xt *)PFA1(cfa);
  135:   NEXT;
  136: #endif
  137:   /* this one is important, so we help the compiler optimizing
  138:      The following version may be better (for scheduling), but probably has
  139:      problems with code fields employing calls and delay slots
  140:   */
  141:   {
  142:     DEF_CA
  143:     Xt *current_ip = (Xt *)PFA1(cfa);
  144:     cfa = *current_ip;
  145:     NEXT1_P1;
  146:     *--rp = (Cell)ip;
  147:     ip = current_ip+1;
  148:     NEXT1_P2;
  149:   }
  150:   
  151:  docon:
  152: #ifdef DEBUG
  153:   printf("%08x: con: %08x\n",(Cell)ip,*(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:  dovar:
  164: #ifdef DEBUG
  165:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  166: #endif
  167: #ifdef USE_TOS
  168:   *sp-- = TOS;
  169:   TOS = (Cell)PFA1(cfa);
  170: #else
  171:   *--sp = (Cell)PFA1(cfa);
  172: #endif
  173:   NEXT;
  174:   
  175:   /* !! user? */
  176:   
  177:  douser:
  178: #ifdef DEBUG
  179:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  180: #endif
  181: #ifdef USE_TOS
  182:   *sp-- = TOS;
  183:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
  184: #else
  185:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
  186: #endif
  187:   NEXT;
  188:   
  189:  dodoes:
  190:   /* this assumes the following structure:
  191:      defining-word:
  192:      
  193:      ...
  194:      DOES>
  195:      (possible padding)
  196:      possibly handler: jmp dodoes
  197:      (possible branch delay slot(s))
  198:      Forth code after DOES>
  199:      
  200:      defined word:
  201:      
  202:      cfa: address of or jump to handler OR
  203:           address of or jump to dodoes, address of DOES-code
  204:      pfa:
  205:      
  206:      */
  207: #ifdef DEBUG
  208:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
  209:   fflush(stdout);
  210: #endif
  211:   *--rp = (Cell)ip;
  212:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
  213: #ifdef USE_TOS
  214:   *sp-- = TOS;
  215:   TOS = (Cell)PFA(cfa);
  216: #else
  217:   *--sp = (Cell)PFA(cfa);
  218: #endif
  219:   ip = DOES_CODE1(cfa);
  220:   NEXT;
  221:   
  222: #include "primitives.i"
  223: }