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:
Matthew Flatt 2012-07-26 16:31:17 -06:00
parent b208a104ec
commit 9d6f0e96ba
2 changed files with 27 additions and 2 deletions

View File

@ -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))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -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,6 +624,10 @@ int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
/* try again */ /* try again */
p = a[1]; p = a[1];
} else { } else {
if (pos >= -a[0]) {
/* last slot indicates whether rest args are allowed */
return (a[-a[0]+1] ? hope : !hope);
} else
return a[pos + 1]; return a[pos + 1];
} }
} else } else