Merge branch 'master' of git://factorcode.org/git/factor

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 ;
 
 : <F-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 <F-destructor> &dispose drop ; inline
 

basis/checksums/openssl/openssl.factor

@@ -19,13 +19,13 @@ C: <openssl-checksum> openssl-checksum
 
 <PRIVATE
 
-TUPLE: evp-md-context handle ;
+TUPLE: evp-md-context < disposable handle ;
 
 : <evp-md-context> ( -- ctx )
-    "EVP_MD_CTX" <c-object>
+    evp-md-context new-disposable
-    dup EVP_MD_CTX_init evp-md-context boa ;
+    "EVP_MD_CTX" <c-object> 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 -- )

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<sequence }
 "Store all output values to a sequence:"

basis/combinators/smart/smart.factor

@@ -7,6 +7,9 @@ IN: combinators.smart
 MACRO: drop-outputs ( quot -- quot' )
     dup infer out>> '[ @ _ ndrop ] ;
 
+MACRO: keep-inputs ( quot -- quot' )
+    dup infer in>> '[ _ _ nkeep ] ;
+
 MACRO: output>sequence ( quot exemplar -- newquot )
     [ dup infer out>> ] dip
     '[ @ _ _ nsequence ] ;

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) ;

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 }

basis/help/vocabs/vocabs.factor

@@ -249,7 +249,8 @@ C: <vocab-author> 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 ;

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 ;
+    [ <image> ] 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>> {

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" <struct-array> >>events ;
 
-M: epoll-mx dispose fd>> close-file ;
+M: epoll-mx dispose* fd>> close-file ;
 
 : make-event ( fd events -- event )
     "epoll-event" <c-object>

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" <struct-array> >>events ;
 
-M: kqueue-mx dispose fd>> close-file ;
+M: kqueue-mx dispose* fd>> close-file ;
 
 : make-kevent ( fd filter flags -- event )
     "kevent" <c-object>

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
 

basis/io/monitors/macosx/macosx.factor

@@ -17,7 +17,6 @@ M:: macosx (monitor) ( path recursive? mailbox -- monitor )
         path 1array 0 0 <event-stream> >>handle
     ] ;
 
-M: macosx-monitor dispose
+M: macosx-monitor dispose* handle>> dispose ;
-    handle>> dispose ;
 
 macosx set-io-backend

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) ;

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 ;
 
