galk

1 files changed, 234 insertions, 7 deletions

diff --git a/calc/main.c b/calc/main.c
index 897363c..6db49ae 100644
--- a/calc/main.c
+++ b/calc/main.c
@@ -10,19 +10,22 @@
 #include <okeffa/io.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <ctype.h>
+#include <assert.h>
 
 #define STACK_SIZE  65536
 
 #define _STR(X)     #X
 #define STR(X)      _STR(X)
 #define STACK(I)    stack[fl*(I)]
+#define STACK_INIT  ((size_t)-1)
 
 static size_t       bitness;
-static size_t       fl;                 //wordness, fz len
+static size_t       fl;                     //wordness, fz len
 static word_t       stack[STACK_SIZE];
-static size_t       sh;                 //stack height
-static size_t       sp        = 0;      //stack ptr
-static wbool_t      flag      = 0;      //carry/borrow
+static size_t       sh;                     //stack height
+static size_t       sp        = STACK_INIT; //stack ptr
+static wbool_t      flag      = 0;          //carry/borrow
 static size_t       pos       = 0;
 static size_t       quote_lev = 0;
 static size_t       comm_lev  = 0;
@@ -32,7 +35,7 @@ static void zap(void){
   for(size_t x = 0;x < sh;x++){
     fz_clear(&STACK(x),fl);
   }
-  sp    = 0;
+  sp    = STACK_INIT;
   flag  = 0;
 }
 
@@ -41,15 +44,233 @@ static void e(char const *str){
 }
 
 static void push(void){
-  if(++sp >= sh) e("stack overflow");
+  if(++sp >= sh) e("stack overflow!");
 }
 
 static void drop(void){
+  assert(sp != STACK_INIT);
   fz_clear(&STACK(sp--),fl);
 }
 
 static void want(size_t n){
-  if(sp < n) e("stack underflow");
+  if(sp+1 < n) e("stack underflow!");
+}
+
+static void ins_nib(word_t *w,word_t nib){
+  assert((nib & 0xF) == nib);
+  word_t of = fz_shl(w,w,fl,4);
+  if(of != 0) e("constant exceeds bitness!");
+  fz_or_w(w,nib);
+}
+
+static bool char_isnib(char c){
+  return (c >= '0' && c <= '9') ||
+         (c >= 'A' && c <= 'F') ||
+         (c >= 'a' && c <= 'f');
+}
+
+static word_t char_getnib(char c){
+  assert(char_isnib(c));
+  if      (c >= '0' && c <= '9') return c-'0';
+  else if (c >= 'A' && c <= 'F') return c-'A'+0xA;
+  else                           return c-'a'+0xA;
+}
+
+static void puts_stack(size_t p){
+  printf("%3zu    ",p);dump_fz(&STACK(p),fl);
+  write_nl();
+}
+
+static void op_normal(char c){
+  switch(c){
+    wbool_t p;
+
+    //stickies
+  case '(': 
+    comm_lev = 1;
+    break;
+
+  case ')': 
+    e("mismatched close-comment parenthesis!");
+
+  case '[': 
+    quote_lev = 1;
+    break;
+
+  case ']': 
+    e("mismatched close-quote bracket!");
+
+  case '{': 
+    want(1);
+    if(fz_zero(&STACK(sp),fl)){
+      cond_lev = 1;
+    }
+    drop();
+    break;
+
+  case '}': 
+    push();
+    fz_frombool(&STACK(sp),fl,0);
+    break;
+
+    //stack motion
+  case '.': 
+    push();
+    fz_clear(&STACK(sp),fl);
+    break;
+
+  case '"': 
+    want(1);
+    push();
+    fz_copy(&STACK(sp-1),&STACK(sp),fl);
+    break;
+
+  case '_': 
+    want(1);
+    drop();
+    break;
+
+  case '\'': 
+    want(2);
+    fz_swap(&STACK(sp),&STACK(sp-1),fl);
+    break;
+
+  case '`': 
+    want(2);
+    push();
+    fz_copy(&STACK(sp-2),&STACK(sp),fl);
+    break;
+
+    //predicates
+  case '=': 
+    want(2);
+    p = fz_eq(&STACK(sp-1),&STACK(sp),fl);
+    drop();
+    fz_frombool(&STACK(sp),fl,p);
+    break;
+
+  case '<': 
+    want(2);
+    p = fz_lt(&STACK(sp-1),&STACK(sp),fl);
+    drop();
+    fz_frombool(&STACK(sp),fl,p);
+    break;
+
+  case '>': 
+    want(2);
+    p = fz_gt(&STACK(sp-1),&STACK(sp),fl);
+    drop();
+    fz_frombool(&STACK(sp),fl,p);
+    break;
+
+    //arithmetic
+  case '+': 
+    want(2);
+    flag = fz_add(&STACK(sp-1),&STACK(sp),&STACK(sp-1),fl);
+    drop();
+    break;
+
+  case '-': 
+    want(2);
+    flag = fz_sub(&STACK(sp-1),&STACK(sp),&STACK(sp-1),fl);
+    drop();
+    break;
+
+    //bitwise
+  case '&': 
+    want(2);
+    fz_and(&STACK(sp-1),&STACK(sp),&STACK(sp-1),fl);
+    drop();
+    break;
+
+  case '|': 
+    want(2);
+    fz_or(&STACK(sp-1),&STACK(sp),&STACK(sp-1),fl);
+    drop();
+    break;
+
+  case '^': 
+    want(2);
+    fz_xor(&STACK(sp-1),&STACK(sp),&STACK(sp-1),fl);
+    drop();
+    break;
+
+  case '~': 
+    want(1);
+    fz_not(&STACK(sp),&STACK(sp),fl);
+    break;
+
+    //other
+  case 'U': 
+    want(3);
+    wbool_t sel = fz_nzero(&STACK(sp),fl);
+    fz_mux(&STACK(sp-2),&STACK(sp-1),&STACK(sp-2),fl,sel);
+    drop();
+    drop();
+    break;
+
+  case 'O': 
+    push();
+    fz_frombool(&STACK(sp),fl,flag);
+    break;
+
+  case '#': 
+    want(1);
+    puts_stack(sp);
+    drop();
+    break;
+
+  case 'Z': 
+    zap();
+    break;
+
+  case 'Q': 
+    for(size_t x = sp;x != STACK_INIT;x--){
+      puts_stack(x);
+    }
+    exit(0);
+    break;
+
+  default:
+    //immediates
+    if(char_isnib(c)){
+      want(1);
+      ins_nib(&STACK(sp),char_getnib(c));  
+    }
+    break;
+  }
+}
+
+static void op(char c){
+  if(comm_lev > 0){
+    switch(c){
+    case '(': comm_lev++; break;
+    case ')': comm_lev--; break;
+    }
+  }else if(quote_lev > 0){
+    switch(c){
+    case '[': quote_lev++; break;
+    case ']': quote_lev--; break;
+    }
+    if(quote_lev > 0){
+      write_char(c);
+    }
+  }else if(cond_lev > 0){
+    switch(c){
+    case '{':
+      cond_lev++;
+      break;
+    case '}':
+      cond_lev--;
+      if(cond_lev == 0){
+        push();
+        fz_frombool(&STACK(sp),fl,1);
+      }
+      break;
+    }
+  }else{
+    op_normal(c);
+  }
 }
 
 int main(int argc,char **argv){
@@ -70,5 +291,11 @@ int main(int argc,char **argv){
 
   fl = bitness/WORD_BITNESS;
 
+  char c;
+  while(c = read_char()){
+    op(c);
+    pos++;
+  }
+  zap();
   return 0;
 }