move list impl to forsp

diff --git a/support.c b/support.c
index 44b45838521a5d03296ffc04d9829e3c82841fce..b400a056e34ebb16d1e5e4caa40f5d54cd715529 100644 (file)
--- a/support.c
+++ b/support.c
@@ -40,32 +40,39 @@ void eq()
     st[sp - 1] = st[sp - 1] == st[sp];
 }
 
-void cons()
+void alloc()
+{
+    int32_t *st = &stack;
+    st[sp - 1] = (int32_t)malloc(st[sp - 1] * sizeof(int32_t));
+}
+
+void dealloc()
 {
     int32_t *st = &stack;
-    int32_t *pair = (int32_t *)malloc(2 * sizeof(int32_t));
     --sp;
-    pair[0] = st[sp];
-    pair[1] = st[sp - 1];
-    st[sp - 1] = (int32_t)pair;
+    free((int32_t *)st[sp]);
 }
 
-void car()
+void peek()
 {
     int32_t *st = &stack;
-    st[sp - 1] = ((int32_t *)st[sp - 1])[0];
+    st[sp - 1] = *(int32_t *)st[sp - 1];
 }
 
-void cdr()
+void poke()
 {
     int32_t *st = &stack;
-    st[sp - 1] = ((int32_t *)st[sp - 1])[1];
+    sp -= 2;
+    int32_t *ptr = (int32_t *)st[sp + 1];
+    *ptr = st[sp];
 }
 
-void decons()
+void dumpstack()
 {
     int32_t *st = &stack;
-    --sp;
-    free((int32_t *)st[sp]);
+    printf("<stack> ");
+    for (int i = 0; i < sp; ++i)
+        printf("%d ", st[i]);
+    putchar('\n');
 }
 

diff --git a/test.fp b/test.fp
index e4aba6c29c2ddef56733ac036d08c1209f0eb46e..2ae975dd099cb5c41293d62dca4b2861f0f18bd0 100644 (file)
--- a/test.fp
+++ b/test.fp
@@ -11,6 +11,14 @@
   ($x x)              $force
   (10 emit)           $cr
   (print)             $print
+  (4 +)               $cell+
+  ($a $d 2 alloc $p
+    ^a ^p poke
+    ^d ^p cell+ poke
+    ^p
+  )                   $cons
+  (peek)              $car
+  (cell+ peek)        $cdr
 
   ; if-stmt
   ($c $t $f c ^f ^t rot cswap $_ force) $if