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

fix verifier for optimizer-introduced raise-arity-error on a closure converted to accept a mutable variable reference

Browse Source 
svn: r3944
This commit is contained in:
Matthew Flatt 2006-08-03 20:02:24 +00:00
parent 931d214b69
commit 24880e18a4
2 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/mzscheme/optimize.ss
View File

@ -402,4 +402,31 @@
(f y))
'11)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check bytecode verification of lifted functions
(let ([check
(lambda (expr)
(let-values ([(r w) (make-pipe)])
(write (compile expr) w)
(parameterize ([read-accept-compiled #t])
(read r))))])
(check '(module m mzscheme
(provide f)
(define (f x)
(let loop ([n 0])
(set! x (+ n 1)) ; close over mutated variable
(loop n #f)
(loop n)))))
(check '(module m mzscheme
(provide f)
(define s (make-string 10))
(define (f x)
(let loop ([n 0])
(set! x (+ n 1)) ; close over mutated variable
(loop n s) ; and refer to global
(loop n))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

15
src/mzscheme/src/eval.c
View File

@ -7514,6 +7514,15 @@ int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
return 0;
}
static int argument_to_arity_error(Scheme_Object *app_rator, int proc_with_refs_ok)
{
/* Since `raise-arity-error' doesn't actually apply its argument,
it's ok to pass any procedure. In particular, the compiler generates
calls to converted procedures. */
return ((proc_with_refs_ok == 2)
&& SAME_OBJ(app_rator, scheme_raise_arity_error_proc));
}
void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
char *stack, Scheme_Hash_Table *ht, Scheme_Object **tls,
int depth, int letlimit, int delta,
@ -7585,7 +7594,8 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
|| (num_stxes && (p == num_toplevels)))
scheme_ill_formed_code(port);
if (proc_with_refs_ok != 1) {
if ((proc_with_refs_ok != 1)
&& !argument_to_arity_error(app_rator, proc_with_refs_ok)) {
if (p >= (num_toplevels + num_stxes + (num_stxes ? 1 : 0))) {
/* It's a lift. Check that the lift is defined, and that it
doesn't want reference arguments. */
@ -7778,7 +7788,8 @@ void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr,
char *new_stack;
if (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REF_ARGS) {
if (proc_with_refs_ok != 1)
if ((proc_with_refs_ok != 1)
&& !argument_to_arity_error(app_rator, proc_with_refs_ok))
scheme_ill_formed_code(port);
}