From 1bb773ba2986a38420748f9e1eef2df3eaaf3532 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Apr 2010 08:52:31 -0600 Subject: [PATCH 01/10] fix compatibility drscheme tool linking --- collects/drscheme/private/tools-drs.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/drscheme/private/tools-drs.rkt b/collects/drscheme/private/tools-drs.rkt index bb121ee72c..e31551b0a4 100644 --- a/collects/drscheme/private/tools-drs.rkt +++ b/collects/drscheme/private/tools-drs.rkt @@ -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. From 32de6647dc2dea724978c9d2a512c7307acc3753 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Apr 2010 08:55:16 -0600 Subject: [PATCH 02/10] fix HtDP language printing --- collects/lang/htdp-langs.rkt | 6 +++--- collects/lang/private/advanced-funs.rkt | 7 ++++++- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index 63b0e97a07..bb8ae1b4ce 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -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)) diff --git a/collects/lang/private/advanced-funs.rkt b/collects/lang/private/advanced-funs.rkt index eea94b3150..585461c2b8 100644 --- a/collects/lang/private/advanced-funs.rkt +++ b/collects/lang/private/advanced-funs.rkt @@ -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") From 8879f4a61dc1288bcc1328ee00da7e3f6369bd31 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Wed, 28 Apr 2010 12:30:25 -0400 Subject: [PATCH 03/10] Updated unstable/srcloc tests for racket. --- collects/tests/unstable/srcloc.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/tests/unstable/srcloc.rkt b/collects/tests/unstable/srcloc.rkt index 299cbf07b8..ac7deae461 100644 --- a/collects/tests/unstable/srcloc.rkt +++ b/collects/tests/unstable/srcloc.rkt @@ -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) From 79b943b2ef727fbf4c9b3ae7a696e1f49180dc53 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Apr 2010 10:46:32 -0600 Subject: [PATCH 04/10] fix tools doc --- collects/drscheme/tool-lib.rkt | 163 ++++++++++++-------------- collects/scribblings/tools/common.rkt | 2 +- 2 files changed, 79 insertions(+), 86 deletions(-) diff --git a/collects/drscheme/tool-lib.rkt b/collects/drscheme/tool-lib.rkt index 8bf07384b0..992434d25f 100644 --- a/collects/drscheme/tool-lib.rkt +++ b/collects/drscheme/tool-lib.rkt @@ -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? diff --git a/collects/scribblings/tools/common.rkt b/collects/scribblings/tools/common.rkt index f687e5c0a2..9a09a16152 100644 --- a/collects/scribblings/tools/common.rkt +++ b/collects/scribblings/tools/common.rkt @@ -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) From 6a28bd0e4b617b9f60384756f509b5fa306d7d3a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Apr 2010 11:02:16 -0600 Subject: [PATCH 05/10] fix some tests for drdr --- collects/meta/props | 7 +++++++ collects/tests/mred/auto.rkt | 8 ++++---- collects/tests/mred/dc.rkt | 2 +- collects/tests/mred/editor.rkt | 2 +- collects/tests/mred/gui.rkt | 2 +- collects/tests/mred/loadtest.rkt | 2 +- collects/tests/mred/paramz.rkt | 2 +- collects/tests/mred/windowing.rkt | 2 +- collects/tests/racket/benchmarks/mz/parsing.scm | 2 +- collects/tests/racket/cache-image-snip-test.rkt | 2 +- collects/tests/racket/embed-me11.rkt | 2 +- collects/tests/racket/prompt-sfs.rkt | 8 ++++---- collects/tests/syntax-color/paren-tree.rkt | 2 +- collects/tests/syntax-color/token-tree.rkt | 2 +- 14 files changed, 26 insertions(+), 19 deletions(-) diff --git a/collects/meta/props b/collects/meta/props index b11e66e948..8924b31e96 100644 --- a/collects/meta/props +++ b/collects/meta/props @@ -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" diff --git a/collects/tests/mred/auto.rkt b/collects/tests/mred/auto.rkt index c90f3e5988..8f37aef12c 100644 --- a/collects/tests/mred/auto.rkt +++ b/collects/tests/mred/auto.rkt @@ -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") diff --git a/collects/tests/mred/dc.rkt b/collects/tests/mred/dc.rkt index 217f14e3a1..064603f23e 100644 --- a/collects/tests/mred/dc.rkt +++ b/collects/tests/mred/dc.rkt @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rkt") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DC Tests ;; diff --git a/collects/tests/mred/editor.rkt b/collects/tests/mred/editor.rkt index 1e235a0d01..e9219151c0 100644 --- a/collects/tests/mred/editor.rkt +++ b/collects/tests/mred/editor.rkt @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rkt") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Editor Tests ;; diff --git a/collects/tests/mred/gui.rkt b/collects/tests/mred/gui.rkt index 1125a133c5..1cc35d6ee7 100644 --- a/collects/tests/mred/gui.rkt +++ b/collects/tests/mred/gui.rkt @@ -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%)))) diff --git a/collects/tests/mred/loadtest.rkt b/collects/tests/mred/loadtest.rkt index d60140522f..117c1de3ae 100644 --- a/collects/tests/mred/loadtest.rkt +++ b/collects/tests/mred/loadtest.rkt @@ -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")) diff --git a/collects/tests/mred/paramz.rkt b/collects/tests/mred/paramz.rkt index a74786bfe9..e78265adf4 100644 --- a/collects/tests/mred/paramz.rkt +++ b/collects/tests/mred/paramz.rkt @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rkt") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Yield Tests ;; diff --git a/collects/tests/mred/windowing.rkt b/collects/tests/mred/windowing.rkt index 6cb61eeb2e..6bda22354c 100644 --- a/collects/tests/mred/windowing.rkt +++ b/collects/tests/mred/windowing.rkt @@ -1,5 +1,5 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rkt") (define shorter? #t) diff --git a/collects/tests/racket/benchmarks/mz/parsing.scm b/collects/tests/racket/benchmarks/mz/parsing.scm index 4900f6f3d2..a1d17b8ecb 100644 --- a/collects/tests/racket/benchmarks/mz/parsing.scm +++ b/collects/tests/racket/benchmarks/mz/parsing.scm @@ -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 diff --git a/collects/tests/racket/cache-image-snip-test.rkt b/collects/tests/racket/cache-image-snip-test.rkt index 88606410bf..4dbc72776e 100644 --- a/collects/tests/racket/cache-image-snip-test.rkt +++ b/collects/tests/racket/cache-image-snip-test.rkt @@ -1,4 +1,4 @@ -(load-relative "loadtest.ss") +(load-relative "loadtest.rkt") (require mrlib/cache-image-snip mzlib/unit) diff --git a/collects/tests/racket/embed-me11.rkt b/collects/tests/racket/embed-me11.rkt index f3ab6ee9f7..c4771e307e 100644 --- a/collects/tests/racket/embed-me11.rkt +++ b/collects/tests/racket/embed-me11.rkt @@ -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" diff --git a/collects/tests/racket/prompt-sfs.rkt b/collects/tests/racket/prompt-sfs.rkt index ccc9ede999..cea6d2a9c0 100644 --- a/collects/tests/racket/prompt-sfs.rkt +++ b/collects/tests/racket/prompt-sfs.rkt @@ -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": +1 +" (get-output-bytes p)) (error "wrong output") (exit 1)))) diff --git a/collects/tests/syntax-color/paren-tree.rkt b/collects/tests/syntax-color/paren-tree.rkt index 44befb9041..4d7c62d1f9 100644 --- a/collects/tests/syntax-color/paren-tree.rkt +++ b/collects/tests/syntax-color/paren-tree.rkt @@ -1,4 +1,4 @@ -(load-relative "../mzscheme/loadtest.ss") +(load-relative "../racket/loadtest.rkt") (require mzlib/class syntax-color/paren-tree) diff --git a/collects/tests/syntax-color/token-tree.rkt b/collects/tests/syntax-color/token-tree.rkt index 1f76b8bd0f..76ba9059b2 100644 --- a/collects/tests/syntax-color/token-tree.rkt +++ b/collects/tests/syntax-color/token-tree.rkt @@ -1,4 +1,4 @@ -(load-relative "../mzscheme/loadtest.ss") +(load-relative "../racket/loadtest.rkt") (require mzlib/class syntax-color/token-tree) From d2670835ce624c581c2cca7e9a4025e9d154ccfc Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Mon, 26 Apr 2010 14:29:20 -0600 Subject: [PATCH 06/10] Remove uneeded place gc lock --- src/racket/gc2/newgc.c | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index c4a331c368..50b1a20d0d 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -3520,13 +3520,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 +3773,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); } From 0a287b59e09fe088f636136152920f8394f0fe84 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Mon, 26 Apr 2010 14:20:37 -0600 Subject: [PATCH 07/10] more SIGSEGV descriptions --- src/racket/gc2/sighand.c | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/racket/gc2/sighand.c b/src/racket/gc2/sighand.c index 1c058874b0..745d1ae003 100644 --- a/src/racket/gc2/sighand.c +++ b/src/racket/gc2/sighand.c @@ -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(); } From c56fb66fa055531d0030a1a2cabd57484cf02855 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Mon, 26 Apr 2010 14:24:15 -0600 Subject: [PATCH 08/10] add page to killing debug --- src/racket/gc2/newgc.c | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 50b1a20d0d..dee0bd431a 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -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 */ @@ -2345,8 +2345,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 +3075,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 +3093,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 +3106,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 @@ -3286,7 +3287,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; From ac8aa01a4854f1d52fd59a80793651e2eee5a1f0 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Mon, 26 Apr 2010 14:25:39 -0600 Subject: [PATCH 09/10] GC - add sanity check default case --- src/racket/gc2/newgc.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index dee0bd431a..0474d6f747 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -3280,6 +3280,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 From 1ce41d49f40b09c998c38556d051ee9e1160118c Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Tue, 27 Apr 2010 16:46:55 -0600 Subject: [PATCH 10/10] Places GC cleanup on place termination --- src/racket/gc2/gc2.h | 5 + src/racket/gc2/newgc.c | 236 ++++++++++++++++++++++++++--------------- src/racket/gc2/newgc.h | 5 +- src/racket/src/env.c | 3 + 4 files changed, 164 insertions(+), 85 deletions(-) diff --git a/src/racket/gc2/gc2.h b/src/racket/gc2/gc2.h index 4afc1858a3..6fa565f220 100644 --- a/src/racket/gc2/gc2.h +++ b/src/racket/gc2/gc2.h @@ -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 diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index 0474d6f747..8565bc9ef8 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -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); diff --git a/src/racket/gc2/newgc.h b/src/racket/gc2/newgc.h index bdacfe71b8..815de91646 100644 --- a/src/racket/gc2/newgc.h +++ b/src/racket/gc2/newgc.h @@ -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; diff --git a/src/racket/src/env.c b/src/racket/src/env.c index 14ec6b81cd..51fcab8575 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -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)