kpair.c (1379B)
1 /* 2 ** kpair.c 3 ** Kernel Pairs 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #include <stdarg.h> 8 9 #include "kpair.h" 10 #include "kobject.h" 11 #include "kstate.h" 12 #include "kmem.h" 13 #include "kgc.h" 14 15 /* GC: assumes car & cdr are rooted */ 16 TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr) 17 { 18 Pair *new_pair = klispM_new(K, Pair); 19 20 /* header + gc_fields */ 21 klispC_link(K, (GCObject *) new_pair, K_TPAIR, (m? 0 : K_FLAG_IMMUTABLE)); 22 23 /* pair specific fields */ 24 new_pair->mark = KFALSE; 25 new_pair->car = car; 26 new_pair->cdr = cdr; 27 28 return gc2pair(new_pair); 29 } 30 31 #define MAX_LIST_N 16 32 33 /* GC: assumes all argps are rooted */ 34 TValue klist_g(klisp_State *K, bool m, int32_t n, ...) 35 { 36 va_list argp; 37 38 klisp_assert(n < MAX_LIST_N); 39 40 TValue dummy = kcons_g(K, m, KINERT, KNIL); 41 krooted_tvs_push(K, dummy); 42 TValue tail = dummy; 43 44 va_start(argp, n); 45 for (int i = 0; i < n; i++) { 46 TValue next_car = va_arg(argp, TValue); 47 TValue np = kcons_g(K, m, next_car, KNIL); 48 kset_cdr_unsafe(K, tail, np); 49 tail = np; 50 } 51 va_end(argp); 52 53 krooted_tvs_pop(K); 54 return kcdr(dummy); 55 } 56 57 58 bool kpairp(TValue obj) { return ttispair(obj); } 59 bool kimmutable_pairp(TValue obj) 60 { 61 return ttispair(obj) && kis_immutable(obj); 62 } 63 bool kmutable_pairp(TValue obj) 64 { 65 return ttispair(obj) && kis_mutable(obj); 66 }