Annotation of gforth/engine.c, revision 1.13

1.1       anton       1: /*
1.13    ! pazsan      2:   $Id: engine.c,v 1.12 1994/08/25 15:25:21 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: 
                     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
1.13    ! pazsan     46: #      define NEXT1_P1
        !            47: #      ifdef i386
        !            48: #              define NEXT1_P2 ({cfa=*ip++; goto *cfa;})
        !            49: #      else
        !            50: #              define NEXT1_P2 ({goto *cfa;})
        !            51: #      endif
1.4       pazsan     52: #      define DEF_CA
1.1       anton      53: #else
1.4       pazsan     54: #      define NEXT1_P1 ({ca = *cfa;})
                     55: #      define NEXT1_P2 ({goto *ca;})
                     56: #      define DEF_CA   Label ca;
1.1       anton      57: #endif
1.13    ! pazsan     58: #if defined(i386) && defined(DIRECT_THREADED)
        !            59: #      define NEXT_P1
        !            60: #      define NEXT1 ({goto *cfa;})
        !            61: #else
        !            62: #      define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
        !            63: #      define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
        !            64: #endif
1.1       anton      65: 
1.4       pazsan     66: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
1.1       anton      67: 
                     68: #ifdef USE_TOS
                     69: #define IF_TOS(x) x
                     70: #else
                     71: #define IF_TOS(x)
                     72: #define TOS (sp[0])
                     73: #endif
                     74: 
                     75: #ifdef USE_FTOS
                     76: #define IF_FTOS(x) x
                     77: #else
                     78: #define IF_FTOS(x)
                     79: #define FTOS (fp[0])
                     80: #endif
                     81: 
                     82: int emitcounter;
                     83: #define NULLC '\0'
                     84: 
1.13    ! pazsan     85: #ifdef copycstr
        !            86: #   define cstr(to,from,size)\
1.3       pazsan     87:        {       memcpy(to,from,size);\
1.1       anton      88:                to[size]=NULLC;}
1.13    ! pazsan     89: #else
        !            90: char scratch[1024];
        !            91: int soffset;
        !            92: #   define cstr(from,size) \
        !            93:            ({ char * to = scratch; \
        !            94:              memcpy(to,from,size); \
        !            95:              to[size] = NULLC; \
        !            96:              soffset = size+1; \
        !            97:              to; \
        !            98:           })
        !            99: #   define cstr1(from,size) \
        !           100:            ({ char * to = scratch+soffset; \
        !           101:              memcpy(to,from,size); \
        !           102:              to[size] = NULLC; \
        !           103:              soffset += size+1; \
        !           104:              to; \
        !           105:           })
        !           106: #endif
        !           107: 
1.1       anton     108: #define NEWLINE        '\n'
                    109: 
1.13    ! pazsan    110: 
1.1       anton     111: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6       pazsan    112: 
1.11      pazsan    113: static Address up0=NULL;
                    114: 
1.13    ! pazsan    115: #if defined(i386) && defined(FORCE_REG)
        !           116: #  define REG(reg) __asm__(reg)
        !           117: 
        !           118: Label *engine(Xt *ip0, Cell *sp0, Cell *rp, Float *fp, Address lp)
        !           119: {
        !           120:    register Xt *ip REG("%esi")=ip0;
        !           121:    register Cell *sp REG("%edi")=sp0;
        !           122: 
        !           123: #else
        !           124: #  define REG(reg)
        !           125: 
1.5       anton     126: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.13    ! pazsan    127: {
        !           128: #endif
1.1       anton     129: /* executes code at ip, if ip!=NULL
                    130:    returns array of machine code labels (for use in a loader), if ip==NULL
                    131: */
1.13    ! pazsan    132:   register Xt cfa
        !           133: #ifdef i386
        !           134: #  ifdef USE_TOS
        !           135:    REG("%ecx")
        !           136: #  else
        !           137:    REG("%edx")
        !           138: #  endif
        !           139: #endif
        !           140:    ;
