Return to engine.c CVS log

Up to [gforth] / gforth

Annotation of gforth/engine.c, revision 1.4

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