b4.c

#include<stdio.h>

//-- macros ---
#define I int                      // I = any int
#define A int                      // A = specifically an address in vm's ram
#define B int                      // B = int used as boolean
#define C char                     // C = char type
#define U8 char                    // U8= 8 bits
#define V void                     // V = void

// shorthand macros
#define $ir I r                    // $ir = declares int return var
#define $r return                  // $r  = returns
#define $rr $r r                   // $rr = returns r
#define $if(p,t,e)if(p)t;else e;   // $if = if/then/else
#define $gd $GD()                  // get data
#define $itr(n)for(I i=0;i<n;i++)  // $itr(n)= iterate/iota (i=0 to..n.)
#define $slp(s)$iter(s.len)        // $slp(s) = i=0 to len(s)

// shorten function defs, since args are all on internal vm stack
#define _op(f) void f(){
#define iop(f) void f(I i){        // int op
#define sop(f) void f(S s){        // str op
#define lop(f) sop(f)A lb=fnd(&s); // lbl op (label)

// constants
#define mm 0xFFFF                  // memory mask (to enforce bounds)
#define dm 0x0FFF                  // data stack mask 
#define am 0x0FFF                  // addr stack mask
#define vm 0x0FFF                  // local var stack mask

// -- virtual memory cells ---
I m[mm + 1];                       // m = 64-kCell memory area
I d[dm + 1]; I dp=0;               // d = data stack
I a[am + 1]; I ap=0;               // a = address stack
I v[vm + 1]; I vp=0;               // v = local variable stack

// -- declare some string buffers to work with (256kb)
struct sstr{ U8 len; C buf[255];}; // S = small byte-counted string type
typedef struct sstr S;
S ss[1024];                        // ss = table of strings
I sc=0;                            // sc= string count
B seq(S* a, S* b){                 // seq(a,b) = are strings equal?
  $r 0; }                          //    TODO
V scp(S* a, S* b){                 // scp(a,b) = string copy
  }                                //    TODO
I fnd(S* s){ I n=0;                // fnd(s) = find id of string
  $itr(sc)                         //   linear search of string table
    $if(seq(s,&ss[i]), $r i, n++); //   if found, return index
  scp(s, &ss[n]); $r sc=n; }       //   else add string to the table

// other registers
A ip=0;                            // ip  = instruction pointer
B ok=1;                            // ok  = matched so far?
A eh=-1;                           // eh  = vm address of error handler.
A g0=0, g1=0;                      // g#  = label registers
I gn=0;                            // gn  = autonumber for label generator
B eot=0;                           // eot = end of text?
A top=-1;                          // top = vm address of start rule

// -- direct control of data stack ---
iop($pd) d[dp++]=i; }              // $pd(i); = put int on data stack
I $gd{ $ir=d[dp--]; dp&=dm; $rr; } // i=$gd; = get int from data stack

// virtual machine instruction set ////////////////////////////////////////
//
// -- instructions ---             -- stack effects ---
_op(NOP)}                          // nop      -   : do nothing-
iop(LIT) d[dp++]=i; }              // dat(i)   -i  : puts i on data stack
_op(PSH) a[ap++]=d[dp--]; }        // psh     i-   : move tos to addr stack
_op(POP) d[dp++]=a[ap--]; }        // pop      -i  : addr stack to tos
_op(GCH) $pd(getchar()); }         // gch      -c  : char from stdin -> tos
_op(PCH) putchar($gd); }           // pch     c-   : send tos -> stdout

// -- meta-ii instructions ---     (most of these are still TODO)
_op(idn) }                         // idn    : read identifier
_op(num) }                         // num    : read number
_op(str) }                         // str    : read 'string'
_op(cll) }                         // cll    : call label
_op(ret) }                         // ret    :  return from subroutine
_op(aok) ok=1; }                   // aok    : set ok=1
lop(brn) ip=lb; }                  // brn    : branch to label (unconditionally)
lop(bok) ip=(ok? ip : lb); }       // bok    : branch if ok=1
lop(bno) ip=(ok? lb : ip); }       // bno    : branch if not ok
lop(eno) ip=(ok? lb : eh); }       // eno    : error if not ok
_op(cps) }                         // cps    : copy string literal to output
_op(cpt) }                         // cpi    : copy last token to output
lop(elb) }                         // lbl    : emit label
_op(out) }                         // out    : newline
lop(adr) top=lb; }                 // adr    : label top rule
_op(end) eot=1; }                  // end    : end of text
#define gn0 $IFE(g0,g0,g0=gn++)
#define gn1 $IFE(g1,g1,g1=gn++)
int main(){ printf("hello world\n"); }