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 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/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 ] ; 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 } 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 ; 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>> { 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/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) ; 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 ; 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/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/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? [ 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 4f182c6777..42d09d0ef9 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 + t debug-leaks? set-global + [ + [ call disposables get clone ] dip + ] [ f debug-leaks? set-global ] [ ] cleanup + assoc-diff (disposables.) ; inline diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index a280ab0666..f463ae2b68 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-disposable 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 ) 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" 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* 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:" 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 39f0e9f2b9..3e57f498af 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? [ delete-at ] [ drop already-unregistered ] if ; PRIVATE> -TUPLE: disposable < identity-tuple disposed id ; +TUPLE: disposable < identity-tuple +{ id integer } +{ disposed boolean } +continuation ; M: disposable hashcode* nip id>> ; @@ -39,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 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 ... ;" } 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 3945924a57..437685137c 100644 --- a/extra/alien/marshall/syntax/syntax-tests.factor +++ b/extra/alien/marshall/syntax/syntax-tests.factor @@ -9,8 +9,7 @@ C-LIBRARY: test C-INCLUDE: C-INCLUDE: - -C-TYPEDEF: char bool +C-INCLUDE: CM-FUNCTION: void outarg1 ( int* a ) *a += 2; 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 } "." } ; 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..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 @@ -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 ;