Annotation of gforth/engine.c, revision 1.6

1.1       anton       1: /*
1.6     ! pazsan      2:   $Id: engine.c,v 1.5 1994/05/07 14:55:47 anton Exp $
1.1       anton       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>
1.2       pazsan     15: #include <time.h>
1.6     ! pazsan     16: #include <sys/time.h>
1.1       anton      17: #include "forth.h"
                     18: #include "io.h"
                     19: 
1.6     ! pazsan     20: #ifndef unlink
        !            21:        extern unlink(char *);
        !            22: #endif
        !            23: #ifndef ftruncate
        !            24:        extern ftruncate(int, int);
        !            25: #endif
1.1       anton      26: 
                     27: typedef union {
                     28:   struct {
                     29: #ifdef BIG_ENDIAN
                     30:     Cell high;
                     31:     Cell low;
                     32: #else
                     33:     Cell low;
                     34:     Cell high;
                     35: #endif;
                     36:   } cells;
                     37:   DCell dcell;
                     38: } Double_Store;
                     39: 
                     40: typedef struct F83Name {
                     41:   struct F83Name       *next;  /* the link field for old hands */
                     42:   char                 countetc;
                     43:   Char                 name[0];
                     44: } F83Name;
                     45: 
                     46: /* are macros for setting necessary? */
                     47: #define F83NAME_COUNT(np)      ((np)->countetc & 0x1f)
                     48: #define F83NAME_SMUDGE(np)     (((np)->countetc & 0x40) != 0)
                     49: #define F83NAME_IMMEDIATE(np)  (((np)->countetc & 0x20) != 0)
                     50: 
                     51: /* NEXT and NEXT1 are split into several parts to help scheduling */
                     52: #ifdef DIRECT_THREADED
1.4       pazsan     53: #      define NEXT1_P1 
                     54: #      define NEXT1_P2 ({goto *cfa;})
                     55: #      define DEF_CA
1.1       anton      56: #else
1.4       pazsan     57: #      define NEXT1_P1 ({ca = *cfa;})
                     58: #      define NEXT1_P2 ({goto *ca;})
                     59: #      define DEF_CA   Label ca;
1.1       anton      60: #endif
                     61: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
                     62: 
1.4       pazsan     63: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
                     64: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
1.1       anton      65: 
                     66: #ifdef USE_TOS
                     67: #define IF_TOS(x) x
                     68: #else
                     69: #define IF_TOS(x)
                     70: #define TOS (sp[0])
                     71: #endif
                     72: 
                     73: #ifdef USE_FTOS
                     74: #define IF_FTOS(x) x
                     75: #else
                     76: #define IF_FTOS(x)
                     77: #define FTOS (fp[0])
                     78: #endif
                     79: 
                     80: int emitcounter;
                     81: #define NULLC '\0'
                     82: 
1.3       pazsan     83: #define cstr(to,from,size)\
                     84:        {       memcpy(to,from,size);\
1.1       anton      85:                to[size]=NULLC;}
                     86: #define NEWLINE        '\n'
                     87: 
                     88: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
                     89: 
1.6     ! pazsan     90: #if ~defined(select) && defined(DOS)
        !            91: /* select replacement for DOS computers for ms only */
        !            92: void select(int n, int a, int b, int c, struct timeval * timeout)
        !            93: {
        !            94:    struct timeval time1;
        !            95:    struct timeval time2;
        !            96:    struct timezone zone1;
        !            97: 
        !            98:    gettimeofday(&time1,&zone1);
        !            99:    time1.tv_sec += timeout->tv_sec;
        !           100:    time1.tv_usec += timeout->tv_usec;
        !           101:    while(time1.tv_usec >= 1000000)
        !           102:      {
        !           103:        time1.tv_usec -= 1000000;
        !           104:        time1.tv_sec++;
        !           105:      }
        !           106:    do
        !           107:      {
        !           108:        gettimeofday(&time2,&zone1);
        !           109:      }
        !           110:    while(time2.tv_usec < time1.tv_usec || time2.tv_sec < time1.tv_sec);
        !           111: }
        !           112: #endif
        !           113: 
