fix (more) closure type tracking for a procedure with only an unused rest arg

Fixs the repair in fe12a32dc3

Relevant to PR 14259
This commit is contained in:
Matthew Flatt 2014-01-07 10:21:38 -07:00
parent 331825700b
commit 4fe1673475
2 changed files with 27 additions and 0 deletions

View File

@ -3207,6 +3207,22 @@
;; Should succeed, as opposed to a validation error:
(eval (read (open-input-bytes (get-output-bytes o))))))
(parameterize ([current-namespace (make-base-namespace)]
[read-on-demand-source #f]
[read-accept-compiled #t])
(let ([o (open-output-bytes)])
(write (compile '(module m racket/base
(require racket/fixnum)
(define ident (lambda (x) x))
(set! ident ident)
(define app (lambda (f) (f)))
(set! app app)
(let ([n (fxmax (length '()) 1)])
(app (lambda _ (ident n))))))
o)
;; Should succeed, as opposed to a validation error:
(eval (read (open-input-bytes (get-output-bytes o))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check interaciton of 3-D macros, non-empty closures, JIT, and bytecode:

View File

@ -1690,11 +1690,21 @@ static mzshort *allocate_boxmap(int n)
}
void scheme_boxmap_set(mzshort *boxmap, int j, int bit, int delta)
/* assumes that existing bits are cleared */
{
j *= CLOS_TYPE_BITS_PER_ARG;
boxmap[delta + (j / BITS_PER_MZSHORT)] |= ((mzshort)bit << (j & (BITS_PER_MZSHORT - 1)));
}
static void boxmap_clear(mzshort *boxmap, int j, int delta)
{
mzshort v;
j *= CLOS_TYPE_BITS_PER_ARG;
v = boxmap[delta + (j / BITS_PER_MZSHORT)];
v ^= (v & ((mzshort)(((1 << CLOS_TYPE_BITS_PER_ARG) - 1) << (j & (BITS_PER_MZSHORT - 1)))));
boxmap[delta + (j / BITS_PER_MZSHORT)] = v;
}
int scheme_boxmap_get(mzshort *boxmap, int j, int delta)
{
j *= CLOS_TYPE_BITS_PER_ARG;
@ -2020,6 +2030,7 @@ resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info,
if (expanded_already) {
/* shift type map down: */
for (i = 0; i < closure_size; i++) {
boxmap_clear(closure_map, i, closure_size);
scheme_boxmap_set(closure_map, i, scheme_boxmap_get(closure_map, i + 1, closure_size), closure_size);
}
SCHEME_CLOSURE_DATA_FLAGS(data) |= CLOS_HAS_TYPED_ARGS;