From 52b47c571e874a133dec6eed59b80922a410782e Mon Sep 17 00:00:00 2001 From: dschmenk Date: Wed, 10 Jul 2024 23:05:20 -0700 Subject: [PATCH] Debugging 64K VM --- src/lisp/drawl.pla | 29 +++++++++++------- src/lisp/s-expr.pla | 72 +++++++++++++++++++++++++++------------------ 2 files changed, 63 insertions(+), 38 deletions(-) diff --git a/src/lisp/drawl.pla b/src/lisp/drawl.pla index 279324b..809854e 100644 --- a/src/lisp/drawl.pla +++ b/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 diff --git a/src/lisp/s-expr.pla b/src/lisp/s-expr.pla index bd98c1e..23415ad 100644 --- a/src/lisp/s-expr.pla +++ b/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