#include "h.h"
#include <stdlib.h>
static int const bug = 0;
typedef struct {cp c; env * e;} Fcont;
typedef struct {env * v; env * e;} Acont; // we hold a val v in an env!
typedef struct cnt {char tag; union {Fcont f; Acont a;} c;
                       struct cnt * C;} cnt;
// tag= [0 for Fcont, 1 for Acont.]
typedef union {env e; cnt c;} gws;
static gws work[worksize];
static int wp;
static gws * fl = 0; // free list
void init(){fl=0; wp = worksize;}
static int sts[5];
static void pstat(){int q=0; char * labs[] =
   {"var", "invoke prim fun", "invoke lam fun", "lambda", "numeral"}; 
   gws * z = fl; while(z) {++q; z = (gws*)z->e.out;}
   printf("ws = %d, lst = %d\n", worksize - wp, q);
   {int j; for(j=0; j<5; ++j) printf("%s: %d\n", labs[j], sts[j]);}}
void pm(void){int k=0; gws* F=fl; 
   while(F) {++k;
      if(F<&work[wp] || F >= &work[worksize]) printf("Fox\n");
      printf("ff %d\n", F-work);
      if(0) if(F->e.refcnt) printf("Foo: %d %d\n", F-work, F->e.v.tag); F=(gws*)F->e.out;}
   if (wp+k != worksize-6) printf("F wp=%d k=%d ws=%d\n", wp, k, worksize);}
static void By(char * x){pstat(); Bye(x);}
static void nv(val * vp, int s){if(vp->tag==1 && vp->u.f.e)
   {++vp->u.f.e->refcnt; printf("nv %d e=%d", s, (gws*)vp->u.f.e-work);}}
static void dcx(env* e, int s){
  printf("dc %d %d rc=%d\n", s, (gws*)e-work, e->refcnt);
  env * wq = 0; // head of chain thru out of blocks with ->v.u.f.e fields to free.
   while(1) {while(1){
     printf("dd %d rc=%d\n", (gws*)e-work, e->refcnt);
     --e->refcnt;
     if(e->refcnt) break;
     if(e->v.tag==1 && e->v.u.f.e){env * t = e->out; e->out = wq; wq = e; e = t;}
     else {env* t = e->out; e->out = (env*)fl; fl = (gws*)e; e = t;}
     if(!e) break;}
  if(!wq) return;
  {env*t = wq->out; wq->out = (env*)fl; fl = (gws*)wq; e = wq->v.u.f.e; wq = t;}}}
void dc(env* e){dcx(e, 0);}
env * gw(){if(fl) {gws * t = fl; fl = (gws*) fl -> e.out; return (env*)t;}
  if(!wp) {wp=worksize; By("Exhausted!");}
  return (env*)&work[--wp];}
// static void pw(env * x){x -> out = (env*)fl; fl = (gws*)x;}
void crsh(char* d, cp c){exit(printf("%s: compiler bug at %d!", d, c-code));}
void csh(char * d){crsh(d, 0);}
static int pi(gws * g){int j=g-work; if(j<0 || j >= worksize) csh("rngg"); return j;}
void cc(val* v, cnt* c){
  typedef struct{int sc; uchar tp;} gp;
  gp a[worksize];
  void ce(env* e, int n){if(!e) return;
     int ei = pi((gws*)e); a[ei].sc+=n;
     if(a[ei].sc > n) return;
     if(a[ei].tp) csh("dug"); a[ei].tp = 128|e->v.tag;
     int t=e->v.tag; if(t>2) csh("vile");
     if(t==1) ce(e->v.u.f.e, 1);}
  {int j=worksize; while(j--) a[j] = (gp){0, 0};}
  {cnt* cs = c; while(cs){int ci = pi((gws*)cs);
     if(a[ci].tp) csh("vog"); a[ci].tp = 1;
     ce(cs->c.f.e, 2);
     if(cs->tag == 1) ce(cs->c.a.v, 1);
     cs = cs->C;}}
     if(v->tag == 1 && v->u.f.e)  ce(v->u.f.e, 1);
     {int j = worksize; while(j--) if(a[j].tp) {
         if(a[j].tp &128 && a[j].sc != work[j].e.refcnt) 
           printf("F a[%d].tp=%d sc=%d refcnt=%d\n", j, a[j].tp, a[j].sc, work[j].e.refcnt);}}}

