diff --git a/src/CHANGELOG b/src/CHANGELOG index 33ca32096..e9799f764 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -921,6 +921,15 @@ ECL 0.6 libraries. For example, (LOAD (OPEN "foo.lsp")) is equivalent to (LOAD "foo.lsp"). + - The arguments of GENSYM should not be remembered by ECLS. The + current behaviour is wrong: + > (gensym) + #:G36 + > (gensym "F") + #:F37 + > (gensym) + #:F38 + TODO: ===== diff --git a/src/c/gbc-new.d b/src/c/gbc-new.d index 713e860c8..e8a9599c3 100644 --- a/src/c/gbc-new.d +++ b/src/c/gbc-new.d @@ -483,8 +483,6 @@ mark_phase(void) mark_object(clwp->lwp_PRINTcase); mark_object(clwp->lwp_READtable); mark_object(clwp->lwp_delimiting_char); - mark_object(clwp->lwp_gensym_prefix); - mark_object(clwp->lwp_gentemp_prefix); mark_object(clwp->lwp_token); /* (current-thread) can return it at any time diff --git a/src/c/gbc.d b/src/c/gbc.d index 7d19b8fe0..2dde37aec 100644 --- a/src/c/gbc.d +++ b/src/c/gbc.d @@ -493,8 +493,6 @@ mark_phase(void) mark_object(clwp->lwp_PRINTcase); mark_object(clwp->lwp_READtable); mark_object(clwp->lwp_delimiting_char); - mark_object(clwp->lwp_gensym_prefix); - mark_object(clwp->lwp_gentemp_prefix); mark_object(clwp->lwp_token); /* (current-thread) can return it at any time diff --git a/src/c/lwp.d b/src/c/lwp.d index 9d27e89e6..6ebce8007 100644 --- a/src/c/lwp.d +++ b/src/c/lwp.d @@ -151,8 +151,6 @@ make_pd() npd->lwp_sharp_eq_context_max = 0; /* for gc */ - npd->lwp_gensym_prefix = OBJNULL; - npd->lwp_gentemp_prefix = OBJNULL; npd->lwp_token = OBJNULL; /* lex_env copy */ @@ -169,7 +167,6 @@ make_pd() npd->lwp_fmt_temporary_string = npd->lwp_fmt_temporary_stream->stream.object0; - npd->lwp_gentemp_prefix = make_simple_string("T"); npd->lwp_token = cl_alloc_simple_string(LISP_PAGESIZE); npd->lwp_token->string.self = cl_alloc_atomic(LISP_PAGESIZE); npd->lwp_token->string.fillp = 0; diff --git a/src/c/symbol.d b/src/c/symbol.d index 205090c0f..c9a8a2a3b 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -19,8 +19,6 @@ /******************************* EXPORTS ******************************/ #ifndef THREADS -cl_object gensym_prefix; -cl_object gentemp_prefix; cl_object cl_token; #endif @@ -30,6 +28,8 @@ cl_object @'si::pname'; /******************************* ------- ******************************/ +static cl_object gensym_prefix; +static cl_object gentemp_prefix; static cl_index gentemp_counter; @(defun make_symbol (str) @@ -342,21 +342,22 @@ symbol_name(cl_object x) @(return x) @) -@(defun gensym (&optional (x gensym_prefix) &aux str) +@(defun gensym (&optional (prefix gensym_prefix) &aux str) cl_index name_length, j, counter_value; - volatile cl_object counter; + cl_object counter; @ - if (type_of(x) == t_string) { - gensym_prefix = x; + if (type_of(prefix) == t_string) { counter = SYM_VAL(@'*gensym-counter*'); - } else - counter = x; + } else { + counter = prefix; + prefix = gensym_prefix; + } if (!FIXNUMP(counter) || FIXNUM_MINUSP(counter)) { FEerror("*gensym-counter*, ~A, not a positive fixnum", 1, counter); } counter_value = fix(counter); - name_length = gensym_prefix->string.fillp; + name_length = prefix->string.fillp; for (j = counter_value; j > 0; j /= 10) name_length++; if (name_length == 0) @@ -364,14 +365,15 @@ symbol_name(cl_object x) str = cl_alloc_simple_string(name_length); str->string.self = (char *)cl_alloc_atomic(name_length+1); str->string.self[name_length] = '\0'; - for (j = 0; j < gensym_prefix->string.fillp; j++) - str->string.self[j] = gensym_prefix->string.self[j]; + for (j = 0; j < prefix->string.fillp; j++) + str->string.self[j] = prefix->string.self[j]; if (counter_value == 0) str->string.self[--name_length] = '0'; else for (j=counter_value; j > 0; j /= 10) str->string.self[--name_length] = j%10 + '0'; - SYM_VAL(@'*gensym-counter*') = MAKE_FIXNUM(counter_value+1); + if (prefix == gensym_prefix) + SYM_VAL(@'*gensym-counter*') = MAKE_FIXNUM(counter_value+1); @(return make_symbol(str)) @) diff --git a/src/h/external.h b/src/h/external.h index 8dda38fcd..13e63b6df 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -759,9 +759,9 @@ extern void init_structure(void); /* symbol.c */ -extern cl_object gensym_prefix; -extern cl_object gentemp_prefix; +#ifndef THREADS extern cl_object cl_token; +#endif extern cl_object make_symbol(cl_object st); extern cl_object make_ordinary(const char *s); extern cl_object make_special(const char *s, cl_object v); diff --git a/src/h/lwp.h b/src/h/lwp.h index fa283ade1..c459aa596 100644 --- a/src/h/lwp.h +++ b/src/h/lwp.h @@ -136,8 +136,6 @@ typedef struct lpd { /* symbol.d */ cl_object lwp_string_register; - cl_object lwp_gensym_prefix; - cl_object lwp_gentemp_prefix; cl_object lwp_token; /* They have to be initialized with * alloc_simple_string and */ } lpd;