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
parent
31029de959
commit
42089b6586
|
@ -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
|
||||
} ;
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -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 ;
|
||||
|
|
@ -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* ;
|
||||
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue