[racket-dev] [plt] Push #22439: master branch updated
Speaking of hashing I though Google's new fast CityHash implementation
was interesting.
http://google-opensource.blogspot.com/2011/04/introducing-cityhash.html
On 04/13/2011 11:00 AM, mflatt at racket-lang.org wrote:
> mflatt has updated `master' from 91d98aa0fa to f6d185abab.
> http://git.racket-lang.org/plt/91d98aa0fa..f6d185abab
>
> =====[ 4 Commits ]======================================================
>
> Directory summary:
> 8.9% collects/setup/
> 56.3% src/racket/src/
> 17.3% src/racket/
> 17.3% src/
>
> ~~~~~~~~~~
>
> 8a2d587 Matthew Flatt<mflatt at racket-lang.org> 2011-04-11 16:38
> :
> | minor hash tuning
> :
> M src/racket/src/bool.c | 68 +++++++++++++++++++++++++++++-----------------
> M src/racket/src/env.c | 14 ++++++---
> M src/racket/src/hash.c | 6 +++-
>
> ~~~~~~~~~~
>
> f36e3ad Matthew Flatt<mflatt at racket-lang.org> 2011-04-11 23:29
> :
> | small clean-ups
> :
> M collects/setup/setup-unit.rkt | 7 +++++--
>
> ~~~~~~~~~~
>
> efed709 Matthew Flatt<mflatt at racket-lang.org> 2011-04-12 10:21
> :
> | improve error reporting when using exec
> :
> M src/racket/src/port.c | 10 +++++++++-
>
> ~~~~~~~~~~
>
> f6d185a Matthew Flatt<mflatt at racket-lang.org> 2011-04-13 10:56
> :
> | configure: use `pkg-config' for libffi
> :
> M src/configure | 32 +++++++++++++++++++++++++++++++-
> M src/racket/configure.ac | 32 +++++++++++++++++++++++++++++++-
>
> =====[ Overall Diff ]===================================================
>
> collects/setup/setup-unit.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/setup/setup-unit.rkt
> +++ NEW/collects/setup/setup-unit.rkt
> @@ -684,9 +684,12 @@
> (match (parallel-workers)
> [(? (lambda (x) (x .> . 1)))
> (compile-cc (collection->cc (list (string->path "racket"))) 0)
> - (managed-compile-zo (build-path main-collects-dir "setup/parallel-build-worker.rkt"))
> + (managed-compile-zo (collection-file-path "parallel-build-worker.rkt" "setup"))
> (with-specified-mode
> - (let ([cct (move-to-begining (list "compiler" "raco" "racket") (move-to-end "drscheme" (sort-collections-tree (collection-tree-map top-level-plt-collects))))])
> + (let ([cct (move-to-begining (list "compiler" "raco" "racket")
> + (move-to-end "drscheme"
> + (sort-collections-tree
> + (collection-tree-map top-level-plt-collects))))])
> (iterate-cct (lambda (cc)
> (let ([dir (cc-path cc)]
> [info (cc-info cc)])
>
> src/configure
> ~~~~~~~~~~~~~
> --- OLD/src/configure
> +++ NEW/src/configure
> @@ -5120,8 +5120,34 @@ if test "${enable_libffi}" = "yes" ; then
> if test "${enable_foreign}" = "yes" ; then
> { echo "$as_me:$LINENO: checking for libffi">&5
> echo $ECHO_N "checking for libffi... $ECHO_C">&6; }
> +
> + # Try to get flags form pkg-config:
> + libffi_config_prog="pkg-config libffi"
> + libffi_config_preflags=`$libffi_config_prog --cflags-only-I 2> /dev/null`
> + if test "$?" = 0 ; then
> + libffi_config_cflags=`$libffi_config_prog --cflags-only-other 2> /dev/null`
> + if test "$?" = 0 ; then
> + libffi_config_ldflags=`$libffi_config_prog --libs 2> /dev/null`
> + if test "$?" != 0 ; then
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> + else
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> + else
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> +
> + OLD_CFLAGS="${CFLAGS}"
> OLD_LDFLAGS="${LDFLAGS}"
> - LDFLAGS="${LDFLAGS} -lffi"
> + CFLAGS="${CFLAGS} ${libffi_config_preflags} ${libffi_config_cflags}"
> + LDFLAGS="${LDFLAGS} ${libffi_config_ldflags}"
> cat>conftest.$ac_ext<<_ACEOF
> /* confdefs.h. */
> _ACEOF
> @@ -5169,9 +5195,13 @@ rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
> { echo "$as_me:$LINENO: result: $have_libffi">&5
> echo "${ECHO_T}$have_libffi">&6; }
> if test "${have_libffi}" = "no" ; then
> + CFLAGS="${OLD_CFLAGS}"
> LDFLAGS="${OLD_LDFLAGS}"
> echo "Building own libffi"
> else
> + CFLAGS="${OLD_CFLAGS}"
> + PREFLAGS="${PREFLAGS} ${libffi_config_preflags}"
> + CFLAGS="${COMPFLAGS} ${libffi_config_cflags}"
> echo "Using installed libffi"
> OWN_LIBFFI="OFF"
> fi
>
> src/racket/configure.ac
> ~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/configure.ac
> +++ NEW/src/racket/configure.ac
> @@ -855,8 +855,34 @@ AC_MSG_RESULT($mbsrtowcs)
> if test "${enable_libffi}" = "yes" ; then
> if test "${enable_foreign}" = "yes" ; then
> AC_MSG_CHECKING([for libffi])
> +
> + # Try to get flags form pkg-config:
> + libffi_config_prog="pkg-config libffi"
> + libffi_config_preflags=`$libffi_config_prog --cflags-only-I 2> /dev/null`
> + if test "$?" = 0 ; then
> + libffi_config_cflags=`$libffi_config_prog --cflags-only-other 2> /dev/null`
> + if test "$?" = 0 ; then
> + libffi_config_ldflags=`$libffi_config_prog --libs 2> /dev/null`
> + if test "$?" != 0 ; then
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> + else
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> + else
> + libffi_config_preflags=""
> + libffi_config_cflags=""
> + libffi_config_ldflags="-lffi"
> + fi
> +
> + OLD_CFLAGS="${CFLAGS}"
> OLD_LDFLAGS="${LDFLAGS}"
> - LDFLAGS="${LDFLAGS} -lffi"
> + CFLAGS="${CFLAGS} ${libffi_config_preflags} ${libffi_config_cflags}"
> + LDFLAGS="${LDFLAGS} ${libffi_config_ldflags}"
> AC_TRY_LINK([#include<ffi.h>],
> [ffi_cif cif; ]
> [ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 0,&ffi_type_void, NULL);],
> @@ -864,9 +890,13 @@ if test "${enable_libffi}" = "yes" ; then
> have_libffi=no)
> AC_MSG_RESULT($have_libffi)
> if test "${have_libffi}" = "no" ; then
> + CFLAGS="${OLD_CFLAGS}"
> LDFLAGS="${OLD_LDFLAGS}"
> echo "Building own libffi"
> else
> + CFLAGS="${OLD_CFLAGS}"
> + PREFLAGS="${PREFLAGS} ${libffi_config_preflags}"
> + CFLAGS="${COMPFLAGS} ${libffi_config_cflags}"
> echo "Using installed libffi"
> OWN_LIBFFI="OFF"
> fi
>
> src/racket/src/bool.c
> ~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/bool.c
> +++ NEW/src/racket/src/bool.c
> @@ -220,7 +220,7 @@ XFORM_NONGCING static MZ_INLINE int double_eqv(double a, double b)
> # endif
> }
>
> -int scheme_eqv (Scheme_Object *obj1, Scheme_Object *obj2)
> +XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2)
> {
> Scheme_Type t1, t2;
>
> @@ -238,7 +238,7 @@ int scheme_eqv (Scheme_Object *obj1, Scheme_Object *obj2)
> else if ((t2 == scheme_float_type)&& (t1 == scheme_double_type))
> return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2));
> #endif
> - return 0;
> + return -1;
> #ifdef MZ_USE_SINGLE_FLOATS
> } else if (t1 == scheme_float_type) {
> return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2));
> @@ -256,7 +256,12 @@ int scheme_eqv (Scheme_Object *obj1, Scheme_Object *obj2)
> } else if (t1 == scheme_char_type)
> return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2);
> else
> - return 0;
> + return -1;
> +}
> +
> +int scheme_eqv (Scheme_Object *obj1, Scheme_Object *obj2)
> +{
> + return (is_eqv(obj1, obj2)> 0);
> }
>
> int scheme_equal (Scheme_Object *obj1, Scheme_Object *obj2)
> @@ -366,6 +371,9 @@ static int is_equal_overflow(Scheme_Object *obj1, Scheme_Object *obj2, Equal_Inf
>
> int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> {
> + Scheme_Type t1, t2;
> + int cmp;
> +
> top:
> if (eql->next_next) {
> if (eql->next) {
> @@ -378,15 +386,22 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> eql->next = eql->next_next;
> }
>
> - if (scheme_eqv(obj1, obj2))
> - return 1;
> - else if (eql->for_chaperone
> + cmp = is_eqv(obj1, obj2);
> + if (cmp> -1)
> + return cmp;
> +
> + if (eql->for_chaperone
> && SCHEME_CHAPERONEP(obj1)
> && (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1)& SCHEME_CHAPERONE_IS_IMPERSONATOR)
> || (eql->for_chaperone> 1))) {
> obj1 = ((Scheme_Chaperone *)obj1)->prev;
> goto top;
> - } else if (NOT_SAME_TYPE(SCHEME_TYPE(obj1), SCHEME_TYPE(obj2))) {
> + }
> +
> + t1 = SCHEME_TYPE(obj1);
> + t2 = SCHEME_TYPE(obj2);
> +
> + if (NOT_SAME_TYPE(t1, t2)) {
> if (!eql->for_chaperone) {
> if (SCHEME_CHAPERONEP(obj1)) {
> obj1 = ((Scheme_Chaperone *)obj1)->val;
> @@ -398,7 +413,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> }
> }
> return 0;
> - } else if (SCHEME_PAIRP(obj1)) {
> + } else if (t1 == scheme_pair_type) {
> # include "mzeqchk.inc"
> if ((eql->car_depth> 2) || !scheme_is_list(obj1)) {
> if (union_check(obj1, obj2, eql))
> @@ -412,7 +427,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> goto top;
> } else
> return 0;
> - } else if (SCHEME_MUTABLE_PAIRP(obj1)) {
> + } else if (t1 == scheme_mutable_pair_type) {
> # include "mzeqchk.inc"
> if (eql->for_chaperone == 1)
> return 0;
> @@ -424,8 +439,8 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> goto top;
> } else
> return 0;
> - } else if (SCHEME_VECTORP(obj1)
> - || SCHEME_FXVECTORP(obj1)) {
> + } else if ((t1 == scheme_vector_type)
> + || (t1 == scheme_fxvector_type)) {
> # include "mzeqchk.inc"
> if ((eql->for_chaperone == 1)&& (!SCHEME_IMMUTABLEP(obj1)
> || !SCHEME_IMMUTABLEP(obj2)))
> @@ -433,7 +448,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> if (union_check(obj1, obj2, eql))
> return 1;
> return vector_equal(obj1, obj2, eql);
> - } else if (SCHEME_FLVECTORP(obj1)) {
> + } else if (t1 == scheme_flvector_type) {
> intptr_t l1, l2, i;
> l1 = SCHEME_FLVEC_SIZE(obj1);
> l2 = SCHEME_FLVEC_SIZE(obj2);
> @@ -446,8 +461,9 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> return 1;
> }
> return 0;
> - } else if (SCHEME_BYTE_STRINGP(obj1)
> - || SCHEME_GENERAL_PATHP(obj1)) {
> + } else if ((t1 == scheme_byte_string_type)
> + || ((t1>= scheme_unix_path_type)
> +&& (t1<= scheme_windows_path_type))) {
> intptr_t l1, l2;
> if ((eql->for_chaperone == 1)&& (!SCHEME_IMMUTABLEP(obj1)
> || !SCHEME_IMMUTABLEP(obj2)))
> @@ -456,7 +472,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> l2 = SCHEME_BYTE_STRTAG_VAL(obj2);
> return ((l1 == l2)
> && !memcmp(SCHEME_BYTE_STR_VAL(obj1), SCHEME_BYTE_STR_VAL(obj2), l1));
> - } else if (SCHEME_CHAR_STRINGP(obj1)) {
> + } else if (t1 == scheme_char_string_type) {
> intptr_t l1, l2;
> if ((eql->for_chaperone == 1)&& (!SCHEME_IMMUTABLEP(obj1)
> || !SCHEME_IMMUTABLEP(obj2)))
> @@ -465,7 +481,8 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> l2 = SCHEME_CHAR_STRTAG_VAL(obj2);
> return ((l1 == l2)
> && !memcmp(SCHEME_CHAR_STR_VAL(obj1), SCHEME_CHAR_STR_VAL(obj2), l1 * sizeof(mzchar)));
> - } else if (SCHEME_STRUCTP(obj1)) {
> + } else if ((t1 == scheme_structure_type)
> + || (t1 == scheme_proc_struct_type)) {
> Scheme_Struct_Type *st1, *st2;
> Scheme_Object *procs1, *procs2;
>
> @@ -559,7 +576,7 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> return 0;
> }
> }
> - } else if (SCHEME_BOXP(obj1)) {
> + } else if (t1 == scheme_box_type) {
> SCHEME_USE_FUEL(1);
> if ((eql->for_chaperone == 1)&& (!SCHEME_IMMUTABLEP(obj1)
> || !SCHEME_IMMUTABLEP(obj2)))
> @@ -569,41 +586,42 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
> obj1 = SCHEME_BOX_VAL(obj1);
> obj2 = SCHEME_BOX_VAL(obj2);
> goto top;
> - } else if (SCHEME_HASHTP(obj1)) {
> + } else if (t1 == scheme_hash_table_type) {
> # include "mzeqchk.inc"
> if (eql->for_chaperone == 1)
> return 0;
> if (union_check(obj1, obj2, eql))
> return 1;
> return scheme_hash_table_equal_rec((Scheme_Hash_Table *)obj1, (Scheme_Hash_Table *)obj2, eql);
> - } else if (SCHEME_HASHTRP(obj1)) {
> + } else if (t1 == scheme_hash_tree_type) {
> # include "mzeqchk.inc"
> if (union_check(obj1, obj2, eql))
> return 1;
> return scheme_hash_tree_equal_rec((Scheme_Hash_Tree *)obj1, (Scheme_Hash_Tree *)obj2, eql);
> - } else if (SCHEME_BUCKTP(obj1)) {
> + } else if (t1 == scheme_bucket_table_type) {
> # include "mzeqchk.inc"
> if (eql->for_chaperone == 1)
> return 0;
> if (union_check(obj1, obj2, eql))
> return 1;
> return scheme_bucket_table_equal_rec((Scheme_Bucket_Table *)obj1, (Scheme_Bucket_Table *)obj2, eql);
> - } else if (SCHEME_CPTRP(obj1)) {
> + } else if (t1 == scheme_cpointer_type) {
> return (((char *)SCHEME_CPTR_VAL(obj1) + SCHEME_CPTR_OFFSET(obj1))
> == ((char *)SCHEME_CPTR_VAL(obj2) + SCHEME_CPTR_OFFSET(obj2)));
> - } else if (SAME_TYPE(SCHEME_TYPE(obj1), scheme_wrap_chunk_type)) {
> + } else if (t1 == scheme_wrap_chunk_type) {
> return vector_equal(obj1, obj2, eql);
> - } else if (SAME_TYPE(SCHEME_TYPE(obj1), scheme_resolved_module_path_type)) {
> + } else if (t1 == scheme_resolved_module_path_type) {
> obj1 = SCHEME_PTR_VAL(obj1);
> obj2 = SCHEME_PTR_VAL(obj2);
> goto top;
> - } else if (!eql->for_chaperone&& SCHEME_CHAPERONEP(obj1)) {
> + } else if (!eql->for_chaperone&& ((t1 == scheme_chaperone_type)
> + || (t1 == scheme_proc_chaperone_type))) {
> /* both chaperones */
> obj1 = ((Scheme_Chaperone *)obj1)->val;
> obj2 = ((Scheme_Chaperone *)obj2)->val;
> goto top;
> } else {
> - Scheme_Equal_Proc eqlp = scheme_type_equals[SCHEME_TYPE(obj1)];
> + Scheme_Equal_Proc eqlp = scheme_type_equals[t1];
> if (eqlp) {
> if (union_check(obj1, obj2, eql))
> return 1;
>
> src/racket/src/env.c
> ~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/env.c
> +++ NEW/src/racket/src/env.c
> @@ -1824,11 +1824,15 @@ static Scheme_Object *make_toplevel(mzshort depth, int position, int resolved, i
> && (position< MAX_CONST_TOPLEVEL_POS))
> return toplevels[depth][position][flags];
>
> - pr = (flags
> - ? scheme_make_pair(scheme_make_integer(position),
> - scheme_make_integer(flags))
> - : scheme_make_integer(position));
> - pr = scheme_make_pair(scheme_make_integer(depth), pr);
> + if ((position< 0xFFFF)&& (depth< 0xFF)) {
> + int ep = position | (depth<< 16) | (flags<< 24);
> + pr = scheme_make_integer(ep);
> + } else {
> + pr = scheme_make_vector(3, NULL);
> + SCHEME_VEC_ELS(pr)[0] = scheme_make_integer(position);
> + SCHEME_VEC_ELS(pr)[1] = scheme_make_integer(flags);
> + SCHEME_VEC_ELS(pr)[2] = scheme_make_integer(depth);
> + }
> v = scheme_hash_get_atomic(toplevels_ht, pr);
> if (v)
> return v;
>
> src/racket/src/hash.c
> ~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/hash.c
> +++ NEW/src/racket/src/hash.c
> @@ -1036,7 +1036,11 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
>
> switch(t) {
> case scheme_integer_type:
> - return k + SCHEME_INT_VAL(o);
> + {
> + uintptr_t iv = to_unsigned_hash(SCHEME_INT_VAL(o));
> + MZ_MIX(iv);
> + return k + iv;
> + }
> #ifdef MZ_USE_SINGLE_FLOATS
> case scheme_float_type:
> #endif
>
> src/racket/src/port.c
> ~~~~~~~~~~~~~~~~~~~~~
> --- OLD/src/racket/src/port.c
> +++ NEW/src/racket/src/port.c
> @@ -8203,12 +8203,20 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
> END_XFORM_SKIP;
>
> err = MSC_IZE(execv)(command, argv);
> + if (err)
> + err = errno;
>
> /* If we get here it failed; give up */
>
> /* using scheme_signal_error will leave us in the forked process,
> so use scheme_console_printf instead */
> - scheme_console_printf("racket: exec failed (%d)\n", err);
> + scheme_console_printf("racket: exec failed (%s%serrno=%d)\n",
> +#ifdef NO_STRERROR_AVAILABLE
> + "", "",
> +#else
> + strerror(err), "; ",
> +#endif
> + err);
>
> /* back to Racket signal dispositions: */
> START_XFORM_SKIP;
![[logo]](/logo.png){kind=logo}