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

fix places & executable interaction

Browse Source 
Added `module-predefined?' and changed `racket -k ...'
This commit is contained in:
Matthew Flatt 2011-11-15 13:53:09 -07:00
parent be996fc4db
commit 3bffcae3c2
20 changed files with 619 additions and 488 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/compiler/embed-unit.rkt
View File

@ -799,7 +799,7 @@
;; into an executable). The bundle is written to the current output port.
(define (do-write-module-bundle outp verbose? modules config? literal-files literal-expressions collects-dest
on-extension program-name compiler expand-namespace
src-filter get-extra-imports)
src-filter get-extra-imports on-decls-done)
(let* ([module-paths (map cadr modules)]
[resolve-one-path (lambda (mp)
(let ([f (resolve-module-path mp #f)])
@ -998,6 +998,7 @@
;; Remove `module' binding before we start running user code:
(write (compile-using-kernel '(namespace-set-variable-value! 'module #f #t)) outp)
(write (compile-using-kernel '(namespace-undefine-variable! 'module)) outp)
(on-decls-done outp)
(newline outp)
(when config-infos
(for ([config-info (in-list config-infos)])
@ -1032,7 +1033,8 @@
on-extension
"?" ; program-name
compiler expand-namespace
src-filter get-extra-imports))
src-filter get-extra-imports
void))
;; The old interface:
@ -1175,6 +1177,7 @@
(update-dll-dir dest (build-path orig-dir dir))))))))
(let ([write-module
(lambda (s)
(define pos #f)
(do-write-module-bundle s
verbose? modules config? literal-files literal-expressions collects-dest
on-extension
@ -1182,11 +1185,14 @@
compiler
expand-namespace
src-filter
get-extra-imports))]
get-extra-imports
(lambda (outp) (set! pos (file-position outp))))
pos)]
[make-full-cmdline
(lambda (start end)
(lambda (start decl-end end)
(let ([start-s (number->string start)]
[end-s (number->string end)])
[decl-end-s (number->string decl-end)]
[end-s (number->string end)])
(append (if launcher?
(if (and (eq? 'windows (system-type))
keep-exe?)
@ -1197,7 +1203,7 @@
exe)))
;; No argv[0]:
null)
(list "-k" start-s end-s))
(list "-k" start-s decl-end-s end-s))
cmdline)))]
[make-starter-cmdline
(lambda (full-cmdline)
@ -1219,20 +1225,21 @@
dir)
"")))
full-cmdline))))])
(let-values ([(start end cmdline-end)
(let-values ([(start decl-end end cmdline-end)
(if (and (eq? (system-type) 'macosx)
(not unix-starter?))
;; For Mach-O, we know how to add a proper segment
(let ([s (open-output-bytes)])
(write-module s)
(define decl-len (write-module s))
(let ([s (get-output-bytes s)])
(let ([start (add-plt-segment dest-exe s)])
(values start
(+ start decl-len)
(+ start (bytes-length s))
#f))))
;; Unix starter: Maybe ELF, in which case we
;; can add a proper section
(let-values ([(s e p)
(let-values ([(s e dl p)
(if unix-starter?
(add-racket-section
orig-exe
@ -1240,25 +1247,28 @@
(if launcher? #".rackcmdl" #".rackprog")
(lambda (start)
(let ([s (open-output-bytes)])
(write-module s)
(define decl-len (write-module s))
(let ([p (file-position s)])
(display (make-starter-cmdline
(make-full-cmdline start (+ start p)))
(make-full-cmdline start
(+ start decl-len)
(+ start p)))
s)
(values (get-output-bytes s) p)))))
(values #f #f #f))])
(values (get-output-bytes s) decl-len p)))))
(values #f #f #f #f))])
(if (and s e)
;; ELF succeeded:
(values s (+ s p) e)
(values s (+ s dl) (+ s p) e)
;; Otherwise, just add to the end of the file:
(let ([start (file-size dest-exe)])
(call-with-output-file* dest-exe write-module
#:exists 'append)
(values start (file-size dest-exe) #f)))))])
(define decl-end
(call-with-output-file* dest-exe write-module
#:exists 'append))
(values start decl-end (file-size dest-exe) #f)))))])
(when verbose?
(fprintf (current-error-port) "Setting command line\n"))
(let ()
(let ([full-cmdline (make-full-cmdline start end)])
(let ([full-cmdline (make-full-cmdline start decl-end end)])
(when collects-path-bytes
(when verbose?
(fprintf (current-error-port) "Setting collection path\n"))
@ -1298,6 +1308,7 @@
(file-position out (+ numpos 7))
(write-bytes #"!" out)
(write-num start)
(write-num decl-end)
(write-num end)
(write-num cmdline-end)
(write-num (length full-cmdline))

4
collects/compiler/private/elf.rkt
View File

@ -203,7 +203,7 @@
new-str-pos new-str-delta)
(values new-str-pos new-str-delta
new-sec-pos new-sec-delta))]
[(data mid) (get-data (+ total-size new-str-delta new-sec-delta))])
[(data decl-len mid) (get-data (+ total-size new-str-delta new-sec-delta))])
(call-with-output-file*
dest-file
#:exists 'truncate
@ -313,4 +313,4 @@
(file-position out dest)
(write-bytes data out)
(values dest (+ dest (bytes-length data)) mid))))))))))))
(values dest (+ dest (bytes-length data)) decl-len mid))))))))))))

12
collects/racket/place.rkt
View File

@ -182,8 +182,9 @@
(raise-type-error who "output-port or #f" out))
(unless (or (not err) (output-port? err) (eq? err 'stdout))
(raise-type-error who "output-port, #f, or 'stdout" err))
(when (and (pair? module-path) (eq? (car module-path) 'quote))
(raise-mismatch-error who "not a filesystem module-path: " module-path))
(when (and (pair? module-path) (eq? (car module-path) 'quote)
(not (module-predefined? module-path)))
(raise-mismatch-error who "not a filesystem or predefined module-path: " module-path))
(when (and (input-port? in) (port-closed? in))
(raise-mismatch-error who "input port is closed: " in))
(when (and (output-port? out) (port-closed? out))
@ -261,6 +262,7 @@
(resolved-module-path-name
(variable-reference->resolved-module-path
vr)))
(when (symbol? name)
(error who "the current module-path-name is not a file path"))
(start-place-func who name func-name in out err))
(when (and (symbol? name)
(not (module-predefined? `(quote ,name))))
(error who "the enclosing module's resolved name is not a path or predefined"))
(start-place-func who (if (symbol? name) `(quote ,name) name) func-name in out err))

13
collects/scribblings/reference/module-reflect.scrbl
View File

@ -1,5 +1,6 @@
#lang scribble/doc
@(require "mz.rkt")
@(require "mz.rkt"
(for-label compiler/embed))
@title{Module Names and Loading}
@ -417,3 +418,13 @@ Like @racket[module-compiled-imports], but produces the imports of
Like @racket[module-compiled-exports], but produces the exports of
@racket[mod], which must be declared (but not necessarily
@tech{instantiate}d or @tech{visit}ed) in the current namespace.}
@defproc[(module-predefined?
[mod (or/c module-path? path? resolved-module-path?)])
boolean?]{
Reports whether @racket[mod] refers to a module that is predefined for
the running Racket instance. Predefined modules always have a symbolic
resolved module path, and they may be predefined always or
specifically within a particular executable (such as one created by
@exec{raco exe} or @racket[create-embedding-executable]).}

6
collects/scribblings/reference/places.scrbl
View File

@ -148,7 +148,11 @@ are simulated using @racket[thread].}
place. If the output ports are @tech{file-stream ports}, then the
connected ports in the places share the underlying stream, otherwise
a @tech{thread} in the creating place pumps bytes to the current
ports in the creating place.}
ports in the creating place.
The @racket[module-path] argument must not be a module path of the
form @racket[(#,(racket quote) _sym)] unless the module is predefined (see
@racket[module-predefined?]).}
@defproc[(dynamic-place* [module-path (or/c module-path? path?)]

12
collects/scribblings/reference/startup.scrbl
View File

@ -166,10 +166,14 @@ flags:
all further command-line elements to be treated as non-flag
arguments.}
@item{@FlagFirst{k} @nonterm{n} @nonterm{m} : Loads code embedded in
the executable from file position @nonterm{n} to
@nonterm{m}. This option is normally embedded in a stand-alone
binary that also embeds Racket code.}
@item{@FlagFirst{k} @nonterm{n} @nonterm{m} @nonterm{p} : Loads code
embedded in the executable from file position @nonterm{n} to
@nonterm{m} and from @nonterm{m} to @nonterm{p}. The first
range is loaded in every new @tech{place}, and any modules
declared in that range are considered predefined in the sense
of @racket[module-predefined?]. This option is normally
embedded in a stand-alone binary that also embeds Racket
code.}
@item{@FlagFirst{m} or @DFlagFirst{main} : Evaluates a call to
@racketidfont{main} as bound in the top-level environment. All

6
doc/release-notes/racket/HISTORY.txt
View File

@ -1,4 +1,8 @@
Version 5.2.2
Version 5.2.0.3
Added module-predefined?
Changed the raacket -k command-line flag
Version 5.2.0.2
Added port-closed-evt
Changed I/O scheduling to use epoll()/kqueue() when available

29
src/racket/cmdline.inc
View File

@ -142,6 +142,7 @@ enum {
mzcmd_REQUIRE_LIB = 4,
mzcmd_REQUIRE_PLANET = 5,
mzcmd_EMBEDDED = 6,
mzcmd_EMBEDDED_REG = 7,
};
/* To avoid having to create a specific mark procedure for
@ -283,7 +284,8 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
|| (fa->eval_kind[i] == mzcmd_REQUIRE_FILE)
|| (fa->eval_kind[i] == mzcmd_REQUIRE_LIB)
|| (fa->eval_kind[i] == mzcmd_REQUIRE_PLANET)
|| (fa->eval_kind[i] == mzcmd_EMBEDDED)) {
|| (fa->eval_kind[i] == mzcmd_EMBEDDED)
|| (fa->eval_kind[i] == mzcmd_EMBEDDED_REG)) {
Scheme_Thread * volatile p;
p = scheme_get_current_thread();
save = p->error_buf;
@ -295,15 +297,11 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
} else if (fa->eval_kind[i] == mzcmd_LOAD) {
/* eval from stdin */
scheme_eval_all_with_prompt(NULL, fa->global_env, 2);
} else if (fa->eval_kind[i] == mzcmd_EMBEDDED_REG) {
scheme_register_embedded_load(fa->evals_and_loads[i]);
scheme_embedded_load(fa->evals_and_loads[i], 1);
} else if (fa->eval_kind[i] == mzcmd_EMBEDDED) {
Scheme_Object *s, *e, *a[3], *eload;
eload = scheme_builtin_value("embedded-load");
s = scheme_make_utf8_string(fa->evals_and_loads[i]);
e = scheme_make_utf8_string(fa->evals_and_loads[i] + strlen(fa->evals_and_loads[i]) + 1);
a[0] = s;
a[1] = e;
a[2] = scheme_make_false();
scheme_apply(eload, 3, a);
scheme_embedded_load(fa->evals_and_loads[i], 0);
} else {
Scheme_Object *a[1], *nsreq;
char *name;
@ -990,11 +988,11 @@ static int run_from_cmd_line(int argc, char *_argv[],
if (!init_ns)
no_init_ns = 1;
break;
case 'k':
if (argc < 3) {
case 'k':
if (argc < 4) {
PRINTF("%s: missing %s after %s switch\n",
prog,
(argc < 2) ? "starting and ending offsets" : "ending offset",
(argc < 2) ? "starting and ending offsets" : "second ending offset",
real_switch);
goto show_need_help;
}
@ -1004,6 +1002,11 @@ static int run_from_cmd_line(int argc, char *_argv[],
evals_and_loads[num_enl] = se;
argv++;
--argc;
eval_kind[num_enl++] = mzcmd_EMBEDDED_REG;
se = make_embedded_load(argv[0], argv[1]);
evals_and_loads[num_enl] = se;
argv++;
--argc;
eval_kind[num_enl++] = mzcmd_EMBEDDED;
break;
case 'N':
@ -1348,7 +1351,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
" -p <package> : Like -e '(require (planet \"<package>\")'\n"
" -r <file>, --script <file> : Same as -f <file> -N <file> --\n"
" -u <file>, --require-script <file> : Same as -t <file> -N <file> --\n"
" -k <n> <m> : Load executable-embedded code from file offset <n> to <m>\n"
" -k <n> <m> <p> : Load executable-embedded code from offset <n> to <p>\n"
" -m, --main : Call `main' with command-line arguments, print results\n"
" Interaction options:\n"
" -i, --repl : Run interactive read-eval-print loop; implies -v\n"

30
src/racket/dynsrc/ustart.c
View File

@ -16,7 +16,8 @@
of little-endian 4-byte ints:
start - offset into the binary
prog_end - offset; start to prog_end is the program region
end - offset; prog_end to end is the command region
decl_end - offset; prog_end to decl_end is the module-command region
end - offset; prog_end to end is the complete command region
count - number of cmdline args in command region
x11? - non-zero => launches GRacket for X
@ -25,10 +26,10 @@
dll_path - DLL directory if non-empty (relative is w.r.t. executable)
cmdline_arg ...
For ELF binaries, the absolute values of `start', `prog_end', and
`end' are ignored if a ".rackcmdl" (starter) or ".rackprog"
For ELF binaries, the absolute values of `start', `decl_end', `prog_end',
and `end' are ignored if a ".rackcmdl" (starter) or ".rackprog"
(embedding) section is found. The `start' value is set to match the
section offset, and `prog_end' and `end' are correspondingly
section offset, and `decl_end', `prog_end', and `end' are correspondingly
adjusted. Using a seciton offset allows linking tools (such as
`strip') to move the data in the executable.
*/
@ -266,7 +267,7 @@ typedef struct
ELF__Xword sh_entsize;
} Elf__Shdr;
static int try_elf_section(const char *me, int *_start, int *_prog_end, int *_end)
static int try_elf_section(const char *me, int *_start, int *_decl_end, int *_prog_end, int *_end)
{
int fd, i;
ELF__Header e;
@ -303,6 +304,7 @@ static int try_elf_section(const char *me, int *_start, int *_prog_end, int *_en
}
if (!strcmp(strs + s.sh_name, ".rackcmdl")
|| !strcmp(strs + s.sh_name, ".rackprog")) {
*_decl_end = (*_decl_end - *_start) + s.sh_offset;
*_prog_end = (*_prog_end - *_start) + s.sh_offset;
*_start = s.sh_offset;
*_end = s.sh_offset + s.sh_size;
@ -321,7 +323,7 @@ int main(int argc, char **argv)
{
char *me = argv[0], *data, **new_argv;
char *exe_path, *lib_path, *dll_path;
int start, prog_end, end, count, fd, v, en, x11;
int start, decl_end, prog_end, end, count, fd, v, en, x11;
int argpos, inpos, collcount = 1, fix_argv;
if (config[7] == '[') {
@ -401,12 +403,13 @@ int main(int argc, char **argv)
}
start = as_int(config + 8);
prog_end = as_int(config + 12);
end = as_int(config + 16);
count = as_int(config + 20);
x11 = as_int(config + 24);
decl_end = as_int(config + 12);
prog_end = as_int(config + 16);
end = as_int(config + 20);
count = as_int(config + 24);
x11 = as_int(config + 28);
fix_argv = try_elf_section(me, &start, &prog_end, &end);
fix_argv = try_elf_section(me, &start, &decl_end, &prog_end, &end);
{
int offset, len;
@ -503,7 +506,7 @@ int main(int argc, char **argv)
if (fix_argv) {
/* next three args are "-k" and numbers; fix
the numbers to match start and prog_end */
the numbers to match start, decl_end, and prog_end */
fix_argv = argpos + 1;
}
@ -522,7 +525,8 @@ int main(int argc, char **argv)
if (fix_argv) {
new_argv[fix_argv] = num_to_string(start);
new_argv[fix_argv+1] = num_to_string(prog_end);
new_argv[fix_argv+1] = num_to_string(decl_end);
new_argv[fix_argv+2] = num_to_string(prog_end);
}
/* Execute the original binary: */

2
src/racket/include/scheme.h
View File

@ -1772,6 +1772,8 @@ XFORM_NONGCING MZ_EXTERN intptr_t scheme_get_multiple_count();
XFORM_NONGCING MZ_EXTERN Scheme_Object **scheme_get_multiple_array();
XFORM_NONGCING MZ_EXTERN void scheme_set_current_thread_ran_some();
MZ_EXTERN void scheme_embedded_load(const char *s, int predefined);
MZ_EXTERN void scheme_register_embedded_load(const char *s);
/* Set these global hooks (optionally): */
typedef void (*Scheme_Exit_Proc)(int v);

2
src/racket/include/schthread.h
View File

@ -123,6 +123,7 @@ typedef struct Thread_Local_Variables {
uintptr_t GC_gen0_alloc_page_end_;
int GC_gen0_alloc_only_;
uintptr_t force_gc_for_place_accounting_;
int scheme_starting_up_;
void *bignum_cache_[BIGNUM_CACHE_SIZE];
int cache_count_;
struct Scheme_Hash_Table *toplevels_ht_;
@ -469,6 +470,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define GC_gen0_alloc_only XOA (scheme_get_thread_local_variables()->GC_gen0_alloc_only_)
#define GC_variable_stack XOA (scheme_get_thread_local_variables()->GC_variable_stack_)
#define force_gc_for_place_accounting XOA (scheme_get_thread_local_variables()->force_gc_for_place_accounting_)
#define scheme_starting_up XOA (scheme_get_thread_local_variables()->scheme_starting_up_)
#define bignum_cache XOA (scheme_get_thread_local_variables()->bignum_cache_)
#define cache_count XOA (scheme_get_thread_local_variables()->cache_count_)
#define toplevels_ht XOA (scheme_get_thread_local_variables()->toplevels_ht_)

824
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

5
src/racket/src/env.c
View File

@ -43,7 +43,7 @@
SHARED_OK int scheme_allow_set_undefined;
void scheme_set_allow_set_undefined(int v) { scheme_allow_set_undefined = v; }
int scheme_get_allow_set_undefined() { return scheme_allow_set_undefined; }
SHARED_OK int scheme_starting_up;
THREAD_LOCAL_DECL(int scheme_starting_up);
/* globals READ-ONLY SHARED */
Scheme_Object *scheme_varref_const_p_proc;
@ -489,13 +489,14 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
scheme_init_foreign(env);
scheme_starting_up = 1; /* in case it's not set already */
scheme_add_embedded_builtins(env);
boot_module_resolver();
scheme_save_initial_module_set(env);
scheme_starting_up = 0;
--scheme_current_thread->suspend_break; /* created with breaks suspended */

16
src/racket/src/eval.c
View File

@ -5078,6 +5078,22 @@ Scheme_Object *scheme_eval_string_multi_with_prompt(const char *str, Scheme_Env
return do_eval_string_all(NULL, str, env, 0, 1);
}
void scheme_embedded_load(const char *desc, int predefined)
{
Scheme_Object *s, *e, *a[3], *eload;
eload = scheme_builtin_value("embedded-load");
s = scheme_make_utf8_string(desc);
e = scheme_make_utf8_string(desc XFORM_OK_PLUS strlen(desc) XFORM_OK_PLUS 1);
a[0] = s;
a[1] = e;
a[2] = scheme_false;
if (predefined)
scheme_starting_up = 1;
(void)scheme_apply(eload, 3, a);
if (predefined)
scheme_starting_up = 0;
}
void scheme_init_collection_paths_post(Scheme_Env *global_env, Scheme_Object *extra_dirs, Scheme_Object *post_dirs)
{
mz_jmp_buf * volatile save, newbuf;

1
src/racket/src/marshal.c
View File

@ -1326,6 +1326,7 @@ static Scheme_Object *read_module(Scheme_Object *obj)
m = MALLOC_ONE_TAGGED(Scheme_Module);
m->so.type = scheme_module_type;
m->predefined = scheme_starting_up;
me = scheme_make_module_exports();
m->me = me;

35
src/racket/src/module.c
View File

@ -63,6 +63,7 @@ static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_to_lang_info(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_to_imports(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_to_exports(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_is_predefined(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_path_index_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *module_path_index_resolve(int argc, Scheme_Object *argv[]);
@ -408,6 +409,7 @@ void scheme_init_module(Scheme_Env *env)
GLOBAL_PRIM_W_ARITY("module->language-info", module_to_lang_info, 1, 2, env);
GLOBAL_PRIM_W_ARITY("module->imports", module_to_imports, 1, 1, env);
GLOBAL_PRIM_W_ARITY2("module->exports", module_to_exports, 1, 1, 2, 2, env);
GLOBAL_PRIM_W_ARITY("module-predefined?", module_is_predefined, 1, 1, env);
GLOBAL_PRIM_W_ARITY("module-path?", is_module_path, 1, 1, env);
}
@ -458,6 +460,7 @@ void scheme_finish_kernel(Scheme_Env *env)
kernel = MALLOC_ONE_TAGGED(Scheme_Module);
kernel->so.type = scheme_module_type;
kernel->predefined = 1;
env->module = kernel;
{
@ -2739,7 +2742,7 @@ static Scheme_Object *module_to_namespace(int argc, Scheme_Object *argv[])
return scheme_module_to_namespace(argv[0], env);
}
static Scheme_Module *module_to_(const char *who, int argc, Scheme_Object *argv[])
static Scheme_Module *module_to_(const char *who, int argc, Scheme_Object *argv[], int unknown_ok)
{
Scheme_Env *env;
Scheme_Object *name;
@ -2764,7 +2767,7 @@ static Scheme_Module *module_to_(const char *who, int argc, Scheme_Object *argv[
m = (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name);
}
if (!m)
if (!m && !unknown_ok)
scheme_arg_mismatch(who,
"unknown module in the current namespace: ",
name);
@ -2776,11 +2779,31 @@ static Scheme_Object *module_to_lang_info(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;
m = module_to_("module->language-info", argc, argv);
m = module_to_("module->language-info", argc, argv, 0);
return (m->lang_info ? m->lang_info : scheme_false);
}
static Scheme_Object *module_is_predefined(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;
m = module_to_("module-predefined?", argc, argv, 1);
return ((m && m->predefined) ? scheme_true : scheme_false);
}
int scheme_is_predefined_module_p(Scheme_Object *name)
{
Scheme_Object *a[1];
Scheme_Module *m;
a[0] = name;
m = module_to_("module-predefined?", 1, a, 1);
return m && m->predefined;
}
static Scheme_Object *extract_compiled_imports(Scheme_Module *m)
{
Scheme_Object *l;
@ -2882,7 +2905,7 @@ static Scheme_Object *module_to_imports(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;
m = module_to_("module->imports", argc, argv);
m = module_to_("module->imports", argc, argv, 0);
return extract_compiled_imports(m);
}
@ -2891,7 +2914,7 @@ static Scheme_Object *module_to_exports(int argc, Scheme_Object *argv[])
{
Scheme_Module *m;
m = module_to_("module->exports", argc, argv);
m = module_to_("module->exports", argc, argv, 0);
return extract_compiled_exports(m);
}
@ -4963,6 +4986,7 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
m = MALLOC_ONE_TAGGED(Scheme_Module);
m->so.type = scheme_module_type;
m->predefined = scheme_starting_up;
env = scheme_new_module_env(for_env, m, 0);
@ -5657,6 +5681,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
m = MALLOC_ONE_TAGGED(Scheme_Module);
m->so.type = scheme_module_type;
m->predefined = scheme_starting_up;
/* must set before calling new_module_env: */
rmp = SCHEME_STX_VAL(nm);

52
src/racket/src/place.c
View File

@ -24,7 +24,8 @@ static Scheme_Object* scheme_place_enabled(int argc, Scheme_Object *args[]);
static Scheme_Object* scheme_place_shared(int argc, Scheme_Object *args[]);
THREAD_LOCAL_DECL(int scheme_current_place_id);
ROSYM static Scheme_Object *quote_symbol;
SHARED_OK static const char *embedded_load;
#ifdef MZ_USE_PLACES
@ -37,6 +38,8 @@ ROSYM static Scheme_Object *quote_symbol;
READ_ONLY static Scheme_Object *scheme_def_place_exit_proc;
SHARED_OK static int scheme_places_enabled = 1;
ROSYM static Scheme_Object *quote_symbol;
static int id_counter;
static mzrt_mutex *id_counter_mutex;
@ -112,6 +115,7 @@ static void register_traversers(void) { }
/*========================================================================*/
/* initialization */
/*========================================================================*/
void scheme_init_place(Scheme_Env *env)
{
Scheme_Env *plenv;
@ -157,10 +161,10 @@ void scheme_init_places_once() {
mzrt_mutex_create(&id_counter_mutex);
REGISTER_SO(scheme_def_place_exit_proc);
scheme_def_place_exit_proc = scheme_make_prim_w_arity(def_place_exit_handler_proc, "default-place-exit-handler", 1, 1);
#endif
REGISTER_SO(quote_symbol);
quote_symbol = scheme_intern_symbol("quote");
#endif
}
int scheme_get_place_id(void)
@ -172,6 +176,11 @@ int scheme_get_place_id(void)
#endif
}
void scheme_register_embedded_load(const char *s)
{
embedded_load = s;
}
#ifdef MZ_USE_PLACES
/************************************************************************/
@ -316,8 +325,10 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
scheme_wrong_type("dynamic-place", "file-stream-output-port or #f", 4, argc, args);
}
if (SCHEME_PAIRP(args[0]) && SAME_OBJ(SCHEME_CAR(args[0]), quote_symbol)) {
scheme_arg_mismatch("dynamic-place", "not only a filesystem module-path: ", args[0]);
if (SCHEME_PAIRP(args[0])
&& SAME_OBJ(SCHEME_CAR(args[0]), quote_symbol)
&& !scheme_is_predefined_module_p(args[0])) {
scheme_arg_mismatch("dynamic-place", "not a filesystem or predefined module-path: ", args[0]);
}
so = places_deep_copy_to_master(args[0]);
@ -2199,7 +2210,33 @@ static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *argv[
return scheme_void; /* Never get here */
}
static int do_embedded_load()
{
if (embedded_load) {
Scheme_Thread * volatile p;
mz_jmp_buf * volatile save, newbuf;
volatile int rc;
p = scheme_get_current_thread();
save = p->error_buf;
p->error_buf = &newbuf;
if (!scheme_setjmp(newbuf)) {
scheme_embedded_load(embedded_load, 1);
rc = 1;
} else {
rc = 0;
}
p->error_buf = save;
return rc;
}
return 1;
}
static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
Place_Start_Data *place_data;
Scheme_Place_Object *place_obj;
@ -2285,10 +2322,9 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_place_exit_proc);
scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: started", scheme_current_place_id);
{
if (do_embedded_load()) {
Scheme_Thread * volatile p;
mz_jmp_buf * volatile saved_error_buf;
mz_jmp_buf new_error_buf;
@ -2313,6 +2349,8 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
p->error_buf = saved_error_buf;
place_set_result(rc);
} else {
place_set_result(scheme_make_integer(1));
}
scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting", scheme_current_place_id);

2
src/racket/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1039
#define EXPECTED_PRIM_COUNT 1040
#define EXPECTED_UNSAFE_COUNT 78
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 11

5
src/racket/src/schpriv.h
View File

@ -179,7 +179,7 @@ void scheme_clear_ephemerons(void);
/* initialization */
/*========================================================================*/
extern int scheme_starting_up;
THREAD_LOCAL_DECL(extern int scheme_starting_up);
void scheme_init_finalization(void);
void scheme_init_portable_case(void);
@ -1096,6 +1096,8 @@ void scheme_populate_pt_ht(struct Scheme_Module_Phase_Exports * pt);
Scheme_Object *scheme_transfer_srcloc(Scheme_Object *to, Scheme_Object *from);
int scheme_is_predefined_module_p(Scheme_Object *name);
/*========================================================================*/
/* syntax run-time structures */
/*========================================================================*/
@ -2994,6 +2996,7 @@ typedef struct Scheme_Module_Export_Info {
typedef struct Scheme_Module
{
Scheme_Object so; /* scheme_module_type */
short predefined;
Scheme_Object *code_key;

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.2.0.2"
#define MZSCHEME_VERSION "5.2.0.3"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)