alien.libraries: add a "deploy-library" word that marks a library to have its dll...

diff --git a/basis/alien/libraries/libraries-docs.factor b/basis/alien/libraries/libraries-docs.factor
index 245565d9edc2204ff5168b824d1915c9255a0470..59142733b93df8fd76f9250a5036328f9036f7b9 100644 (file)
--- a/basis/alien/libraries/libraries-docs.factor
+++ b/basis/alien/libraries/libraries-docs.factor
@@ -60,6 +60,10 @@ $nl
 }
 "Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
 
 }
 "Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
 

+HELP: deploy-library
+{ $values { "name" string } }
+{ $description "Specifies that the logical library named " { $snippet "name" } " should be included during " { $link "tools.deploy" } ". " { $snippet "name" } " must be the name of a library previously loaded with " { $link add-library } "." } ;
+

 HELP: remove-library
 { $values { "name" string } }
 { $description "Unloads a library and removes it from the internal list of libraries. The " { $snippet "name" } " parameter should be a name that was previously passed to " { $link add-library } ". If no library with that name exists, this word does nothing." } ;
 HELP: remove-library
 { $values { "name" string } }
 { $description "Unloads a library and removes it from the internal list of libraries. The " { $snippet "name" } " parameter should be a name that was previously passed to " { $link add-library } ". If no library with that name exists, this word does nothing." } ;


@@ -72,4 +76,9 @@ ARTICLE: "loading-libs" "Loading native libraries"
 }
 "Once a library has been defined, you can try loading it to see if the path name is correct:"
 { $subsections load-library }
 }
 "Once a library has been defined, you can try loading it to see if the path name is correct:"
 { $subsections load-library }

-"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;
+"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again."
+$nl
+"Libraries that do not come standard with the operating system need to be included with deployed applications that use them. A word is provided to instruct " { $link "tools.deploy" } " that a library must be so deployed:"
+{ $subsections
+    deploy-library
+} ;

diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor
index 0d255b8d076b67ce5b0435eb9e5c346bd91133ea..6f80900da0c54a1e72832dc58c4162e081455e73 100644 (file)
--- a/basis/alien/libraries/libraries.factor
+++ b/basis/alien/libraries/libraries.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.strings assocs io.backend
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.strings assocs io.backend

-kernel namespaces destructors ;
+kernel namespaces destructors sequences system io.pathnames ;

 IN: alien.libraries
 
 : dlopen ( path -- dll ) native-string>alien (dlopen) ;
 IN: alien.libraries
 
 : dlopen ( path -- dll ) native-string>alien (dlopen) ;


@@ -9,11 +9,15 @@ IN: alien.libraries
 : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
 
 SYMBOL: libraries
 : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
 
 SYMBOL: libraries

+SYMBOL: deploy-libraries

 
 libraries [ H{ } clone ] initialize
 
 libraries [ H{ } clone ] initialize

+deploy-libraries [ V{ } clone ] initialize

 
 TUPLE: library path abi dll ;
 
 
 TUPLE: library path abi dll ;
 

+ERROR: no-library name ;
+

 : library ( name -- library ) libraries get at ;
 
 : <library> ( path abi -- library )
 : library ( name -- library ) libraries get at ;
 
 : <library> ( path abi -- library )


@@ -31,4 +35,20 @@ M: library dispose dll>> [ dispose ] when* ;
 
 : add-library ( name path abi -- )
     [ 2drop remove-library ]
 
 : add-library ( name path abi -- )
     [ 2drop remove-library ]

