From be40bd33eec5cba50dcc92139eadb3d0113c0ca7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 20 Feb 2009 20:51:13 -0600
Subject: [PATCH] New initialize-alien word

---
 basis/core-foundation/run-loop/run-loop.factor | 14 +++-----------
 basis/io/sockets/secure/openssl/openssl.factor | 14 ++++----------
 basis/libc/libc.factor                         |  9 +--------
 basis/ui/text/freetype/freetype.factor         |  3 +--
 core/alien/alien-tests.factor                  | 12 ++++++++++++
 core/alien/alien.factor                        | 14 ++++++++++++++
 6 files changed, 35 insertions(+), 31 deletions(-)

diff --git a/basis/core-foundation/run-loop/run-loop.factor b/basis/core-foundation/run-loop/run-loop.factor
index 4b98e9a410..3f4f268467 100644
--- a/basis/core-foundation/run-loop/run-loop.factor
+++ b/basis/core-foundation/run-loop/run-loop.factor
@@ -56,25 +56,17 @@ FUNCTION: void CFRunLoopRemoveTimer (
 
 : CFRunLoopDefaultMode ( -- alien )
     #! Ugly, but we don't have static NSStrings
-    \ CFRunLoopDefaultMode get-global dup expired? [
-        drop
+    \ CFRunLoopDefaultMode [
         "kCFRunLoopDefaultMode" <CFString>
-        dup \ CFRunLoopDefaultMode set-global
-    ] when ;
+    ] initialize-alien ;
 
 TUPLE: run-loop fds sources timers ;
 
 : <run-loop> ( -- run-loop )
     V{ } clone V{ } clone V{ } clone \ run-loop boa ;
 
-SYMBOL: expiry-check
-
 : run-loop ( -- run-loop )
-    \ run-loop get-global not expiry-check get expired? or
-    [
-        31337 <alien> expiry-check set-global
-        <run-loop> dup \ run-loop set-global
-    ] [ \ run-loop get-global ] if ;
+    \ run-loop [ <run-loop> ] initialize-alien ;
 
 : add-source-to-run-loop ( source -- )
     [ run-loop sources>> push ]
diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index f78f61ef3b..e72b267c04 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -143,16 +143,11 @@ TUPLE: ssl-handle file handle connected disposed ;
 
 SYMBOL: default-secure-context
 
-: context-expired? ( context -- ? )
-    dup [ handle>> expired? ] [ drop t ] if ;
-
 : current-secure-context ( -- ctx )
     secure-context get [
-        default-secure-context get dup context-expired? [
-            drop
-            <secure-config> <secure-context> default-secure-context set-global
-            current-secure-context
-        ] when
+        default-secure-context [
+            <secure-config> <secure-context>
+        ] initialize-alien
     ] unless* ;
 
 : <ssl-handle> ( fd -- ssl )
@@ -189,8 +184,7 @@ M: openssl check-certificate ( host ssl -- )
     ] [ 2drop ] if ;
 
 : get-session ( addrspec -- session/f )
-    current-secure-context sessions>> at
-    dup expired? [ drop f ] when ;
+    current-secure-context sessions>> at ;
 
 : save-session ( session addrspec -- )
     current-secure-context sessions>> set-at ;
diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index 6863c6ee65..7a55b15473 100644
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -26,15 +26,8 @@ IN: libc
 : (realloc) ( alien size -- newalien )
     "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
 
-SYMBOL: malloc-expiry
-
 : mallocs ( -- assoc )
-    malloc-expiry get-global expired? [
-        -1 <alien> malloc-expiry set-global
-        H{ } clone dup \ mallocs set-global
-    ] [
-        \ mallocs get-global
-    ] if ;
+    \ mallocs [ H{ } clone ] initialize-alien ;
 
 PRIVATE>
 
diff --git a/basis/ui/text/freetype/freetype.factor b/basis/ui/text/freetype/freetype.factor
index c8ac178d52..228b32d323 100644
--- a/basis/ui/text/freetype/freetype.factor
+++ b/basis/ui/text/freetype/freetype.factor
@@ -18,8 +18,7 @@ M: freetype-renderer finish-text-rendering drop ;
 DEFER: init-freetype
 
 : freetype ( -- alien )
-    \ freetype get-global expired? [ init-freetype ] when
-    \ freetype get-global ;
+    \ freetype [ init-freetype ] initialize-alien ;
 
 TUPLE: freetype-font < identity-tuple
 ascent descent height handle widths ;
diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor
index 5a880fa5a9..e4063b733c 100644
--- a/core/alien/alien-tests.factor
+++ b/core/alien/alien-tests.factor
@@ -74,3 +74,15 @@ cell 8 = [
 [ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
 
 [ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
+
+SYMBOL: initialize-test
+
+f initialize-test set-global
+
+[ 31337 ] [ initialize-test [ 31337 ] initialize-alien ] unit-test
+
+[ 31337 ] [ initialize-test [ 69 ] initialize-alien ] unit-test
+
+[ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
+
+[ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
\ No newline at end of file
diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index 52e9cd0f30..83665778f1 100644
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -86,3 +86,17 @@ ERROR: alien-invoke-error library symbol ;
 SYMBOL: callbacks
 
 [ H{ } clone callbacks set-global ] "alien" add-init-hook
+
+<PRIVATE
+
+TUPLE: expiry-check object alien ;
+
+: recompute-value? ( check -- ? )
+    dup [ alien>> expired? ] [ drop t ] if ;
+
+PRIVATE>
+
+: initialize-alien ( symbol quot -- )
+    swap dup get-global dup recompute-value?
+    [ drop [ call dup 31337 <alien> expiry-check boa ] dip set-global ]
+    [ 2nip object>> ] if ; inline
\ No newline at end of file