diff --git a/collects/compiler/commands/ctool.rkt b/collects/compiler/commands/ctool.rkt index df49d2922b..1e962fae63 100644 --- a/collects/compiler/commands/ctool.rkt +++ b/collects/compiler/commands/ctool.rkt @@ -291,18 +291,10 @@ (when (zero? (modulo pos 20)) (fprintf out "\n ")) (unless (eof-object? b) (fprintf out "~a," b) (loop (add1 pos))))) (fprintf out "0\n };\n") - (fprintf out " Scheme_Object *eload = NULL, *a[3] = {NULL, NULL, NULL};\n") - (fprintf out " MZ_GC_DECL_REG(4);\n") - (fprintf out " MZ_GC_VAR_IN_REG(0, eload);\n") - (fprintf out " MZ_GC_ARRAY_VAR_IN_REG(1, a, 3);\n") - (fprintf out " MZ_GC_REG();\n") - (fprintf out " eload = scheme_builtin_value(\"embedded-load\");\n") - (fprintf out " a[0] = scheme_false;\n") - (fprintf out " a[1] = scheme_false;\n") - (fprintf out " a[2] = scheme_make_sized_byte_string((char *)data, ~a, 0);\n" + (fprintf out " scheme_register_embedded_load(~a, (const char *)data);\n" + (file-position in)) + (fprintf out " scheme_embedded_load(~a, (const char *)data, 1);\n" (file-position in)) - (fprintf out " scheme_apply(eload, 3, a);\n") - (fprintf out " MZ_GC_UNREG();\n") (fprintf out "}\n") (fprintf out "#ifdef MZ_XFORM\n") (fprintf out "XFORM_END_SKIP;\n") diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 0f8ecde12e..9a61c7f2af 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -1061,7 +1061,7 @@ (define rst-start (file-position port)) (file-position port (+ rst-start size*)) - + (unless (eof-object? (read-byte port)) (error 'zo-parse "File too big")) diff --git a/collects/tests/racket/embed-in-c.c b/collects/tests/racket/embed-in-c.c index a65ba8bae9..b98571a845 100644 --- a/collects/tests/racket/embed-in-c.c +++ b/collects/tests/racket/embed-in-c.c @@ -1,24 +1,33 @@ #include "scheme.h" +#ifdef USE_DECLARED_MODULE +# include "embed-base.c" +#endif + static int run(Scheme_Env *e, int argc, char *argv[]) { - Scheme_Object *curout = NULL, *v = NULL, *a[2] = {NULL, NULL}; + Scheme_Object *curout = NULL, *v = NULL, *pl = NULL, *a[2] = {NULL, NULL}; Scheme_Config *config = NULL; int i; mz_jmp_buf * volatile save = NULL, fresh; - MZ_GC_DECL_REG(8); + MZ_GC_DECL_REG(9); MZ_GC_VAR_IN_REG(0, e); MZ_GC_VAR_IN_REG(1, curout); MZ_GC_VAR_IN_REG(2, save); MZ_GC_VAR_IN_REG(3, config); MZ_GC_VAR_IN_REG(4, v); MZ_GC_ARRAY_VAR_IN_REG(5, a, 2); + MZ_GC_VAR_IN_REG(8, pl); MZ_GC_REG(); +#ifdef USE_DECLARED_MODULE + declare_modules(e); +#else scheme_set_collects_path(scheme_make_path(MZ_COLLECTION_PATH)); scheme_init_collection_paths(e, scheme_null); +#endif v = scheme_intern_symbol("racket/base"); scheme_namespace_require(v); @@ -40,9 +49,30 @@ static int run(Scheme_Env *e, int argc, char *argv[]) } } + /* Try in a place: */ + a[0] = scheme_intern_symbol("racket/place"); + a[1] = scheme_intern_symbol("dynamic-place"); + v = scheme_dynamic_require(2, a); + a[0] = scheme_intern_symbol("tests/racket/embed-place"); + a[1] = scheme_intern_symbol("go"); + pl = scheme_apply(v, 2, a); + a[0] = scheme_intern_symbol("racket/place"); + a[1] = scheme_intern_symbol("place-channel-get"); + v = scheme_dynamic_require(2, a); + a[0] = pl; + v = scheme_apply(v, 1, a); + if (v != scheme_make_integer(42)) { + printf("place failed\n"); + return 1; + } + /* RESET: */ e = scheme_basic_env(); +#ifdef USE_DECLARED_MODULE + declare_modules(e); +#else scheme_init_collection_paths(e, scheme_null); +#endif v = scheme_intern_symbol("racket/base"); scheme_namespace_require(v); diff --git a/collects/tests/racket/embed-in-c.rkt b/collects/tests/racket/embed-in-c.rkt index 7af37c63e8..7d3d037419 100644 --- a/collects/tests/racket/embed-in-c.rkt +++ b/collects/tests/racket/embed-in-c.rkt @@ -24,43 +24,63 @@ (and m (cadr m)))) "")) -(parameterize ([current-directory dir]) - (unless (system (format "cc -c -o embed-in-c.o -DMZ_COLLECTION_PATH='\"~a\"' -I\"~a\" -DMZ_PRECISE_GC ~a embed-in-c.c" - (find-collects-dir) - (find-include-dir) - (buildinfo "CFLAGS"))) - (error "compile failed")) +(define (go use-declare?) + (parameterize ([current-directory dir]) + (when use-declare? + (system* (build-path (find-console-bin-dir) "raco") + "ctool" + "--3m" + "--c-mods" + (path->string (build-path (find-system-path 'temp-dir) "embed-base.c")) + "++lib" + "racket/base" + "++lib" + "racket/place" + "++lib" + "tests/racket/embed-place")) + (unless (system (format "cc -c -o embed-in-c.o ~a-DMZ_COLLECTION_PATH='\"~a\"' -I\"~a\" -DMZ_PRECISE_GC ~a embed-in-c.c" + (if use-declare? + (format "-DUSE_DECLARED_MODULE -I\"~a\" " (find-system-path 'temp-dir)) + "") + (find-collects-dir) + (find-include-dir) + (buildinfo "CFLAGS"))) + (error "compile failed")) + + (unless (system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a" + (case (system-type 'link) + [(framework) + (format "-F\"~a\" -framework Racket" lib-dir)] + [(static shared) + (format "-L\"~a\" -lracket3m ~a ~a" lib-dir + (buildinfo "LDFLAGS") (buildinfo "LIBS"))] + [else + (error "unsupported")]))) + (error "link failed")) + + (let ([o (open-output-bytes)] + [e (open-output-bytes)]) + (unless (parameterize ([current-input-port (open-input-bytes #"5\n(log-error \"ouch!\")")] + [current-output-port o] + [current-error-port e]) + (system + (format "~a./embed-in-c 1 2 3" + (case (system-type 'link) + [(framework) + (format "env DYLD_FRAMEWORK_PATH=\"~a\" " lib-dir)] + [else ""])))) + (error 'run "failed: ~s" (get-output-bytes e))) + (test #"ouch!\n" (get-output-bytes e)) + (test #"1\n2\n3\n> 5\n> > " (get-output-bytes o))) + + (let ([maybe-delete-file + (lambda (f) (when (file-exists? f) (delete-file f)))]) + (maybe-delete-file "embed-in-c.o") + (maybe-delete-file "embed-in-c"))) - (unless (system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a" - (case (system-type 'link) - [(framework) - (format "-F\"~a\" -framework Racket" lib-dir)] - [(static shared) - (format "-L\"~a\" -lracket3m ~a ~a" lib-dir - (buildinfo "LDFLAGS") (buildinfo "LIBS"))] - [else - (error "unsupported")]))) - (error "link failed")) - - (let ([o (open-output-bytes)] - [e (open-output-bytes)]) - (unless (parameterize ([current-input-port (open-input-bytes #"5\n(log-error \"ouch!\")")] - [current-output-port o] - [current-error-port e]) - (system - (format "~a./embed-in-c 1 2 3" - (case (system-type 'link) - [(framework) - (format "env DYLD_FRAMEWORK_PATH=\"~a\" " lib-dir)] - [else ""])))) - (error 'run "failed: ~s" (get-output-bytes e))) - (test #"ouch!\n" (get-output-bytes e)) - (test #"1\n2\n3\n> 5\n> > " (get-output-bytes o))) + (printf "passed ~a declare\n" (if use-declare? "with" "without"))) - (let ([maybe-delete-file - (lambda (f) (when (file-exists? f) (delete-file f)))]) - (maybe-delete-file "embed-in-c.o") - (maybe-delete-file "embed-in-c"))) +(go #f) +(go #t) -(printf "passed\n") diff --git a/collects/tests/racket/embed-place.rkt b/collects/tests/racket/embed-place.rkt new file mode 100644 index 0000000000..46e33a7483 --- /dev/null +++ b/collects/tests/racket/embed-place.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(require racket/place) + +(provide go) + +(define (go ch) + (place-channel-put ch 42)) diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index aa746a891b..13284350ac 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -298,10 +298,10 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl) /* 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); + scheme_register_embedded_load(-1, fa->evals_and_loads[i]); + scheme_embedded_load(-1, fa->evals_and_loads[i], 1); } else if (fa->eval_kind[i] == mzcmd_EMBEDDED) { - scheme_embedded_load(fa->evals_and_loads[i], 0); + scheme_embedded_load(-1, fa->evals_and_loads[i], 0); } else { Scheme_Object *a[1], *nsreq; char *name; diff --git a/src/racket/include/scheme.h b/src/racket/include/scheme.h index 90af06e77a..35a1cd156c 100644 --- a/src/racket/include/scheme.h +++ b/src/racket/include/scheme.h @@ -1770,8 +1770,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); +MZ_EXTERN void scheme_embedded_load(intptr_t len, const char *s, int predefined); +MZ_EXTERN void scheme_register_embedded_load(intptr_t len, const char *s); /* Set these global hooks (optionally): */ typedef void (*Scheme_Exit_Proc)(int v); diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 43d8a8d7ef..af1247a707 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -5108,15 +5108,24 @@ 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) +void scheme_embedded_load(intptr_t len, 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 (len < 0) { + /* description mode */ + 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; + } else { + /* content mode */ + a[0] = scheme_false; + a[1] = scheme_false; + s = scheme_make_sized_byte_string((char *)desc, len, 0); + a[2] = s; + } if (predefined) scheme_starting_up = 1; (void)scheme_apply(eload, 3, a); diff --git a/src/racket/src/place.c b/src/racket/src/place.c index e5c4441fad..e13ab0bcd3 100644 --- a/src/racket/src/place.c +++ b/src/racket/src/place.c @@ -25,6 +25,7 @@ static Scheme_Object* scheme_place_shared(int argc, Scheme_Object *args[]); THREAD_LOCAL_DECL(int scheme_current_place_id); +SHARED_OK static intptr_t embedded_load_len; SHARED_OK static const char *embedded_load; #ifdef MZ_USE_PLACES @@ -176,8 +177,9 @@ int scheme_get_place_id(void) #endif } -void scheme_register_embedded_load(const char *s) +void scheme_register_embedded_load(intptr_t len, const char *s) { + embedded_load_len = len; embedded_load = s; } @@ -2224,7 +2226,7 @@ static int do_embedded_load() p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { - scheme_embedded_load(embedded_load, 1); + scheme_embedded_load(embedded_load_len, embedded_load, 1); rc = 1; } else { rc = 0;