1.11      pazsan    141:   Address up=up0;
1.1       anton     142:   static Label symbols[]= {
                    143:     &&docol,
                    144:     &&docon,
                    145:     &&dovar,
1.4       pazsan    146:     &&douser,
1.12      anton     147:     &&dodefer,
1.1       anton     148:     &&dodoes,
1.6       pazsan    149:     &&dodoes,  /* dummy for does handler address */
1.1       anton     150: #include "prim_labels.i"
                    151:   };
                    152:   IF_TOS(register Cell TOS;)
                    153:   IF_FTOS(Float FTOS;)
                    154: #ifdef CPU_DEP
                    155:   CPU_DEP;
                    156: #endif
                    157: 
                    158:   if (ip == NULL)
                    159:     return symbols;
1.10      anton     160: 
1.1       anton     161:   IF_TOS(TOS = sp[0]);
                    162:   IF_FTOS(FTOS = fp[0]);
                    163:   prep_terminal();
                    164:   NEXT;
                    165:   
                    166:  docol:
                    167: #ifdef DEBUG
1.6       pazsan    168:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     169: #endif
1.13    ! pazsan    170: #ifdef i386
1.1       anton     171:   /* this is the simple version */
                    172:   *--rp = (Cell)ip;
                    173:   ip = (Xt *)PFA1(cfa);
                    174:   NEXT;
                    175: #endif
                    176:   /* this one is important, so we help the compiler optimizing
                    177:      The following version may be better (for scheduling), but probably has
                    178:      problems with code fields employing calls and delay slots
                    179:   */
                    180:   {
1.4       pazsan    181:     DEF_CA
1.1       anton     182:     Xt *current_ip = (Xt *)PFA1(cfa);
                    183:     cfa = *current_ip;
                    184:     NEXT1_P1;
                    185:     *--rp = (Cell)ip;
                    186:     ip = current_ip+1;
1.3       pazsan    187:     NEXT1_P2;
1.1       anton     188:   }
                    189:   
                    190:  docon:
                    191: #ifdef DEBUG
1.6       pazsan    192:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1       anton     193: #endif
                    194: #ifdef USE_TOS
                    195:   *sp-- = TOS;
                    196:   TOS = *(Cell *)PFA1(cfa);
                    197: #else
                    198:   *--sp = *(Cell *)PFA1(cfa);
                    199: #endif
                    200:   NEXT;
                    201:   
                    202:  dovar:
                    203: #ifdef DEBUG
1.6       pazsan    204:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     205: #endif
                    206: #ifdef USE_TOS
                    207:   *sp-- = TOS;
                    208:   TOS = (Cell)PFA1(cfa);
                    209: #else
                    210:   *--sp = (Cell)PFA1(cfa);
                    211: #endif
                    212:   NEXT;
                    213:   
                    214:   /* !! user? */
                    215:   
1.4       pazsan    216:  douser:
                    217: #ifdef DEBUG
1.6       pazsan    218:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4       pazsan    219: #endif
                    220: #ifdef USE_TOS
                    221:   *sp-- = TOS;
1.5       anton     222:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    223: #else
1.5       anton     224:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    225: #endif
                    226:   NEXT;
                    227:   
1.12      anton     228:  dodefer:
                    229: #ifdef DEBUG
                    230:   printf("%08x: defer: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
                    231: #endif
                    232:   cfa = *(Xt *)PFA1(cfa);
                    233:   NEXT1;
                    234: 
1.1       anton     235:  dodoes:
                    236:   /* this assumes the following structure:
                    237:      defining-word:
                    238:      
                    239:      ...
                    240:      DOES>
                    241:      (possible padding)
                    242:      possibly handler: jmp dodoes
                    243:      (possible branch delay slot(s))
                    244:      Forth code after DOES>
                    245:      
                    246:      defined word:
                    247:      
                    248:      cfa: address of or jump to handler OR
                    249:           address of or jump to dodoes, address of DOES-code
                    250:      pfa:
                    251:      
                    252:      */
                    253: #ifdef DEBUG
1.6       pazsan    254:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
                    255:   fflush(stdout);
1.1       anton     256: #endif
                    257:   *--rp = (Cell)ip;
                    258:   /* PFA1 might collide with DOES_CODE1 here, so we use PFA */
1.13    ! pazsan    259:   ip = DOES_CODE1(cfa);
1.1       anton     260: #ifdef USE_TOS
                    261:   *sp-- = TOS;
                    262:   TOS = (Cell)PFA(cfa);
                    263: #else
                    264:   *--sp = (Cell)PFA(cfa);
                    265: #endif
                    266:   NEXT;
                    267:   
                    268: #include "primitives.i"
                    269: }

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