#include #include #include #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;xi);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; }