KigForth, early attempt

#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#define V(x,b) void x(){b}
#define T sp[0]
#define S sp[1]
#define D sp++
#define AS(a) (sizeof(a)/sizeof(a[0]))
typedef void(*fp)();
typedef union CELL C;
union CELL{int i;fp f;C*p;char*s;};

#define NL printf("\n")
#define PS(s) printf("%s",s)
#define PN(i) printf("%x",i)
#define SP putchar(' ')
// word: name, prev, code, data
#define OD(c) C*p=dic;while(p){{c}p=p[1].p;}
// w.p sometimes points to current word (i.e. its name)
// ip points to data: an array of cells that point to words
C *sp,*rsp,*ip,w,*m; int ms;
C*dic,*h;
V(dump,NL;C*x;PN(ip);SP;PN(w);SP;for(x=m;x<m+ms;x++){x==rsp?PS("R "):x==sp?PS("S "):0;PN(x->i);SP;}NL;)
V(tl,for(;;){(w=*ip).p[2].f();})
V(co,rsp--;rsp->p=ip;ip=w.p+3;)

#define W(n,pr,N,c) V(f_##n,c;ip++;) C n[]={{.s=N},{.p=pr},{.f=f_##n}};
#define B(n,pr,N,o) W(n,pr,N,S.i=T.i o S.i;D)
#define F(n,pr,N,...) C n[]={{.s=N},{.p=pr},{.f=co},__VA_ARGS__};

W(re,0 ,"ret"   ,ip=rsp->p;rsp++;)
W(du,re,"dup"   ,sp++;sp[0]=sp[1])
W(sw,du,"swap"  ,w=S;S=T;T=w)
W(ro,sw,"rot"   ,w=sp[2];sp[2]=S;S=T;T=w)
W(dr,ro,"drop"  ,D)
W(fe,dr,"@"     ,T=*T.p)
W(st,fe,"!"     ,*T.p=T)
W(li,st,"lit"   ,*(--sp)=*(++ip))
W(pn,li,"."     ,PN(T.i);D)
W(hw,pn,"hello" ,PS("hello, world\n"))
B(ad,hw,"+"     ,+)
B(su,ad,"-"     ,-)
B(mu,su,"*"     ,*)
B(di,mu,"/"     ,/)
B(an,di,"and"   ,&)
B(or,ad,"or"    ,|)
B(xo,or,"xor"   ,^)
W(ha,xo,"halt"  ,NL;dump();exit(0))
W(wo,ha,"words" ,OD(PN(p);SP;PS(p[0].s);SP;PN(p[2].p);SP;PN(p[3].p);NL;))
W(lo,wo,"look"  ,OD(if(!strcmp(p->s,T.s))T.p=p;return;);T.p=0;return;)

F(te,lo,"test"  ,{.p=mu},{.p=re})

int main(void) {
  assert(sizeof(int) == sizeof(C));
  assert(sizeof(fp) == sizeof(C));
  assert(sizeof(C*) == sizeof(C));
  assert(sizeof(char*) == sizeof(C));
  C mem[]={
{.p=wo},{.p=hw},{.p=li},{.i=6}, {.p=li},{.i=7},{.p=te},{.p=pn},  {.p=ha},0,0,0, 0,0,0,0,
0,0,0,0 ,0,0,0,0,  0,0,0,0 ,0,0,0,0,
0,0,0,0 ,0,0,0,0,  0,0,0,0 ,0,0,0,0,
0,0,0,0 ,0,0,0,0,  0,0,0,0 ,0,0,0,0};

  dic=te;m=mem;ms=AS(mem);sp=m+30;rsp=m+50;ip=m;w.i=0;
  tl();// no return
  return 0;
}