From d93be391f98fb122a865e3103d5bed10eada95b7 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 21:00:17 +0000 Subject: [PATCH 1/7] Seems we need to call the garbage collector in order to stabilize loading of binary files --- src/c/load.d | 4 ++++ src/lsp/config.lsp.in | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/c/load.d b/src/c/load.d index 00e486dd4..fc64cd0a4 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -314,6 +314,10 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print) cl_object prefix; cl_object output; + /* A full garbage collection enables us to detect unused code + and leave space for the library to be loaded. */ + si_gc(Ct); + /* We need the full pathname */ filename = cl_namestring(cl_truename(filename)); diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in index 6e3350100..808289b7e 100644 --- a/src/lsp/config.lsp.in +++ b/src/lsp/config.lsp.in @@ -46,7 +46,7 @@ Returns, as a string, the location of the machine on which ECL runs." (defun lisp-implementation-version () "Args:() Returns the version of your ECL as a string." - "@PACKAGE_VERSION@ (CVS 2008-05-30 19:03)") + "@PACKAGE_VERSION@ (CVS 2008-05-30 23:00)") (defun machine-type () "Args: () From 75a324fbbe318677165b086f2f54ef7ff4af9a29 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 23:51:44 +0000 Subject: [PATCH 2/7] The last 12 bytes of a string were not used for the hash --- src/c/newhash.h | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/c/newhash.h b/src/c/newhash.h index 5708de610..770d575fe 100644 --- a/src/c/newhash.h +++ b/src/c/newhash.h @@ -34,19 +34,19 @@ ((cl_index)k[7]<<52)) static cl_index -hash_string(cl_index initval, const unsigned char *k, cl_index len) +hash_string(cl_index initval, const unsigned char *k, cl_index length) { register cl_index a = GOLDEN_RATIO, b = GOLDEN_RATIO, c = initval; - for (; len > 24; ) { + register cl_index len; + for (len = length; len >= 24; len -= 24) { a += extract_word(k); k+=8; b += extract_word(k); k+=8; c += extract_word(k); k+=8; mix(a,b,c); - len -= 24; } /*------------------------------------- handle the last 11 bytes */ - c += len; + c += length; switch(len) { /* all the case statements fall through */ case 23: c+=((cl_index)k[22]<<52); @@ -101,21 +101,20 @@ hash_string(cl_index initval, const unsigned char *k, cl_index len) #define extract_word(k) \ (k[0]+((cl_index)k[1]<<8)+((cl_index)k[2]<<16)+((cl_index)k[3]<<24)) - static cl_index -hash_string(cl_index initval, const unsigned char *k, cl_index len) +hash_string(cl_index initval, const unsigned char *k, cl_index length) { register cl_index a = GOLDEN_RATIO, b = GOLDEN_RATIO, c = initval; - for (; len > 12; ) { + register cl_index len; + for (len = length; len >= 12; len -= 12) { a += extract_word(k); k += 4; b += extract_word(k); k += 4; c += extract_word(k); k += 4; mix(a,b,c); - len -= 12; } /*------------------------------------- handle the last 11 bytes */ - c += len; + c += length; switch(len) { /* all the case statements fall through */ case 11: c+=((cl_index)k[10]<<24); From 7677ee8ce68752b90dab686a4f86f2c64a51653e Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 23:51:57 +0000 Subject: [PATCH 3/7] When computing the hash key of a pathname, since they are not circular structures, reset the depth parameter. --- src/c/hash.d | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/c/hash.d b/src/c/hash.d index 73267711d..56f72aaf7 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -99,12 +99,12 @@ _hash_equal(int depth, cl_hashkey h, cl_object x) return hash_string(h, x->base_string.self, x->base_string.fillp); #endif case t_pathname: - h = _hash_equal(depth, h, x->pathname.host); - h = _hash_equal(depth, h, x->pathname.device); - h = _hash_equal(depth, h, x->pathname.directory); - h = _hash_equal(depth, h, x->pathname.name); - h = _hash_equal(depth, h, x->pathname.type); - return _hash_equal(depth, h, x->pathname.version); + h = _hash_equal(0, h, x->pathname.directory); + h = _hash_equal(0, h, x->pathname.name); + h = _hash_equal(0, h, x->pathname.type); + h = _hash_equal(0, h, x->pathname.host); + h = _hash_equal(0, h, x->pathname.device); + return _hash_equal(0, h, x->pathname.version); case t_bitvector: /* Notice that we may round out some bits. We must do this * because the fill pointer may be set in the middle of a byte. @@ -113,7 +113,7 @@ _hash_equal(int depth, cl_hashkey h, cl_object x) * have different hash keys. */ return hash_string(h, x->vector.self.ch, x->vector.fillp / 8); case t_random: - return _hash_equal(depth, h, x->random.value); + return _hash_equal(0, h, x->random.value); default: return _hash_eql(h, x); } From abec6e581f5503412413ada89251be0e40313736 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 23:52:16 +0000 Subject: [PATCH 4/7] Stronger hashing for C files initialization names --- src/cmp/cmpname.lsp | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/cmp/cmpname.lsp b/src/cmp/cmpname.lsp index f57639aec..a3ec8a3e4 100644 --- a/src/cmp/cmpname.lsp +++ b/src/cmp/cmpname.lsp @@ -30,21 +30,30 @@ (base (length code)) (output '()) (digit 0)) - ((zerop number) (concatenate 'string (nreverse output))) + ((zerop number) (coerce (nreverse output) 'base-string)) (multiple-value-setq (number digit) (floor number base)) (push (char code digit) output))))) -(defun unique-init-name (pathname) +(defun unique-init-name (file) "Create a unique name for this initialization function. The current algorithm relies only on the name of the source file and the time at which it is built. This should be enough to prevent name collisions for object files built in the same machine." - (let ((tag (concatenate 'base-string - "_ecl" - (encode-number-in-name (sxhash pathname)) - "_" - (encode-number-in-name (get-universal-time))))) - (cmpnote "Creating tag: ~S for ~S" tag pathname) + (let* ((path (pathname file)) + (path-hash (logxor (ash (sxhash path) 8) + (ash (sxhash (cddr (pathname-directory path))) 16) + (sxhash (pathname-name path)))) + (seconds (get-universal-time)) + (ms (+ (* seconds 1000) + (mod (floor (* 1000 (get-internal-real-time)) + internal-time-units-per-second) + 1000))) + (tag (concatenate 'base-string + "_ecl" + (encode-number-in-name path-hash) + "_" + (encode-number-in-name ms)))) + (cmpnote "Creating tag: ~S for ~S" tag file) tag)) (defun init-name-tag (init-name) From a63f6a5bda96c09e10206a3d889d2ff97240885d Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 23:52:32 +0000 Subject: [PATCH 5/7] Allow depth to be infinite (coded as depth=0) in _hash_equal[p] --- src/c/hash.d | 53 ++++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/src/c/hash.d b/src/c/hash.d index 56f72aaf7..7028cd6f3 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -82,11 +82,12 @@ _hash_equal(int depth, cl_hashkey h, cl_object x) if (Null(x)) { return _hash_equal(depth, h, Cnil_symbol->symbol.name); } - if (depth++ > 3) { - return 0; + if (--depth == 0) { + return h; + } else { + h = _hash_equal(depth, h, ECL_CONS_CAR(x)); + return _hash_equal(depth, h, ECL_CONS_CDR(x)); } - h = _hash_equal(depth, h, ECL_CONS_CAR(x)); - return _hash_equal(depth, h, ECL_CONS_CDR(x)); case t_symbol: x = x->symbol.name; #ifdef ECL_UNICODE @@ -130,11 +131,12 @@ _hash_equalp(int depth, cl_hashkey h, cl_object x) if (Null(x)) { return _hash_equalp(depth, h, Cnil_symbol->symbol.name); } - if (depth++ > 3) { - return 0; + if (--depth == 0) { + return h; + } else { + h = _hash_equalp(depth, h, ECL_CONS_CAR(x)); + return _hash_equalp(depth, h, ECL_CONS_CDR(x)); } - h = _hash_equalp(depth, h, ECL_CONS_CAR(x)); - return _hash_equalp(depth, h, ECL_CONS_CDR(x)); #ifdef ECL_UNICODE case t_string: #endif @@ -145,11 +147,10 @@ _hash_equalp(int depth, cl_hashkey h, cl_object x) goto SCAN; case t_array: len = x->vector.dim; -SCAN: if (depth++ >= 3) { - return 0; - } - for (i = 0; i < len; i++) { - h = _hash_equalp(depth, h, ecl_aref(x, i)); + SCAN: if (--depth) { + for (i = 0; i < len; i++) { + h = _hash_equalp(depth, h, ecl_aref(x, i)); + } } return h; case t_fixnum: @@ -173,11 +174,11 @@ SCAN: if (depth++ >= 3) { case t_bignum: /* FIXME! We should be more precise here! */ case t_ratio: - h = _hash_equalp(depth, h, x->ratio.num); - return _hash_equalp(depth, h, x->ratio.den); + h = _hash_equalp(0, h, x->ratio.num); + return _hash_equalp(0, h, x->ratio.den); case t_complex: - h = _hash_equalp(depth, h, x->complex.real); - return _hash_equalp(depth, h, x->complex.imag); + h = _hash_equalp(0, h, x->complex.real); + return _hash_equalp(0, h, x->complex.imag); case t_instance: case t_hashtable: /* FIXME! We should be more precise here! */ @@ -203,9 +204,9 @@ ecl_search_hash(cl_object key, cl_object hashtable) switch (htest) { case htt_eq: h = (cl_hashkey)key >> 2; break; case htt_eql: h = _hash_eql(0, key); break; - case htt_equal: h = _hash_equal(0, 0, key); break; - case htt_equalp:h = _hash_equalp(0, 0, key); break; - case htt_pack: h = _hash_equal(0, 0, key); + case htt_equal: h = _hash_equal(3, 0, key); break; + case htt_equalp:h = _hash_equalp(3, 0, key); break; + case htt_pack: h = _hash_equal(3, 0, key); ho = MAKE_FIXNUM(h & 0xFFFFFFF); break; default: corrupted_hash(hashtable); @@ -283,9 +284,9 @@ add_new_to_hash(cl_object key, cl_object hashtable, cl_object value) switch (htest) { case htt_eq: h = (cl_hashkey)key >> 2; break; case htt_eql: h = _hash_eql(0, key); break; - case htt_equal: h = _hash_equal(0, 0, key); break; - case htt_equalp:h = _hash_equalp(0, 0, key); break; - case htt_pack: h = _hash_equal(0, 0, key); break; + case htt_equal: h = _hash_equal(3, 0, key); break; + case htt_equalp:h = _hash_equalp(3, 0, key); break; + case htt_pack: h = _hash_equal(3, 0, key); break; default: corrupted_hash(hashtable); } e = hashtable->hash.data; @@ -608,7 +609,7 @@ cl_hash_table_rehash_threshold(cl_object ht) cl_object cl_sxhash(cl_object key) { - cl_index output = _hash_equal(0, 0, key); + cl_index output = _hash_equal(3, 0, key); const cl_index mask = ((cl_index)1 << (FIXNUM_BITS - 3)) - 1; @(return MAKE_FIXNUM(output & mask)) } @@ -628,7 +629,7 @@ cl_sxhash(cl_object key) @ for (h = 0; narg; narg--) { cl_object o = cl_va_arg(args); - h = _hash_equal(0, h, o); + h = _hash_equal(3, h, o); } @(return MAKE_FIXNUM(h)) @) @@ -638,7 +639,7 @@ cl_sxhash(cl_object key) @ for (h = 0; narg; narg--) { cl_object o = cl_va_arg(args); - h = _hash_equalp(0, h, o); + h = _hash_equalp(3, h, o); } @(return MAKE_FIXNUM(h)) @) From 70c30b8ef93d2f5362848cde3ce4fdd3ecb94ea4 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Fri, 30 May 2008 23:55:54 +0000 Subject: [PATCH 6/7] In compile-file, ensure that :output-file is appended the proper file extension --- src/CHANGELOG | 3 +++ src/cmp/cmpmain.lsp | 3 ++- src/lsp/config.lsp.in | 2 +- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 1497e39b9..f0bfdcb46 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -234,6 +234,9 @@ ECL 0.9k: - Garbage collection statistics was broken for libraries other than the one shipped with ECL. + - When COMPILE-FILE is provided a value of :OUTPUT-FILE, the file extension + ".fas" was not automatically appended. + * Optimization and performance: - TYPEP now can be optimized if the type argument is a constant. diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 1acde5164..62f164450 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -500,7 +500,8 @@ static cl_object VV[VM]; (setq *compile-file-truename* (truename *compile-file-pathname*)) (when (eq output-file 'T) - (setf output-file (compile-file-pathname *compile-file-truename* :type (if system-p :object :fasl)))) + (setf output-file *compile-file-truename*)) + (setf output-file (compile-file-pathname output-file :type (if system-p :object :fasl))) #+PDE (setq sys:*source-pathname* *compile-file-truename*) diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in index 808289b7e..57599431c 100644 --- a/src/lsp/config.lsp.in +++ b/src/lsp/config.lsp.in @@ -46,7 +46,7 @@ Returns, as a string, the location of the machine on which ECL runs." (defun lisp-implementation-version () "Args:() Returns the version of your ECL as a string." - "@PACKAGE_VERSION@ (CVS 2008-05-30 23:00)") + "@PACKAGE_VERSION@ (CVS 2008-05-31 01:49)") (defun machine-type () "Args: () From af6c551e808271f0b8ce9ce0a61b1878c791ef08 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Sat, 31 May 2008 12:58:01 +0000 Subject: [PATCH 7/7] When using the generational garbage collector, do not use dlopen/dlclose wrappers, which deactivate the garbage collector. In this case, we need not explicit calls to si_gc(Ct) in si_load_binary() --- src/c/load.d | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/c/load.d b/src/c/load.d index fc64cd0a4..d615c832a 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -315,8 +315,11 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print) cl_object output; /* A full garbage collection enables us to detect unused code - and leave space for the library to be loaded. */ + and leave space for the library to be loaded. This is only + required when we use the dlopen wrappers. */ +#ifndef GBC_BOEHM_GENGC si_gc(Ct); +#endif /* We need the full pathname */ filename = cl_namestring(cl_truename(filename));