From e6a0257a79e1f01f3feb7d88b4613c24d549dad1 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 21 Nov 2016 09:30:59 +0100 Subject: [PATCH] core: Cleanup cells. * mes.c: Use accessors rather than g_cell[] access throughout. --- HACKING | 10 -- NEWS | 7 + define.c | 2 +- lib.c | 22 +-- math.c | 52 ++++---- mes.c | 349 +++++++++++++++++++++--------------------------- posix.c | 4 +- quasiquote.c | 4 +- string.c | 44 +++--- tests/gc-0.test | 14 +- tests/gc-1.test | 20 +-- type.c | 22 +-- 12 files changed, 251 insertions(+), 299 deletions(-) diff --git a/HACKING b/HACKING index e8782f60..e3135515 100644 --- a/HACKING +++ b/HACKING @@ -44,16 +44,6 @@ now include appropriate (mes-use-module ...) stanzas. This hack allows for scripts/includes.mes to generate the list of files to be prepended. Previously, this information was put in GNUmakefile. -** Garbage collection? -Mes is using malloc without freeing anything, memory is patient these -days :-) Sadly, a factor 10^6 less patient than the future that SICP -authors were hoping for (we have 10^3 less memory and 10^3 more -instructions). - -SICP's stop and copy Garbage Colletor (Jam Scraper?) algorithm is now -available, but it cannot be hooked up yet as even in boot mode the -core mes eval/apply is still running; it executes the Scheme based -eval/apply. ** Actually do something useful, build: [[https://en.wikipedia.org/wiki/Tiny_C_Compiler][Tiny C Compiler]] * OLD: Booting from LISP-1.5 into Mes diff --git a/NEWS b/NEWS index ffa93302..d75de6ad 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,13 @@ Copyright © 2016 Jan Nieuwenhuizen Please send Mes bug reports to janneke@gnu.org. +* Changes in 0.3 since 0.2 +** Core +*** Number-based rather than pointer-based cells. +*** Garbage collector aka Jam scraper. +A variant on SICP's stop and copy Garbage Colletor (Jam Scraper?) +algorithm has been implemented. + * Changes in 0.2 since 0.1 ** Core *** Names of symbols and strings are list of characters [WAS: c-string]. diff --git a/define.c b/define.c index 6a685b9e..49b71f9b 100644 --- a/define.c +++ b/define.c @@ -30,7 +30,7 @@ vm_define_env () { SCM x; SCM name = cadr (r1); - if (type (name) != PAIR) + if (TYPE (name) != PAIR) x = eval_env (caddr (r1), cons (cons (cadr (r1), cadr (r1)), r0)); else { name = car (name); diff --git a/lib.c b/lib.c index 63a82c21..da6fd34a 100644 --- a/lib.c +++ b/lib.c @@ -60,10 +60,10 @@ list (SCM x) ///((arity . n)) SCM list_ref (SCM x, SCM k) { - assert (type (x) == PAIR); - assert (type (k) == NUMBER); - int n = value (k); - while (n-- && g_cells[x].cdr != cell_nil) x = g_cells[x].cdr; + assert (TYPE (x) == PAIR); + assert (TYPE (k) == NUMBER); + int n = VALUE (k); + while (n-- && CDR (x) != cell_nil) x = CDR (x); return x != cell_nil ? car (x) : cell_undefined; } @@ -73,7 +73,7 @@ vector_to_list (SCM v) SCM x = cell_nil; for (int i = 0; i < LENGTH (v); i++) { SCM e = VECTOR (v)+i; - if (type (e) == REF) e = g_cells[e].ref; + if (TYPE (e) == REF) e = g_cells[e].ref; x = append2 (x, cons (e, cell_nil)); } return x; @@ -82,20 +82,20 @@ vector_to_list (SCM v) SCM integer_to_char (SCM x) { - assert (type (x) == NUMBER); - return make_char (value (x)); + assert (TYPE (x) == NUMBER); + return make_char (VALUE (x)); } SCM char_to_integer (SCM x) { - assert (type (x) == CHAR); - return make_number (value (x)); + assert (TYPE (x) == CHAR); + return make_number (VALUE (x)); } SCM builtin_exit (SCM x) { - assert (type (x) == NUMBER); - exit (value (x)); + assert (TYPE (x) == NUMBER); + exit (VALUE (x)); } diff --git a/math.c b/math.c index 6c0e1032..8a9c023b 100644 --- a/math.c +++ b/math.c @@ -24,9 +24,9 @@ greater_p (SCM x) ///((name . ">") (arity . n)) int n = INT_MAX; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - if (value (car (x)) >= n) return cell_f; - n = value (car (x)); + assert (TYPE (car (x)) == NUMBER); + if (VALUE (car (x)) >= n) return cell_f; + n = VALUE (car (x)); x = cdr (x); } return cell_t; @@ -38,9 +38,9 @@ less_p (SCM x) ///((name . "<") (arity . n)) int n = INT_MIN; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - if (value (car (x)) <= n) return cell_f; - n = value (car (x)); + assert (TYPE (car (x)) == NUMBER); + if (VALUE (car (x)) <= n) return cell_f; + n = VALUE (car (x)); x = cdr (x); } return cell_t; @@ -50,12 +50,12 @@ SCM is_p (SCM x) ///((name . "=") (arity . n)) { if (x == cell_nil) return cell_t; - assert (g_cells[car (x)].type == NUMBER); - int n = value (car (x)); + assert (TYPE (car (x)) == NUMBER); + int n = VALUE (car (x)); x = cdr (x); while (x != cell_nil) { - if (value (car (x)) != n) return cell_f; + if (VALUE (car (x)) != n) return cell_f; x = cdr (x); } return cell_t; @@ -65,15 +65,15 @@ SCM minus (SCM x) ///((name . "-") (arity . n)) { SCM a = car (x); - assert (g_cells[a].type == NUMBER); - int n = value (a); + assert (TYPE (a) == NUMBER); + int n = VALUE (a); x = cdr (x); if (x == cell_nil) n = -n; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n -= value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n -= VALUE (car (x)); x = cdr (x); } return make_number (n); @@ -85,8 +85,8 @@ plus (SCM x) ///((name . "+") (arity . n)) int n = 0; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n += value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n += VALUE (car (x)); x = cdr (x); } return make_number (n); @@ -97,14 +97,14 @@ divide (SCM x) ///((name . "/") (arity . n)) { int n = 1; if (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n = value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n = VALUE (car (x)); x = cdr (x); } while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n /= value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n /= VALUE (car (x)); x = cdr (x); } return make_number (n); @@ -113,9 +113,9 @@ divide (SCM x) ///((name . "/") (arity . n)) SCM modulo (SCM a, SCM b) { - assert (g_cells[a].type == NUMBER); - assert (g_cells[b].type == NUMBER); - return make_number (value (a) % value (b)); + assert (TYPE (a) == NUMBER); + assert (TYPE (b) == NUMBER); + return make_number (VALUE (a) % VALUE (b)); } SCM @@ -124,8 +124,8 @@ multiply (SCM x) ///((name . "*") (arity . n)) int n = 1; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n *= value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n *= VALUE (car (x)); x = cdr (x); } return make_number (n); @@ -137,8 +137,8 @@ logior (SCM x) ///((arity . n)) int n = 0; while (x != cell_nil) { - assert (g_cells[car (x)].type == NUMBER); - n |= value (car (x)); + assert (TYPE (car (x)) == NUMBER); + n |= VALUE (car (x)); x = cdr (x); } return make_number (n); diff --git a/mes.c b/mes.c index 745e2d71..8fd34297 100644 --- a/mes.c +++ b/mes.c @@ -169,61 +169,38 @@ scm *g_news = 0; #define CAR(x) g_cells[x].car #define CDR(x) g_cells[x].cdr +#define HITS(x) g_cells[x].hits +#define LENGTH(x) g_cells[x].length +#define NAME(x) g_cells[x].name +#define STRING(x) g_cells[x].string +#define TYPE(x) g_cells[x].type +#define MACRO(x) g_cells[x].macro +#define REF(x) g_cells[x].ref +#define VALUE(x) g_cells[x].value +#define VECTOR(x) g_cells[x].vector +#define FUNCTION(x) functions[g_cells[x].function] +#define NCAR(x) g_news[x].car +#define NTYPE(x) g_news[x].type + #define CAAR(x) CAR (CAR (x)) #define CDAR(x) CDR (CAR (x)) #define CAAR(x) CAR (CAR (x)) #define CADAR(x) CAR (CDR (CAR (x))) #define CDADAR(x) CAR (CDR (CAR (CDR (x)))) #define CADR(x) CAR (CDR (x)) -#define LENGTH(x) g_cells[x].length -#define STRING(x) g_cells[x].string -#define TYPE(x) g_cells[x].type -#define MACRO(x) g_cells[x].macro -#define VALUE(x) g_cells[x].value -#define VECTOR(x) g_cells[x].vector - -#define FUNCTION(x) functions[g_cells[x].function] - -#define NCAR(x) g_news[x].car -#define NTYPE(x) g_news[x].type - -enum type_t -type (SCM x) -{ - return g_cells[x].type; -} SCM car (SCM x) { - assert (g_cells[x].type == PAIR); - return g_cells[x].car; + assert (TYPE (x) == PAIR); + return CAR (x); } SCM cdr (SCM x) { - assert (g_cells[x].type == PAIR); - return g_cells[x].cdr; -} - -long -value (SCM x) -{ - return g_cells[x].value; -} - -SCM -alloc (int n) -{ -#if GC - assert (g_free.value + n < ARENA_SIZE); - SCM x = g_free.value; - g_free.value += n; - return x; -#else - return (SCM )malloc(n*sizeof (scm)); -#endif + assert (TYPE (x) == PAIR); + return CDR (x); } SCM @@ -297,7 +274,7 @@ gc_loop (SCM scan) SCM gc_copy (SCM old) { - if (type (old) == BROKEN_HEART) return g_cells[old].car; + if (TYPE (old) == BROKEN_HEART) return g_cells[old].car; SCM new = g_free.value++; g_news[new] = g_cells[old]; if (NTYPE (new) == VECTOR) @@ -353,53 +330,27 @@ gc_show () return cell_unspecified; } -SCM -gc_make_cell (SCM type, SCM car, SCM cdr) -{ - SCM x = gc_alloc (1); - assert (g_cells[type].type == NUMBER); - g_cells[x].type = value (type); - if (value (type) == CHAR || value (type) == NUMBER) { - if (car) g_cells[x].car = g_cells[car].car; - if (cdr) g_cells[x].cdr = g_cells[cdr].cdr; - } else { - g_cells[x].car = car; - g_cells[x].cdr = cdr; - } - return x; -} - SCM tmp; SCM tmp_num; SCM tmp_num2; SCM tmp_num3; SCM tmp_num4; -SCM -gc_make_vector (SCM n) -{ - g_cells[tmp_num].value = VECTOR; - SCM v = gc_alloc (value (n)); - SCM x = gc_make_cell (tmp_num, (SCM)(long)value (n), v); - for (int i=0; i= g_free.value || g_cells[p].type != PAIR) - g_cells[car (x)].string = cstring_to_list (g_cells[car (x)].name); - if (list_of_char_equal_p (g_cells[car (x)].string, s) == cell_t) break; + SCM p = STRING (car (x)); + if (p < 0 || p >= g_free.value || TYPE (p) != PAIR) + STRING (car (x)) = cstring_to_list (NAME (car (x))); + if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break; x = cdr (x); } if (x) x = car (x); @@ -1046,7 +978,7 @@ make_vector (SCM n) { int k = VALUE (n); g_cells[tmp_num].value = VECTOR; - SCM v = alloc (k); + SCM v = gc_alloc (k); SCM x = make_cell (tmp_num, k, v); for (int i=0; i= g_free.value || g_cells[p].type != PAIR) - fprintf (f, "%s", g_cells[x].name); + SCM p = STRING (x); + if (p < 0 || p >= g_free.value || TYPE (p) != PAIR) + fprintf (f, "%s", NAME (x)); else - display_ (f, g_cells[x].string); + display_ (f, STRING (x)); fprintf (f, ">"); break; } @@ -1273,12 +1221,12 @@ display_helper (FILE* f, SCM x, bool cont, char const *sep, bool quote) SCM p = STRING (x); assert (p); while (p != cell_nil) { - assert (g_cells[car (p)].type == CHAR); - fputc (g_cells[car (p)].value, f); + assert (TYPE (car (p)) == CHAR); + fputc (VALUE (car (p)), f); p = cdr (p); } } - else if (g_cells[x].type != PAIR && g_cells[x].name) fprintf (f, "%s", g_cells[x].name); + else if (TYPE (x) != PAIR && NAME (x)) fprintf (f, "%s", NAME (x)); } return cell_unspecified; } @@ -1324,21 +1272,28 @@ write_char (SCM x) ///((arity . n)) SCM c = car (x); SCM p = cdr (x); int fd = 1; - if (g_cells[p].type == PAIR && g_cells[car (p)].type == NUMBER) fd = g_cells[car (p)].value; + if (TYPE (p) == PAIR && TYPE (car (p)) == NUMBER) fd = VALUE (car (p)); FILE *f = fd == 1 ? stdout : stderr; - assert (g_cells[c].type == NUMBER || g_cells[c].type == CHAR); - fputc (value (c), f); + assert (TYPE (c) == NUMBER || TYPE (c) == CHAR); + fputc (VALUE (c), f); return c; } SCM unget_char (SCM c) { - assert (g_cells[c].type == NUMBER || g_cells[c].type == CHAR); - ungetchar (value (c)); + assert (TYPE (c) == NUMBER || TYPE (c) == CHAR); + ungetchar (VALUE (c)); return c; } +SCM +symbol_to_list (SCM x) +{ + assert (TYPE (x) == SYMBOL); + return STRING (x); +} + int readcomment (int c) { @@ -1358,7 +1313,7 @@ readword (int c, SCM w, SCM a) { if (c == EOF && w == cell_nil) return cell_nil; if (c == '\n' && w == cell_nil) return readword (getchar (), w, a); - if (c == '\n' && value (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot; + if (c == '\n' && VALUE (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot; if (c == EOF || c == '\n') return lookup (w, a); if (c == ' ') return readword ('\n', w, a); if (c == '"' && w == cell_nil) return readstring (); @@ -1367,7 +1322,7 @@ readword (int c, SCM w, SCM a) if (c == '(') {ungetchar (c); return lookup (w, a);} if (c == ')' && w == cell_nil) {ungetchar (c); return cell_nil;} if (c == ')') {ungetchar (c); return lookup (w, a);} - if (c == ',' && peekchar () == '@') {getchar (); return cons (lookup (g_cells[cell_symbol_unquote_splicing].string, a), + if (c == ',' && peekchar () == '@') {getchar (); return cons (lookup (STRING (cell_symbol_unquote_splicing), a), cons (readword (getchar (), w, a), cell_nil));} if ((c == '\'' @@ -1378,10 +1333,10 @@ readword (int c, SCM w, SCM a) cell_nil));} if (c == '#' && peekchar () == ',' && w == cell_nil) { getchar (); - if (peekchar () == '@'){getchar (); return cons (lookup (g_cells[cell_symbol_unsyntax_splicing].string, a), + if (peekchar () == '@'){getchar (); return cons (lookup (STRING (cell_symbol_unsyntax_splicing), a), cons (readword (getchar (), w, a), cell_nil));} - return cons (lookup (g_cells[cell_symbol_unsyntax].string, a), cons (readword (getchar (), w, a), cell_nil)); + return cons (lookup (STRING (cell_symbol_unsyntax), a), cons (readword (getchar (), w, a), cell_nil)); } if (c == '#' && (peekchar () == '\'' || peekchar () == '`') && w == cell_nil) { c = getchar (); @@ -1687,7 +1642,7 @@ make_closure (SCM args, SCM body, SCM a) SCM lookup_macro (SCM x, SCM a) { - if (g_cells[x].type != SYMBOL) return cell_f; + if (TYPE (x) != SYMBOL) return cell_f; SCM m = assq_ref_cache (x, a); if (macro_p (m) == cell_t) return MACRO (m); return cell_f; diff --git a/posix.c b/posix.c index e99caf59..a577806d 100644 --- a/posix.c +++ b/posix.c @@ -28,7 +28,7 @@ string_to_cstring (SCM s) s = STRING (s); while (s != cell_nil) { - *p++ = value (car (s)); + *p++ = VALUE (car (s)); s = cdr (s); } *p = 0; @@ -50,5 +50,5 @@ current_input_port () SCM set_current_input_port (SCM port) { - g_stdin = fdopen (value (port), "r"); + g_stdin = fdopen (VALUE (port), "r"); } diff --git a/quasiquote.c b/quasiquote.c index e2b5d294..00eb72d8 100644 --- a/quasiquote.c +++ b/quasiquote.c @@ -46,7 +46,7 @@ vm_eval_quasiquote () else if (atom_p (r1) == cell_t) return r1; else if (eq_p (car (r1), cell_symbol_unquote) == cell_t) return eval_env (cadr (r1), r0); - else if (type (r1) == PAIR && g_cells[car (r1)].type == PAIR + else if (TYPE (r1) == PAIR && TYPE (car (r1)) == PAIR && eq_p (caar (r1), cell_symbol_unquote_splicing) == cell_t) { r2 = eval_env (cadar (r1), r0); @@ -101,7 +101,7 @@ eval_quasisyntax (SCM e, SCM a) else if (atom_p (e) == cell_t) return e; else if (eq_p (car (e), cell_symbol_unsyntax) == cell_t) return eval_env (cadr (e), a); - else if (g_cells[e].type == PAIR && g_cells[car (e)].type == PAIR + else if (TYPE (e) == PAIR && TYPE (car (e)) == PAIR && eq_p (caar (e), cell_symbol_unsyntax_splicing) == cell_t) return append2 (eval_env (cadar (e), a), eval_quasisyntax (cdr (e), a)); return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a)); diff --git a/string.c b/string.c index 37d928fc..c02b22cc 100644 --- a/string.c +++ b/string.c @@ -31,7 +31,7 @@ string_append (SCM x) ///((arity . n)) while (x != cell_nil) { SCM s = car (x); - assert (g_cells[s].type == STRING); + assert (TYPE (s) == STRING); p = append2 (p, STRING (s)); x = cdr (x); } @@ -47,38 +47,38 @@ list_to_string (SCM x) SCM string_length (SCM x) { - assert (g_cells[x].type == STRING); - return make_number (value (length (STRING (x)))); + assert (TYPE (x) == STRING); + return make_number (VALUE (length (STRING (x)))); } SCM string_ref (SCM x, SCM k) { - assert (g_cells[x].type == STRING); - assert (g_cells[k].type == NUMBER); - g_cells[tmp_num].value = value (k); - return make_char (value (list_ref (STRING (x), tmp_num))); + assert (TYPE (x) == STRING); + assert (TYPE (k) == NUMBER); + VALUE (tmp_num) = VALUE (k); + return make_char (VALUE (list_ref (STRING (x), tmp_num))); } SCM substring (SCM x) ///((arity . n)) { - assert (g_cells[x].type == PAIR); - assert (g_cells[car (x)].type == STRING); - SCM s = g_cells[car (x)].string; - assert (g_cells[cadr (x)].type == NUMBER); - int start = g_cells[cadr (x)].value; - int end = g_cells[length (s)].value; - if (g_cells[cddr (x)].type == PAIR) { - assert (g_cells[caddr (x)].type == NUMBER); - assert (g_cells[caddr (x)].value <= end); - end = g_cells[caddr (x)].value; + assert (TYPE (x) == PAIR); + assert (TYPE (car (x)) == STRING); + SCM s = STRING (car (x)); + assert (TYPE (cadr (x)) == NUMBER); + int start = VALUE (cadr (x)); + int end = VALUE (length (s)); + if (TYPE (cddr (x)) == PAIR) { + assert (TYPE (caddr (x)) == NUMBER); + assert (VALUE (caddr (x)) <= end); + end = VALUE (caddr (x)); } int n = end - start; while (start--) s = cdr (s); SCM p = cell_nil; while (n-- && s != cell_nil) { - p = append2 (p, cons (make_char (g_cells[car (s)].value), cell_nil)); + p = append2 (p, cons (make_char (VALUE (car (s))), cell_nil)); s = cdr (s); } return make_string (p); @@ -87,8 +87,8 @@ substring (SCM x) ///((arity . n)) SCM number_to_string (SCM x) { - assert (g_cells[x].type == NUMBER); - int n = value (x); + assert (TYPE (x) == NUMBER); + int n = VALUE (x); SCM p = n < 0 ? cons (make_char ('-'), cell_nil) : cell_nil; do { p = cons (make_char (n % 10 + '0'), p); @@ -100,13 +100,13 @@ number_to_string (SCM x) SCM string_to_symbol (SCM x) { - assert (g_cells[x].type == STRING); + assert (TYPE (x) == STRING); return make_symbol (STRING (x)); } SCM symbol_to_string (SCM x) { - assert (g_cells[x].type == SYMBOL); + assert (TYPE (x) == SYMBOL); return make_string (STRING (x)); } diff --git a/tests/gc-0.test b/tests/gc-0.test index 9d201e5d..aa00fec8 100755 --- a/tests/gc-0.test +++ b/tests/gc-0.test @@ -25,15 +25,15 @@ exit $? ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define zero (gc-make-cell 2 0 0)) -(define one (gc-make-cell 2 0 1)) -(define pair (gc-make-cell 3 zero one)) -(define zero-list (gc-make-cell 3 zero '())) -(define v (gc-make-vector 1)) +(define zero (make-cell 2 0 0)) +(define one (make-cell 2 0 1)) +(define pair (make-cell 3 zero one)) +(define zero-list (make-cell 3 zero '())) +(define v (make-vector 1)) (display v) (newline) (vector-set! v 0 88) -(define zero-v-list (gc-make-cell 3 v zero-list)) -(define list (gc-make-cell 3 (gc-make-cell 3 zero one) zero-v-list)) +(define zero-v-list (make-cell 3 v zero-list)) +(define list (make-cell 3 (make-cell 3 zero one) zero-v-list)) (display "list: ") (display list) (newline) (display "v: ") (display v) (newline) (gc) diff --git a/tests/gc-1.test b/tests/gc-1.test index fe934b2b..35d35430 100755 --- a/tests/gc-1.test +++ b/tests/gc-1.test @@ -25,24 +25,24 @@ exit $? ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define first (gc-make-cell 0 0 #\F)) (newline) +(define first (make-cell 0 0 #\F)) (newline) -(define one (gc-make-cell 2 0 1)) +(define one (make-cell 2 0 1)) (display "\n one=") (display one) (newline) -(define two (gc-make-cell 2 0 2)) -(define pair2-nil (gc-make-cell 3 two '())) +(define two (make-cell 2 0 2)) +(define pair2-nil (make-cell 3 two '())) (display "\npair2-nil=") (display pair2-nil) (newline) (gc-show) -(define list1-2 (gc-make-cell 3 one pair2-nil)) +(define list1-2 (make-cell 3 one pair2-nil)) (display "\nlist1-2=") (display list1-2) (newline) (gc-show) -(define three (gc-make-cell 2 0 3)) -(define four (gc-make-cell 2 0 4)) -(define pair4-nil (gc-make-cell 3 four '())) -(define list3-4 (gc-make-cell 3 three pair4-nil)) -(define list1234 (gc-make-cell 3 list1-2 list3-4)) +(define three (make-cell 2 0 3)) +(define four (make-cell 2 0 4)) +(define pair4-nil (make-cell 3 four '())) +(define list3-4 (make-cell 3 three pair4-nil)) +(define list1234 (make-cell 3 list1-2 list3-4)) (gc-show) (gc list1234) (gc-show) diff --git a/type.c b/type.c index d698cdbc..61c3b578 100644 --- a/type.c +++ b/type.c @@ -23,55 +23,55 @@ SCM char_p (SCM x) { - return type (x) == CHAR ? cell_t : cell_f; + return TYPE (x) == CHAR ? cell_t : cell_f; } SCM macro_p (SCM x) { - return type (x) == MACRO ? cell_t : cell_f; + return TYPE (x) == MACRO ? cell_t : cell_f; } SCM number_p (SCM x) { - return type (x) == NUMBER ? cell_t : cell_f; + return TYPE (x) == NUMBER ? cell_t : cell_f; } SCM pair_p (SCM x) { - return type (x) == PAIR ? cell_t : cell_f; + return TYPE (x) == PAIR ? cell_t : cell_f; } SCM ref_p (SCM x) { - return type (x) == REF ? cell_t : cell_f; + return TYPE (x) == REF ? cell_t : cell_f; } SCM string_p (SCM x) { - return type (x) == STRING ? cell_t : cell_f; + return TYPE (x) == STRING ? cell_t : cell_f; } SCM symbol_p (SCM x) { - return type (x) == SYMBOL ? cell_t : cell_f; + return TYPE (x) == SYMBOL ? cell_t : cell_f; } SCM vector_p (SCM x) { - return type (x) == VECTOR ? cell_t : cell_f; + return TYPE (x) == VECTOR ? cell_t : cell_f; } SCM builtin_p (SCM x) { - return type (x) == FUNCTION ? cell_t : cell_f; + return TYPE (x) == FUNCTION ? cell_t : cell_f; } // Non-types @@ -84,7 +84,7 @@ null_p (SCM x) SCM atom_p (SCM x) { - return (type (x) == PAIR ? cell_f : cell_t); + return (TYPE (x) == PAIR ? cell_f : cell_t); } SCM @@ -98,5 +98,5 @@ SCM make_number (int); SCM mes_type_of (SCM x) { - return make_number (type (x)); + return make_number (TYPE (x)); }