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: << } "." } ; "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 HELP: remove-library
{ $values { "name" string } } { $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." } ; { $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:" "Once a library has been defined, you can try loading it to see if the path name is correct:"
{ $subsections load-library } { $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. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.strings assocs io.backend USING: accessors alien alien.strings assocs io.backend
kernel namespaces destructors ; kernel namespaces destructors sequences system io.pathnames ;
IN: alien.libraries IN: alien.libraries
: dlopen ( path -- dll ) native-string>alien (dlopen) ; : dlopen ( path -- dll ) native-string>alien (dlopen) ;
@ -9,11 +9,15 @@ IN: alien.libraries
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ; : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
SYMBOL: libraries 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 ( name -- library ) libraries get at ;
: <library> ( path abi -- library ) : <library> ( path abi -- library )
@ -31,4 +35,20 @@ M: library dispose dll>> [ dispose ] when* ;
: add-library ( name path abi -- ) : add-library ( name path abi -- )
[ 2drop remove-library ] [ 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 io.directories.hierarchy io.backend quotations io.launcher
tools.deploy.config tools.deploy.config.editor bootstrap.image tools.deploy.config tools.deploy.config.editor bootstrap.image
io.encodings.utf8 destructors accessors hashtables io.encodings.utf8 destructors accessors hashtables
vocabs.metadata.resources ; tools.deploy.libraries vocabs.metadata.resources ;
IN: tools.deploy.backend IN: tools.deploy.backend
: copy-vm ( executable bundle-name -- vm ) : copy-vm ( executable bundle-name -- vm )
prepend-path vm over copy-file ; 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 ) : image-name ( vocab bundle-name -- str )
prepend-path ".image" append ; prepend-path ".image" append ;
@ -99,10 +112,16 @@ DEFER: ?make-staging-image
] { } make ] { } make
] bind ; ] 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-deploy-image ( vm image vocab config -- manifest )
make-boot-image make-boot-image
over "vocab-manifest-" prepend temp-file over "vocab-manifest-" prepend temp-file
[ swap deploy-command-line run-factor ] [ swap deploy-command-line run-factor ]
[ utf8 file-lines ] bi ; [ parse-vocab-manifest-file ] bi ;
HOOK: deploy* os ( vocab -- ) 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 create-app-dir ] keep
[ bundle-name deploy.app-image ] keep [ bundle-name deploy.app-image ] keep
namespace make-deploy-image 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 bundle-name show-in-finder
] bind ] bind
] with-directory ; ] with-directory ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2010 Slava Pestov. ! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 io.streams.c init fry namespaces math make assocs kernel parser
parser.notes lexer strings.parser vocabs sequences sequences.deep parser.notes lexer strings.parser vocabs sequences sequences.deep
sequences.private words memory kernel.private continuations io sequences.private words memory kernel.private continuations io
@ -19,6 +19,7 @@ QUALIFIED: layouts
QUALIFIED: source-files QUALIFIED: source-files
QUALIFIED: source-files.errors QUALIFIED: source-files.errors
QUALIFIED: vocabs QUALIFIED: vocabs
FROM: alien.libraries.private => >deployed-library-path ;
IN: tools.deploy.shaker IN: tools.deploy.shaker
! This file is some hairy shit. ! This file is some hairy shit.
@ -505,11 +506,28 @@ SYMBOL: deploy-vocab
: write-vocab-manifest ( vocab-manifest-out -- ) : write-vocab-manifest ( vocab-manifest-out -- )
"Writing vocabulary manifest to " write dup print flush "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 -- ) : strip ( vocab-manifest-out -- )
[ write-vocab-manifest ] when* [ write-vocab-manifest ] when*
startup-stripper startup-stripper
prepare-deploy-libraries
strip-libc strip-libc
strip-destructors strip-destructors
strip-call strip-call

View File

@ -19,7 +19,7 @@ M: unix deploy* ( vocab -- )
[ bundle-name create-app-dir ] keep [ bundle-name create-app-dir ] keep
[ bundle-name image-name ] keep [ bundle-name image-name ] keep
namespace make-deploy-image namespace make-deploy-image
bundle-name "" copy-resources bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
] bind ] bind
] with-directory ; ] with-directory ;

View File

@ -36,7 +36,7 @@ M: winnt deploy*
[ drop embed-ico ] [ drop embed-ico ]
[ image-name ] [ image-name ]
[ drop namespace make-deploy-image ] [ drop namespace make-deploy-image ]
[ nip "" copy-resources ] [ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]
[ nip open-in-explorer ] [ nip open-in-explorer ]
} 2cleave } 2cleave
] bind ] bind

View File

@ -90,6 +90,8 @@ CONSTANT: FILE_ACTION_MODIFIED 3
CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4 CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5 CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
CONSTANT: DONT_RESOLVE_DLL_REFERENCES 1
STRUCT: FILE_NOTIFY_INFORMATION STRUCT: FILE_NOTIFY_INFORMATION
{ NextEntryOffset DWORD } { NextEntryOffset DWORD }
{ Action DWORD } { Action DWORD }
@ -1167,7 +1169,7 @@ FUNCTION: BOOL FreeConsole ( ) ;
! FUNCTION: FreeEnvironmentStringsA ! FUNCTION: FreeEnvironmentStringsA
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ; FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
! FUNCTION: FreeLibrary FUNCTION: BOOL FreeLibrary ( HMODULE hModule ) ;
! FUNCTION: FreeLibraryAndExitThread ! FUNCTION: FreeLibraryAndExitThread
! FUNCTION: FreeResource ! FUNCTION: FreeResource
! FUNCTION: FreeUserPhysicalPages ! FUNCTION: FreeUserPhysicalPages
@ -1314,7 +1316,8 @@ FUNCTION: DWORD GetLogicalDrives ( ) ;
! FUNCTION: GetLongPathNameW ! FUNCTION: GetLongPathNameW
! FUNCTION: GetMailslotInfo ! FUNCTION: GetMailslotInfo
! FUNCTION: GetModuleFileNameA ! FUNCTION: GetModuleFileNameA
! FUNCTION: GetModuleFileNameW FUNCTION: DWORD GetModuleFileNameW ( HMODULE hModule, LPTSTR lpFilename, DWORD nSize ) ;
ALIAS: GetModuleFileName GetModuleFileNameW
FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ; FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
ALIAS: GetModuleHandle GetModuleHandleW ALIAS: GetModuleHandle GetModuleHandleW
! FUNCTION: GetModuleHandleExA ! FUNCTION: GetModuleHandleExA