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>