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

fix bytecode validator bug

Browse Source 
If a function is bound by a `letrec' (or internal definition)
that cannot be simplified to `let' or lifted to a constant or
top-/module-level function, and if the `letrec' binding is used in
a non-application position, and if the function has in its closure
a typed binding (i.e., boxed, fixnum, flonum, or extflonum),
then the validator was incorrectly rejecting the function's
bytecode --- because the validator didn't distinguish between typed
arguments and typed closure content.

File under "surprised that we didn't hit this one earlier".
This commit is contained in:
Matthew Flatt 2013-05-03 08:29:32 -06:00
parent e278d43e22
commit 717eacf90d
2 changed files with 36 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/tests/racket/optimize.rktl
View File

@ -3124,6 +3124,27 @@
(if (<= y x) (* x y) '-))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure that a procedure used in a first-order
;; way bound by `letrec' can have a typed closure element:
(let ([e `(module m racket/base
(provide f)
(define (f v)
(let ([y (vector-length v)])
(letrec ([foo (lambda (r)
(if (zero? r)
y
(foo (sub1 r))))])
foo))))]
[o (open-output-bytes)])
(write (compile e) o)
(parameterize ([current-namespace (make-base-namespace)])
(eval
(parameterize ([read-accept-compiled #t])
(read (open-input-bytes (get-output-bytes o)))))
(((dynamic-require ''m 'f) (vector 1)) 0)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

19
src/racket/src/validate.c
View File

@ -1812,6 +1812,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
case scheme_letrec_type:
{
Scheme_Letrec *l = (Scheme_Letrec *)expr;
Scheme_Closure_Data *data;
int i, c;
c = l->count;
@ -1830,10 +1831,20 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
scheme_ill_formed_code(port);
#endif
stack[delta + i] = VALID_VAL;
if (SCHEME_CLOSURE_DATA_FLAGS(((Scheme_Closure_Data *)l->procs[i])) & CLOS_HAS_TYPED_ARGS) {
procs = scheme_hash_tree_set(as_nonempty_procs(procs),
scheme_make_integer(delta + i),
l->procs[i]);
data = (Scheme_Closure_Data *)l->procs[i];
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_TYPED_ARGS) {
/* If any arguments (as opposed to closure slots) are typed, then
add the procedure to `procs': */
int j;
for (j = data->num_params; j--; ) {
if (scheme_boxmap_get(data->closure_map, j, data->closure_size))
break;
}
if (j >= 0) {
procs = scheme_hash_tree_set(as_nonempty_procs(procs),
scheme_make_integer(delta + i),
l->procs[i]);
}
}
}