90 lines
2.1 KiB
Factor
Executable File
90 lines
2.1 KiB
Factor
Executable File
! Copyright (C) 2007 Doug Coleman.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: continuations io.backend libc kernel namespaces
|
|
sequences system vectors ;
|
|
IN: destructors
|
|
|
|
GENERIC: destruct ( obj -- )
|
|
|
|
SYMBOL: error-destructors
|
|
SYMBOL: always-destructors
|
|
|
|
TUPLE: destructor object destroyed? ;
|
|
|
|
M: destructor destruct
|
|
dup destructor-destroyed? [
|
|
drop
|
|
] [
|
|
dup destructor-object destruct
|
|
t swap set-destructor-destroyed?
|
|
] if ;
|
|
|
|
: <destructor> ( obj -- newobj )
|
|
f destructor construct-boa ;
|
|
|
|
: add-error-destructor ( obj -- )
|
|
<destructor> error-destructors get push ;
|
|
|
|
: add-always-destructor ( obj -- )
|
|
<destructor> always-destructors get push ;
|
|
|
|
: do-always-destructors ( -- )
|
|
always-destructors get [ destruct ] each ;
|
|
|
|
: do-error-destructors ( -- )
|
|
error-destructors get [ destruct ] each ;
|
|
|
|
: with-destructors ( quot -- )
|
|
[
|
|
V{ } clone always-destructors set
|
|
V{ } clone error-destructors set
|
|
[ do-always-destructors ]
|
|
[ do-error-destructors ] cleanup
|
|
] with-scope ; inline
|
|
|
|
! Memory allocations
|
|
TUPLE: memory-destructor alien ;
|
|
|
|
C: <memory-destructor> memory-destructor
|
|
|
|
M: memory-destructor destruct ( obj -- )
|
|
memory-destructor-alien free ;
|
|
|
|
: free-always ( alien -- )
|
|
<memory-destructor> add-always-destructor ;
|
|
|
|
: free-later ( alien -- )
|
|
<memory-destructor> add-error-destructor ;
|
|
|
|
! Handles
|
|
TUPLE: handle-destructor alien ;
|
|
|
|
C: <handle-destructor> handle-destructor
|
|
|
|
HOOK: destruct-handle io-backend ( obj -- )
|
|
|
|
M: handle-destructor destruct ( obj -- )
|
|
handle-destructor-alien destruct-handle ;
|
|
|
|
: close-always ( handle -- )
|
|
<handle-destructor> add-always-destructor ;
|
|
|
|
: close-later ( handle -- )
|
|
<handle-destructor> add-error-destructor ;
|
|
|
|
! Sockets
|
|
TUPLE: socket-destructor alien ;
|
|
|
|
C: <socket-destructor> socket-destructor
|
|
|
|
HOOK: destruct-socket io-backend ( obj -- )
|
|
|
|
M: socket-destructor destruct ( obj -- )
|
|
socket-destructor-alien destruct-socket ;
|
|
|
|
: close-socket-always ( handle -- )
|
|
<socket-destructor> add-always-destructor ;
|
|
|
|
: close-socket-later ( handle -- )
|
|
<socket-destructor> add-error-destructor ;
|