suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix bug in vector->immutable-vector on 0-sized vector

Browse Source 
svn: r7748
This commit is contained in:
Matthew Flatt 2007-11-16 18:19:53 +00:00
parent 4f8d89dcb2
commit 28a1f1f60a
2 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/mzscheme/src/list.c
View File

@ -614,13 +614,19 @@ Scheme_Object *scheme_make_raw_pair(Scheme_Object *car, Scheme_Object *cdr)
return cons; return cons;
} }
#ifdef MZ_PRECISE_GC
# define cons(car, cdr) GC_malloc_pair(car, cdr)
#else
# define cons(car, cdr) scheme_make_pair(car, cdr)
#endif
Scheme_Object *scheme_build_list(int size, Scheme_Object **argv) Scheme_Object *scheme_build_list(int size, Scheme_Object **argv)
{ {
Scheme_Object *pair = scheme_null; Scheme_Object *pair = scheme_null;
int i; int i;
for (i = size; i--; ) { for (i = size; i--; ) {
pair = scheme_make_pair(argv[i], pair); pair = cons(argv[i], pair);
} }
return pair; return pair;
@ -632,7 +638,7 @@ Scheme_Object *scheme_build_list_offset(int size, Scheme_Object **argv, int delt
int i; int i;
for (i = size; i-- > delta; ) { for (i = size; i-- > delta; ) {
pair = scheme_make_pair(argv[i], pair); pair = cons(argv[i], pair);
} }
return pair; return pair;
@ -644,7 +650,7 @@ Scheme_Object *scheme_alloc_list(int size)
int i; int i;
for (i = size; i--; ) { for (i = size; i--; ) {
pair = scheme_make_pair(scheme_false, pair); pair = cons(scheme_false, pair);
} }
return pair; return pair;
@ -694,7 +700,7 @@ scheme_named_map_1(char *name, Scheme_Object *(*fun)(Scheme_Object*, Scheme_Obje
Scheme_Object *v; Scheme_Object *v;
v = SCHEME_STX_CAR(lst); v = SCHEME_STX_CAR(lst);
v = fun(v, form); v = fun(v, form);
pr = scheme_make_pair(v, scheme_null); pr = cons(v, scheme_null);
if (last) if (last)
SCHEME_CDR(last) = pr; SCHEME_CDR(last) = pr;
else else
@ -764,7 +770,7 @@ mpair_p_prim (int argc, Scheme_Object *argv[])
static Scheme_Object * static Scheme_Object *
cons_prim (int argc, Scheme_Object *argv[]) cons_prim (int argc, Scheme_Object *argv[])
{ {
return scheme_make_pair(argv[0], argv[1]); return cons(argv[0], argv[1]);
} }
static Scheme_Object * static Scheme_Object *
@ -902,29 +908,26 @@ list_p_prim (int argc, Scheme_Object *argv[])
#define NORMAL_LIST_INIT() l = scheme_null #define NORMAL_LIST_INIT() l = scheme_null
#define STAR_LIST_INIT() --argc; l = argv[argc] #define STAR_LIST_INIT() --argc; l = argv[argc]
#ifndef MZ_PRECISE_GC
# define GC_malloc_pair scheme_make_pair
#endif
#define LIST_BODY(INIT, scheme_make_pair) \ #define LIST_BODY(INIT) \
int i; \ int i; \
Scheme_Object *l; \ Scheme_Object *l; \
INIT; \ INIT; \
for (i = argc ; i--; ) { \ for (i = argc ; i--; ) { \
l = scheme_make_pair(argv[i], l); \ l = cons(argv[i], l); \
} \ } \
return l return l
static Scheme_Object * static Scheme_Object *
list_prim (int argc, Scheme_Object *argv[]) list_prim (int argc, Scheme_Object *argv[])
{ {
LIST_BODY(NORMAL_LIST_INIT(), GC_malloc_pair); LIST_BODY(NORMAL_LIST_INIT());
} }
static Scheme_Object * static Scheme_Object *
list_star_prim (int argc, Scheme_Object *argv[]) list_star_prim (int argc, Scheme_Object *argv[])
{ {
LIST_BODY(STAR_LIST_INIT(), GC_malloc_pair); LIST_BODY(STAR_LIST_INIT());
} }
static Scheme_Object * static Scheme_Object *
@ -965,7 +968,7 @@ scheme_append (Scheme_Object *lst1, Scheme_Object *lst2)
first = last = NULL; first = last = NULL;
while (SCHEME_PAIRP(lst1)) { while (SCHEME_PAIRP(lst1)) {
v = scheme_make_pair(SCHEME_CAR(lst1), scheme_null); v = cons(SCHEME_CAR(lst1), scheme_null);
if (!first) if (!first)
first = v; first = v;
else else
@ -1021,7 +1024,7 @@ reverse_prim (int argc, Scheme_Object *argv[])
while (!SCHEME_NULLP (lst)) { while (!SCHEME_NULLP (lst)) {
if (!SCHEME_PAIRP(lst)) if (!SCHEME_PAIRP(lst))
scheme_wrong_type("reverse", "proper list", 0, argc, argv); scheme_wrong_type("reverse", "proper list", 0, argc, argv);
last = scheme_make_pair (SCHEME_CAR (lst), last); last = cons(SCHEME_CAR (lst), last);
lst = SCHEME_CDR (lst); lst = SCHEME_CDR (lst);
SCHEME_USE_FUEL(1); SCHEME_USE_FUEL(1);
@ -1658,7 +1661,7 @@ static Scheme_Object *do_map_hash_table(int argc,
p[1] = (Scheme_Object *)bucket->val; p[1] = (Scheme_Object *)bucket->val;
if (keep) { if (keep) {
v = _scheme_apply(f, 2, p); v = _scheme_apply(f, 2, p);
v = scheme_make_pair(v, scheme_null); v = cons(v, scheme_null);
if (last) if (last)
SCHEME_CDR(last) = v; SCHEME_CDR(last) = v;
else else
@ -1679,7 +1682,7 @@ static Scheme_Object *do_map_hash_table(int argc,
p[1] = hash->vals[i]; p[1] = hash->vals[i];
if (keep) { if (keep) {
v = _scheme_apply(f, 2, p); v = _scheme_apply(f, 2, p);
v = scheme_make_pair(v, scheme_null); v = cons(v, scheme_null);
if (last) if (last)
SCHEME_CDR(last) = v; SCHEME_CDR(last) = v;
else else

12
src/mzscheme/src/vector.c
View File

@ -287,6 +287,12 @@ vector_to_list (int argc, Scheme_Object *argv[])
return scheme_vector_to_list(argv[0]); return scheme_vector_to_list(argv[0]);
} }
#ifdef MZ_PRECISE_GC
# define cons(car, cdr) GC_malloc_pair(car, cdr)
#else
# define cons(car, cdr) scheme_make_pair(car, cdr)
#endif
Scheme_Object * Scheme_Object *
scheme_vector_to_list (Scheme_Object *vec) scheme_vector_to_list (Scheme_Object *vec)
{ {
@ -297,13 +303,13 @@ scheme_vector_to_list (Scheme_Object *vec)
if (i < 0xFFF) { if (i < 0xFFF) {
for (; i--; ) { for (; i--; ) {
pair = scheme_make_pair(SCHEME_VEC_ELS(vec)[i], pair); pair = cons(SCHEME_VEC_ELS(vec)[i], pair);
} }
} else { } else {
for (; i--; ) { for (; i--; ) {
if (!(i & 0xFFF)) if (!(i & 0xFFF))
SCHEME_USE_FUEL(0xFFF); SCHEME_USE_FUEL(0xFFF);
pair = scheme_make_pair(SCHEME_VEC_ELS(vec)[i], pair); pair = cons(SCHEME_VEC_ELS(vec)[i], pair);
} }
} }
@ -364,7 +370,7 @@ static Scheme_Object *vector_to_immutable (int argc, Scheme_Object *argv[])
ovec = argv[0]; ovec = argv[0];
len = SCHEME_VEC_SIZE(ovec); len = SCHEME_VEC_SIZE(ovec);
if (!len) if (!len)
return vec; return ovec;
vec = scheme_make_vector(len, NULL); vec = scheme_make_vector(len, NULL);
for (i = 0; i < len; i++) { for (i = 0; i < len; i++) {