-: <closing-stream> ( -- stream ) closing-stream new ;
+: <closing-stream> ( -- stream ) closing-stream new-disposable ;
 
 M: closing-stream dispose* drop ;
 

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

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 )
+! We stick malloc-ptr instances in the global disposables set
-    \ mallocs [ H{ } clone ] initialize-alien ;
+TUPLE: malloc-ptr value continuation ;
+
+M: malloc-ptr hashcode* value>> hashcode* ;
+
+M: malloc-ptr equal?
+    over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
+
+: <malloc-ptr> ( 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
 <PRIVATE
 
 : add-malloc ( alien -- alien )
-    dup mallocs conjoin ;
+    dup <malloc-ptr> register-disposable ;
 
 : delete-malloc ( alien -- )
-    [
+    [ <malloc-ptr> unregister-disposable ] when* ;
-        mallocs delete-at*
-        [ drop ] [ double-free ] if
-    ] when* ;
 
 : malloc-exists? ( alien -- ? )
-    mallocs key? ;
+    <malloc-ptr> disposables get key? ;
 
 PRIVATE>
 

basis/listener/listener.factor

@@ -163,6 +163,7 @@ SYMBOL: interactive-vocabs
     "syntax"
     "tools.annotations"
     "tools.crossref"
+    "tools.destructors"
     "tools.disassembler"
     "tools.errors"
     "tools.memory"

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? [

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" } ;

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
+

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
 
 <PRIVATE
 
-: disposable-tally ( -- assoc )
+: class-tally ( assoc -- assoc' )
-    disposables get
+    H{ } clone [ [ keys ] dip '[ dup class _ push-at ] each ] keep ;
-    H{ } clone [ [ keys ] dip '[ class _ inc-at ] each ] keep ;
-
-: subtract-values ( assoc1 assoc2 -- assoc )
-    [ [ keys ] bi@ append prune ] 2keep
-    H{ } clone [
-        '[
-            [ _ _ [ at 0 or ] bi-curry@ bi - ] keep _ set-at
-        ] each
-    ] keep ;
 
 : (disposables.) ( assoc -- )
-    >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<sequence
+            ] with-row
+        ] each
+    ] tabular-output nl ;
+
+: sort-disposables ( seq -- seq' )
+    [ disposable? ] partition [ [ id>> ] 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 get clone
-    (disposables.) ; inline
+    t debug-leaks? set-global
+    [
+        [ call disposables get clone ] dip
+    ] [ f debug-leaks? set-global ] [ ] cleanup
+     assoc-diff (disposables.) ; inline

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 ;
 
 : <pixel-format> ( 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 )

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
+stack-checker summary io.pathnames io.styles kernel namespaces
-prettyprint quotations tools.crossref tools.annotations editors
+parser prettyprint quotations tools.crossref tools.annotations
-tools.profiler tools.test tools.time tools.walker vocabs vocabs.loader
+editors tools.profiler tools.test tools.time tools.walker vocabs
-words sequences classes compiler.errors compiler.units
+vocabs.loader words sequences classes compiler.errors
-accessors vocabs.parser macros.expander ui ui.tools.browser
+compiler.units accessors vocabs.parser macros.expander ui
-ui.tools.listener ui.tools.listener.completion ui.tools.profiler
+ui.tools.browser ui.tools.listener ui.tools.listener.completion
-ui.tools.inspector ui.tools.traceback ui.commands ui.gadgets.editors
+ui.tools.profiler ui.tools.inspector ui.tools.traceback
-ui.gestures ui.operations ui.tools.deploy models help.tips
+ui.commands ui.gadgets.editors ui.gestures ui.operations
-source-files.errors ;
+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"

basis/windows/com/wrapper/wrapper.factor

@@ -153,7 +153,7 @@ PRIVATE>
     [ +live-wrappers+ get adjoin ] bi ;
 
 : <com-wrapper> ( 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*

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:"

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

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?
+
 <PRIVATE
 
+SLOT: continuation
+
 : register-disposable ( obj -- )
+    debug-leaks? get-global [ continuation >>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 -- )
     [

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-method? ] must-fail-with
+
+! What happens if we close a file twice?
+[ ] [
+    "closing-twice" unique-file ascii <file-writer>
+    [ dispose ] [ dispose ] bi
+] unit-test

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 ... ;" }

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"      [ [ ] ] }

extra/alien/marshall/syntax/syntax-tests.factor

@@ -9,8 +9,7 @@ C-LIBRARY: test
 
 C-INCLUDE: <stdlib.h>
 C-INCLUDE: <string.h>
-
+C-INCLUDE: <stdbool.h>
-C-TYPEDEF: char bool
 
 CM-FUNCTION: void outarg1 ( int* a )
     *a += 2;

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 <program-instance> } "." } ;
+{ $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 <program-instance> } "." } ;
 
 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 <program-instance> } "." } ;
@@ -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 <shader-instance> } "." } ;
+{ $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 <shader-instance> } "." } ;
 
 HELP: shader-instance
 { $class-description "A " { $snippet "shader-instance" } " is a " { $link shader } " that has been compiled for a graphics context using " { $link <shader-instance> } "." } ;

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: <pile-c-array>
+{ $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: <pile-c-object>
+{ $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 <pile> }
 { $subsection pile-alloc }
+{ $subsection <pile-c-array> }
+{ $subsection <pile-c-object> }
 { $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." ;

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-object> ( pile c-type -- alien )
+    heap-size pile-alloc ; inline
+
+: <pile-c-array> ( pile n c-type -- alien )
+    heap-size * pile-alloc ; inline
+
 : pile-align ( pile align -- pile )
     [ align ] curry change-offset ;