-    [ <library> swap libraries get set-at ] 3bi ;
\ No newline at end of file
+    [ <library> swap libraries get set-at ] 3bi ;
+
+: deploy-library ( name -- )
+    dup libraries get key?
+    [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
+    [ no-library ] if ;
+
+<PRIVATE
+HOOK: >deployed-library-path os ( path -- path' )
+
+M: windows >deployed-library-path
+    file-name ;
+M: unix >deployed-library-path
+    file-name "$ORIGIN" prepend-path ;
+M: macosx >deployed-library-path
+    file-name "@executable_path/../Frameworks" prepend-path ;
+PRIVATE>

diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor
index 9d6b8d4c0805fba47028827720827351f05b7aec..4a4037d754856268941a268d3034d4173b334a8d 100644 (file)
--- a/basis/tools/deploy/backend/backend.factor
+++ b/basis/tools/deploy/backend/backend.factor
@@ -8,14 +8,27 @@ io.streams.c io.files io.files.temp io.pathnames io.directories
 io.directories.hierarchy io.backend quotations io.launcher
 tools.deploy.config tools.deploy.config.editor bootstrap.image
 io.encodings.utf8 destructors accessors hashtables
 io.directories.hierarchy io.backend quotations io.launcher
 tools.deploy.config tools.deploy.config.editor bootstrap.image
 io.encodings.utf8 destructors accessors hashtables

-vocabs.metadata.resources ;
+tools.deploy.libraries vocabs.metadata.resources ;

 IN: tools.deploy.backend
 
 : copy-vm ( executable bundle-name -- vm )
     prepend-path vm over copy-file ;
 
 IN: tools.deploy.backend
 
 : copy-vm ( executable bundle-name -- vm )
     prepend-path vm over copy-file ;
 

+TUPLE: vocab-manifest vocabs libraries ;
+

 : copy-resources ( manifest name dir -- )
 : copy-resources ( manifest name dir -- )

-    append-path swap [ copy-vocab-resources ] with each ;
+    append-path swap vocabs>> [ copy-vocab-resources ] with each ;
+
+ERROR: cant-deploy-library-file library ;
+<PRIVATE
+: copy-library ( dir library -- )
+    dup find-library-file
+    [ nip swap over file-name append-path copy-file ]
+    [ cant-deploy-library-file ] if* ;
+PRIVATE>
+
+: copy-libraries ( manifest name dir -- )
+    append-path swap libraries>> [ copy-library ] with each ;

 
 : image-name ( vocab bundle-name -- str )
     prepend-path ".image" append ;
 
 : image-name ( vocab bundle-name -- str )
     prepend-path ".image" append ;


@@ -99,10 +112,16 @@ DEFER: ?make-staging-image
         ] { } make
     ] bind ;
 
         ] { } make
     ] bind ;
 

+: parse-vocab-manifest-file ( path -- vocab-manifest )
+    utf8 file-lines
+    dup first "VOCABS:" =
+    [ "LIBRARIES:" split1 vocab-manifest boa ]
+    [ "invalid vocab manifest!" throw ] if ;
+

 : make-deploy-image ( vm image vocab config -- manifest )
     make-boot-image
     over "vocab-manifest-" prepend temp-file
     [ swap deploy-command-line run-factor ]
 : make-deploy-image ( vm image vocab config -- manifest )
     make-boot-image
     over "vocab-manifest-" prepend temp-file
     [ swap deploy-command-line run-factor ]

-    [ utf8 file-lines ] bi ;
+    [ parse-vocab-manifest-file ] bi ;

 
 HOOK: deploy* os ( vocab -- )
 
 HOOK: deploy* os ( vocab -- )

diff --git a/basis/tools/deploy/libraries/libraries.factor b/basis/tools/deploy/libraries/libraries.factor
new file mode 100644 (file)
index 0000000..36fe303
--- /dev/null
+++ b/basis/tools/deploy/libraries/libraries.factor
@@ -0,0 +1,11 @@
+! (c)2010 Joe Groff bsd license
+USING: alien.libraries io.pathnames io.pathnames.private kernel
+system vocabs.loader ;
+IN: tools.deploy.libraries
+
+HOOK: find-library-file os ( file -- path )
+
+os windows?
+"tools.deploy.libraries.windows"
+"tools.deploy.libraries.unix" ? require
+

