fix for bytecode validator
Fix tchecking for a rest argument to a function that is lifted by closure conversion so that one of its arguments is a mutable local variable's location. Also reject bytecode that would pass too many arguments to a lifted function, since that would trigger an arity error that might try to use a location as a value. Merge to v5.3
This commit is contained in:
parent
b208a104ec
commit
9d6f0e96ba
|
@ -2123,6 +2123,26 @@
|
||||||
(parse-string "()"))
|
(parse-string "()"))
|
||||||
(err/rt-test (do-test-of-lift-fixpoint) exn:fail?)
|
(err/rt-test (do-test-of-lift-fixpoint) exn:fail?)
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; generate byecode with a lifted function that has
|
||||||
|
;; a boxed argument and rest args, to test that case
|
||||||
|
;; of the validator
|
||||||
|
|
||||||
|
(parameterize ([current-namespace (make-base-namespace)])
|
||||||
|
(define o (open-output-bytes))
|
||||||
|
(write
|
||||||
|
(compile
|
||||||
|
'(lambda (x)
|
||||||
|
(define (g . y) (if (zero? (random 1))
|
||||||
|
(reverse (cons x y))
|
||||||
|
(g y y y y y y y y y)))
|
||||||
|
(set! x x)
|
||||||
|
(g 12 13)))
|
||||||
|
o)
|
||||||
|
(test '(13 12 10)
|
||||||
|
(parameterize ([read-accept-compiled #t])
|
||||||
|
(eval (read (open-input-bytes (get-output-bytes o)))))
|
||||||
|
10))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
|
@ -242,8 +242,9 @@ static void define_values_validate(Scheme_Object *data, Mz_CPort *port,
|
||||||
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
|
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
|
||||||
int sz;
|
int sz;
|
||||||
sz = data->num_params;
|
sz = data->num_params;
|
||||||
new_a = MALLOC_N_ATOMIC(mzshort, (sz + 1));
|
new_a = MALLOC_N_ATOMIC(mzshort, (sz + 2));
|
||||||
new_a[0] = -sz;
|
new_a[0] = -sz;
|
||||||
|
new_a[sz+1] = !!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST);
|
||||||
for (i = 0; i < sz; i++) {
|
for (i = 0; i < sz; i++) {
|
||||||
int bit = ((mzshort)1 << ((2 * i) & (BITS_PER_MZSHORT - 1)));
|
int bit = ((mzshort)1 << ((2 * i) & (BITS_PER_MZSHORT - 1)));
|
||||||
if (data->closure_map[data->closure_size + ((2 * i) / BITS_PER_MZSHORT)] & bit)
|
if (data->closure_map[data->closure_size + ((2 * i) / BITS_PER_MZSHORT)] & bit)
|
||||||
|
@ -623,7 +624,11 @@ int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
|
||||||
/* try again */
|
/* try again */
|
||||||
p = a[1];
|
p = a[1];
|
||||||
} else {
|
} else {
|
||||||
return a[pos + 1];
|
if (pos >= -a[0]) {
|
||||||
|
/* last slot indicates whether rest args are allowed */
|
||||||
|
return (a[-a[0]+1] ? hope : !hope);
|
||||||
|
} else
|
||||||
|
return a[pos + 1];
|
||||||
}
|
}
|
||||||
} else
|
} else
|
||||||
return 0;
|
return 0;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user