Annotation of gforth/engine.c, revision 1.15

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

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