diff --git a/basis/tools/deploy/libraries/tags.txt b/basis/tools/deploy/libraries/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/tools/deploy/libraries/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/tools/deploy/libraries/unix/tags.txt b/basis/tools/deploy/libraries/unix/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/tools/deploy/libraries/unix/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/tools/deploy/libraries/unix/unix.factor b/basis/tools/deploy/libraries/unix/unix.factor
new file mode 100644 (file)
index 0000000..6c3dbb4
--- /dev/null
+++ b/basis/tools/deploy/libraries/unix/unix.factor
@@ -0,0 +1,16 @@
+! (c)2010 Joe Groff bsd license
+USING: io.files io.pathnames io.pathnames.private kernel
+sequences system tools.deploy.libraries ;
+IN: tools.deploy.libraries.unix
+
+! stupid hack. better ways to find the library name would be open the library,
+! note a symbol address found in the library, then call dladdr (or use
+: ?exists ( path -- path/f )
+    dup exists? [ drop f ] unless ; inline
+
+M: unix find-library-file
+    dup absolute-path? [ ?exists ] [
+        { "/lib" "/usr/lib" "/usr/local/lib" }
+        [ prepend-path ?exists ] with map-find drop
+    ] if ;
+

diff --git a/basis/tools/deploy/libraries/windows/windows.factor b/basis/tools/deploy/libraries/windows/windows.factor
new file mode 100644 (file)
index 0000000..4698754
--- /dev/null
+++ b/basis/tools/deploy/libraries/windows/windows.factor
@@ -0,0 +1,16 @@
+! (c)2010 Joe Groff bsd license
+USING: alien.strings byte-arrays io.encodings.utf16n kernel
+specialized-arrays system tools.deploy.libraries windows.kernel32
+windows.types ;
+FROM: alien.c-types => ushort ;
+SPECIALIZED-ARRAY: ushort
+IN: tools.deploy.libraries.windows
+
+M: windows find-library-file
+    f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
+        [
+            32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep
+            utf16n alien>string
+        ] [ FreeLibrary drop ] bi
+    ] [ f ] if* ;
+

diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor
index 8bd3749093404b0dadf39bf64969ca4abb000e81..c02642ba1d1c5db792d5e865a23108b472e656f4 100644 (file)
--- a/basis/tools/deploy/macosx/macosx.factor
+++ b/basis/tools/deploy/macosx/macosx.factor
@@ -81,7 +81,9 @@ M: macosx deploy* ( vocab -- )
             [ bundle-name create-app-dir ] keep
             [ bundle-name deploy.app-image ] keep
             namespace make-deploy-image
             [ bundle-name create-app-dir ] keep
             [ bundle-name deploy.app-image ] keep
             namespace make-deploy-image

-            bundle-name "Contents/Resources" copy-resources
+            bundle-name
+            [ "Contents/Resources" copy-resources ]
+            [ "Contents/Frameworks" copy-libraries ] 2bi

             bundle-name show-in-finder
         ] bind
     ] with-directory ;
             bundle-name show-in-finder
         ] bind
     ] with-directory ;

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index d8a653c02139d927edacaf954d287a9944b153be..5630275aa1ad37fc66d866d6d9dbe69546b6a1c8 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.

-USING: arrays accessors io.backend io.encodings.utf8 io.files
+USING: arrays alien.libraries accessors io.backend io.encodings.utf8 io.files

 io.streams.c init fry namespaces math make assocs kernel parser
 parser.notes lexer strings.parser vocabs sequences sequences.deep
 sequences.private words memory kernel.private continuations io
 io.streams.c init fry namespaces math make assocs kernel parser
 parser.notes lexer strings.parser vocabs sequences sequences.deep
 sequences.private words memory kernel.private continuations io


@@ -19,6 +19,7 @@ QUALIFIED: layouts
 QUALIFIED: source-files
 QUALIFIED: source-files.errors
 QUALIFIED: vocabs
 QUALIFIED: source-files
 QUALIFIED: source-files.errors
 QUALIFIED: vocabs

+FROM: alien.libraries.private => >deployed-library-path ;

 IN: tools.deploy.shaker
 
 ! This file is some hairy shit.
 IN: tools.deploy.shaker
 
 ! This file is some hairy shit.


@@ -505,11 +506,28 @@ SYMBOL: deploy-vocab
 
 : write-vocab-manifest ( vocab-manifest-out -- )
     "Writing vocabulary manifest to " write dup print flush
 
 : write-vocab-manifest ( vocab-manifest-out -- )
     "Writing vocabulary manifest to " write dup print flush

-    vocabs swap utf8 set-file-lines ;
+    vocabs "VOCABS:" prefix
+    deploy-libraries get [ libraries get path>> ] map "LIBRARIES:" prefix append
+    swap utf8 set-file-lines ;
+
+: prepare-deploy-libraries ( -- )
+    "Preparing deployed libraries" print flush
+    deploy-libraries get [
+        libraries get [
+            [ path>> >deployed-library-path ] [ abi>> ] bi <library>
+        ] change-at
+    ] each
+    
+    [
+        "deploy-libraries" "alien.libraries" lookup forget
+        "deploy-library" "alien.libraries" lookup forget
+        ">deployed-library-path" "alien.libraries.private" lookup forget
+    ] with-compilation-unit ;

 
 : strip ( vocab-manifest-out -- )
     [ write-vocab-manifest ] when*
     startup-stripper
 
 : strip ( vocab-manifest-out -- )
     [ write-vocab-manifest ] when*
     startup-stripper

