Annotation of gforth/engine/cgen.c, revision 1.1

1.1     ! anton       1: /* C-code generation for Gforth
        !             2: 
        !             3:   Copyright (C) 2010 Free Software Foundation, Inc.
        !             4: 
        !             5:   This file is part of Gforth.
        !             6: 
        !             7:   Gforth is free software; you can redistribute it and/or
        !             8:   modify it under the terms of the GNU General Public License
        !             9:   as published by the Free Software Foundation, either version 3
        !            10:   of the License, or (at your option) any later version.
        !            11: 
        !            12:   This program is distributed in the hope that it will be useful,
        !            13:   but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14:   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15:   GNU General Public License for more details.
        !            16: 
        !            17:   You should have received a copy of the GNU General Public License
        !            18:   along with this program; if not, see http://www.gnu.org/licenses/.
        !            19: */
        !            20: 
        !            21: #include "config.h"
        !            22: #include "forth.h"
        !            23: 
        !            24: /* Assumptions: 
        !            25: 
        !            26:    1) the function corresponding to (the first BB in) a
        !            27:    colon def is stored in the 2nd cell of the code field.
        !            28: 
        !            29:    2) the function corresponding to (the first BB of) a does-handler
        !            30:    is stored in the second cell of the code field.
        !            31: 
        !            32: */
        !            33: 
        !            34: /* run-time system */
        !            35: 
        !            36: 
        !            37: 
        !            38: 
        !            39: /* defined types: 
        !            40:    bb: basic block (or other unit fitting in C function;
        !            41:    doer: docol etc. called from execute
        !            42: */
        !            43: 
        !            44: typedef void *(*Bb)();
        !            45: typedef Bb (*Doer)(Bb,Cell *);
        !            46: typedef void (*Gen)();
        !            47: 
        !            48: Cell translate_link(Cell *);
        !            49: 
        !            50: void control_loop(Bb next)
        !            51: {
        !            52:   for (;;)
        !            53:     next = next();
        !            54: }
        !            55: 
        !            56: /* Doers */
        !            57: 
        !            58: Bb docol(Bb next, Cell *cfa)
        !            59: {
        !            60:   *--gforth_RP = (Cell)next;
        !            61:   return (Bb)cfa[1];
        !            62: }
        !            63: 
        !            64: void translate_link_colon_def(Cell *cfa)
        !            65: {
        !            66:   cfa[1] = translate_link(PFA(cfa));
        !            67:   cfa[0] = (Cell)docol;
        !            68: }
        !            69: 
        !            70: Bb docol0(Bb next, Cell *cfa)
        !            71: /* first invocation: compile on demand */
        !            72: {
        !            73:   translate_link_colon_def(cfa);
        !            74:   return docol(next, cfa);
        !            75: }
        !            76: 
        !            77: Bb docon(Bb next, Cell *cfa)
        !            78: {
        !            79:   *--gforth_SP = *PFA(cfa);
        !            80:   return next;
        !            81: }
        !            82: 
        !            83: Bb dovar(Bb next, Cell *cfa)
        !            84: {
        !            85:   *--gforth_SP = (Cell)PFA(cfa);
        !            86:   return next;
        !            87: }
        !            88: 
        !            89: Bb douser(Bb next, Cell *cfa)
        !            90: {
        !            91:   *--gforth_SP = (Cell)(gforth_UP + *(Cell *)PFA(cfa));
        !            92:   return next;
        !            93: }
        !            94: 
        !            95: Bb dodefer(Bb next, Cell *cfa)
        !            96: {
        !            97:   Cell *next_cfa = (Cell *)*PFA(cfa);
        !            98:   Doer next_doer = *(Doer *)next_cfa;
        !            99:   return next_doer(next, next_cfa);
        !           100: }
        !           101: 
        !           102: Bb dofield(Bb next, Cell *cfa)
        !           103: {
        !           104:   *gforth_SP += *PFA(cfa);
        !           105:   return next;
        !           106: }
        !           107: 
        !           108: Bb dovalue(Bb next, Cell *cfa)
        !           109: {
        !           110:   *--gforth_SP = *PFA(cfa);
        !           111:   return next;
        !           112: }
        !           113: 
        !           114: Bb dodoes(Bb next, Cell *cfa)
        !           115: {
        !           116:   *--gforth_RP = (Cell)next;
        !           117:   *--gforth_SP = (Cell)PFA(cfa);
        !           118:   return (Bb)cfa[1];
        !           119: }
        !           120: 
        !           121: void translate_link_does_handler(Cell *cfa)
        !           122: {
        !           123:   cfa[1] = translate_link((Cell *)cfa[1]);
        !           124:   cfa[0] = (Cell)dodoes;
        !           125: }
        !           126: 
        !           127: Bb dodoes0(Bb next, Cell *cfa)
        !           128: {
        !           129:   translate_link_does_handler(cfa);
        !           130:   return dodoes(next,cfa);
        !           131: }
        !           132: 
        !           133: Bb doabicode(Bb next, Cell *cfa)
        !           134: {
        !           135:   abifunc *f = (abifunc *)PFA(cfa);
        !           136:   gforth_SP = (*f)(gforth_SP, &gforth_FP);
        !           137:   return next;
        !           138: }
        !           139: 
        !           140: Bb dosemiabicode(Bb next, Cell *cfa)
        !           141: {
        !           142:   Address body = (Address)PFA(cfa);
        !           143:   semiabifunc *f = (semiabifunc *)DOES_CODE1(cfa);
        !           144:   gforth_SP = (*f)(gforth_SP, &gforth_FP, body);
        !           145:   return next;
        !           146: }
        !           147: 
        !           148: Bb cgen_symbols[] = {
        !           149:   docol0,
        !           150:   docon,
        !           151:   dovar,
        !           152:   douser,
        !           153:   dodefer,
        !           154:   dofield,
        !           155:   dovalue,
        !           156:   dodoes0,
        !           157:   doabicode,
        !           158:   dosemiabicode
        !           159: };
        !           160: /* !! actually we need all the primitives for the code fields as well.
        !           161:    Generate them?
        !           162:  */
        !           163:   
        !           164: /* Translator */
        !           165: 
        !           166: /* primitive descriptions (static) */
        !           167: typedef struct stack_effect {
        !           168:   char in;   /* stack items on input */
        !           169:   char out;  /* stack items on output */
        !           170:   char dump; /* if true, dump this stack (apart from in, out) to memory */
        !           171: } Stackeffect;
        !           172: 
        !           173: typedef struct prim {
        !           174:   Stackeffect se[MAX_STACKS];
        !           175:   Gen  gen;
        !           176:   char end_bb;
        !           177: } Prim;
        !           178: 
        !           179: Prim prims[] = {
        !           180: };
        !           181: 
        !           182: typedef struct stackpoint {
        !           183:   signed char depth;  /* current depth (relative to starting depth) */
        !           184:   char loaded_start;  /* from which depth the loading starts */
        !           185:   char loaded; /* how many stack items have been loaded from start to here */
        !           186:   char stored; /* how many stack items will be stored from here to end */
        !           187:   char new;    /* how many new stack items were accesses from start to here */
        !           188:   char old;    /* how many existing stack items were accessed */
        !           189: } Stackpoint;
        !           190: 
        !           191: typedef struct codepoint {
        !           192:   Cell *tc;
        !           193:   StackPoint stack[MAX_STACKS];
        !           194: } Codepoint;
        !           195: 
        !           196: 
        !           197: void forward_pass(Cell *tc, Codepoint *p, int n)
        !           198: {
        !           199:   for (j=0; j<MAX_STACKS; j++) {
        !           200:     Stackpoint *sp = p[0].stack;
        !           201:     sp->depth        = 0;
        !           202:     sp->loaded       = 0;
        !           203:     sp->loaded_start = 0;
        !           204:     sp->new          = 0;
        !           205:   }
        !           206:   for (i=0; i<n; i++) {
        !           207:     for (j=0; j<MAX_STACKS; j++) {
        !           208:       Stackpoint *b = p[i].stack+j; /* before */
        !           209:       Stackpoint *a = p[i].stack+j; /* after */
        !           210:       Stackeffect *s = p[PRIM_NUM(*tc)].se+j;
        !           211:       int depth = b->depth - s.in;
        !           212:       if (depth<b->old)
        !           213:        a->old=depth;
        !           214:       if (s->dump) {
        !           215:        a->loaded = 0;
        !           216:        a->loaded_start = depth;
        !           217:       } else {
        !           218:        a->loaded = min(depth,b->loaded);
        !           219:        a->loaded_start = min(depth,b->loaded_start);
        !           220:       }
        !           221:       depth += s.out;
        !           222:       a->new = max(b->new, depth);
        !           223:       a->depth = depth;
        !           224:     }
        !           225:   }
        !           226: }
        !           227: 
        !           228: 
        !           229: 
        !           230: char *cgen(Cell *tc)
        !           231: {
        !           232:   int n = npoints(tc);
        !           233:   Codepoint p[n+1];
        !           234: 
        !           235:   forward_pass(tc,p,n);
        !           236:   backwards_pass(tc,p,n);
        !           237:   decl_stack_items(p,n);
        !           238:   gen_prims(p);
        !           239: }
        !           240: 
        !           241: 
        !           242: 
        !           243: 
        !           244: Cell translate_link(Cell *bb_tc)
        !           245: {
        !           246:   Bb bbfunc = lookup_bb(bb_tc);
        !           247: 
        !           248:   if (bbfunc == NULL) {
        !           249:     char *filename_c  = cgen(bb_tc);
        !           250:     char *filename_la = compile(filename_tc);
        !           251:     lt_dlhandle lib = lt_dlopen(filename_la);
        !           252:     bb_func = lt_dlsym(symbol(bb_tc));
        !           253:   }
        !           254:   return (Cell) bb_func;
        !           255: }

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