val eval(cp x, env * e){ // Use the stack at first
  uchar op; val v; cnt * c = 0; {int j=5; while(j--) sts[j]=0;}
  void px(int s) {cnt* t=c; printf("da %d %d\n", s, (gws*)c-work);
    dcx(c->c.a.v, 1); c=c->C; dcx((env*)t, 2);}
  top: op = *x;
  printf("zz %d rc=%d %x cd=%d\n", (gws*)e-work, e->refcnt, op, x-code);
  if(bug){printf("(%02x @ %d"/*)*/, op, x-code);}
  printf("za %d %d %x\n", (gws*)c-work, c?(gws*)c->C-work:0, op);
  if(op < 0xfd) {env * E = e; ++sts[0];
     while(op--) if (E) E = E->out; else crsh("bad sym\n", x);
     v=E->v; nv(&v, 1); dcx(e, 3);}
  else if(op == 0xfe) {++e->refcnt;
     {cnt * w = (cnt*)gw(); w -> C = c; c = w;} // Grow chain of continuations.
     printf("aa e=%d c=%d\n", (gws*)e-work, (gws*)c-work);
     c->tag=0; // Fcont
     c->c.f = (Fcont){3+x+*(us *)(x+1), e}; // Locate expr for argument.
     x += 3; goto top; // eval fun.
     dst0: x = c->c.f.c; e = c->c.f.e; // recover from 'call'.
     printf("ab %d\n", (gws*)c-work);
     c->tag=1; // Acont
     {env* ep = gw(); *ep = (env){1, v, 0};
       nv(&v, 2);
       printf("ba %d\n", (gws*)ep-work);
       c->c.a.v = ep; goto top;} // extention to hold fun during appl
     dst1: {val f = c->c.a.v->v; // retrieve fun for this application.
       if(f.tag == 2) {++sts[1]; // f is prim fun to be applied.
         if(v.tag) By("Numeric operator applied to function");
         else v = f.u.p(v.u.i);}
       else if(f.tag == 1) {++sts[2]; // The applied fun is from a lam expr.
         {env * ee = gw(); ee->refcnt = 1;
           printf("ca %d c=%d rc=%d t=%d\n", (gws*)ee-work, (gws*)c-work, ee->refcnt, c->tag);
           {env* ep = f.u.f.e; ee->out = ep; 
             if(ep) ++ep->refcnt;}
           e = ee;} // extend the environ
         e->v = v; // endow environ with argument.
         printf("cb %d\n", (gws*)c-work);
         {px(1); x = f.u.f.c; goto top;}}
       else By("Number as function");
       px(2);}}
  else if(op == 255) {++sts[3]; v = (val){1, {.f = {e, x+1}}};}
  else if(op == 253) {nis y = 0; ++x; ++sts[4]; dcx(e, 4);
     do y = y<<7 | (*x & 0x7f); while(*(x++) < 0x80);
     v = (val){0, { .i = y }};}
  if(bug){cnt * x = c; printf("\n("/*)*/); while(x) {printf("t=%d ", x->tag); x=x->C;}
           printf(/*(*/")\nvt=%d", v.tag); if(!v.tag) printf(" %d", (int)v.u.i);
       if(v.tag==1){env * z = v.u.f.e; printf("[%x"/*]*/, v.u.f.c-code);
         while(z) {printf(" e=%d", z->v.tag);
           if(!z->v.tag) printf(":%d", (int)z->v.u.i); z = z->out;} printf(/*[*/"]");}}
  printf("ad %d\n", (gws*)c-work);
  if(1) cc(&v, c);
  if(c) {printf("ae %d\n", (gws*)c-work);
    if(c->tag==0) goto dst0;
    if(c->tag==1) goto dst1;
    exit(printf("Blather\n"));}
  pstat();
  return v;}