Annotation of gforth/engine.c, revision 1.10

1.1       anton       1: /*
1.10    ! anton       2:   $Id: engine.c,v 1.9 1994/07/07 14:59:21 pazsan 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.4       pazsan     46: #      define NEXT1_P1 
                     47: #      define NEXT1_P2 ({goto *cfa;})
                     48: #      define DEF_CA
1.1       anton      49: #else
1.4       pazsan     50: #      define NEXT1_P1 ({ca = *cfa;})
                     51: #      define NEXT1_P2 ({goto *ca;})
                     52: #      define DEF_CA   Label ca;
1.1       anton      53: #endif
                     54: #define NEXT_P1 ({cfa = *ip++; NEXT1_P1;})
                     55: 
1.4       pazsan     56: #define NEXT1 ({DEF_CA NEXT1_P1; NEXT1_P2;})
                     57: #define NEXT ({DEF_CA NEXT_P1; NEXT1_P2;})
1.1       anton      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: 
1.3       pazsan     76: #define cstr(to,from,size)\
                     77:        {       memcpy(to,from,size);\
1.1       anton      78:                to[size]=NULLC;}
                     79: #define NEWLINE        '\n'
                     80: 
                     81: static char* fileattr[6]={"r","rb","r+","r+b","w+","w+b"};
1.6       pazsan     82: 
1.5       anton      83: Label *engine(Xt *ip, Cell *sp, Cell *rp, Float *fp, Address lp)
1.1       anton      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;
1.4       pazsan     89:   Address up=NULL;
1.1       anton      90:   static Label symbols[]= {
                     91:     &&docol,
                     92:     &&docon,
                     93:     &&dovar,
1.4       pazsan     94:     &&douser,
1.1       anton      95:     &&dodoes,
1.6       pazsan     96:     &&dodoes,  /* dummy for does handler address */
1.1       anton      97: #include "prim_labels.i"
                     98:   };
1.10    ! anton      99:   int throw_code;
1.1       anton     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:   
1.10    ! anton     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: 
1.1       anton     122:   IF_TOS(TOS = sp[0]);
                    123:   IF_FTOS(FTOS = fp[0]);
                    124:   prep_terminal();
                    125:   NEXT;
                    126:   
                    127:  docol:
                    128: #ifdef DEBUG
1.6       pazsan    129:   printf("%08x: col: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     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:   {
1.4       pazsan    142:     DEF_CA
1.1       anton     143:     Xt *current_ip = (Xt *)PFA1(cfa);
                    144:     cfa = *current_ip;
                    145:     NEXT1_P1;
                    146:     *--rp = (Cell)ip;
                    147:     ip = current_ip+1;
1.3       pazsan    148:     NEXT1_P2;
1.1       anton     149:   }
                    150:   
                    151:  docon:
                    152: #ifdef DEBUG
1.6       pazsan    153:   printf("%08x: con: %08x\n",(Cell)ip,*(Cell*)PFA1(cfa));
1.1       anton     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
1.6       pazsan    165:   printf("%08x: var: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.1       anton     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:   
1.4       pazsan    177:  douser:
                    178: #ifdef DEBUG
1.6       pazsan    179:   printf("%08x: user: %08x\n",(Cell)ip,(Cell)PFA1(cfa));
1.4       pazsan    180: #endif
                    181: #ifdef USE_TOS
                    182:   *sp-- = TOS;
1.5       anton     183:   TOS = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    184: #else
1.5       anton     185:   *--sp = (Cell)(up+*(Cell*)PFA1(cfa));
1.4       pazsan    186: #endif
                    187:   NEXT;
                    188:   
1.1       anton     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
1.6       pazsan    208:   printf("%08x/%08x: does: %08x\n",(Cell)ip,(Cell)cfa,*(Cell)PFA(cfa));
                    209:   fflush(stdout);
1.1       anton     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: }

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