1.5       anton     114: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.1       anton     115: /* executes code at ip, if ip!=NULL
                    116:    returns array of machine code labels (for use in a loader), if ip==NULL
                    117: */
                    118: {
                    119:   Xt cfa;
1.4       pazsan    120:   Address up=NULL;
1.1       anton     121:   static Label symbols[]= {
                    122:     &&docol,
                    123:     &&docon,
                    124:     &&dovar,
1.4       pazsan    125:     &&douser,
1.1       anton     126:     &&dodoes,
1.6     ! pazsan    127:     &&dodoes,  /* dummy for does handler address */
1.1       anton     128: #include "prim_labels.i"
                    129:   };
                    130:   IF_TOS(register Cell TOS;)
                    131:   IF_FTOS(Float FTOS;)
                    132: #ifdef CPU_DEP
                    133:   CPU_DEP;
                    134: #endif
                    135: 
                    136:   if (ip == NULL)
                    137:     return symbols;
                    138:   
                    139:   IF_TOS(TOS = sp[0]);
                    140:   IF_FTOS(FTOS = fp[0]);
                    141:   prep_terminal();
                    142:   NEXT;
                    143:   
                    144:  docol:
                    145: #ifdef DEBUG
1.6     ! pazsan    146:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     147: #endif
                    148: #ifdef undefined
                    149:   /* this is the simple version */
                    150:   *--rp = (Cell)ip;
                    151:   ip = (Xt *)PFA1(cfa);
                    152:   NEXT;
                    153: #endif
                    154:   /* this one is important, so we help the compiler optimizing
                    155:      The following version may be better (for scheduling), but probably has
                    156:      problems with code fields employing calls and delay slots
                    157:   */
                    158:   {
1.4       pazsan    159:     DEF_CA
1.1       anton     160:     Xt *current_ip = (Xt *)PFA1(cfa);
                    161:     cfa = *current_ip;
                    162:     NEXT1_P1;
                    163:     *--rp = (Cell)ip;
                    164:     ip = current_ip+1;
1.3       pazsan    165:     NEXT1_P2;
1.1       anton     166:   }
                    167:   
                    168:  docon:
                    169: #ifdef DEBUG
1.6     ! pazsan    170:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1       anton     171: #endif
                    172: #ifdef USE_TOS
                    173:   *sp-- = TOS;
                    174:   TOS = *(Cell *)PFA1(cfa);
                    175: #else
                    176:   *--sp = *(Cell *)PFA1(cfa);
                    177: #endif
                    178:   NEXT;
                    179:   
                    180:  dovar:
                    181: #ifdef DEBUG
1.6     ! pazsan    182:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     183: #endif
                    184: #ifdef USE_TOS
                    185:   *sp-- = TOS;
                    186:   TOS = (Cell)PFA1(cfa);
                    187: #else
                    188:   *--sp = (Cell)PFA1(cfa);
                    189: #endif
                    190:   NEXT;
                    191:   
                    192:   /* !! user? */
                    193:   
1.4       pazsan    194:  douser:
                    195: #ifdef DEBUG
1.6     ! pazsan    196:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4       pazsan    197: #endif
                    198: #ifdef USE_TOS
                    199:   *sp-- = TOS;
1.5       anton     200:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    201: #else
1.5       anton     202:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    203: #endif
                    204:   NEXT;
                    205:   
1.1       anton     206:  dodoes:
                    207:   /* this assumes the following structure:
                    208:      defining-word:
                    209:      
                    210:      ...
                    211:      DOES>
                    212:      (possible padding)
                    213:      possibly handler: jmp dodoes
                    214:      (possible branch delay slot(s))
                    215:      Forth code after DOES>
                    216:      
                    217:      defined word:
                    218:      
                    219:      cfa: address of or jump to handler OR
                    220:           address of or jump to dodoes, address of DOES-code
                    221:      pfa:
                    222:      
                    223:      */
                    224: #ifdef DEBUG
1.6     ! pazsan    225:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
        !           226:   fflush(stdout);
1.1       anton     227: #endif
                    228:   *--rp = (Cell)ip;
                    229:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
                    230: #ifdef USE_TOS
                    231:   *sp-- = TOS;
                    232:   TOS = (Cell)PFA(cfa);
                    233: #else
                    234:   *--sp = (Cell)PFA(cfa);
                    235: #endif
                    236:   ip = DOES_CODE1(cfa);
                    237:   NEXT;
                    238:   
                    239: #include "primitives.i"
                    240: }

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