alien.libraries: add a "deploy-library" word that marks a library to have its dll deployed with applications that use it. add support to tools.deploy to find and copy deployed libraries into target bundle

db4
Joe Groff 2010-02-16 13:32:14 -08:00
parent 31029de959
commit 42089b6586
13 changed files with 129 additions and 13 deletions

View File

@ -60,6 +60,10 @@ $nl
}
"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." } ;
@ -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 }
"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
} ;

View File

@ -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
kernel namespaces destructors ;
kernel namespaces destructors sequences system io.pathnames ;
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
SYMBOL: deploy-libraries
libraries [ H{ } clone ] initialize
deploy-libraries [ V{ } clone ] initialize
TUPLE: library path abi dll ;
ERROR: no-library name ;
: 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 ]
[ <library> swap libraries get set-at ] 3bi ;
[ <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>

View File

@ -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
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 ;
TUPLE: vocab-manifest vocabs libraries ;
: 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 ;
@ -99,10 +112,16 @@ DEFER: ?make-staging-image
] { } 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 ]
[ utf8 file-lines ] bi ;
[ parse-vocab-manifest-file ] bi ;
HOOK: deploy* os ( vocab -- )

View File

@ -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

View File

@ -0,0 +1 @@
unportable

View File

@ -0,0 +1 @@
unportable

View File

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

View File

@ -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* ;

View File

@ -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 "Contents/Resources" copy-resources
bundle-name
[ "Contents/Resources" copy-resources ]
[ "Contents/Frameworks" copy-libraries ] 2bi
bundle-name show-in-finder
] bind
] with-directory ;

View File

@ -1,6 +1,6 @@
! 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
@ -19,6 +19,7 @@ QUALIFIED: layouts
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.
@ -505,11 +506,28 @@ SYMBOL: deploy-vocab
: 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
prepare-deploy-libraries
strip-libc
strip-destructors
strip-call

View File

@ -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 "" copy-resources
bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
] bind
] with-directory ;

View File

@ -36,7 +36,7 @@ M: winnt deploy*
[ 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

View File

@ -90,6 +90,8 @@ CONSTANT: FILE_ACTION_MODIFIED 3
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 }
@ -1167,7 +1169,7 @@ FUNCTION: BOOL FreeConsole ( ) ;
! FUNCTION: FreeEnvironmentStringsA
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
! FUNCTION: FreeLibrary
FUNCTION: BOOL FreeLibrary ( HMODULE hModule ) ;
! FUNCTION: FreeLibraryAndExitThread
! FUNCTION: FreeResource
! FUNCTION: FreeUserPhysicalPages
@ -1314,7 +1316,8 @@ FUNCTION: DWORD GetLogicalDrives ( ) ;
! 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