+    prepare-deploy-libraries

     strip-libc
     strip-destructors
     strip-call
     strip-libc
     strip-destructors
     strip-call

diff --git a/basis/tools/deploy/unix/unix.factor b/basis/tools/deploy/unix/unix.factor
index 2646f2d5a490f6d1451e1e6ed1db37efd56d6a69..1b6b8596e2b691cda181a488de1199cba6f23e0a 100644 (file)
--- a/basis/tools/deploy/unix/unix.factor
+++ b/basis/tools/deploy/unix/unix.factor
@@ -19,7 +19,7 @@ M: unix deploy* ( vocab -- )
             [ bundle-name create-app-dir ] keep
             [ bundle-name image-name ] keep
             namespace make-deploy-image
             [ bundle-name create-app-dir ] keep
             [ bundle-name image-name ] keep
             namespace make-deploy-image

-            bundle-name "" copy-resources
+            bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi

             bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
         ] bind
     ] with-directory ;
             bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
         ] bind
     ] with-directory ;

diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor
index 9f0b22847b04b73c9fe5e2766fa7ffa219fb0963..1dd60583fa84d603a679afc58fc5b2cde795565e 100755 (executable)
--- a/basis/tools/deploy/windows/windows.factor
+++ b/basis/tools/deploy/windows/windows.factor
@@ -36,7 +36,7 @@ M: winnt deploy*
                 [ drop embed-ico ]
                 [ image-name ]
                 [ drop namespace make-deploy-image ]
                 [ drop embed-ico ]
                 [ image-name ]
                 [ drop namespace make-deploy-image ]

-                [ nip "" copy-resources ]
+                [ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]

                 [ nip open-in-explorer ]
             } 2cleave 
         ] bind
                 [ nip open-in-explorer ]
             } 2cleave 
         ] bind

diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 576fac3a0692334d4e213585a7065788f9b4cef9..db0005e21956733a80dc8211f460f6fed3d9da9f 100644 (file)
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -90,6 +90,8 @@ CONSTANT: FILE_ACTION_MODIFIED 3
 CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
 CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
 
 CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
 CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
 

+CONSTANT: DONT_RESOLVE_DLL_REFERENCES 1
+

 STRUCT: FILE_NOTIFY_INFORMATION
     { NextEntryOffset DWORD }
     { Action DWORD }
 STRUCT: FILE_NOTIFY_INFORMATION
     { NextEntryOffset DWORD }
     { Action DWORD }


@@ -1167,7 +1169,7 @@ FUNCTION: BOOL FreeConsole ( ) ;
 ! FUNCTION: FreeEnvironmentStringsA
 FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
 ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
 ! FUNCTION: FreeEnvironmentStringsA
 FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
 ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW

-! FUNCTION: FreeLibrary
+FUNCTION: BOOL FreeLibrary ( HMODULE hModule ) ;

 ! FUNCTION: FreeLibraryAndExitThread
 ! FUNCTION: FreeResource
 ! FUNCTION: FreeUserPhysicalPages
 ! FUNCTION: FreeLibraryAndExitThread
 ! FUNCTION: FreeResource
 ! FUNCTION: FreeUserPhysicalPages


@@ -1314,7 +1316,8 @@ FUNCTION: DWORD GetLogicalDrives ( ) ;
 ! FUNCTION: GetLongPathNameW
 ! FUNCTION: GetMailslotInfo
 ! FUNCTION: GetModuleFileNameA
 ! FUNCTION: GetLongPathNameW
 ! FUNCTION: GetMailslotInfo
 ! FUNCTION: GetModuleFileNameA

-! FUNCTION: GetModuleFileNameW
+FUNCTION: DWORD GetModuleFileNameW ( HMODULE hModule, LPTSTR lpFilename, DWORD nSize ) ;
+ALIAS: GetModuleFileName GetModuleFileNameW

 FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
 ALIAS: GetModuleHandle GetModuleHandleW
 ! FUNCTION: GetModuleHandleExA
 FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
 ALIAS: GetModuleHandle GetModuleHandleW
 ! FUNCTION: GetModuleHandleExA