From b0424737a72c6135db6d65ee68da1b8088f69b69 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 21 Mar 2018 08:54:55 -0600 Subject: [PATCH] places: handle impersonated values by copying Recognize vector, hash table, and prefab impersoantors/chaperones, and allow them as place0channel messages by copying. Closes #2001 --- .../scribblings/reference/places.scrbl | 6 +- pkgs/racket-test-core/tests/racket/place.rktl | 57 ++++++++ racket/src/racket/src/list.c | 14 +- racket/src/racket/src/place.c | 138 ++++++++++++++++-- racket/src/racket/src/schpriv.h | 4 + 5 files changed, 198 insertions(+), 21 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/places.scrbl b/pkgs/racket-doc/scribblings/reference/places.scrbl index 42860c538a..8e8f056cd5 100644 --- a/pkgs/racket-doc/scribblings/reference/places.scrbl +++ b/pkgs/racket-doc/scribblings/reference/places.scrbl @@ -372,10 +372,12 @@ messages: @item{@tech{pairs}, @tech{lists}, @tech{vectors}, and immutable @tech{prefab} structures containing message-allowed values, where a mutable vector is automatically replaced by an - immutable vector;} + immutable vector and where @tech{impersonators} or vectors and + @tech{prefab} structures are copied;} @item{@tech{hash tables} where mutable hash tables are automatically - replaced by immutable variants;} + replaced by immutable variants, and where an + hash table @tech{impersonator} is copied;} @item{@tech{place channels}, where a @tech{place descriptor} is automatically replaced by a plain place channel;} diff --git a/pkgs/racket-test-core/tests/racket/place.rktl b/pkgs/racket-test-core/tests/racket/place.rktl index f8bcb705e1..d16bbae67b 100644 --- a/pkgs/racket-test-core/tests/racket/place.rktl +++ b/pkgs/racket-test-core/tests/racket/place.rktl @@ -102,6 +102,63 @@ (test (not (place-enabled?)) place-message-allowed? (cons v 1)) (test (not (place-enabled?)) place-message-allowed? (vector v))) +;; ---------------------------------------- +;; Place messages and chaperones + +(test #t place-message-allowed? (chaperone-vector (vector 1 2) (lambda (v i e) e) (lambda (v i e) e))) +(test #t place-message-allowed? (chaperone-hash (hasheq 1 2 3 4) + (lambda (ht k) (values k (lambda (ht k v) v))) + (lambda (ht k v) (values k v)) + (lambda (ht k) k) + (lambda (ht k) k))) +(test #t place-message-allowed? (chaperone-hash (make-hash) + (lambda (ht k) (values k (lambda (ht k v) v))) + (lambda (ht k v) (values k v)) + (lambda (ht k) k) + (lambda (ht k) k))) +(let () + (struct posn (x y) #:prefab) + (test #t place-message-allowed? (chaperone-struct '#s(posn 1 2) + posn-x (lambda (p x) x)))) + +(let () + (define-values (in out) (place-channel)) + + (place-channel-put out (impersonate-vector (vector 1 2) (lambda (v i e) (add1 e)) (lambda (v i e) e))) + (test '#(2 3) place-channel-get in) + + (let ([ht (make-hash)]) + (hash-set! ht 1 2) + (hash-set! ht 3 4) + (place-channel-put out (impersonate-hash ht + (lambda (ht k) (values k (lambda (ht k v) (add1 v)))) + (lambda (ht k v) (values k v)) + (lambda (ht k) k) + (lambda (ht k) k))) + (test '#hash((1 . 3) (3 . 5)) + place-channel-get in)) + + (let () + (struct posn (x y) #:prefab) + (place-channel-put out (chaperone-struct (posn 1 2) + posn-x (lambda (p x) x))) + (test (posn 1 2) place-channel-get in)) + + ;; MAke sure large values are handled correctly + (let ([v (for/list ([i 10000]) + (impersonate-vector (vector i + (impersonate-vector (vector (- i)) + (lambda (v i e) (sub1 e)) + (lambda (v i e) e))) + (lambda (v i e) (list e)) + (lambda (v i e) e)))]) + (test #t 'allowed? (place-message-allowed? v)) + (place-channel-put out v) + (test #t 'equal? (equal? v (place-channel-get in)))) + + (void)) + +;; ---------------------------------------- (require (submod "place-utils.rkt" place-test-submod)) (test 0 p 0) diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index 979fdd22df..f183c9bf4d 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -3633,7 +3633,9 @@ Scheme_Object *scheme_chaperone_hash_traversal_get(Scheme_Object *table, Scheme_ return chaperone_hash_op("hash-ref", table, key, NULL, 0, scheme_null); } -Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) + +Scheme_Object *scheme_chaperone_hash_table_filtered_copy(Scheme_Object *obj, + Hash_Table_Element_Filter_Proc filter) { Scheme_Object *a[3], *v, *v2, *idx, *key, *val; int is_eq, is_eqv; @@ -3644,14 +3646,14 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) is_eq = SCHEME_TRUEP(scheme_hash_eq_p(1, a)); is_eqv = SCHEME_TRUEP(scheme_hash_eqv_p(1, a)); - if (SCHEME_HASHTP(obj)) { + if (SCHEME_HASHTP(v)) { if (is_eq) v2 = make_hasheq(0, NULL); else if (is_eqv) v2 = make_hasheqv(0, NULL); else v2 = make_hash(0, NULL); - } else if (SCHEME_HASHTRP(obj)) { + } else if (SCHEME_HASHTRP(v)) { if (is_eq) v2 = scheme_make_immutable_hasheq(0, NULL); else if (is_eqv) @@ -3674,6 +3676,7 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) key = scheme_hash_table_iterate_key(2, a); val = scheme_chaperone_hash_get(obj, key); + if (filter && val) val = filter(val); if (val) { a[0] = v2; a[1] = key; @@ -3692,6 +3695,11 @@ Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) return v2; } +Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj) +{ + return scheme_chaperone_hash_table_filtered_copy(obj, NULL); +} + static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[]) { intptr_t v; diff --git a/racket/src/racket/src/place.c b/racket/src/racket/src/place.c index 07cc1f1ffd..dc4f040faa 100644 --- a/racket/src/racket/src/place.c +++ b/racket/src/racket/src/place.c @@ -88,9 +88,11 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab # define mzPDC_DIRECT_UNCOPY 3 # define mzPDC_DESER 4 # define mzPDC_CLEAN 5 + +static Scheme_Object *strip_chaperones(Scheme_Object *so); #endif -static void places_prepare_direct(Scheme_Object *so); +static Scheme_Object *places_prepare_direct(Scheme_Object *so); static void log_place_event(const char *what, const char *tag, int has_amount, intptr_t amount); # ifdef MZ_PRECISE_GC @@ -485,13 +487,22 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) { place_data->err = rw[5]; } } - - places_prepare_direct(place_data->current_library_collection_paths); - places_prepare_direct(place_data->current_library_collection_links); - places_prepare_direct(place_data->compiled_roots); - places_prepare_direct(place_data->channel); - places_prepare_direct(place_data->module); - places_prepare_direct(place_data->function); + + { + Scheme_Object *tmp; + tmp = places_prepare_direct(place_data->current_library_collection_paths); + place_data->current_library_collection_paths = tmp; + tmp = places_prepare_direct(place_data->current_library_collection_links); + place_data->current_library_collection_links = tmp; + tmp = places_prepare_direct(place_data->compiled_roots); + place_data->compiled_roots = tmp; + tmp = places_prepare_direct(place_data->channel); + place_data->channel = tmp; + tmp = places_prepare_direct(place_data->module); + place_data->module = tmp; + tmp = places_prepare_direct(place_data->function); + place_data->function = tmp; + } /* create new place */ proc_thread = mz_proc_thread_create(place_start_proc, place_data); @@ -775,8 +786,10 @@ static Scheme_Object *do_places_deep_copy(Scheme_Object *so, int mode, int gcabl #endif } -static void places_prepare_direct(Scheme_Object *so) { +static Scheme_Object *places_prepare_direct(Scheme_Object *so) { + so = strip_chaperones(so); (void)do_places_deep_copy(so, mzPDC_CHECK, 1, NULL, NULL); + return so; } static Scheme_Object *places_deep_direct_uncopy(Scheme_Object *so) { @@ -1931,6 +1944,79 @@ DEEP_DONE_L: } +static Scheme_Object *strip_chaperones_k(void); + +/* Recognizes the same shapes as places_deep_copy_worker, but also + allows chaperones and impersonators. The result is an + impersonator-free copy of `so`. */ +static Scheme_Object *strip_chaperones(Scheme_Object *so) +{ + Scheme_Object *o; + +#ifdef DO_STACK_CHECK + { +# include "mzstkchk.h" + { + Scheme_Thread *p = scheme_current_thread; + p->ku.k.p1 = (void *)so; + return scheme_handle_stack_overflow(strip_chaperones_k); + } + } +#endif + + if (SCHEME_CHAPERONEP(so)) + o = SCHEME_CHAPERONE_VAL(so); + else + o = so; + + if (SCHEME_PAIRP(o)) { + return scheme_make_pair(strip_chaperones(SCHEME_CAR(o)), + strip_chaperones(SCHEME_CDR(o))); + } else if (SCHEME_VECTORP(o)) { + Scheme_Object *v, *e; + intptr_t len = SCHEME_VEC_SIZE(o), i; + v = scheme_make_vector(len, NULL); + for (i = 0; i < len; i++) { + if (SAME_OBJ(o, so)) + e = SCHEME_VEC_ELS(so)[i]; + else + e = scheme_chaperone_vector_ref(so, i); + e = strip_chaperones(e); + SCHEME_VEC_ELS(v)[i] = e; + } + return v; + } else if (SCHEME_HASHTP(o) || SCHEME_HASHTRP(o)) { + return scheme_chaperone_hash_table_filtered_copy(so, strip_chaperones); + } else if (SCHEME_STRUCTP(o)) { + Scheme_Structure *s = (Scheme_Structure *)(o), *s2; + Scheme_Object *e; + intptr_t i, len = s->stype->num_slots; + if (!s->stype->prefab_key) + return NULL; + s2 = (Scheme_Structure *)scheme_make_blank_prefab_struct_instance(s->stype); + for (i = 0; i < len; i++) { + if (SAME_OBJ(o, so)) + e = s->slots[i]; + else + e = scheme_struct_ref(so, i); + e = strip_chaperones(e); + s2->slots[i] = e; + } + return (Scheme_Object *)s2; + } else + return so; +} + +static Scheme_Object *strip_chaperones_k(void) +{ + Scheme_Thread *p = scheme_current_thread; + Scheme_Object *so = (Scheme_Object *)p->ku.k.p1; + + p->ku.k.p1 = NULL; + + return strip_chaperones(so); +} + #if 0 /* unused code, may be useful when/if we revive shared symbol and prefab key tables */ Scheme_Struct_Type *scheme_make_prefab_struct_type_in_master(Scheme_Object *base, @@ -2393,10 +2479,21 @@ static Scheme_Object *places_serialize(Scheme_Object *so, void **msg_memory, Sch new_so = trivial_copy(so, NULL); if (new_so) return new_so; - GC_create_message_allocator(); - new_so = do_places_deep_copy(so, mzPDC_COPY, 0, master_chain, invalid_object); - tmp = GC_finish_message_allocator(); - (*msg_memory) = tmp; + while (1) { + GC_create_message_allocator(); + new_so = do_places_deep_copy(so, mzPDC_COPY, 0, master_chain, invalid_object); + tmp = GC_finish_message_allocator(); + (*msg_memory) = tmp; + + if (!new_so && SCHEME_CHAPERONEP(*invalid_object)) { + /* try again after removing chaperones */ + so = strip_chaperones(so); + if (!so) + break; + } else + break; + } + return new_so; #else return so; @@ -2477,11 +2574,20 @@ Scheme_Object *place_receive(int argc, Scheme_Object *args[]) { static Scheme_Object* place_allowed_p(int argc, Scheme_Object *args[]) { Scheme_Hash_Table *ht = NULL; - - if (places_deep_copy_worker(args[0], &ht, mzPDC_CHECK, 1, 0, NULL, NULL)) + Scheme_Object *v, *invalid_object = NULL; + + v = args[0]; + + if (places_deep_copy_worker(v, &ht, mzPDC_CHECK, 1, 0, NULL, &invalid_object)) return scheme_true; - else + else { + if (invalid_object && SCHEME_CHAPERONEP(invalid_object)) { + v = strip_chaperones(v); + if (v && places_deep_copy_worker(v, &ht, mzPDC_CHECK, 1, 0, NULL, NULL)) + return scheme_true; + } return scheme_false; + } } # ifdef MZ_PRECISE_GC diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 3237b88a5b..8f3e1b2498 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3746,6 +3746,10 @@ Scheme_Object *scheme_check_assign_not_undefined (int argc, Scheme_Object *argv[ Scheme_Object *scheme_chaperone_vector_copy(Scheme_Object *obj); Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj); +typedef Scheme_Object *(*Hash_Table_Element_Filter_Proc)(Scheme_Object *); +Scheme_Object *scheme_chaperone_hash_table_filtered_copy(Scheme_Object *obj, + Hash_Table_Element_Filter_Proc filter); + void scheme_bad_vec_index(char *name, Scheme_Object *i, const char *what, Scheme_Object *vec, intptr_t bottom, intptr_t len);