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.

163
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]
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
@racket[get-the-snip-class-list]
is initialized with all of the snipclasses in DrRacket's eventspace's snip-class-list.
}]})
}
@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; 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.}]})
(proc-doc/names
drracket:eval:get-snip-classes
@ -577,10 +572,9 @@ 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],
or nothing if @racket[filename] is @racket[#f] or not supplied.})
@{Opens a DrRacket frame that displays
@racket[filename],
or nothing if @racket[filename] is @racket[#f] or not supplied.})
;
;
@ -1124,71 +1118,70 @@ 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)]{
controls the name of the menu just to the right of the language
menu (defaultly named ``Scheme'')}
@cap[drscheme:define-popup
(or/c #f
(list/c string? string? string?)
(cons/c string? string?))
(list "(define" "(define ...)" "δ")]{
specifies the prefix that the define popup should look for and what
label it should have, or @racket[#f] if it should not appear at all.
If the list of three strings alternative is used, the first string is
the prefix that is looked for when finding definitions. The second
and third strings are used as the label of the control, in horizontal
and vertical mode, respectively.
The pair of strings alternative is deprecated. If it is used,
the pair @racket[(cons a-str b-str)] is the same as @racket[(list a-str b-str "δ")].}
@cap[drscheme:help-context-term (or/c false/c string?) #f]{
specifies a context query for documentation searches that are
initiated in this language, can be @racket[#f] (no change to the
user's setting) or a string to be used as a context query (note: the
context is later maintained as a cookie, @racket[""] is different
from @racket[#f] in that it clears the stored context)}
@cap[drscheme:special:insert-fraction boolean? #t]{
determines if the insert fraction menu item in the special menu is
visible}
@cap[drscheme:special:insert-lambda boolean? #t]{
determines if the insert lambda menu item in the special menu is
visible}
@cap[drscheme:special:insert-large-letters boolean? #t]{
determines if the insert large letters menu item in the special menu
is visible}
@cap[drscheme:special:insert-image boolean? #t]{
determines if the insert image menu item in the special menu is
visible}
@cap[drscheme:special:insert-comment-box boolean? #t]{
determines if the insert comment box menu item in the special menu
is visible}
@cap[drscheme:special:insert-gui-tool boolean? #t]{
determines if the insert gui menu item in the special menu is
visible}
@cap[drscheme:special:slideshow-menu-item boolean? #t]{
determines if the insert pict box menu item in the special menu is
visible}
@cap[drscheme:special:insert-text-box boolean? #t]{
determines if the insert text box menu item in the special menu is
visible}
@cap[drscheme:special:xml-menus boolean? #t]{
determines if the insert scheme box, insert scheme splice box, and
the insert xml box menu item in the special menu are visible}
@cap[drscheme:autocomplete-words (listof string?) '()]{
determines the list of words that are used when completing words in
this language}
@cap[drscheme:tabify-menu-callback
(or/c false/c (-> (is-a?/c text%) number? number? void?))
(λ (t a b) (send t tabify-selection a b))]{
is used as the callback when the ``Reindent'' or ``Reindent All''
menu is selected. The first argument is the editor, and the second
and third are a range in the editor.}
))})
@cap[drscheme:define-popup
(or/c #f
(list/c string? string? string?)
(cons/c string? string?))
(list "(define" "(define ...)" "δ")]{
specifies the prefix that the define popup should look for and what
label it should have, or @racket[#f] if it should not appear at all.
If the list of three strings alternative is used, the first string is
the prefix that is looked for when finding definitions. The second
and third strings are used as the label of the control, in horizontal
and vertical mode, respectively.
The pair of strings alternative is deprecated. If it is used,
the pair @racket[(cons a-str b-str)] is the same as @racket[(list a-str b-str "δ")].}
@cap[drscheme:help-context-term (or/c false/c string?) #f]{
specifies a context query for documentation searches that are
initiated in this language, can be @racket[#f] (no change to the
user's setting) or a string to be used as a context query (note: the
context is later maintained as a cookie, @racket[""] is different
from @racket[#f] in that it clears the stored context)}
@cap[drscheme:special:insert-fraction boolean? #t]{
determines if the insert fraction menu item in the special menu is
visible}
@cap[drscheme:special:insert-lambda boolean? #t]{
determines if the insert lambda menu item in the special menu is
visible}
@cap[drscheme:special:insert-large-letters boolean? #t]{
determines if the insert large letters menu item in the special menu
is visible}
@cap[drscheme:special:insert-image boolean? #t]{
determines if the insert image menu item in the special menu is
visible}
@cap[drscheme:special:insert-comment-box boolean? #t]{
determines if the insert comment box menu item in the special menu
is visible}
@cap[drscheme:special:insert-gui-tool boolean? #t]{
determines if the insert gui menu item in the special menu is
visible}
@cap[drscheme:special:slideshow-menu-item boolean? #t]{
determines if the insert pict box menu item in the special menu is
visible}
@cap[drscheme:special:insert-text-box boolean? #t]{
determines if the insert text box menu item in the special menu is
visible}
@cap[drscheme:special:xml-menus boolean? #t]{
determines if the insert scheme box, insert scheme splice box, and
the insert xml box menu item in the special menu are visible}
@cap[drscheme:autocomplete-words (listof string?) '()]{
determines the list of words that are used when completing words in
this language}
@cap[drscheme:tabify-menu-callback
(or/c false/c (-> (is-a?/c text%) number? number? void?))
(λ (t a b) (send t tabify-selection a b))]{
is used as the callback when the ``Reindent'' or ``Reindent All''
menu is selected. The first argument is the editor, and the second
and third are a range in the editor.}
))})
(proc-doc/names
drracket:language:capability-registered?

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

@ -8,6 +8,11 @@
scheme/port
"../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

276
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,135 +1876,180 @@ 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);
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 collect_master() {
NewGC *saved_gc;
saved_gc = GC_switch_to_master_gc();
{
#if defined(DEBUG_GC_PAGES)
printf("START MASTER COLLECTION\n");
GCVERBOSEprintf("START MASTER COLLECTION\n");
#endif
MASTERGC->major_places_gc = 0;
garbage_collect(MASTERGC, 1, 0);
#if defined(DEBUG_GC_PAGES)
printf("END MASTER COLLECTION\n");
GCVERBOSEprintf("END MASTER COLLECTION\n");
#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;
}
int alive = MASTERGCINFO->alive;
/* wake everyone back up, except MASTERGC and ourself */
for (i=2; i < alive; i++) {
mzrt_sema_post(MASTERGCINFO->wait_sema);
}
}
if (last_one_here) {
NewGC *saved_gc;
GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
}
GC_switch_back_from_master(saved_gc);
}
saved_gc = GC_switch_to_master_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("START MASTER COLLECTION\n");
GCVERBOSEprintf("START MASTER COLLECTION\n");
printf("%i READY\n", gc->place_id);
GCVERBOSEprintf("%i READY\n", i);
#endif
MASTERGC->major_places_gc = 0;
garbage_collect(MASTERGC, 1, 0);
#if defined(DEBUG_GC_PAGES)
printf("END MASTER COLLECTION\n");
GCVERBOSEprintf("END MASTER COLLECTION\n");
#endif
{
int i = 0;
int maxid = MASTERGCINFO->next_GC_id;
/* wake everyone back up */
for (i=2; i < maxid; i++) {
mzrt_sema_post(MASTERGCINFO->wait_sema);
}
}
/* don't count MASTERGC*/
if ((MASTERGCINFO->alive -1) == MASTERGCINFO->ready) {
last_one_here = 1;
}
else {
last_one_here = 0;
}
GC_switch_back_from_master(saved_gc);
}
else {
GC_LOCK_DEBUG("UNMGCLOCK GC_switch_to_master_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
/* wait on semaphonre */
mzrt_sema_wait(MASTERGCINFO->wait_sema);
last_one_here = -1;
}
}
GC_LOCK_DEBUG("UNMGCLOCK wait_if_master_in_progress\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc);
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*/
mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
newid = MASTERGCINFO->next_GC_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;
/* 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);
GC_LOCK_DEBUG("MGCLOCK NewGCMasterInfo_register_gc\n");
{
long newid = NewGCMasterInfo_find_free_id();
newgc->place_id = newid;
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);
MASTERGCINFO->signal_fds[gc->place_id] = fd;
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)