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

adjust `raco ctool --c-mods' and related to work with places

Browse Source 
That is, the generated declare_modules() function registers the
module-declaration code so that it is run in any new place, too.

Merge to 5.2.1
This commit is contained in:
Matthew Flatt 2012-01-19 13:12:38 -07:00
parent c723aeeb6a
commit 481e061440
9 changed files with 123 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/compiler/commands/ctool.rkt
View File

@ -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")

34
collects/tests/racket/embed-in-c.c
View File

@ -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);

90
collects/tests/racket/embed-in-c.rkt
View File

@ -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"))
(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 ([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")))
(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")))
(printf "passed ~a declare\n" (if use-declare? "with" "without")))
(go #f)
(go #t)
(printf "passed\n")

7
collects/tests/racket/embed-place.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(require racket/place)
(provide go)
(define (go ch)
(place-channel-put ch 42))

6
src/racket/cmdline.inc
View File

@ -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;

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

@ -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);

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

@ -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);

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

@ -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;