File:  [gforth] / gforth / Attic / engine.c
Revision 1.11: download - view: text, annotated - select for diffs
Wed Jul 13 19:21:02 1994 UTC (27 years ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Moved setjmp from engine to go_forth, because the socalled "globbered"
variables where saved in memory (and this slows down everything).
Added global up0 for security (up is globbered).

Added restrict's functionalitz to cross.fs

removed all occurency of cell+ name>, because the bug in name> is
fixed.

Added a dusty workaround at the end of prims2x.fs, because of
strange exceptions.

    1: /*
    2:   $Id: engine.c,v 1.11 1994/07/13 19:21:02 pazsan 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: static Address up0=NULL;
   84: 
   85: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
   86: /* executes code at ip, if ip!=NULL
   87:    returns array of machine code labels (for use in a loader), if ip==NULL
   88: */
   89: {
   90:   Xt cfa;
   91:   Address up=up0;
   92:   static Label symbols[]= {
   93:     &&docol,
   94:     &&docon,
   95:     &&dovar,
   96:     &&douser,
   97:     &&dodoes,
   98:     &&dodoes,  /* dummy for does handler address */
   99: #include "prim_labels.i"
  100:   };
  101:   IF_TOS(register Cell TOS;)
  102:   IF_FTOS(Float FTOS;)
  103: #ifdef CPU_DEP
  104:   CPU_DEP;
  105: #endif
  106: 
  107:   if (ip == NULL)
  108:     return symbols;
  109: 
  110:   IF_TOS(TOS = sp[0]);
  111:   IF_FTOS(FTOS = fp[0]);
  112:   prep_terminal();
  113:   NEXT;
  114:   
  115:  docol:
  116: #ifdef DEBUG
  117:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  118: #endif
  119: #ifdef undefined
  120:   /* this is the simple version */
  121:   *--rp = (Cell)ip;
  122:   ip = (Xt *)PFA1(cfa);
  123:   NEXT;
  124: #endif
  125:   /* this one is important, so we help the compiler optimizing
  126:      The following version may be better (for scheduling), but probably has
  127:      problems with code fields employing calls and delay slots
  128:   */
  129:   {
  130:     DEF_CA
  131:     Xt *current_ip = (Xt *)PFA1(cfa);
  132:     cfa = *current_ip;
  133:     NEXT1_P1;
  134:     *--rp = (Cell)ip;
  135:     ip = current_ip+1;
  136:     NEXT1_P2;
  137:   }
  138:   
  139:  docon:
  140: #ifdef DEBUG
  141:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
  142: #endif
  143: #ifdef USE_TOS
  144:   *sp-- = TOS;
  145:   TOS = *(Cell *)PFA1(cfa);
  146: #else
  147:   *--sp = *(Cell *)PFA1(cfa);
  148: #endif
  149:   NEXT;
  150:   
  151:  dovar:
  152: #ifdef DEBUG
  153:   printf("%08x: var: %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:   /* !! user? */
  164:   
  165:  douser:
  166: #ifdef DEBUG
  167:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
  168: #endif
  169: #ifdef USE_TOS
  170:   *sp-- = TOS;
  171:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
  172: #else
  173:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
  174: #endif
  175:   NEXT;
  176:   
  177:  dodoes:
  178:   /* this assumes the following structure:
  179:      defining-word:
  180:      
  181:      ...
  182:      DOES>
  183:      (possible padding)
  184:      possibly handler: jmp dodoes
  185:      (possible branch delay slot(s))
  186:      Forth code after DOES>
  187:      
  188:      defined word:
  189:      
  190:      cfa: address of or jump to handler OR
  191:           address of or jump to dodoes, address of DOES-code
  192:      pfa:
  193:      
  194:      */
  195: #ifdef DEBUG
  196:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
  197:   fflush(stdout);
  198: #endif
  199:   *--rp = (Cell)ip;
  200:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
  201: #ifdef USE_TOS
  202:   *sp-- = TOS;
  203:   TOS = (Cell)PFA(cfa);
  204: #else
  205:   *--sp = (Cell)PFA(cfa);
  206: #endif
  207:   ip = DOES_CODE1(cfa);
  208:   NEXT;
  209:   
  210: #include "primitives.i"
  211: }

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