From 5532d4b9968f8697a26e96edbee4185558dc9198 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 31 Oct 2015 13:29:35 +0100 Subject: [PATCH 1/3] generic-dispatch: move copy operation Move copy operation before the function which has side-effects. Reported and fixed by clasp dev team. Thanks! --- src/c/gfun.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/c/gfun.d b/src/c/gfun.d index 058d080e5..6fa96119e 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -244,9 +244,9 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf) * compute the applicable methods. We must save * the keys and recompute the cache location if * it was filled. */ + cl_object keys = cl_copy_seq(vector); func = compute_applicable_method(env, frame, gf); if (env->values[1] != ECL_NIL) { - cl_object keys = cl_copy_seq(vector); if (e->key != OBJNULL) { e = ecl_search_cache(cache); } From dfe68fe96aca416a5ee5edbe2f62056adb50ef29 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 1 Nov 2015 21:52:57 +0300 Subject: [PATCH 2/3] Reduce cache size for generic functions. Instead of occupying two vector elements (one for the actual value and one for a bit indicating whether it's an eql-specializer) store cons cells containing eql specializer values from CLOS::GENERIC-FUNCTION-SPEC-LIST. --- src/c/gfun.d | 13 +++++++------ src/c/main.d | 4 +--- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/c/gfun.d b/src/c/gfun.d index 6fa96119e..a86436eed 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -127,21 +127,22 @@ fill_spec_vector(cl_object vector, cl_object frame, cl_object gf) cl_object spec_how = ECL_CONS_CAR(spec_how_list); cl_object spec_type = ECL_CONS_CAR(spec_how); int spec_position = ecl_fixnum(ECL_CONS_CDR(spec_how)); + cl_object eql_spec; unlikely_if (spec_position >= narg) FEwrong_num_arguments(gf); unlikely_if (spec_no >= vector->vector.dim) ecl_internal_error("Too many arguments to fill_spec_vector()"); /* Need to differentiate between EQL specializers and class specializers, because the EQL value can be a - class, and may classh with a class specializer. */ - if (ECL_LISTP(spec_type) && ecl_memql(args[spec_position], spec_type)) { - argtype[spec_no++] = args[spec_position]; - argtype[spec_no++] = 1; + class, and may clash with a class specializer. + Store the cons cell containing the EQL value. */ + if (ECL_LISTP(spec_type) && + !Null(eql_spec = ecl_memql(args[spec_position], spec_type))) { + argtype[spec_no++] = eql_spec; } else { argtype[spec_no++] = cl_class_of(args[spec_position]); - argtype[spec_no++] = 0; } - + } end_loop_for_on_unsafe(spec_how_list); vector->vector.fillp = spec_no; return vector; diff --git a/src/c/main.d b/src/c/main.d index b341faf6e..3c9044874 100755 --- a/src/c/main.d +++ b/src/c/main.d @@ -169,9 +169,7 @@ ecl_init_env(cl_env_ptr env) ((struct ecl_fficall*)env->fficall)->registers = 0; #endif - /* Needs 128 elements for 64 entries to differentiate between - EQL specializers and class specializers */ - env->method_cache = ecl_make_cache(128, 4096); + env->method_cache = ecl_make_cache(64, 4096); env->slot_cache = ecl_make_cache(3, 4096); env->pending_interrupt = ECL_NIL; { From 61150e38be5405b8a1c691b6330b473259852b77 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 1 Nov 2015 22:08:05 +0300 Subject: [PATCH 3/3] ext:function-lambda-list: don't crash on uninitialized GFs. Macroexpanding DEFMETHOD creates a partially initialized GF (not the greatest idea in itself). function-lambda-list then croaks on the LAMBDA-LIST slot being unbound. --- src/lsp/top.lsp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index 4f59ae2b4..1caa68ab7 100644 --- a/src/lsp/top.lsp +++ b/src/lsp/top.lsp @@ -844,7 +844,9 @@ Use special code 0 to cancel this operation.") (t (function-lambda-list (fdefinition function))))) ((typep function 'generic-function) - (values (clos:generic-function-lambda-list function) t)) + (if (slot-boundp function 'clos::lambda-list) + (values (clos:generic-function-lambda-list function) t) + (values nil nil))) ;; Use the lambda list from the function definition, if available, ;; but remove &aux arguments. ((let ((f (function-lambda-expression function)))