From 82130cb2e821a0ac4afef8ced60e5b8db2df512a Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Mon, 15 Jul 2024 20:43:46 -0700 Subject: [PATCH] Still working on better GC --- src/lisp/drawl.pla | 18 +-- src/lisp/loop.lisp | 16 +-- src/lisp/s-expr.pla | 328 ++++++++++++++++++++++++-------------------- src/makefile | 4 +- 4 files changed, 193 insertions(+), 173 deletions(-) diff --git a/src/lisp/drawl.pla b/src/lisp/drawl.pla index fad0f02..a88c3b6 100644 --- a/src/lisp/drawl.pla +++ b/src/lisp/drawl.pla @@ -130,18 +130,6 @@ def natv_go(symptr, expr) return NULL end -def natv_set(symptr, expr) - symptr = eval_expr(expr=>cdr=>car) - set_assoc(eval_expr(expr=>car), symptr) - return symptr -end - -def natv_setq(symptr, expr) - symptr = eval_expr(expr=>cdr=>car) - set_assoc(expr=>car, symptr) - return symptr -end - // // REPL native helper functions // @@ -195,7 +183,6 @@ def read_keybd ^(readline + ^readline + 1) = 0 until ^readline drop, expr = parse_expr(readline + 1, 0, @refill_keybd) - //print_expr(expr); putln // DEBUG - print parsed expression return expr end @@ -249,7 +236,7 @@ def parse_cmdline#0 fileref = fileio:open(filename) if fileref fileio:newline(fileref, $7F, $0D) - readfn = @read_file + readfn = @read_file filebuf = heapalloc(FILEBUF_SIZE) else puts("Unable to open: "); puts(filename); putln @@ -273,8 +260,7 @@ sym_cond = new_sym("COND") // This should actually match COND new_sym("PROG")=>natv = @natv_prog new_sym("GO")=>natv = @natv_go new_sym("RETURN")=>natv = @natv_return -new_sym("SET")=>natv = @natv_set -new_sym("SETQ")=>natv = @natv_setq +new_sym("MEM")=>natv = @natv_memavail new_sym("BYE")=>natv = @natv_bye parse_cmdline diff --git a/src/lisp/loop.lisp b/src/lisp/loop.lisp index dba0e6f..f6d68dd 100644 --- a/src/lisp/loop.lisp +++ b/src/lisp/loop.lisp @@ -1,11 +1,11 @@ -(LABEL LOOP (LAMBDA (I M FN) - (COND ((AND (< I M) (FN I)),(LOOP (+ 1 I) M FN)) - (T,(EQ I M))) - ) -) -(LABEL LPRINT (LAMBDA (N) - (ATOM (PRINT N)) - ) +(DEFINE + (LOOP (LAMBDA (I M FN) + (COND ((AND (< I M) (FN I)),(LOOP (+ 1 I) M FN)) + (T,(EQ I M))) + )) + (LPRINT (LAMBDA (N) + (ATOM (PRINT N)) + )) ) (LOOP 1 100 LPRINT) diff --git a/src/lisp/s-expr.pla b/src/lisp/s-expr.pla index c96ca9d..61b5fc0 100644 --- a/src/lisp/s-expr.pla +++ b/src/lisp/s-expr.pla @@ -34,12 +34,6 @@ struc t_sym word apval char name[0] end -struc t_array - res[t_elem] - word dimension[4] - word offset[4] - word arraymem -end struc t_numint res[t_elem] word intval[2] @@ -48,33 +42,44 @@ struc t_numfloat res[t_elem] res floatval[10] end - -predef eval_expr(expr) - -var sym_nil, sym_quote, sym_lambda, sym_cond, sym_set -res[t_elem] pred_true = 0, 0, BOOL_TRUE - -var cons_list = NULL -var cons_free = NULL -var int_list = NULL -var int_free = NULL -var float_list = NULL -var float_free = NULL -var sym_list = NULL -var assoc_list = NULL // SYM->value association list +struc t_array + res[t_elem] + word dimension[4] + word offset[4] + word arraymem +end const fmt_fp = FPSTR_FIXED|FPSTR_STRIP|FPSTR_FLEX export var fmt_fpint = 6 export var fmt_fpfrac = 4 +var assoc_list = NULL // SYM->value association list +var cons_list = NULL +var cons_free = NULL +var cons_last = NULL +var int_list = NULL +var int_free = NULL +var int_last = NULL +var float_list = NULL +var float_free = NULL +var float_last = NULL +var sym_list = NULL + +var sym_nil, sym_quote, sym_lambda, sym_cond, sym_set +res[t_elem] pred_true = 0, 0, BOOL_TRUE + +byte parsing = 0 // Flag for GC to skip during parsing + +predef eval_expr(expr) + // // Garbage collector // -def mark_list(listptr)#0 - while listptr - listptr->type = listptr->type | MARK_BIT - listptr = listptr=>link +def mark_list(list)#0 + while list + list->type = list->type | MARK_BIT + list = list=>link loop end @@ -86,6 +91,7 @@ end def sweep_expr(expr)#0 while expr + if not expr->type & MARK_BIT; return; fin // Stop if MARK_BIT clear expr->type = expr->type & MARK_MASK if expr->type == CONS_TYPE sweep_expr(expr=>car) @@ -110,29 +116,32 @@ def sweep_used#0 fin symptr = symptr=>link loop + sweep_expr(cons_last) + sweep_expr(int_last) + sweep_expr(float_last) end def collect_list(listhead, freehead)#2 - var listptr, prevptr + var elemptr, prevptr prevptr = NULL - listptr = listhead - while listptr - if listptr->type & MARK_BIT + elemptr = listhead + while elemptr + if elemptr->type & MARK_BIT if prevptr - prevptr=>link = listptr=>link - listptr=>link = freehead - freehead = listptr - listptr = prevptr=>link + prevptr=>link = elemptr=>link + elemptr=>link = freehead + freehead = elemptr + elemptr = prevptr=>link else - listhead = listptr=>link - listptr=>link = freehead - freehead = listptr - listptr = listhead + listhead = elemptr=>link + elemptr=>link = freehead + freehead = elemptr + elemptr = listhead fin else - prevptr = listptr - listptr = listptr=>link + prevptr = elemptr + elemptr = elemptr=>link fin loop return listhead, freehead @@ -145,6 +154,7 @@ def collect_unused#0 end export def gc#0 + if parsing; return; fin mark_elems sweep_used collect_unused @@ -171,24 +181,9 @@ export def new_cons#1 return consptr end -def match_int(intlo, inthi) - var intptr - - intptr = int_list - while intptr - if intptr=>intval[0] == intlo and intptr=>intval[1] == inthi - return intptr - fin - intptr = intptr=>link - loop - return NULL -end - export def new_int(intlo, inthi)#1 var intptr - intptr = match_int(intlo, inthi) - if intptr; return intptr; fin if int_free intptr = int_free int_free = int_free=>link @@ -203,30 +198,9 @@ export def new_int(intlo, inthi)#1 return intptr end -def match_float(extptr) - var floatptr - byte i - - floatptr = float_list - while floatptr - for i = 0 to 4 - if floatptr=>floatval[i] <> extptr=>[i] - break - fin - next - if i > 4 - return floatptr - fin - floatptr = floatptr=>link - loop - return NULL -end - export def new_float(extptr)#1 var floatptr - floatptr = match_float(extptr) - if floatptr; return floatptr; fin if float_free floatptr = float_free float_free = float_free=>link @@ -320,66 +294,6 @@ export def new_sym(symstr)#1 return symptr end -// -// Build/set association between symbols and values -// - -def assoc(symptr) - var pair - - if symptr->type & TYPE_MASK == SYM_TYPE - // - // Search association list for symbol - // - pair = assoc_list - while pair - if (pair=>car=>car == symptr) - return pair=>car - fin - pair = pair=>cdr - loop - fin - return NULL // SYM not associated -end - -export def new_assoc(symptr, valptr)#0 - var pair, addlist - - if symptr and (symptr->type & TYPE_MASK <> SYM_TYPE) - puts("Not a SYM in new_assoc\n") - return - fin - pair = new_cons - pair=>car = symptr - pair=>cdr = valptr - if assoc_list // Add to end of assoc_list - addlist = assoc_list - while addlist=>cdr - addlist = addlist=>cdr - loop - addlist=>cdr = new_cons - addlist = addlist=>cdr - else // New list - assoc_list = new_cons - addlist = assoc_list - fin - addlist=>car = pair -end - -export def set_assoc(symptr, valptr)#0 - var pair - - // - // Search association list for symbol - // - pair = assoc(symptr) - if pair - pair=>cdr = valptr // update association - else - new_assoc(symptr, valptr) // add association if unknown - fin -end - // // Print textual representation of S-expression // @@ -448,7 +362,7 @@ def print_atom(atom)#0 puts("]\n") break otherwise - puts("Unkown atom type\n") + puts("Unknown atom type\n") wend fin end @@ -553,6 +467,7 @@ end export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr var exprptr, consptr, elemptr, quotecons + parsing++ exprptr = NULL consptr = NULL while TRUE @@ -565,6 +480,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr if level evalptr = refill() // Refill input buffer else + parsing-- return evalptr, exprptr fin break @@ -576,6 +492,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr if not exprptr exprptr = sym_nil fin + parsing-- return evalptr + 1, exprptr is '(' evalptr++ @@ -594,6 +511,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr quotecons=>cdr=>car = elemptr elemptr = quotecons if level == 0 + parsing-- return evalptr, elemptr fin break @@ -605,6 +523,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr // if not (consptr and consptr=>car) puts("Invalid . operator\n") + parsing-- return evalptr, exprptr fin consptr=>cdr = elemptr @@ -621,6 +540,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr evalptr++ fin if level == 0 + parsing-- return evalptr, elemptr fin wend @@ -634,6 +554,7 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr else if consptr=>cdr puts("Improperly formed .\n") + parsing-- return evalptr, exprptr fin consptr=>cdr = new_cons @@ -645,9 +566,84 @@ export def parse_expr(evalptr, level, refill)#2 // return evalptr, exprptr consptr=>car = elemptr fin loop + parsing-- return evalptr, exprptr end +// +// Build/set association between symbols and values +// + +export def new_assoc(symptr, valptr)#0 + var pair, addlist + + if symptr and (symptr->type & TYPE_MASK <> SYM_TYPE) + puts("Not a SYM in new_assoc\n") + return + fin + pair = new_cons + pair=>car = symptr + pair=>cdr = valptr + if assoc_list // Add to end of assoc_list + addlist = assoc_list + while addlist=>cdr + addlist = addlist=>cdr + loop + addlist=>cdr = new_cons + addlist = addlist=>cdr + else // New list + assoc_list = new_cons + addlist = assoc_list + fin + addlist=>car = pair +end + +def assoc_pair(symptr) + var pair + + // + // Search association list for symbol + // + pair = assoc_list + while pair + if (pair=>car=>car == symptr) + return pair=>car + fin + pair = pair=>cdr + loop + return NULL // SYM not associated +end + +export def set_assoc(symptr, valptr)#0 + var pair + + // + // Search association list for symbol + // + pair = assoc_pair(symptr) + if pair + pair=>cdr = valptr // update association + else + new_assoc(symptr, valptr) // add association if unknown + fin +end + +def assoc(symptr) + var pair + + // + // Search association list for symbol + // + pair = assoc_list + while pair + if (pair=>car=>car == symptr) + return pair=>car=>cdr + fin + pair = pair=>cdr + loop + return NULL // SYM not associated +end + // // Evaluate expression // @@ -666,9 +662,9 @@ def enter_lambda(curl, expr, params)#2 // curl, expr // Update current associations during tail recursion // while args - assoc(args=>car)=>cdr = eval_expr(params=>car) - args = args=>cdr - params = params=>cdr + assoc_pair(args=>car)=>cdr = eval_expr(params=>car) + args = args=>cdr + params = params=>cdr loop else // @@ -725,22 +721,24 @@ export def eval_expr(expr)#1 expr = expr=>cdr loop else // Symbol associated with lambda - curl, expr = enter_lambda(curl, assoc(expr_car)=>cdr, expr=>cdr) + curl, expr = enter_lambda(curl, assoc(expr_car), expr=>cdr) fin elsif expr_car->type == CONS_TYPE and expr_car=>car == sym_lambda curl, expr = enter_lambda(NULL, expr_car, expr=>cdr) // Inline lambda fin else // - // Atom + // Atom - return the symbol value or the atom itself // if expr->type & TYPE_MASK == SYM_TYPE - if expr=>apval + if expr=>apval // Constant expr = expr=>apval ^ NULL_HACK - elsif expr=>array + elsif expr=>lambda // DEFINEd lambda S-expression + expr = expr=>lambda + elsif expr=>array // Array expr = expr=>array - else - expr = assoc(expr)=>cdr + else // Look on the association list last + expr = assoc(expr) fin fin break @@ -768,7 +766,29 @@ def natv_null(symptr, expr) end def natv_eq(symptr, expr) - return bool_pred(eval_expr(expr=>car) == eval_expr(expr=>cdr=>car)) + byte iseq, i + + symptr = eval_expr(expr=>car) + expr = eval_expr(expr=>cdr=>car) + if symptr == expr + return @pred_true + fin + iseq = FALSE + if symptr->type == NUM_INT and expr->type == NUM_INT + iseq = symptr=>intval[0] == expr=>intval[0] + if iseq + iseq = symptr=>intval[1] == expr=>intval[1] + fin + elsif symptr->type == NUM_FLOAT and expr->type == NUM_FLOAT + iseq = TRUE + for i = 0 to 4 + if symptr=>floatval[i] <> expr=>floatval[i] + iseq = FALSE + break + fin + next + fin + return bool_pred(iseq) end def natv_and(symptr, expr) @@ -926,6 +946,18 @@ def natv_csetq(symptr, expr) return symptr end +def natv_set(symptr, expr) + symptr = eval_expr(expr=>cdr=>car) + set_assoc(eval_expr(expr=>car), symptr) + return symptr +end + +def natv_setq(symptr, expr) + symptr = eval_expr(expr=>cdr=>car) + set_assoc(expr=>car, symptr) + return symptr +end + def natv_print(symptr, expr) expr = eval_expr(expr=>car) print_expr(expr) @@ -951,8 +983,6 @@ 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("CSET")=>natv = @natv_cset -new_sym("CSETQ")=>natv = @natv_csetq new_sym("NOT")=>natv = @natv_null new_sym("AND")=>natv = @natv_and new_sym("OR")=>natv = @natv_or @@ -960,6 +990,10 @@ new_sym("NULL")=>natv = @natv_null new_sym("LABEL")=>natv = @natv_label new_sym("DEFINE")=>natv = @natv_define new_sym("ARRAY")=>natv = @natv_array +new_sym("CSET")=>natv = @natv_cset +new_sym("CSETQ")=>natv = @natv_csetq +new_sym("SET")=>natv = @natv_set +new_sym("SETQ")=>natv = @natv_setq new_sym("PRINT")=>natv = @natv_print return modkeep | modinitkeep done diff --git a/src/makefile b/src/makefile index 07eabfb..60fd9a7 100755 --- a/src/makefile +++ b/src/makefile @@ -178,11 +178,11 @@ $(SEXPR): lisp/s-expr.pla ./$(PLASM) -AMOW lisp/s-expr.pla acme --setpc 4094 -o $(SEXPR) lisp/s-expr.a -$(SMATH): lisp/s-math.pla +$(SMATH): lisp/s-expr.pla lisp/s-math.pla ./$(PLASM) -AMOW lisp/s-math.pla acme --setpc 4094 -o $(SMATH) lisp/s-math.a -$(DRAWL): lisp/drawl.pla +$(DRAWL): lisp/s-expr.pla lisp/drawl.pla ./$(PLASM) -AMOW lisp/drawl.pla acme --setpc 4094 -o $(DRAWL) lisp/drawl.a