Return to cgen.c CVS log

Up to [gforth] / gforth / engine

work on C-code generation

/* C-code generation for Gforth

  Copyright (C) 2010 Free Software Foundation, Inc.

  This file is part of Gforth.

  Gforth is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation, either version 3
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, see http://www.gnu.org/licenses/.
*/

#include "config.h"
#include "forth.h"

/* Assumptions: 

   1) the function corresponding to (the first BB in) a
   colon def is stored in the 2nd cell of the code field.

   2) the function corresponding to (the first BB of) a does-handler
   is stored in the second cell of the code field.

*/

/* run-time system */




/* defined types: 
   bb: basic block (or other unit fitting in C function;
   doer: docol etc. called from execute
*/

typedef void *(*Bb)();
typedef Bb (*Doer)(Bb,Cell *);
typedef void (*Gen)();

Cell translate_link(Cell *);

void control_loop(Bb next)
{
  for (;;)
    next = next();
}

/* Doers */

Bb docol(Bb next, Cell *cfa)
{
  *--gforth_RP = (Cell)next;
  return (Bb)cfa[1];
}

void translate_link_colon_def(Cell *cfa)
{
  cfa[1] = translate_link(PFA(cfa));
  cfa[0] = (Cell)docol;
}

Bb docol0(Bb next, Cell *cfa)
/* first invocation: compile on demand */
{
  translate_link_colon_def(cfa);
  return docol(next, cfa);
}

Bb docon(Bb next, Cell *cfa)
{
  *--gforth_SP = *PFA(cfa);
  return next;
}

Bb dovar(Bb next, Cell *cfa)
{
  *--gforth_SP = (Cell)PFA(cfa);
  return next;
}

Bb douser(Bb next, Cell *cfa)
{
  *--gforth_SP = (Cell)(gforth_UP + *(Cell *)PFA(cfa));
  return next;
}

Bb dodefer(Bb next, Cell *cfa)
{
  Cell *next_cfa = (Cell *)*PFA(cfa);
  Doer next_doer = *(Doer *)next_cfa;
  return next_doer(next, next_cfa);
}

Bb dofield(Bb next, Cell *cfa)
{
  *gforth_SP += *PFA(cfa);
  return next;
}

Bb dovalue(Bb next, Cell *cfa)
{
  *--gforth_SP = *PFA(cfa);
  return next;
}

Bb dodoes(Bb next, Cell *cfa)
{
  *--gforth_RP = (Cell)next;
  *--gforth_SP = (Cell)PFA(cfa);
  return (Bb)cfa[1];
}

void translate_link_does_handler(Cell *cfa)
{
  cfa[1] = translate_link((Cell *)cfa[1]);
  cfa[0] = (Cell)dodoes;
}

Bb dodoes0(Bb next, Cell *cfa)
{
  translate_link_does_handler(cfa);
  return dodoes(next,cfa);
}

Bb doabicode(Bb next, Cell *cfa)
{
  abifunc *f = (abifunc *)PFA(cfa);
  gforth_SP = (*f)(gforth_SP, &gforth_FP);
  return next;
}

Bb dosemiabicode(Bb next, Cell *cfa)
{
  Address body = (Address)PFA(cfa);
  semiabifunc *f = (semiabifunc *)DOES_CODE1(cfa);
  gforth_SP = (*f)(gforth_SP, &gforth_FP, body);
  return next;
}

Bb cgen_symbols[] = {
  docol0,
  docon,
  dovar,
  douser,
  dodefer,
  dofield,
  dovalue,
  dodoes0,
  doabicode,
  dosemiabicode
};
/* !! actually we need all the primitives for the code fields as well.
   Generate them?
 */
  
/* Translator */

/* primitive descriptions (static) */
typedef struct stack_effect {
  char in;   /* stack items on input */
  char out;  /* stack items on output */
  char dump; /* if true, dump this stack (apart from in, out) to memory */
} Stackeffect;

typedef struct prim {
  Stackeffect se[MAX_STACKS];
  Gen  gen;
  char end_bb;
} Prim;

Prim prims[] = {
};

typedef struct stackpoint {
  signed char depth;  /* current depth (relative to starting depth) */
  char loaded_start;  /* from which depth the loading starts */
  char loaded; /* how many stack items have been loaded from start to here */
  char stored; /* how many stack items will be stored from here to end */
  char new;    /* how many new stack items were accesses from start to here */
  char old;    /* how many existing stack items were accessed */
} Stackpoint;

typedef struct codepoint {
  Cell *tc;
  StackPoint stack[MAX_STACKS];
} Codepoint;


void forward_pass(Cell *tc, Codepoint *p, int n)
{
  for (j=0; j<MAX_STACKS; j++) {
    Stackpoint *sp = p[0].stack;
    sp->depth        = 0;
    sp->loaded       = 0;
    sp->loaded_start = 0;
    sp->new          = 0;
  }
  for (i=0; i<n; i++) {
    for (j=0; j<MAX_STACKS; j++) {
      Stackpoint *b = p[i].stack+j; /* before */
      Stackpoint *a = p[i].stack+j; /* after */
      Stackeffect *s = p[PRIM_NUM(*tc)].se+j;
      int depth = b->depth - s.in;
      if (depth<b->old)
	a->old=depth;
      if (s->dump) {
	a->loaded = 0;
	a->loaded_start = depth;
      } else {
	a->loaded = min(depth,b->loaded);
	a->loaded_start = min(depth,b->loaded_start);
      }
      depth += s.out;
      a->new = max(b->new, depth);
      a->depth = depth;
    }
  }
}



char *cgen(Cell *tc)
{
  int n = npoints(tc);
  Codepoint p[n+1];

  forward_pass(tc,p,n);
  backwards_pass(tc,p,n);
  decl_stack_items(p,n);
  gen_prims(p);
}




Cell translate_link(Cell *bb_tc)
{
  Bb bbfunc = lookup_bb(bb_tc);

  if (bbfunc == NULL) {
    char *filename_c  = cgen(bb_tc);
    char *filename_la = compile(filename_tc);
    lt_dlhandle lib = lt_dlopen(filename_la);
    bb_func = lt_dlsym(symbol(bb_tc));
  }
  return (Cell) bb_func;
}