klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit d42799bda832be3d88a870be32b19aff2be441b3
parent 42c59c8b753ee03171ce779a12b2b47a3e1273d6
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat, 16 Apr 2011 11:07:11 -0300

Added klist & kimm_list to create lists & removed the implicit rooting of car & cdr in kcons. All code should be refactored to use klist (that root internal pairs) and/or root elements when constructing pairs.

Diffstat:
Msrc/kgenv_mut.h | 2+-
Msrc/kpair.c | 27+++++++++++++++++++++++----
Msrc/kpair.h | 9++++++---
3 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h @@ -158,7 +158,7 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree, kset_mark(top, top); } else { /* create a new pair as copy, save it in the mark */ - TValue new_pair = kdummy_imm_cons(K); + TValue new_pair = kimm_cons(K, KNIL, KNIL); kset_mark(top, new_pair); } /* keep the old pair and continue with the car */ diff --git a/src/kpair.c b/src/kpair.c @@ -4,19 +4,18 @@ ** See Copyright Notice in klisp.h */ +#include <stdarg.h> + #include "kpair.h" #include "kobject.h" #include "kstate.h" #include "kmem.h" #include "kgc.h" +/* GC: assumes car & cdr are rooted */ TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr) { - krooted_tvs_push(K, car); - krooted_tvs_push(K, cdr); Pair *new_pair = klispM_new(K, Pair); - krooted_tvs_pop(K); - krooted_tvs_pop(K); /* header + gc_fields */ klispC_link(K, (GCObject *) new_pair, K_TPAIR, (m? 0 : K_FLAG_IMMUTABLE)); @@ -30,4 +29,24 @@ TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr) return gc2pair(new_pair); } +/* GC: assumes all argps are rooted */ +TValue klist_g(klisp_State *K, bool m, int32_t n, ...) +{ + va_list argp; + TValue tail = KNIL; + + krooted_vars_push(K, &tail); + + va_start(argp, n); + for (int i = 0; i < n; i++) { + TValue next_car = va_arg(argp, TValue); + tail = kcons_g(K, m, next_car, tail); + } + va_end(argp); + + krooted_vars_pop(K); + return tail; +} + + bool kpairp(TValue obj) { return ttispair(obj); } diff --git a/src/kpair.h b/src/kpair.h @@ -51,13 +51,16 @@ #define kset_car(p_, v_) (kcar(p_) = (v_)) #define kset_cdr(p_, v_) (kcdr(p_) = (v_)) -#define kdummy_cons(st_) (kcons(st_, KNIL, KNIL)) -#define kdummy_imm_cons(st_) (kimm_cons(st_, KNIL, KNIL)) - +/* GC: assumes car & cdr are rooted */ TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr); +/* GC: assumes all argps are rooted */ +TValue klist_g(klisp_State *K, bool m, int32_t n, ...); + #define kcons(K_, car_, cdr_) (kcons_g(K_, true, car_, cdr_)) #define kimm_cons(K_, car_, cdr_) (kcons_g(K_, false, car_, cdr_)) +#define klist(K_, n_, ...) (klist_g(K_, true, n_, __VA_ARGS__)) +#define kimm_list(K_, n_, ...) (klist_g(K_, false, n_, __VA_ARGS__)) #define kget_source_info(p_) (tv2pair(p_)->si) #define kset_source_info(p_, si_) (kget_source_info(p_) = (si_))