From 3f362dfc993212b14ea890511f18a1e2ecc5f0e5 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 21 Nov 2014 08:19:05 -0800 Subject: [PATCH] destructors: change check-disposed not to drop the disposable. --- basis/cache/cache.factor | 2 +- basis/io/backend/unix/unix.factor | 6 +-- basis/io/files/windows/windows.factor | 2 +- basis/io/monitors/linux/linux.factor | 2 +- basis/io/monitors/monitors.factor | 10 ++--- basis/io/monitors/windows/windows.factor | 2 +- basis/io/pools/pools.factor | 2 +- basis/io/ports/ports.factor | 52 ++++++++++++++---------- basis/io/sockets/sockets.factor | 4 +- core/destructors/destructors.factor | 4 +- core/io/streams/c/c.factor | 12 +++--- 11 files changed, 53 insertions(+), 45 deletions(-) diff --git a/basis/cache/cache.factor b/basis/cache/cache.factor index f623b878a2..4caa5b40ac 100755 --- a/basis/cache/cache.factor +++ b/basis/cache/cache.factor @@ -22,7 +22,7 @@ M: cache-assoc assoc-size assoc>> assoc-size ; M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ; M: cache-assoc set-at - [ check-disposed ] keep + check-disposed [ ] 2dip assoc>> set-at ; diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 0c39b24064..c0dac8f717 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -35,7 +35,7 @@ M: fd dispose } cleave ] unless-disposed ; -M: fd handle-fd dup check-disposed fd>> ; +M: fd handle-fd check-disposed fd>> ; M: fd cancel-operation ( fd -- ) [ @@ -103,7 +103,7 @@ M: fd refill M: unix (wait-to-read) ( port -- ) dup - dup handle>> dup check-disposed refill dup + dup handle>> check-disposed refill dup [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; ! Writers @@ -123,7 +123,7 @@ M: fd drain M: unix (wait-to-write) ( port -- ) dup - dup handle>> dup check-disposed drain + dup handle>> check-disposed drain dup [ wait-for-port ] [ 2drop ] if ; M: unix io-multiplex ( nanos -- ) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index fa6c9801b4..24c953645c 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -165,7 +165,7 @@ M: windows handle-length ( handle -- n/f ) ptr>> [ [ 32 bits >>offset ] [ -32 shift >>offset-high ] bi ] when* ; : make-FileArgs ( port handle -- ) - [ nip dup check-disposed handle>> ] + [ nip check-disposed handle>> ] [ [ buffer>> dup buffer-length 0 DWORD ] dip make-overlapped ] 2bi ; diff --git a/basis/io/monitors/linux/linux.factor b/basis/io/monitors/linux/linux.factor index d1047e7fbe..ee2f21cd75 100755 --- a/basis/io/monitors/linux/linux.factor +++ b/basis/io/monitors/linux/linux.factor @@ -114,7 +114,7 @@ M: linux-monitor dispose* ( monitor -- ) ] if ; : inotify-read-loop ( port -- ) - dup check-disposed + check-disposed dup wait-to-read drop 0 over buffer>> parse-file-notifications 0 over buffer>> buffer-reset diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index 21fd11df4a..c0286f594d 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -43,7 +43,7 @@ TUPLE: file-change path changed monitor ; : queue-change ( path changes monitor -- ) 3dup and and [ - [ check-disposed ] keep + check-disposed [ file-change boa ] keep queue>> mailbox-put ] [ 3drop ] if ; @@ -54,11 +54,9 @@ HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) (monitor) ; : next-change ( monitor -- change ) - [ check-disposed ] - [ - [ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout - dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if - ] bi ; + check-disposed + [ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout + dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if ; SYMBOL: +add-file+ SYMBOL: +remove-file+ diff --git a/basis/io/monitors/windows/windows.factor b/basis/io/monitors/windows/windows.factor index f5d659ef4f..2c522f5b09 100644 --- a/basis/io/monitors/windows/windows.factor +++ b/basis/io/monitors/windows/windows.factor @@ -77,7 +77,7 @@ TUPLE: win32-monitor < monitor port ; ] each ; : fill-queue ( monitor -- ) - dup port>> dup check-disposed + dup port>> check-disposed [ buffer>> ptr>> ] [ read-changes zero? ] bi [ 2dup parse-notify-records ] unless 2drop ; diff --git a/basis/io/pools/pools.factor b/basis/io/pools/pools.factor index d1042818f7..ebab3f92a9 100644 --- a/basis/io/pools/pools.factor +++ b/basis/io/pools/pools.factor @@ -7,7 +7,7 @@ IN: io.pools TUPLE: pool connections disposed expired ; : check-pool ( pool -- ) - dup check-disposed + check-disposed dup expired>> expired? [ 31337 >>expired connections>> delete-all diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 8e7a529c5f..8646d3b609 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -39,7 +39,7 @@ HOOK: (wait-to-read) io-backend ( port -- ) ] [ drop f ] if ; inline M: input-port stream-read1 - dup check-disposed + check-disposed dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline ERROR: not-a-c-ptr object ; @@ -58,7 +58,7 @@ ERROR: not-a-c-ptr object ; { fixnum c-ptr } declare ; inline : prepare-read ( count port -- count' port ) - [ integer>fixnum-strict 0 max ] dip dup check-disposed ; inline + [ integer>fixnum-strict 0 max ] dip check-disposed ; inline :: read-loop ( dst n-remaining port n-read -- n-total ) n-remaining port read-step :> ( n-buffered ptr ) @@ -100,11 +100,15 @@ M: input-port stream-read-unsafe PRIVATE> M: input-port stream-read-until - 2dup read-until-step dup [ [ 2drop ] 2dip ] [ + 2dup read-until-step dup [ + [ 2drop ] 2dip + ] [ over [ drop BV{ } like [ read-until-loop ] keep B{ } like swap - ] [ [ 2drop ] 2dip ] if + ] [ + [ 2drop ] 2dip + ] if ] if ; TUPLE: output-port < buffered-port ; @@ -125,16 +129,16 @@ HOOK: (wait-to-write) io-backend ( port -- ) PRIVATE> M: output-port stream-flush - [ check-disposed ] [ port-flush ] bi ; + check-disposed port-flush ; : wait-to-write ( len port -- ) [ nip ] [ buffer>> buffer-capacity <= ] 2bi [ drop ] [ port-flush ] if ; inline M: output-port stream-write1 - [ check-disposed ] - [ 1 swap wait-to-write ] - [ buffer>> buffer-write1 ] tri ; inline + check-disposed + 1 over wait-to-write + buffer>> buffer-write1 ; inline M: output-port stream-write - dup check-disposed [ + check-disposed [ binary-object [ check-c-ptr ] [ integer>fixnum-strict ] bi* ] [ port-write ] bi* ; @@ -165,13 +169,20 @@ HOOK: can-seek-handle? os ( handle -- ? ) HOOK: handle-length os ( handle -- n/f ) +> tell-handle ] [ buffer>> buffer-length ] bi ; inline + +PRIVATE> + M: input-port stream-tell - [ check-disposed ] - [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ; + check-disposed port-tell - ; M: output-port stream-tell - [ check-disposed ] - [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ; + check-disposed port-tell + ; + + + M: input-port stream-seek + check-disposed do-seek-relative - [ check-disposed ] [ buffer>> 0 swap buffer-reset ] - [ handle>> seek-handle ] tri ; + [ handle>> seek-handle ] bi ; M: output-port stream-seek + check-disposed do-seek-relative - [ check-disposed ] [ stream-flush ] - [ handle>> seek-handle ] tri ; + [ handle>> seek-handle ] bi ; M: buffered-port stream-seekable? handle>> can-seek-handle? ; @@ -221,10 +234,7 @@ M: buffered-port dispose* M: port cancel-operation handle>> cancel-operation ; M: port dispose* - [ - [ handle>> &dispose drop ] - [ handle>> shutdown ] bi - ] with-destructors ; + [ handle>> &dispose shutdown ] with-destructors ; GENERIC: underlying-port ( stream -- port ) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 0a7287fc53..db968e1a7c 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -296,10 +296,10 @@ ERROR: invalid-port object ; dup { [ datagram-port? ] [ raw-port? ] } 1|| [ invalid-port ] unless ; : check-send ( packet addrspec port -- packet addrspec port ) - check-connectionless-port dup check-disposed check-port ; + check-connectionless-port check-disposed check-port ; : check-receive ( port -- port ) - check-connectionless-port dup check-disposed ; + check-connectionless-port check-disposed ; HOOK: (send) io-backend ( packet addrspec datagram -- ) diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index e2ea06d740..716f91cfa5 100755 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -35,8 +35,8 @@ GENERIC: dispose* ( disposable -- ) ERROR: already-disposed disposable ; -: check-disposed ( disposable -- ) - dup disposed>> [ already-disposed ] [ drop ] if ; inline +: check-disposed ( disposable -- disposable ) + dup disposed>> [ already-disposed ] when ; inline GENERIC: dispose ( disposable -- ) diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 7bcc5a6844..464c9b83e3 100644 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -19,14 +19,14 @@ INSTANCE: c-writer file-writer : ( handle -- stream ) c-writer new-c-stream ; M: c-writer stream-write1 - dup check-disposed handle>> fputc ; + check-disposed handle>> fputc ; M: c-writer stream-write - dup check-disposed + check-disposed [ binary-object ] [ handle>> ] bi* fwrite ; M: c-writer stream-flush - dup check-disposed handle>> fflush ; + check-disposed handle>> fflush ; TUPLE: c-reader < c-stream ; INSTANCE: c-reader input-stream @@ -35,10 +35,10 @@ INSTANCE: c-reader file-reader : ( handle -- stream ) c-reader new-c-stream ; M: c-reader stream-read-unsafe - dup check-disposed handle>> fread-unsafe ; + check-disposed handle>> fread-unsafe ; M: c-reader stream-read1 - dup check-disposed handle>> fgetc ; + check-disposed handle>> fgetc ; : read-until-loop ( handle seps accum -- accum ch ) pick fgetc dup [ @@ -49,7 +49,7 @@ M: c-reader stream-read1 ] if ; inline recursive M: c-reader stream-read-until - dup check-disposed handle>> swap + check-disposed handle>> swap 32 read-until-loop [ B{ } like ] dip over empty? over not and [ 2drop f f ] when ;