adjust module name resolve to use cc-marks less

Use `continuation-mark-set-first', instead.
Also, re-enable bytecode for Racket code that is built into
the binary, which had been left disabled accidentally.
This commit is contained in:
Matthew Flatt 2011-09-14 14:52:05 -06:00
parent 7315bfa554
commit 3b077078de
4 changed files with 515 additions and 509 deletions

File diff suppressed because it is too large Load Diff

View File

@ -11,7 +11,7 @@
EXPECTED_PRIM_COUNT to the new value, and then USE_COMPILED_STARTUP
can be set to 1 again. */
#define USE_COMPILED_STARTUP 0
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1034
#define EXPECTED_UNSAFE_COUNT 78

View File

@ -960,12 +960,14 @@
"(when load?"
"(let((got(hash-ref ht modname #f)))"
"(unless got"
"(let((l(let((tag(if(continuation-prompt-available? -loading-prompt-tag)"
"(let((loading"
"(let((tag(if(continuation-prompt-available? -loading-prompt-tag)"
" -loading-prompt-tag"
"(default-continuation-prompt-tag))))"
"(continuation-mark-set->list"
"(current-continuation-marks tag)"
"(continuation-mark-set-first"
" #f"
" -loading-filename"
" null"
" tag)))"
"(nsr(namespace-module-registry(current-namespace))))"
"(for-each"
@ -976,19 +978,20 @@
" 'standard-module-name-resolver"
" \"cycle in loading at ~.s: ~.s\""
" filename"
"(map cdr(reverse(cons s l))))))"
" l))"
"(map cdr(reverse(cons s loading))))))"
" loading)"
"((if(continuation-prompt-available? -loading-prompt-tag)"
"(lambda(f)(f))"
"(lambda(f)(call-with-continuation-prompt f -loading-prompt-tag)))"
"(lambda()"
"(with-continuation-mark -loading-filename(cons "
"(with-continuation-mark -loading-filename(cons(cons "
"(namespace-module-registry(current-namespace))"
" normal-filename)"
" loading)"
"(parameterize((current-module-declare-name modname))"
"((current-load/use-compiled) "
" filename "
"(string->symbol(path->string no-sfx)))))))"
"(string->symbol(path->string no-sfx))))))))"
"(hash-set! ht modname #t))))"
"(when(and(not(vector? s-parsed))"
"(or(string? s)"

View File

@ -1092,13 +1092,15 @@
(let ([got (hash-ref ht modname #f)])
(unless got
;; Currently loading?
(let ([l (let ([tag (if (continuation-prompt-available? -loading-prompt-tag)
-loading-prompt-tag
(default-continuation-prompt-tag))])
(continuation-mark-set->list
(current-continuation-marks tag)
-loading-filename
tag))]
(let ([loading
(let ([tag (if (continuation-prompt-available? -loading-prompt-tag)
-loading-prompt-tag
(default-continuation-prompt-tag))])
(continuation-mark-set-first
#f
-loading-filename
null
tag))]
[nsr (namespace-module-registry (current-namespace))])
(for-each
(lambda (s)
@ -1108,19 +1110,20 @@
'standard-module-name-resolver
"cycle in loading at ~.s: ~.s"
filename
(map cdr (reverse (cons s l))))))
l))
((if (continuation-prompt-available? -loading-prompt-tag)
(lambda (f) (f))
(lambda (f) (call-with-continuation-prompt f -loading-prompt-tag)))
(lambda ()
(with-continuation-mark -loading-filename (cons
(namespace-module-registry (current-namespace))
normal-filename)
(parameterize ([current-module-declare-name modname])
((current-load/use-compiled)
filename
(string->symbol (path->string no-sfx)))))))
(map cdr (reverse (cons s loading))))))
loading)
((if (continuation-prompt-available? -loading-prompt-tag)
(lambda (f) (f))
(lambda (f) (call-with-continuation-prompt f -loading-prompt-tag)))
(lambda ()
(with-continuation-mark -loading-filename (cons (cons
(namespace-module-registry (current-namespace))
normal-filename)
loading)
(parameterize ([current-module-declare-name modname])
((current-load/use-compiled)
filename
(string->symbol (path->string no-sfx))))))))
(hash-set! ht modname #t))))
;; If a `lib' path, cache pathname manipulations
(when (and (not (vector? s-parsed))