Return to engine.c CVS log

Up to [gforth] / gforth

Annotation of gforth/engine.c, revision 1.1

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