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

Merge branch 'master' of git:plt

Browse Source
This commit is contained in:
John Clements 2010-04-28 11:49:22 -07:00
commit 3f4f013a7b
25 changed files with 312 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/private/tools-drs.rkt
View File

@ -80,8 +80,8 @@ This file sets up the right lexical environment to invoke the tools that want to
;; these two definitions are a hack. They give bindings for the drracket: based names that
;; appear in the source of language-object-contract.rkt.
(define drracket:language:capability-registered? drscheme:language:capability-registered?)
(define drracket:language:get-capability-contract drscheme:language:get-capability-contract)
(define (drracket:language:capability-registered? . args) (apply drscheme:language:capability-registered? args))
(define (drracket:language:get-capability-contract . args) (apply drscheme:language:get-capability-contract args))
;; invoke-drs-tool : unit/sig string -> (values (-> void) (-> void))
;; invokes the tools and returns the two phase thunks.

39
collects/drscheme/tool-lib.rkt
View File

@ -111,31 +111,26 @@ all of the names in the tools library, for use defining keybindings
Specifically, it sets these parameters:
@itemize[
@item{ @racket[current-namespace] has been set to a newly
@item{@racket[current-namespace] has been set to a newly
created empty namespace. This namespace has the following modules
copied (with @racket[namespace-attach-module])
from DrRacket's original namespace:
@itemize[@item{@racket['mzscheme]}@item{@racket['mred]}]
}@item{
@racket[read-curly-brace-as-paren]
is @racket[#t],
}@item{
@racket[read-square-bracket-as-paren]
is @racket[#t],
}@item{
@racket[error-print-width] is set to 250.
}@item{
@racket[current-ps-setup]
}
@item{@racket[read-curly-brace-as-paren]
is @racket[#t]; }
@item{@racket[read-square-bracket-as-paren]
is @racket[#t];}
@item{@racket[error-print-width] is set to 250;}
@item{@racket[current-ps-setup]
is set to a newly created
@racket[ps-setup%]
object.
}@item{ The @racket[exit-handler] is set to
a parameter that kills the user's custodian.
}@item{ The snip-class-list, returned by
object;}
@item{the @racket[exit-handler] is set to
a parameter that kills the user's custodian; and}
@item{the snip-class-list, returned by
@racket[get-the-snip-class-list]
is initialized with all of the snipclasses in DrRacket's eventspace's snip-class-list.
}]})
is initialized with all of the snipclasses in DrRacket's eventspace's snip-class-list.}]})
(proc-doc/names
drracket:eval:get-snip-classes
@ -577,11 +572,10 @@ all of the names in the tools library, for use defining keybindings
((or/c string? false/c) . -> . (is-a?/c drracket:unit:frame%)))
(() (filename))
@{Opens a DrRacket frame that displays @racket[filename],
@{Opens a DrRacket frame that displays
@racket[filename],
or nothing if @racket[filename] is @racket[#f] or not supplied.})
;
;
;
@ -1124,8 +1118,7 @@ all of the names in the tools library, for use defining keybindings
(item @racket['key : contract = default]
"--- " desc ...)])])
(itemize
@cap[drracket:check-syntax-button boolean? #t]{
controls the visiblity of the check syntax button}
@cap[drracket:check-syntax-button boolean? #t]{controls the visiblity of the check syntax button}
@cap[drracket:language-menu-title
string?
(string-constant scheme-menu-name)]{

6
collects/lang/htdp-langs.rkt
View File

@ -201,11 +201,11 @@
[(drscheme:language:simple-settings-insert-newlines settings)
(if (number? width)
(parameterize ([pretty-print-columns width])
(pretty-print converted-value port))
(pretty-print converted-value port))]
(pretty-write converted-value port))
(pretty-write converted-value port))]
[else
(parameterize ([pretty-print-columns 'infinity])
(pretty-print converted-value port))
(pretty-write converted-value port))
(newline port)])))))
settings
width))

