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<mfl...@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<mfl...@racket-lang.org> 2011-04-11 23:29
:
| small clean-ups
:
M collects/setup/setup-unit.rkt | 7 +++++--
~~~~~~~~~~
efed709 Matthew Flatt<mfl...@racket-lang.org> 2011-04-12 10:21
:
| improve error reporting when using exec
:
M src/racket/src/port.c | 10 +++++++++-
~~~~~~~~~~
f6d185a Matthew Flatt<mfl...@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;
