Debugging 64K VM

src/lisp/drawl.pla

@@ -26,13 +26,13 @@ import sexpr
   end
   struc t_sym
     res[t_elem]
-    var natv
-    var lambda
+    word natv
+    word lambda
     char[0] name
   end
   struc t_numint
     res[t_elem]
-    var intval[2]
+    word[2] intval
   end
 
   predef gc#0
@@ -83,9 +83,8 @@ def refill_keybd
   repeat
     readline = gets('>'|$80)
     ^(readline + ^readline + 1) = 0
-    readline++
   until ^readline
-  return readline
+  return readline + 1
 end
 
 def read_keybd
@@ -94,9 +93,8 @@ def read_keybd
   repeat
     readline = gets('?'|$80)
     ^(readline + ^readline + 1) = 0
-    readline++
   until ^readline
-  drop, expr = parse_expr(readline, 0, @refill_keybd)
+  drop, expr = parse_expr(readline + 1, 0, @refill_keybd)
   //print_expr(expr); putln // DEBUG - print parsed expression
   return expr
 end
@@ -145,7 +143,7 @@ end
 def parse_cmdline#0
   var filename
 
-  puts("DRAWL (LISP 1.5) symbolic processor")
+  puts("DRAWL (LISP 1.5) symbolic processor\n")
   readfn = @read_keybd
   filename = argNext(argFirst)
   if ^filename
@@ -162,9 +160,20 @@ end
 // REPL
 //
 
+def print_syms#0
+    var symptr
+    
+    symptr = new_sym("PRINT")
+    while symptr
+        print_expr(symptr)
+        symptr = symptr=>link
+    loop
+end
+
+print_syms
 parse_cmdline
-new_sym("BYE")=>natv = @natv_bye)
-new_sym("MEM")=>natv = @natv_memavail)
+new_sym("BYE")=>natv = @natv_bye
+new_sym("MEM")=>natv = @natv_memavail
 while not quit
   putln; print_expr(eval_expr(readfn()))
   gc_trigger--; if gc_trigger == 0; gc; gc_trigger = GC_RESET; fin

src/lisp/s-expr.pla

@@ -24,13 +24,13 @@ struc t_cons
 end
 struc t_sym
   res[t_elem]
-  var natv
-  var lambda
+  word natv
+  word lambda
   char[0] name
 end
 struc t_numint
   res[t_elem]
-  var intval[2]
+  word[2] intval
 end
 
 predef eval_expr(expr)
@@ -191,6 +191,7 @@ def match_sym(symstr)
         if symptr->name[i] <> symstr->[i]; break; fin
       next
       if i > len
+        puts("Match symbol:"); puts(symstr - 1); putln
         return symptr
       fin
     fin
@@ -202,6 +203,7 @@ end
 export def new_sym(symstr)#1
   var symptr
 
+  puts("sym_list(@$"); puth(@sym_list); puts("):$"); puth(sym_list); putln
   symptr = match_sym(symstr)
   if symptr; return symptr; fin // Return already existing symbol
   symptr         = heapalloc(t_sym + ^symstr)
@@ -211,6 +213,7 @@ export def new_sym(symstr)#1
   symptr=>natv   = NULL
   symptr=>lambda = NULL
   memcpy(symptr + name, symstr + 1, ^symstr)
+  puts("New symbol:"); puts(symstr); putln
   return symptr
 end
 
@@ -511,6 +514,16 @@ def enter_lambda(expr, params)
   return expr=>cdr=>cdr=>car
 end
 
+def print_syms#0
+    var symptr
+    
+    symptr = sym_list
+    while symptr
+        print_atom(symptr)
+        symptr = symptr=>link
+    loop
+end
+
 export def eval_expr(expr)#1
   var alist_enter, result
 
@@ -522,6 +535,8 @@ export def eval_expr(expr)#1
       // List - first element better be a function
       //
       if expr=>car->type & TYPE_MASK == SYM_TYPE
+        puts("Calling function:"); print_atom(expr=>car); putc('@'); puth(expr=>car=>natv); putln
+        print_syms
         if expr=>car=>natv
           result = expr=>car=>natv(expr=>cdr) // Native function
           expr   = NULL
@@ -542,7 +557,7 @@ export def eval_expr(expr)#1
       else
         result = expr
       fin
-      expr   = NULL
+      expr = NULL
     fin
   loop
   assoc_list = alist_enter
@@ -783,28 +798,29 @@ new_assoc(new_sym("T"),   @pred_true)
 new_assoc(new_sym("F"),   @pred_false)
 sym_lambda = new_sym("LAMBDA")
 sym_quote  = new_sym("QUOTE")
-sym_quote=>natv         = @natv_quote)
-new_sym("CAR")=>natv    = @natv_car)
-new_sym("CDR")=>natv    = @natv_cdr)
-new_sym("CONS")=>natv   = @natv_cons)
-new_sym("ATOM")=>natv   = @natv_atom)
-new_sym("EQ")=>natv     = @natv_eq)
-new_sym("NOT")=>natv    = @natv_not)
-new_sym("AND")=>natv    = @natv_and)
-new_sym("OR")=>natv     = @natv_or)
-new_sym("COND")=>natv   = @natv_cond)
-new_sym("SET")=>natv    = @natv_set)
-new_sym("SETQ")=>natv   = @natv_setq)
-new_sym("NULL")=>natv   = @natv_null)
-new_sym("LABEL")=>natv  = @natv_label)
-new_sym("DEFINE")=>natv = @natv_define)
-new_sym("+")=>natv      = @natv_add)
-new_sym("-")=>natv      = @natv_sub)
-new_sym("*")=>natv      = @natv_mul)
-new_sym("/")=>natv      = @natv_div)
-new_sym("REM")=>natv    = @natv_rem)
-new_sym("NEG")=>natv    = @natv_neg)
-new_sym(">")=>natv      = @natv_gt)
-new_sym("<")=>natv      = @natv_lt)
-new_sym("PRINT")=>natv  = @natv_print)
+sym_quote=>natv         = @natv_quote
+new_sym("CAR")=>natv    = @natv_car
+new_sym("CDR")=>natv    = @natv_cdr
+new_sym("CONS")=>natv   = @natv_cons
+new_sym("ATOM")=>natv   = @natv_atom
+new_sym("EQ")=>natv     = @natv_eq
+new_sym("NOT")=>natv    = @natv_not
+new_sym("AND")=>natv    = @natv_and
+new_sym("OR")=>natv     = @natv_or
+new_sym("COND")=>natv   = @natv_cond
+new_sym("SET")=>natv    = @natv_set
+new_sym("SETQ")=>natv   = @natv_setq
+new_sym("NULL")=>natv   = @natv_null
+new_sym("LABEL")=>natv  = @natv_label
+new_sym("DEFINE")=>natv = @natv_define
+new_sym("+")=>natv      = @natv_add
+new_sym("-")=>natv      = @natv_sub
+new_sym("*")=>natv      = @natv_mul
+new_sym("/")=>natv      = @natv_div
+new_sym("REM")=>natv    = @natv_rem
+new_sym("NEG")=>natv    = @natv_neg
+new_sym(">")=>natv      = @natv_gt
+new_sym("<")=>natv      = @natv_lt
+new_sym("PRINT")=>natv  = @natv_print
+puts("func + address:"); puth(match_sym("+")=>natv); putln
 done