7
collects/lang/private/advanced-funs.rkt
View File

@ -9,6 +9,11 @@
"../posn.ss"
(for-syntax scheme/base))
(define pp
(let ([pretty-print (lambda (v)
(pretty-write v))])
pretty-print))
(provide-and-document
procedures
@ -35,7 +40,7 @@
"to print the argument to stdout (without quotes on symbols and strings, etc.)")
(write (any -> void)
"to print the argument to stdout (in a traditional style that is somewhere between print and display)")
(pretty-print (any -> void)
((pp pretty-print) (any -> void)
"like write, but with standard newlines and indentation")
(printf (string any ... -> void)
"to format the rest of the arguments according to the first argument and print it to stdout")

7
collects/meta/props
View File

@ -636,6 +636,13 @@ path/s is either such a string or a list of them.
"collects/ffi/examples/tcl.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/xmmsctrl.rkt" drdr:command-line ""
"collects/ffi/examples/xosd.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/use-c-printf.rkt" drdr:command-line "mzc -k ~s"
"collects/ffi/examples/use-esd.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/use-magick.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/use-sndfile.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/use-tcl.rkt" drdr:command-line "mzc ~s"
"collects/ffi/examples/use-xmmsctrl.rkt" drdr:command-line ""
"collects/ffi/examples/use-xosd.rkt" drdr:command-line "mzc ~s"
"collects/ffi/magick.rkt" drdr:command-line "mzc ~s"
"collects/ffi/unsafe/objc.rkt" drdr:command-line "mzc ~s"
"collects/ffi/private/objc-doc-unsafe.rkt" drdr:command-line "mzc ~s"

2
collects/scribblings/tools/common.rkt
View File

@ -35,7 +35,7 @@
[(_ name)
(string? (syntax-e #'name))
(let ([name (syntax-e #'name)])
(with-syntax ([rx (regexp (regexp-quote (format "^drracket:~a:" name)))])
(with-syntax ([rx (regexp (format "^~a" (regexp-quote (format "drracket:~a:" name))))])
#'(include-previously-extracted scribblings/tools/tool-lib-extracts rx)))]))
(provide docs-get/extend)

8
collects/tests/mred/auto.rkt
View File

@ -1,5 +1,5 @@
(load-relative "editor.ss")
(load-relative "paramz.ss")
(load-relative "dc.ss")
(load-relative "windowing.ss")
(load-relative "editor.rkt")
(load-relative "paramz.rkt")
(load-relative "dc.rkt")
(load-relative "windowing.rkt")

2
collects/tests/mred/dc.rkt
View File

@ -1,5 +1,5 @@
(load-relative "loadtest.ss")
(load-relative "loadtest.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DC Tests ;;

2
collects/tests/mred/editor.rkt
View File

@ -1,5 +1,5 @@
(load-relative "loadtest.ss")
(load-relative "loadtest.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Editor Tests ;;

2
collects/tests/mred/gui.rkt
View File

@ -1,4 +1,4 @@
(let ([f (load-relative "gui-main.ss")])
(let ([f (load-relative "gui-main.rkt")])
(thread
(lambda ()
(f "New" "Save" mred:console-frame%))))

2
collects/tests/mred/loadtest.rkt
View File

@ -2,4 +2,4 @@
(unless (with-handlers ([exn:fail? (lambda (x) #f)])
(namespace-variable-binding 'SECTION)
#t)
(load-relative "testing.ss"))
(load-relative "testing.rkt"))

2
collects/tests/mred/paramz.rkt
View File

@ -1,5 +1,5 @@
(load-relative "loadtest.ss")
(load-relative "loadtest.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Yield Tests ;;

2
collects/tests/mred/windowing.rkt
View File

@ -1,5 +1,5 @@
(load-relative "loadtest.ss")
(load-relative "loadtest.rkt")
(define shorter? #t)

2
collects/tests/racket/benchmarks/mz/parsing.scm
View File

@ -1,6 +1,6 @@
(require (lib "scheme-lexer.ss" "syntax-color") scheme/gui/base)
(define path (build-path (collection-path "framework" "private") "frame.ss"))
(define path (build-path (collection-path "framework" "private") "frame.rkt"))
(define content
(with-input-from-file path

2
collects/tests/racket/cache-image-snip-test.rkt
View File

@ -1,4 +1,4 @@
(load-relative "loadtest.ss")
(load-relative "loadtest.rkt")
(require mrlib/cache-image-snip
mzlib/unit)

2
collects/tests/racket/embed-me11.rkt
View File

@ -1,2 +1,2 @@
#reader(lib "embed-me11-rd.ss" "tests" "mzscheme")
#reader(lib "embed-me11-rd.ss" "tests" "racket")
"It goes to ~a!\n"

8
collects/tests/racket/prompt-sfs.rkt
View File

@ -1,5 +1,5 @@
#lang scheme
(require scheme/system)
#lang racket
(require racket/system)
#|
@ -10,7 +10,7 @@ the `x' binding is part of the deeper meta-continuation when `ak'
is captured, but it is delimited inside the binding, so `x'
should not be reated in `ak'.
The test is implemented using `dump-memory-stats' in another mzscheme
The test is implemented using `dump-memory-stats' in another racket
process.
|#
@ -19,7 +19,7 @@ process.
(let ([f (find-executable-path (find-system-path 'exec-file) #f)])
(let ([p (open-output-bytes)])
(parameterize ([current-error-port p])
(system* f "-l" "tests/mzscheme/prompt-sfs" "sub"))
(system* f "-l" "tests/racket/prompt-sfs" "sub"))
(unless (regexp-match? #rx"<will-executor>: +1 +" (get-output-bytes p))
(error "wrong output")
(exit 1))))

2
collects/tests/syntax-color/paren-tree.rkt
View File

@ -1,4 +1,4 @@
(load-relative "../mzscheme/loadtest.ss")
(load-relative "../racket/loadtest.rkt")
(require mzlib/class
syntax-color/paren-tree)

2
collects/tests/syntax-color/token-tree.rkt
View File

@ -1,4 +1,4 @@
(load-relative "../mzscheme/loadtest.ss")
(load-relative "../racket/loadtest.rkt")
(require mzlib/class
syntax-color/token-tree)

4
collects/tests/unstable/srcloc.rkt
View File

@ -1,9 +1,9 @@
(load-relative "../mzscheme/loadtest.ss")
(load-relative "../racket/loadtest.rkt")
(Section 'srcloc)
(require unstable/srcloc)
(require scheme/shared)
(require racket/shared)
(test #t source-location? #f)
(test #f source-location? #t)

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

@ -413,6 +413,11 @@ GC2_EXTERN void GC_construct_child_gc();
Creates a new place specific GC and links to the master GC.
*/
GC2_EXTERN void GC_destruct_child_gc();
/*
Destroys a place specific GC once the place has finished.
*/
GC2_EXTERN void *GC_switch_to_master_gc();
/*
Switches to the master GC

236
src/racket/gc2/newgc.c
View File

@ -146,11 +146,11 @@ static void GCVERBOSEprintf(const char *fmt, ...) {
static void GCVERBOSEPAGE(const char *msg, mpage* page) {
NewGC *gc = GC_get_GC();
if(postmaster_and_master_gc(gc)) {
GCVERBOSEprintf("%s %p %p %p\n", msg, page, page->addr, (void*)((long)page->addr + real_page_size(page)));
GCVERBOSEprintf("%s %p: %p %p %p\n", msg, gc, page, page->addr, (void*)((long)page->addr + real_page_size(page)));
}
}
# ifdef KILLING_DEBUG
static void killing_debug(NewGC *gc, void *info);
static void killing_debug(NewGC *gc, mpage *page, objhead *info);
# endif
#else
# define GCVERBOSEPAGE(msg, page) /* EMPTY */
@ -1876,82 +1876,66 @@ void GC_write_barrier(void *p)
#ifdef MZ_USE_PLACES
static void NewGCMasterInfo_initialize() {
int i;
MASTERGCINFO = ofm_malloc_zero(sizeof(NewGCMasterInfo));
MASTERGCINFO->size = 32;
MASTERGCINFO->alive = 0;
MASTERGCINFO->ready = 0;
MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->size);
for (i=0; i < 32; i++ ) {
MASTERGCINFO->signal_fds[i] = (void *)-2;
}
mzrt_rwlock_create(&MASTERGCINFO->cangc);
mzrt_sema_create(&MASTERGCINFO->wait_sema, 0);
}
static void NewGCMasterInfo_cleanup() {
mzrt_rwlock_destroy(MASTERGCINFO->cangc);
free(MASTERGCINFO->signal_fds);
free(MASTERGCINFO);
MASTERGCINFO = NULL;
}
static void NewGCMasterInfo_set_have_collected(NewGC *gc) {
MASTERGCINFO->have_collected[gc->place_id] = 1;
}
/* signals every place to do a full gc at then end of
garbage_collect the places will call
wait_if_master_in_progress and
rendezvous for a master gc */
/* this is only called from the master so the cangc lock should already be held */
static void master_collect_initiate() {
if (MASTERGC->major_places_gc == 0) {
int i = 0;
int maxid = MASTERGCINFO->next_GC_id;
int size = MASTERGCINFO->size;
int count = 0;
MASTERGC->major_places_gc = 1;
MASTERGCINFO->ready = 0;
for (i=1; i < maxid; i++) {
for (i=1; i < size; i++) {
void *signal_fd = MASTERGCINFO->signal_fds[i];
MASTERGCINFO->have_collected[i] = -1;
if (signal_fd >= 0 ) {
if (signal_fd < (void*) -2) {
scheme_signal_received_at(signal_fd);
}
#if defined(DEBUG_GC_PAGES)
printf("%i SIGNALED BUT NOT COLLECTED\n", i);
GCVERBOSEprintf("%i SIGNALED BUT NOT COLLECTED\n", i);
#endif
count++;
}
if (count == (MASTERGCINFO->alive -1)) {
break;
}
}
if (count != (MASTERGCINFO->alive -1)) {
printf("GC2 count != MASTERGCINFO->alive %i %li\n", count, MASTERGCINFO->alive);
abort();
}
#if defined(DEBUG_GC_PAGES)
printf("Woke up %i places for MASTER GC\n", count);
GCVERBOSEprintf("Woke up %i places for MASTER GC\n", count);
#endif
}
}
static void wait_if_master_in_progress(NewGC *gc) {
if (MASTERGC->major_places_gc == 1) {
int last_one_here = 1;
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK GC_switch_to_master_gc\n");
{
int i = 0;
int maxid = MASTERGCINFO->next_GC_id;
NewGCMasterInfo_set_have_collected(gc);
for (i=1; i < maxid; i++) {
int have_collected = MASTERGCINFO->have_collected[i];
if (have_collected == 1) {
#if defined(DEBUG_GC_PAGES)
printf("%i READY\n", i);
GCVERBOSEprintf("%i READY\n", i);
#endif
}
else {
#if defined(DEBUG_GC_PAGES)
printf("%i SIGNALED BUT NOT COLLECTED\n", i);
GCVERBOSEprintf("%i SIGNALED BUT NOT COLLECTED\n", i);
#endif
last_one_here = 0;
}
}
}
if (last_one_here) {
static void collect_master() {
NewGC *saved_gc;
GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
saved_gc = GC_switch_to_master_gc();
{
#if defined(DEBUG_GC_PAGES)
@ -1967,44 +1951,105 @@ static void wait_if_master_in_progress(NewGC *gc) {
{
int i = 0;
int maxid = MASTERGCINFO->next_GC_id;
/* wake everyone back up */
for (i=2; i < maxid; i++) {
int alive = MASTERGCINFO->alive;
/* wake everyone back up, except MASTERGC and ourself */
for (i=2; i < alive; i++) {
mzrt_sema_post(MASTERGCINFO->wait_sema);
}
}
}
GC_switch_back_from_master(saved_gc);
}
static void wait_if_master_in_progress(NewGC *gc) {
int last_one_here = -1;
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK wait_if_master_in_progress\n");
{
if (MASTERGC->major_places_gc == 1) {
MASTERGCINFO->ready++;
#if defined(DEBUG_GC_PAGES)
printf("%i READY\n", gc->place_id);
GCVERBOSEprintf("%i READY\n", i);
#endif
/* don't count MASTERGC*/
if ((MASTERGCINFO->alive -1) == MASTERGCINFO->ready) {
last_one_here = 1;
}
else {
GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
last_one_here = 0;
}
}
else {
last_one_here = -1;
}
}
GC_LOCK_DEBUG("UNMGCLOCK wait_if_master_in_progress\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
/* wait on semaphonre */
switch(last_one_here) {
case -1:
/* master doesn't want to collect */
return;
break;
case 0:
/* wait on semaphore */
mzrt_sema_wait(MASTERGCINFO->wait_sema);
}
break;
case 1:
/* Your the last one here. */
collect_master();
break;
default:
printf("GC2 wait_if_master_in_progress invalid case, unreachable\n");
abort();
break;
}
}
static void NewGCMasterInfo_get_next_id(NewGC *newgc) {
int newid;
/* this could just be an atomic op if we had those */
/* waiting for other threads to finish a possible concurrent GC is not optimal*/
/* MUST CALL WITH cangc lock */
static long NewGCMasterInfo_find_free_id() {
GC_ASSERT(MASTERGCINFO->live <= MASTERGCINFO->size);
if ((MASTERGCINFO->alive + 1) == MASTERGCINFO->size) {
MASTERGCINFO->size++;
MASTERGCINFO->alive++;
MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->size);
return MASTERGCINFO->size - 1;
}
else {
int i;
int size = MASTERGCINFO->size;
for (i = 0; i < size; i++) {
if (MASTERGCINFO->signal_fds[i] == (void*)-2) {
MASTERGCINFO->alive++;
return i;
}
}
}
printf("Error in MASTERGCINFO table\n");
abort();
}
static void NewGCMasterInfo_register_gc(NewGC *newgc) {
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
newid = MASTERGCINFO->next_GC_id++;
GC_LOCK_DEBUG("MGCLOCK NewGCMasterInfo_register_gc\n");
{
long newid = NewGCMasterInfo_find_free_id();
newgc->place_id = newid;
/* printf("ALLOCATED GC OID %li\n", newgc->place_id); */
MASTERGCINFO->have_collected = realloc(MASTERGCINFO->have_collected, sizeof(char) * MASTERGCINFO->next_GC_id);
MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->next_GC_id);
MASTERGCINFO->have_collected[newid] = 0;
MASTERGCINFO->signal_fds[newid] = (void *)-1;
}
GC_LOCK_DEBUG("UNMGCLOCK NewGCMasterInfo_register_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
}
void GC_set_put_external_event_fd(void *fd) {
NewGC *gc = GC_get_GC();
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK GC_set_put_external_event_fd\n");
{
MASTERGCINFO->signal_fds[gc->place_id] = fd;
}
GC_LOCK_DEBUG("UNMGCLOCK GC_set_put_external_event_fd\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
}
#endif
@ -2027,7 +2072,7 @@ static void NewGC_initialize(NewGC *newgc, NewGC *parentgc) {
}
#ifdef MZ_USE_PLACES
NewGCMasterInfo_get_next_id(newgc);
NewGCMasterInfo_register_gc(newgc);
#endif
mark_stack_initialize(newgc);
@ -2110,6 +2155,31 @@ void GC_construct_child_gc() {
newgc->primoridal_gc = MASTERGC;
}
void GC_destruct_child_gc() {
NewGC *gc = GC_get_GC();
int waiting = 0;
do {
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK GC_destruct_child_gc\n");
waiting = MASTERGC->major_places_gc;
if (!waiting) {
MASTERGCINFO->signal_fds[gc->place_id] = (void *)-2;
gc->place_id = -1;
MASTERGCINFO->alive--;
}
GC_LOCK_DEBUG("UNMGCLOCK GC_destruct_child_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
if (waiting) {
garbage_collect(gc, 1, 0);
waiting = 1;
}
} while (waiting == 1);
}
static inline void save_globals_to_gc(NewGC *gc) {
gc->saved_GC_variable_stack = GC_variable_stack;
gc->saved_GC_gen0_alloc_page_ptr = GC_gen0_alloc_page_ptr;
@ -2156,7 +2226,7 @@ void *GC_switch_to_master_gc() {
/*obtain exclusive access to MASTERGC*/
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK GC_switch_to_master_gc\n");
//GC_LOCK_DEBUG("MGCLOCK GC_switch_to_master_gc\n");
GC_set_GC(MASTERGC);
restore_globals_from_gc(MASTERGC);
@ -2169,7 +2239,7 @@ void GC_switch_back_from_master(void *gc) {
save_globals_to_gc(MASTERGC);
/*release exclusive access to MASTERGC*/
GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
//GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
GC_set_GC(gc);
@ -2345,8 +2415,10 @@ void GC_mark2(const void *const_p, struct NewGC *gc)
page->live_size += ohead->size;
record_backtrace(page, p);
push_ptr(gc, p);
} else GCDEBUG((DEBUGOUTF, "Not marking %p (it's old; %p / %i)\n",
p, page, page->previous_size));
}
else {
GCDEBUG((DEBUGOUTF, "Not marking %p (it's old; %p / %i)\n", p, page, page->previous_size));
}
} else {
/* this is a generation 0 object. This means that we do have
to do all of the above. Fun, fun, fun. */
@ -3073,10 +3145,10 @@ static void fprintf_buffer(FILE* file, char* buf, int l) {
fprintf(file, "\n");
}
static void fprintf_debug(NewGC *gc, const char *msg, objhead *info, FILE* file, int isgc) {
static void fprintf_debug(NewGC *gc, mpage *page, const char *msg, objhead *info, FILE* file, int isgc) {
if (!isgc || postmaster_and_master_gc(gc)) {
Scheme_Object *obj = OBJHEAD_TO_OBJPTR(info);
fprintf(file, "%s %p ot %i it %i im %i is %i is >> 3 %i\n", msg, obj, obj->type, info->type, info->mark, info->size, info->size >> 3);
fprintf(file, "%s %p ot %i it %i im %i is %i is >> 3 %i %p %i\n", msg, obj, obj->type, info->type, info->mark, info->size, info->size >> 3, page, page->marked_on);
switch (obj->type) {
case scheme_unix_path_type:
if (pagemap_find_page(gc->page_maps, SCHEME_PATH_VAL(obj))) {
@ -3091,7 +3163,9 @@ static void fprintf_debug(NewGC *gc, const char *msg, objhead *info, FILE* file,
break;
case scheme_resolved_module_path_type:
if (pagemap_find_page(gc->page_maps, SCHEME_PTR_VAL(obj))) {
fprintf_debug(gc, "RMP ", OBJPTR_TO_OBJHEAD(SCHEME_PTR_VAL(obj)), file, isgc);
/*
fprintf_debug(gc, page, "RMP ", OBJPTR_TO_OBJHEAD(SCHEME_PTR_VAL(obj)), file, isgc);
*/
}
else {
fprintf(file, "RMP %p already freed and out of bounds\n", SCHEME_PATH_VAL(obj));
@ -3102,11 +3176,8 @@ static void fprintf_debug(NewGC *gc, const char *msg, objhead *info, FILE* file,
}
}
}
static void killing_debug(NewGC *gc, void *info) {
fprintf_debug(gc, "killing", (objhead *) info, gcdebugOUT(), 1);
}
static void marking_rmp_debug(NewGC *gc, void *info) {
fprintf_debug(gc, "marking rmp", (objhead *) info, gcdebugOUT(), 0);
static void killing_debug(NewGC *gc, mpage *page, objhead *info) {
fprintf_debug(gc, page, "killing", info, gcdebugOUT(), 1);
}
#endif
@ -3279,6 +3350,10 @@ static void repair_heap(NewGC *gc)
break;
case PAGE_ATOMIC:
start += info->size;
break;
default:
printf("Unhandled info->type %i\n", info->type);
abort();
}
info->mark = 0;
#ifdef MZ_USE_PLACES
@ -3286,7 +3361,7 @@ static void repair_heap(NewGC *gc)
#endif
} else {
#ifdef KILLING_DEBUG
killing_debug(gc, info);
killing_debug(gc, page, info);
#endif
info->dead = 1;
start += info->size;
@ -3520,13 +3595,6 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master)
int next_gc_full;
#ifdef MZ_USE_PLACES
if (postmaster_and_place_gc(gc)) {
mzrt_rwlock_rdlock(MASTERGCINFO->cangc);
/* printf("RD MGCLOCK garbage_collect %i\n", gc->place_id); */
}
#endif
old_mem_use = gc->memory_in_use;
old_gen0 = gc->gen0.current_size;
@ -3780,8 +3848,6 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master)
#ifdef MZ_USE_PLACES
if (postmaster_and_place_gc(gc)) {
/* printf("UN RD MGCLOCK garbage_collect %i\n", gc->place_id); */
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
if (gc->gc_full) {
wait_if_master_in_progress(gc);
}

5
src/racket/gc2/newgc.h
View File

@ -87,8 +87,9 @@ typedef struct Page_Range {
#ifdef MZ_USE_PLACES
typedef struct NewGCMasterInfo {
unsigned short next_GC_id;
unsigned char *have_collected;
unsigned long size;
unsigned long alive;
unsigned long ready;
void **signal_fds;
mzrt_rwlock *cangc;
mzrt_sema *wait_sema;

16
src/racket/gc2/sighand.c
View File

@ -50,8 +50,16 @@ void fault_handler(int sn, struct siginfo *si, void *ctx)
if (c == SEGV_MAPERR) {
printf("SIGSEGV MAPERR si_code %i fault on addr %p\n", c, p);
}
else {
printf("SIGSEGV ?????? SI_CODE %i fault on addr %p\n", c, p);
if (c == 0 ) {
/* I have now idea why this happens on linux */
/* supposedly its coming from the user via kill */
/* so just ignore it. */
printf("SIGSEGV SI_USER SI_CODE %i fault on addr %p\n", c, p);
printf("pid %i uid %i\n", si->si_pid, si->si_uid);
return;
}
if (c == 128 ) {
printf("SIGSEGV SI_KERNEL SI_CODE %i fault on addr %p sent by kernel\n", c, p);
}
#if WAIT_FOR_GDB
launchgdb();
@ -67,10 +75,10 @@ void fault_handler(int sn, struct siginfo *si, void *ctx)
printf("ADDR %p OWNED BY MASTER %i\n", p, m);
}
#endif
printf("mprotect fault on %p\n", p);
printf("SIGSEGV SEGV_ACCERR SI_CODE %i fault on %p\n", c, p);
}
else {
printf("?? %i fault on %p\n", si->si_code, p);
printf("SIGSEGV ???? SI_CODE %i fault on %p\n", c, p);
}
abort();
}

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

@ -567,6 +567,9 @@ void scheme_place_instance_destroy() {
#if defined(MZ_USE_PLACES)
scheme_kill_green_thread_timer();
#endif
#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES)
GC_destruct_child_gc();
#endif
}
static void make_kernel_env(void)