From cb54ca6402db79e19de05c69707dd4858b28ef35 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 20 Aug 2009 18:36:34 -0500 Subject: [PATCH 01/22] clarify 'deprecated' docs --- core/syntax/syntax-docs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index a988e57365..cc4b080491 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -193,7 +193,8 @@ HELP: delimiter HELP: deprecated { $syntax ": foo ... ; deprecated" } -{ $description "Declares the most recently defined word as deprecated. If the " { $vocab-link "tools.deprecation" } " vocabulary is loaded, usages of deprecated words will be noted as they are made." } ; +{ $description "Declares the most recently defined word as deprecated. If the " { $vocab-link "tools.deprecation" } " vocabulary is loaded, usages of deprecated words will be noted by the " { $link "tools.errors" } " system." } +{ $notes "Code that uses deprecated words continues to function normally; the errors are purely informational. However, code that uses deprecated words should be updated, for the deprecated words are intended to be removed soon." } ; HELP: SYNTAX: { $syntax "SYNTAX: foo ... ;" } From c6b9a458815850ca2a8b6af8f606fe18d536de37 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 20 Aug 2009 18:36:55 -0500 Subject: [PATCH 02/22] $deprecated help markup --- basis/help/markup/markup.factor | 8 ++++++++ basis/help/stylesheet/stylesheet.factor | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 6f82a6f50b..2270088490 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -137,6 +137,14 @@ ALIAS: $slot $snippet ] with-nesting ] ($heading) ; +: $deprecated ( element -- ) + [ + deprecated-style get [ + last-element off + "This word is deprecated" $heading print-element + ] with-nesting + ] ($heading) ; + ! Images : $image ( element -- ) [ first write-image ] ($span) ; diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor index 74d7f6c115..c7811a605d 100644 --- a/basis/help/stylesheet/stylesheet.factor +++ b/basis/help/stylesheet/stylesheet.factor @@ -85,6 +85,14 @@ H{ { wrap-margin 500 } } warning-style set-global +SYMBOL: deprecated-style +H{ + { page-color COLOR: gray90 } + { border-color COLOR: red } + { border-width 5 } + { wrap-margin 500 } +} deprecated-style set-global + SYMBOL: table-content-style H{ { wrap-margin 350 } From 6f6edd79acfb4d99f99220ccd402dd1db4fb4825 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 21 Aug 2009 21:17:15 -0500 Subject: [PATCH 03/22] combinators.smart: "keep-inputs" combinator --- basis/combinators/smart/smart-docs.factor | 12 +++++++++++- basis/combinators/smart/smart.factor | 3 +++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/basis/combinators/smart/smart-docs.factor b/basis/combinators/smart/smart-docs.factor index 59b65d91cd..85545a730c 100644 --- a/basis/combinators/smart/smart-docs.factor +++ b/basis/combinators/smart/smart-docs.factor @@ -106,11 +106,21 @@ HELP: append-outputs-as { append-outputs append-outputs-as } related-words +HELP: drop-outputs +{ $values { "quot" quotation } } +{ $description "Calls a quotation and drops any values it leaves on the stack." } ; + +HELP: keep-inputs +{ $values { "quot" quotation } } +{ $description "Calls a quotation and preserves any values it takes off the stack." } ; + +{ drop-outputs keep-inputs } related-words ARTICLE: "combinators.smart" "Smart combinators" "A " { $emphasis "smart combinator" } " is a macro which reflects on the stack effect of an input quotation. The " { $vocab-link "combinators.smart" } " vocabulary implements a few simple smart combinators which look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl -"Call a quotation and discard all output values:" +"Call a quotation and discard all output values or preserve all input values:" { $subsection drop-outputs } +{ $subsection keep-inputs } "Take all input values from a sequence:" { $subsection input> '[ @ _ ndrop ] ; +MACRO: keep-inputs ( quot -- quot' ) + dup infer in>> '[ _ _ nkeep ] ; + MACRO: output>sequence ( quot exemplar -- newquot ) [ dup infer out>> ] dip '[ @ _ _ nsequence ] ; From 17a08cb07a926a2198771dd9879c6c20fe7e95e0 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 22 Aug 2009 20:15:13 -0500 Subject: [PATCH 04/22] gpu.shaders docs corrections --- extra/gpu/shaders/shaders-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/gpu/shaders/shaders-docs.factor b/extra/gpu/shaders/shaders-docs.factor index d59fa1bc39..33b97d7a82 100755 --- a/extra/gpu/shaders/shaders-docs.factor +++ b/extra/gpu/shaders/shaders-docs.factor @@ -111,7 +111,7 @@ HELP: output-index { $notes "Named fragment shader outputs require OpenGL 3.0 or later and GLSL 1.30 or later, or OpenGL 2.0 or later and GLSL 1.20 or earlier with the " { $snippet "GL_EXT_gpu_shader4" } " extension." } ; HELP: program -{ $class-description "A " { $snippet "program" } " provides a specification for linking a " { $link program-instance } " in a graphics context. Programs are defined with " { $link POSTPONE: GLSL-PROGRAM: } " and instantiated in a context with " { $link } "." } ; +{ $class-description "A " { $snippet "program" } " provides a specification for linking a " { $link program-instance } " in a graphics context. Programs are defined with " { $link POSTPONE: GLSL-PROGRAM: } " and instantiated for a context with " { $link } "." } ; HELP: program-instance { $class-description "A " { $snippet "program-instance" } " is a shader " { $link program } " that has been compiled and linked for a graphics context using " { $link } "." } ; @@ -120,10 +120,10 @@ HELP: refresh-program { $values { "program" program } } -{ $description "Rereads the source code for every " { $link shader } " in " { $link program } " and attempts to refresh all the existing " { $link shader-instance } "s and " { $link program-instance } "s for those programs. If the new source code fails to compile or link, the existing instances are untouched; otherwise, they are updated on the fly to reference the newly compiled code." } ; +{ $description "Rereads the source code for every " { $link shader } " in " { $link program } " and attempts to refresh all the existing " { $link shader-instance } "s and " { $link program-instance } "s for those shaders. If any of the new source code fails to compile or link, the existing valid shader and program instances will remain untouched. However, subsequent attempts to compile new shader or program instances will still attempt to use the new source code. If the compilation and linking succeed, the existing shader and program instances will be updated on the fly to reference the newly compiled code." } ; HELP: shader -{ $class-description "A " { $snippet "shader" } " provides a block of GLSL source code that can be compiled into a " { $link shader-instance } " in a graphics context. Shaders are defined with " { $link POSTPONE: GLSL-SHADER: } " or " { $link POSTPONE: GLSL-SHADER-FILE: } " and instantiated in a context with " { $link } "." } ; +{ $class-description "A " { $snippet "shader" } " provides a block of GLSL source code that can be compiled into a " { $link shader-instance } " in a graphics context. Shaders are defined with " { $link POSTPONE: GLSL-SHADER: } " or " { $link POSTPONE: GLSL-SHADER-FILE: } " and instantiated for a context with " { $link } "." } ; HELP: shader-instance { $class-description "A " { $snippet "shader-instance" } " is a " { $link shader } " that has been compiled for a graphics context using " { $link } "." } ; From 4923c66cc9fc8f8c4bbbde8ee95985c970175d69 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 22 Aug 2009 21:03:39 -0500 Subject: [PATCH 05/22] memory.piles: and convenience words --- extra/memory/piles/piles-docs.factor | 16 ++++++++++++++++ extra/memory/piles/piles.factor | 6 ++++++ 2 files changed, 22 insertions(+) diff --git a/extra/memory/piles/piles-docs.factor b/extra/memory/piles/piles-docs.factor index c2bc29af1c..108c3535c9 100644 --- a/extra/memory/piles/piles-docs.factor +++ b/extra/memory/piles/piles-docs.factor @@ -32,6 +32,20 @@ HELP: pile-alloc } { $description "Requests " { $snippet "size" } " bytes from a " { $link pile } ". If the pile does not have enough space to satisfy the request, a " { $link not-enough-pile-space } " error is thrown." } ; +HELP: +{ $values + { "pile" pile } { "n" integer } { "c-type" "a C type" } + { "alien" alien } +} +{ $description "Requests enough space from a " { $link pile } " to hold " { $snippet "n" } " values of " { $snippet "c-type" } ". If the pile does not have enough space to satisfy the request, a " { $link not-enough-pile-space } " error is thrown." } ; + +HELP: +{ $values + { "pile" pile } { "c-type" "a C type" } + { "alien" alien } +} +{ $description "Requests enough space from a " { $link pile } " to hold a value of " { $snippet "c-type" } ". If the pile does not have enough space to satisfy the request, a " { $link not-enough-pile-space } " error is thrown." } ; + HELP: pile-empty { $values { "pile" pile } @@ -42,6 +56,8 @@ ARTICLE: "memory.piles" "Piles" "A " { $link pile } " is a block of raw memory. Portions of its memory can be allocated from the beginning of the pile in constant time, and the pile can be emptied and its pointer reset to the beginning." { $subsection } { $subsection pile-alloc } +{ $subsection } +{ $subsection } { $subsection pile-align } { $subsection pile-empty } "An example of the utility of piles is in video games. For example, the game Abuse was scripted with a Lisp dialect. In order to avoid stalls from traditional GC or heap-based allocators, the Abuse Lisp VM would allocate values from a preallocated pile over the course of a frame, and release the entire pile at the end of the frame." ; diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index b8a79b4824..651bf2ec6c 100644 --- a/extra/memory/piles/piles.factor +++ b/extra/memory/piles/piles.factor @@ -28,6 +28,12 @@ M: pile dispose [ + ] curry change-offset drop ] 2tri ; +: ( pile c-type -- alien ) + heap-size pile-alloc ; inline + +: ( pile n c-type -- alien ) + heap-size * pile-alloc ; inline + : pile-align ( pile align -- pile ) [ align ] curry change-offset ; From 556adeb9b4b15e6fe6941a9189ad89f982436817 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 23 Aug 2009 09:51:12 -0500 Subject: [PATCH 06/22] handle RGBA pngs (when inflate finally works) --- basis/images/png/png.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor index 2469a6a72c..86247351c9 100755 --- a/basis/images/png/png.factor +++ b/basis/images/png/png.factor @@ -95,7 +95,11 @@ ERROR: unimplemented-color-type image ; unimplemented-color-type ; : decode-truecolor-alpha ( loading-png -- loading-png ) - unimplemented-color-type ; + [ ] dip { + [ png-image-bytes >>bitmap ] + [ [ width>> ] [ height>> ] bi 2array >>dim ] + [ drop RGBA >>component-order ubyte-components >>component-type ] + } cleave ; : decode-png ( loading-png -- loading-png ) dup color-type>> { From bbb220f892f84be7b962e34443fd7b303579ed2b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 24 Aug 2009 19:43:19 -0500 Subject: [PATCH 07/22] make memory.piles load without auto-use --- extra/memory/piles/piles.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index 651bf2ec6c..46729c42be 100644 --- a/extra/memory/piles/piles.factor +++ b/extra/memory/piles/piles.factor @@ -1,5 +1,5 @@ ! (c)2009 Joe Groff bsd license -USING: accessors alien destructors kernel libc math ; +USING: accessors alien alien.c-types destructors kernel libc math ; IN: memory.piles TUPLE: pile From 197a64eaaeaa4685e232623fe8fd96206c7adf0c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:19:55 -0500 Subject: [PATCH 08/22] io.streams.duplex: fix test --- basis/io/streams/duplex/duplex-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/streams/duplex/duplex-tests.factor b/basis/io/streams/duplex/duplex-tests.factor index 4903db2b1b..b64273ebb3 100644 --- a/basis/io/streams/duplex/duplex-tests.factor +++ b/basis/io/streams/duplex/duplex-tests.factor @@ -5,7 +5,7 @@ IN: io.streams.duplex.tests ! Test duplex stream close behavior TUPLE: closing-stream < disposable ; -: ( -- stream ) closing-stream new ; +: ( -- stream ) closing-stream new-disposable ; M: closing-stream dispose* drop ; From 3be328056db8ab721e3a92c542568f592bf61d6b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:21:03 -0500 Subject: [PATCH 09/22] libc: use central disposables mechanism to track mallocs --- basis/libc/libc-tests.factor | 4 ++-- basis/libc/libc.factor | 28 ++++++++++++------------- basis/tools/deploy/shaker/shaker.factor | 2 -- 3 files changed, 16 insertions(+), 18 deletions(-) diff --git a/basis/libc/libc-tests.factor b/basis/libc/libc-tests.factor index b00463127f..3dcebb5e7a 100644 --- a/basis/libc/libc-tests.factor +++ b/basis/libc/libc-tests.factor @@ -4,8 +4,8 @@ destructors kernel ; 100 malloc "block" set -[ t ] [ "block" get mallocs key? ] unit-test +[ t ] [ "block" get malloc-exists? ] unit-test [ ] [ [ "block" get &free drop ] with-destructors ] unit-test -[ f ] [ "block" get mallocs key? ] unit-test +[ f ] [ "block" get malloc-exists? ] unit-test diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index 7a55b15473..926a6c4ec4 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -3,7 +3,7 @@ ! Copyright (C) 2007, 2008 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: alien assocs continuations alien.destructors kernel -namespaces accessors sets summary ; +namespaces accessors sets summary destructors destructors.private ; IN: libc : errno ( -- int ) @@ -26,8 +26,16 @@ IN: libc : (realloc) ( alien size -- newalien ) "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ; -: mallocs ( -- assoc ) - \ mallocs [ H{ } clone ] initialize-alien ; +! We stick malloc-ptr instances in the global disposables set +TUPLE: malloc-ptr value continuation ; + +M: malloc-ptr hashcode* value>> hashcode* ; + +M: malloc-ptr equal? + over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ; + +: ( value -- malloc-ptr ) + malloc-ptr new swap >>value ; PRIVATE> @@ -39,11 +47,6 @@ M: bad-ptr summary : check-ptr ( c-ptr -- c-ptr ) [ bad-ptr ] unless* ; -ERROR: double-free ; - -M: double-free summary - drop "Free failed since memory is not allocated" ; - ERROR: realloc-error ptr size ; M: realloc-error summary @@ -52,16 +55,13 @@ M: realloc-error summary register-disposable ; : delete-malloc ( alien -- ) - [ - mallocs delete-at* - [ drop ] [ double-free ] if - ] when* ; + [ unregister-disposable ] when* ; : malloc-exists? ( alien -- ? ) - mallocs key? ; + disposables get key? ; PRIVATE> diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index c587f842ca..b24981ed88 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -284,8 +284,6 @@ IN: tools.deploy.shaker "io-thread" "io.thread" lookup , - "mallocs" "libc.private" lookup , - "disposables" "destructors" lookup , deploy-threads? [ From b12bbaf7ecad3b18cb446a32faa7424f3bd9efd2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:21:38 -0500 Subject: [PATCH 10/22] tools.destructors: destructors. and leaks words now output a 'show instances' link which lists all relevant disposables --- basis/tools/destructors/destructors.factor | 52 +++++++++++++++------- core/destructors/destructors.factor | 16 +++++-- 2 files changed, 49 insertions(+), 19 deletions(-) diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor index 4f182c6777..d032b5291a 100644 --- a/basis/tools/destructors/destructors.factor +++ b/basis/tools/destructors/destructors.factor @@ -1,31 +1,51 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs classes destructors fry kernel math namespaces -prettyprint sequences sets sorting ; +prettyprint sequences sets sorting continuations accessors arrays +io io.styles combinators.smart ; IN: tools.destructors alist sort-keys simple-table. ; + class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with + standard-table-style [ + [ + [ "Disposable class" write ] with-cell + [ "Instances" write ] with-cell + [ ] with-cell + ] with-row + [ + [ + [ + [ pprint-cell ] + [ pprint-cell ] + [ [ "[ List instances ]" swap write-object ] with-cell ] + tri* + ] input> ] sort-with ] dip append ; PRIVATE> : disposables. ( -- ) - disposable-tally (disposables.) ; + disposables get (disposables.) ; + +: disposables-of-class. ( class -- ) + [ disposables get values sort-disposables ] dip + '[ _ instance? ] filter stack. ; : leaks ( quot -- ) - disposable-tally [ call disposable-tally ] dip subtract-values - (disposables.) ; inline + disposables get clone + debug-leaks? on + [ + [ call disposables get clone ] dip + ] [ ] [ debug-leaks? off ] cleanup + assoc-diff (disposables.) ; inline diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index 39f0e9f2b9..d306da18c4 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -1,24 +1,34 @@ ! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors continuations kernel namespaces make -sequences vectors sets assocs init ; +sequences vectors sets assocs init math ; IN: destructors SYMBOL: disposables [ H{ } clone disposables set-global ] "destructors" add-init-hook +ERROR: already-unregistered disposable ; + +SYMBOL: debug-leaks? + >continuation ] when disposables get conjoin ; : unregister-disposable ( obj -- ) - disposables get delete-at ; + disposables get 2dup key? [ already-unregistered ] unless delete-at ; PRIVATE> -TUPLE: disposable < identity-tuple disposed id ; +TUPLE: disposable < identity-tuple +{ id integer } +{ disposed boolean } +continuation ; M: disposable hashcode* nip id>> ; From 623ddfca6f8c56c985e390dbfbcee259df655648 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:22:00 -0500 Subject: [PATCH 11/22] ui.tools.operations: disposables now have a 'dispose' operation, and disposables created within a 'leaks' now have an operation which shows the continuation that created them --- basis/ui/tools/operations/operations.factor | 35 +++++++++++++++------ 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index 4944cba1d6..3019de4e21 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: continuations definitions generic help.topics threads -stack-checker summary io.pathnames io.styles kernel namespaces parser -prettyprint quotations tools.crossref tools.annotations editors -tools.profiler tools.test tools.time tools.walker vocabs vocabs.loader -words sequences classes compiler.errors compiler.units -accessors vocabs.parser macros.expander ui ui.tools.browser -ui.tools.listener ui.tools.listener.completion ui.tools.profiler -ui.tools.inspector ui.tools.traceback ui.commands ui.gadgets.editors -ui.gestures ui.operations ui.tools.deploy models help.tips -source-files.errors ; +stack-checker summary io.pathnames io.styles kernel namespaces +parser prettyprint quotations tools.crossref tools.annotations +editors tools.profiler tools.test tools.time tools.walker vocabs +vocabs.loader words sequences classes compiler.errors +compiler.units accessors vocabs.parser macros.expander ui +ui.tools.browser ui.tools.listener ui.tools.listener.completion +ui.tools.profiler ui.tools.inspector ui.tools.traceback +ui.commands ui.gadgets.editors ui.gestures ui.operations +ui.tools.deploy models help.tips source-files.errors destructors +libc libc.private ; IN: ui.tools.operations ! Objects @@ -182,6 +183,22 @@ M: word com-stack-effect 1quotation com-stack-effect ; { +listener+ t } } define-operation +! Disposables +[ disposable? ] \ dispose H{ } define-operation + +! Disposables with a continuation +PREDICATE: tracked-disposable < disposable + continuation>> >boolean ; + +PREDICATE: tracked-malloc-ptr < malloc-ptr + continuation>> >boolean ; + +: com-creation-traceback ( disposable -- ) + continuation>> traceback-window ; + +[ tracked-disposable? ] \ com-creation-traceback H{ { +primary+ t } } define-operation +[ tracked-malloc-ptr? ] \ com-creation-traceback H{ { +primary+ t } } define-operation + ! Operations -> commands interactor "quotation" From adc154e06bba18e2b16ea69ac0ac1ece66bca641 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:27:22 -0500 Subject: [PATCH 12/22] destructors: already-unregistered error had the wrong content, also don't throw an error when disposing a disposable twice --- core/destructors/destructors-tests.factor | 11 ++++++++++- core/destructors/destructors.factor | 8 ++++++-- core/io/files/files-tests.factor | 8 +++++++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor index f9d0770d02..c55b5ef423 100644 --- a/core/destructors/destructors-tests.factor +++ b/core/destructors/destructors-tests.factor @@ -1,5 +1,5 @@ USING: destructors kernel tools.test continuations accessors -namespaces sequences ; +namespaces sequences destructors.private ; IN: destructors.tests TUPLE: dispose-error ; @@ -66,3 +66,12 @@ M: dummy-destructor dispose ( obj -- ) ] ignore-errors destroyed?>> ] unit-test +TUPLE: silly-disposable < disposable ; + +M: silly-disposable dispose* drop ; + +silly-disposable new-disposable "s" set +"s" get dispose +[ "s" get unregister-disposable ] +[ disposable>> silly-disposable? ] +must-fail-with diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index d306da18c4..4190cdaaf5 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -21,7 +21,7 @@ SLOT: continuation disposables get conjoin ; : unregister-disposable ( obj -- ) - disposables get 2dup key? [ already-unregistered ] unless delete-at ; + disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ; PRIVATE> @@ -49,7 +49,11 @@ M: object dispose dup disposed>> [ drop ] [ t >>disposed dispose* ] if ; M: disposable dispose - [ unregister-disposable ] [ call-next-method ] bi ; + dup disposed>> [ drop ] [ + [ unregister-disposable ] + [ call-next-method ] + bi + ] if ; : dispose-each ( seq -- ) [ diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index f57dafbdc6..6387e47dfc 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -152,4 +152,10 @@ USE: debugger.threads "non-byte-array-error" unique-file binary [ "" write ] with-file-writer -] [ no-method? ] must-fail-with \ No newline at end of file +] [ no-method? ] must-fail-with + +! What happens if we close a file twice? +[ ] [ + "closing-twice" unique-file ascii + [ dispose ] [ dispose ] bi +] unit-test \ No newline at end of file From b2a1858f8f66183db1d9619158c77b0bb43a5574 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:33:27 -0500 Subject: [PATCH 13/22] Move a few more things over to new disposable protocol --- basis/checksums/openssl/openssl.factor | 8 ++++---- basis/io/backend/unix/multiplexers/epoll/epoll.factor | 2 +- basis/io/backend/unix/multiplexers/kqueue/kqueue.factor | 2 +- basis/io/backend/unix/multiplexers/multiplexers.factor | 6 +++--- basis/ui/pixel-formats/pixel-formats.factor | 8 +++++--- 5 files changed, 14 insertions(+), 12 deletions(-) diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index 58748b7c29..6f21d96e86 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -19,13 +19,13 @@ C: openssl-checksum ( -- ctx ) - "EVP_MD_CTX" - dup EVP_MD_CTX_init evp-md-context boa ; + evp-md-context new-disposable + "EVP_MD_CTX" dup EVP_MD_CTX_init >>handle ; -M: evp-md-context dispose +M: evp-md-context dispose* handle>> EVP_MD_CTX_cleanup drop ; : with-evp-md-context ( quot -- ) diff --git a/basis/io/backend/unix/multiplexers/epoll/epoll.factor b/basis/io/backend/unix/multiplexers/epoll/epoll.factor index e1428fee4d..98c48c113d 100644 --- a/basis/io/backend/unix/multiplexers/epoll/epoll.factor +++ b/basis/io/backend/unix/multiplexers/epoll/epoll.factor @@ -18,7 +18,7 @@ TUPLE: epoll-mx < mx events ; max-events epoll_create dup io-error >>fd max-events "epoll-event" >>events ; -M: epoll-mx dispose fd>> close-file ; +M: epoll-mx dispose* fd>> close-file ; : make-event ( fd events -- event ) "epoll-event" diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor index 7bd157136a..f7b15beb54 100644 --- a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor +++ b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor @@ -17,7 +17,7 @@ TUPLE: kqueue-mx < mx events ; kqueue dup io-error >>fd max-events "kevent" >>events ; -M: kqueue-mx dispose fd>> close-file ; +M: kqueue-mx dispose* fd>> close-file ; : make-kevent ( fd filter flags -- event ) "kevent" diff --git a/basis/io/backend/unix/multiplexers/multiplexers.factor b/basis/io/backend/unix/multiplexers/multiplexers.factor index 844670d635..73d8a60310 100644 --- a/basis/io/backend/unix/multiplexers/multiplexers.factor +++ b/basis/io/backend/unix/multiplexers/multiplexers.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors assocs sequences threads ; +USING: kernel accessors assocs sequences threads destructors ; IN: io.backend.unix.multiplexers -TUPLE: mx fd reads writes ; +TUPLE: mx < disposable fd reads writes ; : new-mx ( class -- obj ) - new + new-disposable H{ } clone >>reads H{ } clone >>writes ; inline diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index a280ab0666..b902521079 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -46,13 +46,15 @@ HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value ERROR: invalid-pixel-format-attributes world attributes ; -TUPLE: pixel-format world handle ; +TUPLE: pixel-format < disposable world handle ; : ( world attributes -- pixel-format ) 2dup (make-pixel-format) - [ nip pixel-format boa ] [ invalid-pixel-format-attributes ] if* ; + [ pixel-format new swap >>handle swap >>world ] + [ invalid-pixel-format-attributes ] + ?if ; -M: pixel-format dispose +M: pixel-format dispose* [ (free-pixel-format) ] [ f >>handle drop ] bi ; : pixel-format-attribute ( pixel-format attribute-name -- value ) From e44a0158e60fdcbc4af3aeb67273bac4f4a02a09 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:45:06 -0500 Subject: [PATCH 14/22] tools.destructors: leaks now tracks leaks globally --- basis/tools/destructors/destructors.factor | 4 ++-- core/destructors/destructors.factor | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor index d032b5291a..c0aa35b049 100644 --- a/basis/tools/destructors/destructors.factor +++ b/basis/tools/destructors/destructors.factor @@ -44,8 +44,8 @@ PRIVATE> : leaks ( quot -- ) disposables get clone - debug-leaks? on + t debug-leaks? set-global [ [ call disposables get clone ] dip - ] [ ] [ debug-leaks? off ] cleanup + ] [ ] [ f debug-leaks? set-global ] cleanup assoc-diff (disposables.) ; inline diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index 4190cdaaf5..3e57f498af 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -17,7 +17,7 @@ SYMBOL: debug-leaks? SLOT: continuation : register-disposable ( obj -- ) - debug-leaks? get [ continuation >>continuation ] when + debug-leaks? get-global [ continuation >>continuation ] when disposables get conjoin ; : unregister-disposable ( obj -- ) From 8b68a07649a23fbfc9f0a343f6d91c3a053362a6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:45:19 -0500 Subject: [PATCH 15/22] ui.pixel-formats: fix screwup --- basis/ui/pixel-formats/pixel-formats.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index b902521079..f463ae2b68 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -50,7 +50,7 @@ TUPLE: pixel-format < disposable world handle ; : ( world attributes -- pixel-format ) 2dup (make-pixel-format) - [ pixel-format new swap >>handle swap >>world ] + [ pixel-format new-disposable swap >>handle swap >>world ] [ invalid-pixel-format-attributes ] ?if ; From 7b6d00a833ebd6326516b9bdd735a512018c347e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:45:46 -0500 Subject: [PATCH 16/22] alien.destructors: don't use disposable protocol, since it is common practice to 'leak' alien destructors (|Foo idiom) --- basis/alien/destructors/destructors.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor index 24a75304b7..7fd991b9af 100755 --- a/basis/alien/destructors/destructors.factor +++ b/basis/alien/destructors/destructors.factor @@ -4,7 +4,7 @@ USING: functors destructors accessors kernel parser words effects generalizations sequences ; IN: alien.destructors -SLOT: alien +TUPLE: alien-destructor alien ; FUNCTOR: define-destructor ( F -- ) @@ -16,12 +16,12 @@ N [ F stack-effect out>> length ] WHERE -TUPLE: F-destructor < disposable alien ; +TUPLE: F-destructor < alien-destructor ; : ( alien -- destructor ) - F-destructor new-disposable swap >>alien ; inline + F-destructor boa ; inline -M: F-destructor dispose* alien>> F N ndrop ; +M: F-destructor dispose alien>> F N ndrop ; : &F ( alien -- alien ) dup &dispose drop ; inline From 29b489c892919c8f40cab2b8e9b81a1f94df939b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 20:55:24 -0500 Subject: [PATCH 17/22] io.monitors: fixes for disposable protocol --- basis/io/monitors/macosx/macosx.factor | 3 +-- basis/io/monitors/monitors.factor | 2 -- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/basis/io/monitors/macosx/macosx.factor b/basis/io/monitors/macosx/macosx.factor index be1dcc64b6..96f178fb79 100644 --- a/basis/io/monitors/macosx/macosx.factor +++ b/basis/io/monitors/macosx/macosx.factor @@ -17,7 +17,6 @@ M:: macosx (monitor) ( path recursive? mailbox -- monitor ) path 1array 0 0 >>handle ] ; -M: macosx-monitor dispose - handle>> dispose ; +M: macosx-monitor dispose* handle>> dispose ; macosx set-io-backend diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index d8bb1ed488..cb2f552a32 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -22,8 +22,6 @@ M: object dispose-monitors ; TUPLE: monitor < disposable path queue timeout ; -M: monitor hashcode* path>> hashcode* ; - M: monitor timeout timeout>> ; M: monitor set-timeout (>>timeout) ; From c925724d7b119121c1467d5164349fbdafe2bb5c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 21:44:48 -0500 Subject: [PATCH 18/22] Improve destructors docs, fix bug where debug-leaks? wasn't being switched off --- basis/listener/listener.factor | 1 + .../tools/destructors/destructors-docs.factor | 7 ++++-- .../destructors/destructors-tests.factor | 13 +++++++++++ basis/tools/destructors/destructors.factor | 2 +- core/destructors/destructors-docs.factor | 22 +++++++++++++++++-- 5 files changed, 40 insertions(+), 5 deletions(-) create mode 100644 basis/tools/destructors/destructors-tests.factor diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index 34d9eac121..57d1fd3964 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -163,6 +163,7 @@ SYMBOL: interactive-vocabs "syntax" "tools.annotations" "tools.crossref" + "tools.destructors" "tools.disassembler" "tools.errors" "tools.memory" diff --git a/basis/tools/destructors/destructors-docs.factor b/basis/tools/destructors/destructors-docs.factor index e5a8f0318b..e01c61db00 100644 --- a/basis/tools/destructors/destructors-docs.factor +++ b/basis/tools/destructors/destructors-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax quotations ; +USING: help.markup help.syntax help.tips quotations destructors ; IN: tools.destructors HELP: disposables. @@ -10,10 +10,13 @@ HELP: leaks { $values { "quot" quotation } } -{ $description "Runs a quotation, printing any increases in the number of disposable objects after the quotation returns." } ; +{ $description "Runs a quotation, printing any increases in the number of disposable objects after the quotation returns. The " { $link debug-leaks? } " variable is also switched on while the quotation runs, recording the current continuation in every newly-created disposable object." } ; + +TIP: "Use the " { $link leaks } " combinator to track down resource leaks." ; ARTICLE: "tools.destructors" "Destructor tools" "The " { $vocab-link "tools.destructors" } " vocabulary provides words for tracking down resource leaks." +{ $subsection debug-leaks? } { $subsection disposables. } { $subsection leaks } { $see-also "destructors" } ; diff --git a/basis/tools/destructors/destructors-tests.factor b/basis/tools/destructors/destructors-tests.factor new file mode 100644 index 0000000000..24904f76f6 --- /dev/null +++ b/basis/tools/destructors/destructors-tests.factor @@ -0,0 +1,13 @@ +USING: kernel tools.destructors tools.test destructors namespaces ; +IN: tools.destructors.tests + +f debug-leaks? set-global + +[ [ 3 throw ] leaks ] must-fail + +[ f ] [ debug-leaks? get-global ] unit-test + +[ ] [ [ ] leaks ] unit-test + +[ f ] [ debug-leaks? get-global ] unit-test + diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor index c0aa35b049..42d09d0ef9 100644 --- a/basis/tools/destructors/destructors.factor +++ b/basis/tools/destructors/destructors.factor @@ -47,5 +47,5 @@ PRIVATE> t debug-leaks? set-global [ [ call disposables get clone ] dip - ] [ ] [ f debug-leaks? set-global ] cleanup + ] [ f debug-leaks? set-global ] [ ] cleanup assoc-diff (disposables.) ; inline diff --git a/core/destructors/destructors-docs.factor b/core/destructors/destructors-docs.factor index 8a0c36b99a..a342352b90 100644 --- a/core/destructors/destructors-docs.factor +++ b/core/destructors/destructors-docs.factor @@ -1,7 +1,24 @@ USING: help.markup help.syntax libc kernel continuations io -sequences ; +sequences classes ; IN: destructors +HELP: debug-leaks? +{ $var-description "When this variable is on, " { $link new-disposable } " stores the current continuation in the " { $link disposable } "'s " { $slot "continuation" } " slot." } +{ $see-also "tools.destructors" } ; + +HELP: disposable +{ $class-description "Parent class for disposable resources. This class has three slots:" + { $list + { { $slot "disposed" } " - boolean. Set to true by " { $link dispose } ". Assert that it is false with " { $link check-disposed } "." } + { { $slot "id" } " - unique identifier. Set by " { $link new-disposable } "." } + { { $slot "continuation" } " - current continuation at construction time, for debugging. Set by " { $link new-disposable } " if " { $link debug-leaks? } " is on." } + } +"New instances must be constructed with " { $link new-disposable } " and subclasses must implement " { $link dispose* } "." } ; + +HELP: new-disposable +{ $values { "class" class } { "disposable" disposable } } +{ $description "Constructs a new instance of a subclass of " { $link disposable } ". This sets the " { $slot "id" } " slot, registers the new object with the global " { $link disposables } " set, and if " { $link debug-leaks? } " is on, stores the current continuation in the " { $slot "continuation" } " slot." } ; + HELP: dispose { $values { "disposable" "a disposable object" } } { $contract "Releases operating system resources associated with a disposable object. Disposable objects include streams, memory mapped files, and so on." @@ -52,7 +69,8 @@ HELP: dispose-each { $description "Attempts to dispose of each element of a sequence and collects all of the errors into a sequence. If any errors are thrown during disposal, the last error is rethrown after all objects have been disposed." } ; HELP: disposables -{ $var-description "Global variable holding all disposable objects which have not been disposed of yet. The " { $link new-disposable } " word adds objects here, and the " { $link dispose } " method on disposables removes them. The " { $link "tools.destructors" } " vocabulary provides some words for working with this data." } ; +{ $var-description "Global variable holding all disposable objects which have not been disposed of yet. The " { $link new-disposable } " word adds objects here, and the " { $link dispose } " method on disposables removes them. The " { $link "tools.destructors" } " vocabulary provides some words for working with this data." } +{ $see-also "tools.destructors" } ; ARTICLE: "destructors-anti-patterns" "Resource disposal anti-patterns" "Words which create objects corresponding to external resources should always be used with " { $link with-disposal } ". The following code is wrong:" From bb51ee8d260bb6150aa1e587680274c75c9e4fc3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Aug 2009 21:56:14 -0500 Subject: [PATCH 19/22] help.vocabs: 'authors' and 'tags' weren't recursing like they should've been --- basis/help/vocabs/vocabs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/help/vocabs/vocabs.factor b/basis/help/vocabs/vocabs.factor index 7d99493691..e8b145d37e 100644 --- a/basis/help/vocabs/vocabs.factor +++ b/basis/help/vocabs/vocabs.factor @@ -249,7 +249,8 @@ C: vocab-author } cleave ; : keyed-vocabs ( str quot -- seq ) - [ all-vocabs ] 2dip '[ [ _ swap @ member? ] filter ] assoc-map ; inline + [ all-vocabs-recursive ] 2dip + '[ [ _ swap @ member? ] filter no-prefixes ] assoc-map ; inline : tagged ( tag -- assoc ) [ vocab-tags ] keyed-vocabs ; From 93adf617c03f9b4b6faa01365d6bf8ce26736bc0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 05:02:50 -0500 Subject: [PATCH 20/22] windows.com.wrapper: crash fix --- basis/windows/com/wrapper/wrapper.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 81ae923d26..afa3abf287 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -153,7 +153,7 @@ PRIVATE> [ +live-wrappers+ get adjoin ] bi ; : ( implementations -- wrapper ) - com-wrapper new-disposable swap (make-callbacks) >>vtbls + com-wrapper new-disposable swap (make-callbacks) >>callbacks dup allocate-wrapper ; M: com-wrapper dispose* From 6106eed185f934c682014130b8d3aaa79d0130d8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 05:06:16 -0500 Subject: [PATCH 21/22] alien.marshall.syntax: don't clobber bool type in unit tests --- extra/alien/marshall/syntax/syntax-tests.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/alien/marshall/syntax/syntax-tests.factor b/extra/alien/marshall/syntax/syntax-tests.factor index 3945924a57..68e6f7aff8 100644 --- a/extra/alien/marshall/syntax/syntax-tests.factor +++ b/extra/alien/marshall/syntax/syntax-tests.factor @@ -10,7 +10,8 @@ C-LIBRARY: test C-INCLUDE: C-INCLUDE: -C-TYPEDEF: char bool +! This used to typedef 'bool' but that's bad for PowerPC where its really an int +C-TYPEDEF: char mybool CM-FUNCTION: void outarg1 ( int* a ) *a += 2; @@ -38,7 +39,7 @@ CM-FUNCTION: void change_time ( double hours, sundial* d ) d->wedge.degrees = hours * 30; ; -CM-FUNCTION: bool c_not ( bool p ) +CM-FUNCTION: mybool c_not ( mybool p ) return !p; ; From 965e9ba3279e567899370fc4beb7a526a2480593 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Aug 2009 05:10:41 -0500 Subject: [PATCH 22/22] alien.marshall: fix unit tests --- extra/alien/marshall/marshall.factor | 4 ++-- extra/alien/marshall/syntax/syntax-tests.factor | 6 ++---- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor index 547e37f78a..d861178fad 100644 --- a/extra/alien/marshall/marshall.factor +++ b/extra/alien/marshall/marshall.factor @@ -93,7 +93,7 @@ ALIAS: marshall-void* marshall-pointer : primitive-marshaller ( type -- quot/f ) { - { "bool" [ [ marshall-bool ] ] } + { "bool" [ [ ] ] } { "boolean" [ [ marshall-bool ] ] } { "char" [ [ marshall-primitive ] ] } { "uchar" [ [ marshall-primitive ] ] } @@ -179,7 +179,7 @@ ALIAS: marshall-void* marshall-pointer : primitive-unmarshaller ( type -- quot/f ) { - { "bool" [ [ unmarshall-bool ] ] } + { "bool" [ [ ] ] } { "boolean" [ [ unmarshall-bool ] ] } { "char" [ [ ] ] } { "uchar" [ [ ] ] } diff --git a/extra/alien/marshall/syntax/syntax-tests.factor b/extra/alien/marshall/syntax/syntax-tests.factor index 68e6f7aff8..437685137c 100644 --- a/extra/alien/marshall/syntax/syntax-tests.factor +++ b/extra/alien/marshall/syntax/syntax-tests.factor @@ -9,9 +9,7 @@ C-LIBRARY: test C-INCLUDE: C-INCLUDE: - -! This used to typedef 'bool' but that's bad for PowerPC where its really an int -C-TYPEDEF: char mybool +C-INCLUDE: CM-FUNCTION: void outarg1 ( int* a ) *a += 2; @@ -39,7 +37,7 @@ CM-FUNCTION: void change_time ( double hours, sundial* d ) d->wedge.degrees = hours * 30; ; -CM-FUNCTION: mybool c_not ( mybool p ) +CM-FUNCTION: bool c_not ( bool p ) return !p; ;