suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco exe: add --embed-dlls for Windows

Browse Source 
Creating an executable with embedded DLLs means that the executable
can be truly stand-alone, instead of needing to be kept with its
DLLs in a relative subdirectory.

DLL embedding works by bypassing the OS's LoadLibrary and
GetProcAddress functions, and instead maps the DLL into memory
and performs relocations explicitly. Joachim Bauch's MemoryModule
(Mozilla license) implements those steps.
This commit is contained in:
Matthew Flatt 2018-03-24 17:02:34 -06:00
parent 1803e647e1
commit e01a21db0c
36 changed files with 2101 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/compiler-lib/compiler/commands/exe.rkt
View File

@ -41,6 +41,8 @@
(list "-A" (path->string (find-system-path 'addon-dir)))
(remove "-U" (exe-embedded-flags)))))
(launcher #t)]
[("--embed-dlls") "On Windows, embed DLLs in the executable"
(exe-aux (cons (cons 'embed-dlls? #t) (exe-aux)))]
[("--config-path") path "Set <path> as configuration directory for executable"
(exe-embedded-config-path path)]
[("--collects-path") path "Set <path> as main collects for executable"

4
pkgs/compiler-test/info.rkt
View File

@ -16,5 +16,7 @@
"gui-lib"
"htdp-lib"
"plai-lib"
"rackunit-lib"))
"rackunit-lib"
"dynext-lib"
"mzscheme-lib"))
(define update-implies '("compiler-lib"))

33
pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -297,6 +297,27 @@
`("-l" "tests/compiler/embed/embed-me5.rkt"))
(try-exe mr-dest "This is 5: #<class:button%>\n" #t)))
(define (try-embedded-dlls)
(prepare mz-dest "embed-me1.rkt")
(make-embedding-executable
mz-dest #f #f
`((#t (lib "embed-me1.rkt" "tests" "compiler" "embed")))
'()
#f
`("-l" "tests/compiler/embed/embed-me1.rkt")
'((embed-dlls? . #t)))
(try-exe mz-dest "This is 1\n" #t)
(prepare mr-dest "embed-me5.rkt")
(make-embedding-executable
mr-dest #t #f
`((#t (lib "embed-me5.rkt" "tests" "compiler" "embed")))
'()
#f
`("-l" "tests/compiler/embed/embed-me5.rkt")
'((embed-dlls? . #t)))
(try-exe mr-dest "This is 5: #<class:button%>\n" #t))
;; Try the raco interface:
(require setup/dirs
mzlib/file)
@ -309,7 +330,8 @@
(define (system+ . args)
(printf "> ~a\n" (car (reverse args)))
(apply system* args))
(unless (apply system* args)
(error 'system+ "command failed ~s" args)))
(define (short-mzc-tests mred?)
(parameterize ([current-directory (find-system-path 'temp-dir)])
@ -399,6 +421,7 @@
(try-exe (mk-dest mred?) "Hello from a place!\n" mred?)
;; raco exe --launcher
(printf ">>launcher\n")
(system+ raco
"exe"
"--launcher"
@ -409,6 +432,7 @@
;; the rest use mzc...
(printf ">>mzc\n")
(system+ mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
@ -470,7 +494,7 @@
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution
(delete-directory/files "cts")
(parameterize ([current-error-port (open-output-nowhere)])
(test #f system+ (mk-dest mred?))))
(test #f system* (mk-dest mred?))))
(check-collection-path "embed-me6b.rkt" "racket/fixnum.rkt" #t)
(check-collection-path "embed-me6.rkt" "mzlib/etc.rkt"
;; "mzlib" is found via the "collects" path
@ -702,12 +726,15 @@
(try-basic)
(try-mzc)
(try-extension)
(unless (eq? 'windows (system-type))
(try-extension))
(try-gracket)
(try-reader)
(try-planet)
(try-*sl)
(try-source)
(when (eq? 'windows (system-type))
(try-embedded-dlls))
;; ----------------------------------------
;; Make sure that embedding does not break future module declarations

12
pkgs/racket-doc/scribblings/raco/exe-api.scrbl
View File

@ -251,6 +251,13 @@ currently supported keys are as follows:
original executable's path to DLLs is converted to an absolute
path if it was relative.}
@item{@racket['embed-dlls?] (Windows) : A boolean indicating whether
to copy DLLs into the executable, where the default value is
@racket[#f]. Embedded DLLs are instantiated by an internal
linking step that bypasses some operating system facilities,
so it will not work for all Windows DLLs, but typical DLLs
will work as embedded.}
@item{@racket['subsystem] (Windows) : A symbol, either
@racket['console] for a console application or
@racket['windows] for a consoleless application; the default
@ -368,7 +375,10 @@ reader extensions needed to parse a module that will be included as
source, as long as the reader is referenced through an absolute module
path. Each path given to @racket[extras-proc] corresponds to the
actual file name (e.g., @filepath{.ss}/@filepath{.rkt} conversions
have been applied as needed to refer to the existing file).}
have been applied as needed to refer to the existing file).
@history[#:changed "6.90.0.23" @elem{Added @racket[embed-dlls?] as an
@racket[#:aux] key.}]}
@defproc[(make-embedding-executable [dest path-string?]

13
pkgs/racket-doc/scribblings/raco/exe.scrbl
View File

@ -68,7 +68,7 @@ interface to the embedding mechanism.
A stand-alone executable is ``stand-alone'' in the sense that you can
run it without starting @exec{racket}, @exec{gracket}, or
DrRacket. However, the executable depends on Racket shared libraries,
DrRacket. However, the executable may depend on Racket shared libraries
and possibly other run-time files declared via
@racket[define-runtime-path]. The executable can be packaged with
support libraries to create a distribution using @exec{raco
@ -95,6 +95,14 @@ The @exec{raco exe} command accepts the following command-line flags:
are installed in user scope; use @exec{--exf -U} to enable access
to user-scope packages from the launcher.}
@item{@DFlag{embed-dlls} --- On Windows, for a stand-alone executable,
copies any needed DLLs into the executable. Embedding DLLs makes
the resulting executable truly stand-alone if it does not depend on
other external files. Not all DLLs work with embedding, and
limitations are mostly related to thread-local storage and
resources, but all DLLs within the main Racket distribution work
with @DFlag{embed-dlls}.}
@item{@DFlag{config-path} @nonterm{path} --- set @nonterm{path}
within the executable as the path to the @tech{configuration
directory}; if the path is relative, it will be treated as relative
@ -184,7 +192,8 @@ The @exec{raco exe} command accepts the following command-line flags:
]
@history[#:changed "6.3.0.11" @elem{Added support for
@racketidfont{declare-preserve-for-embedding}.}]
@racketidfont{declare-preserve-for-embedding}.}
#:changed "6.90.0.23" @elem{Added @DFlag{embed-dlls}.}]
@; ----------------------------------------------------------------------

85
racket/collects/compiler/distribute.rkt
View File

@ -7,12 +7,12 @@
setup/cross-system
pkg/path
setup/main-collects
dynext/filename-version
"private/macfw.rkt"
"private/windlldir.rkt"
"private/elf.rkt"
"private/collects-path.rkt"
"private/write-perm.rkt")
"private/write-perm.rkt"
"private/win-dll-list.rkt")
(provide assemble-distribution)
@ -106,12 +106,16 @@
relative-collects-dir
(build-path dest-dir specific-lib-dir "exts")
(build-path specific-lib-dir "exts"))))])
(make-directory* lib-dir)
(make-directory* collects-dir)
(make-directory* exts-dir)
;; Copy libs into place
(install-libs lib-dir types (not executables?))
(install-libs lib-dir types
#:extras-only? (not executables?)
#:no-dlls? (and (eq? 'windows (cross-system-type))
;; If all executables have "<system>" the the
;; DLL dir, then no base DLLS are needed
(for/and ([f (in-list orig-binaries)])
(current-no-dlls? f))))
;; Copy collections into place
(unless (null? copy-collects) (make-directory* collects-dir))
(for-each (lambda (dir)
(for-each (lambda (f)
(copy-directory/files*
@ -161,38 +165,18 @@
;; Done!
(void))))))
(define (install-libs lib-dir types extras-only?)
(define (install-libs lib-dir types
#:extras-only? extras-only?
#:no-dlls? no-dlls?)
(case (cross-system-type)
[(windows)
(let ([copy-dll (lambda (name)
(copy-file* (search-dll (find-cross-dll-dir) name)
(build-path lib-dir name)))]
[versionize (lambda (template)
(let ([f (search-dll (find-cross-dll-dir)
(format template filename-version-part))])
(if (file-exists? f)
(format template filename-version-part)
(format template "xxxxxxx"))))])
(map copy-dll (list
"libiconv-2.dll"
"longdouble.dll"))
(unless extras-only?
(when (or (memq 'racketcgc types)
(memq 'gracketcgc types))
(map copy-dll
(list
(versionize "libracket~a.dll")
(versionize "libmzgc~a.dll"))))
(when (or (memq 'racket3m types)
(memq 'gracket3m types))
(map copy-dll
(list
(versionize "libracket3m~a.dll"))))
(when (or (memq 'racketcs types)
(memq 'gracketcs types))
(map copy-dll
(list
(versionize "libracketcs~a.dll"))))))]
(if no-dlls?
'()
(let ([copy-dll (lambda (name)
(make-directory* lib-dir)
(copy-file* (search-dll name)
(build-path lib-dir name)))])
(map copy-dll (get-racket-dlls types #:extras-only? extras-only?))))]
[(macosx)
(unless extras-only?
(when (or (memq 'racketcgc types)
@ -207,10 +191,9 @@
[(unix)
(unless extras-only?
(let ([lib-plt-dir (build-path lib-dir "plt")])
(unless (directory-exists? lib-plt-dir)
(make-directory lib-plt-dir))
(let ([copy-bin
(lambda (name variant gr?)
(make-directory* lib-plt-dir)
(copy-file* (build-path (if gr?
(find-lib-dir)
(find-console-bin-dir))
@ -241,28 +224,6 @@
(memq 'gracketcs types))
(copy-shared-lib "racketcs" lib-dir)))))]))
(define (search-dll dll-dir dll)
(if dll-dir
(build-path dll-dir dll)
(let* ([exe-dir
(let ([exec (path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))])
(let-values ([(base name dir?) (split-path exec)])
base))]
[paths (cons
exe-dir
(path-list-string->path-list
(or (getenv "PATH") "")
(list (find-system-path 'sys-dir))))])
(or (ormap (lambda (p)
(let ([p (build-path p dll)])
(and (file-exists? p)
p)))
paths)
;; Can't find it, so just use executable's dir:
(build-path exe-dir dll)))))
(define (copy-framework name variant lib-dir)
(let* ([fw-name (format "~a.framework" name)]
[sub-dir (build-path fw-name "Versions"
@ -298,6 +259,7 @@
(define avail-lib-files #f)
(define (copy-shared-lib name lib-dir)
(make-directory* lib-dir)
(unless avail-lib-files
(set! avail-lib-files (directory-list (find-cross-dll-dir))))
(let* ([rx (byte-regexp (string->bytes/latin-1
@ -320,7 +282,8 @@
(case (cross-system-type)
[(windows)
(for-each (lambda (b)
(update-dll-dir b "lib"))
(unless (current-no-dlls? b)
(update-dll-dir b "lib")))
binaries)]
[(macosx)
(if (and (= 1 (length types))

109
racket/collects/compiler/embed.rkt
View File

@ -22,9 +22,9 @@
"private/collects-path.rkt"
"private/configdir.rkt"
"private/write-perm.rkt"
"private/win-dll-list.rkt"
"find-exe.rkt")
(provide/contract [make-embedding-executable
(->* (path-string?
any/c
@ -558,7 +558,7 @@
[_else (error 'create-empbedding-executable
"expansion mismatch when getting external paths: ~e"
(syntax->datum e))]))))]
[extra-runtime-paths (filter
values
(map (lambda (p)
@ -1116,7 +1116,8 @@
early-literal-expressions config? literal-files literal-expressions
collects-dest
on-extension program-name compiler expand-namespace
src-filter get-extra-imports on-decls-done)
src-filter get-extra-imports on-decls-done
embedded-dlls-box)
(let* ([program-name-bytes (if program-name
(path->bytes program-name)
#"?")]
@ -1248,7 +1249,15 @@
p)))
(let ([p (cond
[(bytes? p) (bytes->path p)]
[(so-spec? p) (so-find p)]
[(so-spec? p)
(define path (so-find p))
(cond
[(and path embedded-dlls-box)
(set-box! embedded-dlls-box (cons path (unbox embedded-dlls-box)))
;; Don't record the path in the executable since we'll
;; record the whole DLL in the executable
#f]
[else path])]
[(and (list? p)
(eq? 'lib (car p)))
(let ([p (if (null? (cddr p))
@ -1356,7 +1365,8 @@
#f ; program-name
compiler expand-namespace
src-filter get-extra-imports
void))
void
#f)) ; don't accumulate embedded DLLs
;; The old interface:
@ -1501,20 +1511,28 @@
"/")
dest
mred?))))))
(define embed-dlls? (and (eq? 'windows (cross-system-type))
(let ([m (assq 'embed-dlls? aux)])
(and m (cdr m)))))
(define embedded-dlls-box (and embed-dlls? (box null)))
(when (eq? 'windows (cross-system-type))
(let ([m (or (assq 'dll-dir aux)
(and relative? '(dll-dir . #f)))])
(if m
(if (cdr m)
(update-dll-dir dest (cdr m))
;; adjust relative path, since exe directory can change:
(update-dll-dir dest (find-relative-path* dest (find-cross-dll-dir))))
;; Check whether we need an absolute path to DLLs:
(let ([dir (get-current-dll-dir dest)])
(when (relative-path? dir)
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-dll-dir dest (build-path orig-dir dir))))))))
(cond
[embed-dlls?
(update-dll-dir dest #t)]
[else
(let ([m (or (assq 'dll-dir aux)
(and relative? '(dll-dir . #f)))])
(if m
(if (cdr m)
(update-dll-dir dest (cdr m))
;; adjust relative path, since exe directory can change:
(update-dll-dir dest (find-relative-path* dest (find-cross-dll-dir))))
;; Check whether we need an absolute path to DLLs:
(let ([dir (get-current-dll-dir dest)])
(when (relative-path? dir)
(let-values ([(orig-dir name dir?) (split-path
(path->complete-path orig-exe))])
(update-dll-dir dest (build-path orig-dir dir)))))))]))
(define (adjust-config-dir)
(let ([m (or (assq 'config-dir aux)
(and relative? '(config-dir . #f)))]
@ -1567,7 +1585,8 @@
expand-namespace
src-filter
get-extra-imports
(lambda (outp) (set! pos (file-position outp))))
(lambda (outp) (set! pos (file-position outp)))
embedded-dlls-box)
pos)]
[make-full-cmdline
(lambda (start decl-end end)
@ -1638,7 +1657,24 @@
1
1033 ; U.S. English
bstr))
(update-resources dest-exe pe new-rsrcs)
(define new+dll-rsrcs
(if embed-dlls?
(resource-set new-rsrcs
;; Racket's "user-defined" type for embedded DLLs:
258
1
1033 ; U.S. English
(pack-embedded-dlls
(append
(get-racket-dlls
(list
(case (cross-system-type 'gc)
[(3m) (if mred? 'gracket3m 'racket3m)]
[(cgc) (if mred? 'gracketcgc 'racketcgc)]
[(cs) (if mred? 'gracketcs 'racketcs)])))
(unbox embedded-dlls-box))))
new-rsrcs))
(update-resources dest-exe pe new+dll-rsrcs)
(values 0 decl-len init-len (+ init-len cmdline-len))]
[(and (eq? (cross-system-type) 'macosx)
(not unix-starter?))
@ -1828,3 +1864,36 @@
(define (find-relative-path* wrt-exe p)
(define-values (wrt base name) (split-path (path->complete-path wrt-exe)))
(find-relative-path (simplify-path wrt) (simplify-path p)))
;; To embed DLLs in the executable as resource ID 258:
(define (pack-embedded-dlls name-or-paths)
(define bstrs (for/list ([p (in-list name-or-paths)])
(file->bytes (if (string? p)
(search-dll p)
p))))
(define names (for/list ([p (in-list name-or-paths)])
(if (string? p)
p
(let-values ([(base name dir) (split-path p)])
(path-element->string name)))))
(define start-pos (+ 4 ; count
;; name array:
(for/sum ([p (in-list names)])
(+ 2 (bytes-length (string->bytes/utf-8 p))))
;; starting-position array:
(* 4 (add1 (length names)))))
(define-values (rev-offsets total)
(for/fold ([rev-offsets null] [total start-pos]) ([bstr (in-list bstrs)])
(values (cons total rev-offsets)
(+ total (bytes-length bstr)))))
(apply
bytes-append
(integer->integer-bytes (length names) 4 #t #f)
(append
(for/list ([p (in-list names)])
(define bstr (string->bytes/utf-8 p))
(bytes-append (integer->integer-bytes (bytes-length bstr) 2 #t #f) bstr))
(for/list ([offset (in-list (reverse rev-offsets))])
(integer->integer-bytes offset 4 #t #f))
(list (integer->integer-bytes total 4 #t #f))
bstrs)))

56
racket/collects/compiler/private/win-dll-list.rkt Normal file
View File

@ -0,0 +1,56 @@
#lang racket/base
(require setup/dirs
dynext/filename-version)
(provide get-racket-dlls
search-dll)
(define (get-racket-dlls types #:extras-only? [extras-only? #f])
(define (versionize template)
(let ([f (search-dll (format template filename-version-part))])
(if (file-exists? f)
(format template filename-version-part)
(format template "xxxxxxx"))))
(append
(list
"libiconv-2.dll"
"longdouble.dll")
(if extras-only?
'()
(cond
[(or (memq 'racketcgc types)
(memq 'gracketcgc types))
(list
(versionize "libracket~a.dll")
(versionize "libmzgc~a.dll"))]
[(or (memq 'racket3m types)
(memq 'gracket3m types))
(list
(versionize "libracket3m~a.dll"))]
[(or (memq 'racketcs types)
(memq 'gracketcs types))
(list
(versionize "libracketcs~a.dll"))]))))
(define (search-dll dll)
(define dll-dir (find-cross-dll-dir))
(if dll-dir
(build-path dll-dir dll)
(let* ([exe-dir
(let ([exec (path->complete-path
(find-executable-path (find-system-path 'exec-file))
(find-system-path 'orig-dir))])
(let-values ([(base name dir?) (split-path exec)])
base))]
[paths (cons
exe-dir
(path-list-string->path-list
(or (getenv "PATH") "")
(list (find-system-path 'sys-dir))))])
(or (ormap (lambda (p)
(let ([p (build-path p dll)])
(and (file-exists? p)
p)))
paths)
;; Can't find it, so just use executable's dir:
(build-path exe-dir dll)))))

10
racket/collects/compiler/private/windlldir.rkt
View File

@ -4,7 +4,8 @@
"winutf16.rkt")
(provide update-dll-dir
get-current-dll-dir)
get-current-dll-dir
current-no-dlls?)
(define label (delay/sync (byte-regexp (bytes->utf-16-bytes #"dLl dIRECTORy:"))))
(define max-dir-len (* 512 2)) ; sizeof(wchar_t) is 2
@ -27,7 +28,7 @@
(write-bytes path-bytes)
(write-byte 0))
#:exists 'update))))
(define (get-current-dll-dir dest)
(with-input-from-file dest
(lambda ()
@ -35,4 +36,7 @@
(error 'get-current-dll-dir "cannot find DLL path in file: ~e" dest))
(let ([p (make-limited-input-port (current-input-port) max-dir-len)])
(let ([m (regexp-match #rx#"(?:[^\0].|.[^\0])*" p)])
(bytes->path (utf-16-bytes->bytes (car m)))))))))
(bytes->path (utf-16-bytes->bytes (car m))))))))
(define (current-no-dlls? dest)
(regexp-match? #rx#"^<" (get-current-dll-dir dest))))

6
racket/collects/compiler/private/xform.rkt
View File

@ -620,6 +620,9 @@
[(and (tok? e)
(eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION))
'function]
[(and (tok? e)
(eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_DELTA))
'delta]
[(and (tok? e)
(eq? (tok-n e) 'XFORM_GC_VARIABLE_STACK_THROUGH_DIRECT_FUNCTION))
'direct-function]
@ -643,6 +646,8 @@
"#define GC_VARIABLE_STACK ((scheme_get_thread_local_variables())->GC_variable_stack_)\n"]
[(thread-local)
"#define GC_VARIABLE_STACK ((&scheme_thread_locals)->GC_variable_stack_)\n"]
[(delta)
"#define GC_VARIABLE_STACK (((Thread_Local_Variables *)((char *)&scheme_thread_locals_space + scheme_tls_delta))->GC_variable_stack_)\n"]
[else "#define GC_VARIABLE_STACK GC_variable_stack\n"]))
(if (or gc-variable-stack-through-funcs?
@ -1713,6 +1718,7 @@
(or (eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_GETSPECIFIC (tok-n (car e)))
(eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION (tok-n (car e)))
(eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_DIRECT_FUNCTION (tok-n (car e)))
(eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_DELTA (tok-n (car e)))
(eq? 'XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL (tok-n (car e))))))
(define (access-modifier? e)

4
racket/src/gracket/Makefile.in
View File

@ -69,8 +69,8 @@ GRACKETLDFLAGS = $(LDFLAGS) -L../racket
GRACKETRES@NOT_MINGW@ =
GRACKETRESDEP@NOT_MINGW@ =
GRACKETRES@MINGW@ = -mwindows gres.o
GRACKETRESDEP@MINGW@ = gres.o
GRACKETRES@MINGW@ = -mwindows gres.o ../racket/MemoryModule.@LTO@
GRACKETRESDEP@MINGW@ = gres.o ../racket/MemoryModule.@LTO@
LOCALFLAGS_wx_xt = @WX_MMD_FLAG@
LOCALFLAGS_wx_mac = -I$(srcdir)/../mac/racket -MMD -DWX_CARBON

6
racket/src/gracket/gc2/Makefile.in
View File

@ -56,7 +56,7 @@ MZMMM_wx_xt = @RUN_RACKET_MMM@
MZMMM_wx_mac = @RUN_RACKET_MMM@
MZMMM = $(MZMMM_@WXVARIANT@)
SETUP_BOOT = -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled
SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled
XFORM_CMD = $(MZMMM) $(SELF_RACKET_FLAGS) $(SETUP_BOOT) --tag ++out $(srcdir)/../../racket/gc2/xform-mod.rkt
XFORM_CPP_ARGS = -I$(srcdir)/../../racket/gc2 $(NOGCINC) $(OPTIONS) @PREFLAGS@ $(XFORM_INC_@WXVARIANT@)
@ -105,8 +105,8 @@ GRACKETMZOBJS_la =
../gracket@MMM@@NOT_OSX@@NOT_MINGW@: grmain.@LTO@ ../../racket/libracket3m.@LIBSFX@ $(LIBRKTIO_@LIBSFX@)
$(GRACKETLINKER) $(GRACKETLDFLAGS) -o ../gracket@MMM@ grmain.@LTO@ ../../racket/libracket3m.@LIBSFX@ $(GRACKETMZOBJS_@LIBSFX@) $(GRACKETLIBS_@LIBSFX@)
../gracket@MMM@@MINGW@: grmain.@LTO@ ../../racket/gc2/libracket3m.dll.a ../gres.o
$(GRACKETLINKER) -mwindows $(GRACKETLDFLAGS) -o ../gracket@MMM@ grmain.@LTO@ ../gres.o ../../racket/gc2/libracket3m.dll.a $(GRACKETMZOBJS_@LIBSFX@) $(GRACKETLIBS_@LIBSFX@) -l delayimp -static-libgcc
../gracket@MMM@@MINGW@: grmain.@LTO@ ../../racket/MemoryModule.@LTO@ ../../racket/gc2/libracket3m.dll.a ../gres.o
$(GRACKETLINKER) -mwindows $(GRACKETLDFLAGS) -o ../gracket@MMM@ grmain.@LTO@ ../../racket/MemoryModule.@LTO@ ../gres.o ../../racket/gc2/libracket3m.dll.a $(GRACKETMZOBJS_@LIBSFX@) $(GRACKETLIBS_@LIBSFX@) -l delayimp -static-libgcc
MZFW = ../../racket/Racket.framework/Versions/$(FWVERSION)_3m/Racket
MRAPPSKEL = ../GRacket@MMM@.app/Contents/Info.plist

14
racket/src/racket/Makefile.in
View File

@ -242,15 +242,18 @@ libracket.dll.a: lib/libracketxxxxxxx.dll
libmzgc.dll.a: lib/libmzgcxxxxxxx.dll
@DLLTOOL@ --def libmzgc.def -D libmzgcxxxxxxx.dll --output-lib libmzgcxxxxxxx.lib --output-exp libmzgcxxxxxxx.lib --output-delaylib libmzgc.dll.a
rres.o : $(srcdir)/../worksp/racket/racket.rc
rres.o: $(srcdir)/../worksp/racket/racket.rc
@WINDRES@ -i $(srcdir)/../worksp/racket/racket.rc -o rres.o
MW_RACKET_LIBS = libracket.dll.a libmzgc.dll.a @LDFLAGS@ @LIBS@ -ldelayimp -static-libgcc
racket@CGC@@MINGW@: libracket.dll.a libmzgc.dll.a main.@LTO@ $(SPECIALIZINGOBJECTS) rres.o
@MZLINKER@ -o racket@CGC@ main.@LTO@ rres.o $(SPECIALIZINGOBJECTS) $(MW_RACKET_LIBS)
racket@CGC@@MINGW@: libracket.dll.a libmzgc.dll.a main.@LTO@ MemoryModule.@LTO@ $(SPECIALIZINGOBJECTS) rres.o
@MZLINKER@ -o racket@CGC@ main.@LTO@ MemoryModule.@LTO@ rres.o $(SPECIALIZINGOBJECTS) $(MW_RACKET_LIBS)
mingw-other@MINGW@: mzsj86g.o rres.o comres.o com_glue.@LTO@
MemoryModule.@LTO@: $(srcdir)/../start/MemoryModule.c $(srcdir)/../start/MemoryModule.h
$(CC) -c -I $(srcdir)/../start -o MemoryModule.@LTO@ $(srcdir)/../start/MemoryModule.c
mingw-other@MINGW@: mzsj86g.o MemoryModule.@LTO@ rres.o comres.o com_glue.@LTO@
$(NOOP)
mingw-other@NOT_MINGW@:
@ -270,7 +273,8 @@ DEF_C_DIRS = $(DEF_COLLECTS_DIR) $(DEF_CONFIG_DIR)
MAIN_HEADER_DEPS = $(srcdir)/include/scheme.h $(srcdir)/include/schthread.h $(srcdir)/sconfig.h \
$(srcdir)/src/stypes.h $(srcdir)/cmdline.inc $(srcdir)/parse_cmdl.inc \
$(srcdir)/../start/config.inc $(srcdir)/../start/delayed.inc $(srcdir)/parse_cmdl.inc
$(srcdir)/../start/config.inc $(srcdir)/../start/delayed.inc $(srcdir)/parse_cmdl.inc \
$(srcdir)/../start/embedded_dll.inc
main.@LTO@: $(srcdir)/main.c $(MAIN_HEADER_DEPS)
$(CC) -I$(builddir) -I$(srcdir)/include $(CFLAGS) $(CPPFLAGS) @OPTIONS@ @MZOPTIONS@ $(DEF_C_DIRS) -c $(srcdir)/main.c -o main.@LTO@

4
racket/src/racket/gc2/Makefile.in
View File

@ -617,8 +617,8 @@ libracket3m.dll.a: ../lib/libracket3mxxxxxxx.dll
MW_RACKET_LIBS = gc2/libracket3m.dll.a @LDFLAGS@ @LIBS@ -ldelayimp -static-libgcc
../racket@MMM@@MINGW@: libracket3m.dll.a main.@LTO@ ../rres.o $(SPECIALIZINGOBJECTS)
cd ..; @MZLINKER@ -o racket@MMM@ gc2/main.@LTO@ rres.o $(SPECIALIZINGOBJECTS) $(MW_RACKET_LIBS)
../racket@MMM@@MINGW@: libracket3m.dll.a main.@LTO@ ../MemoryModule.@LTO@ ../rres.o $(SPECIALIZINGOBJECTS)
cd ..; @MZLINKER@ -o racket@MMM@ gc2/main.@LTO@ MemoryModule.@LTO@ rres.o $(SPECIALIZINGOBJECTS) $(MW_RACKET_LIBS)
../mzcom@MMM@@NOT_MINGW@:
$(NOOP)

3
racket/src/racket/include/scheme.h
View File

@ -1921,6 +1921,9 @@ MZ_EXTERN void scheme_set_compiled_file_paths(Scheme_Object *list);
MZ_EXTERN void scheme_set_compiled_file_roots(Scheme_Object *list);
#ifdef DOS_FILE_SYSTEM
MZ_EXTERN void scheme_set_dll_path(wchar_t *s);
typedef void *(*scheme_dll_open_proc)(const char *name, int as_global);
typedef void *(*scheme_dll_find_object_proc)(void *h, const char *name);
MZ_EXTERN void scheme_set_dll_procs(scheme_dll_open_proc, scheme_dll_find_object_proc);
#endif
MZ_EXTERN void scheme_init_collection_paths(Scheme_Env *global_env, Scheme_Object *extra_dirs);

8
racket/src/racket/include/schthread.h
View File

@ -35,6 +35,7 @@ extern "C" {
# else
# define THREAD_LOCAL __declspec(thread)
# define MZ_THREAD_EXTERN extern
# define IMPLEMENT_THREAD_LOCAL_VIA_OFFSET
# define IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC
# endif
# else
@ -486,6 +487,13 @@ static __inline Thread_Local_Variables *scheme_get_thread_local_variables(void)
END_XFORM_SKIP;
XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION;
# endif
# elif defined (IMPLEMENT_THREAD_LOCAL_VIA_OFFSET)
MZ_THREAD_EXTERN THREAD_LOCAL Thread_Local_Variables scheme_thread_locals_space;
extern int scheme_tls_delta;
# define scheme_get_thread_local_variables() ((Thread_Local_Variables *)((char *)&scheme_thread_locals_space + scheme_tls_delta))
# ifdef MZ_XFORM
XFORM_GC_VARIABLE_STACK_THROUGH_DELTA;
# endif
# else
MZ_THREAD_EXTERN THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# define scheme_get_thread_local_variables() (&scheme_thread_locals)

11
racket/src/racket/main.c
View File

@ -311,13 +311,22 @@ START_XFORM_SKIP;
#ifdef DOS_FILE_SYSTEM
# include "win_tls.inc"
# include "../start/embedded_dll.inc"
#endif
#ifdef DOS_FILE_SYSTEM
static int load_delayed_done;
void load_delayed()
{
if (load_delayed_done)
return;
load_delayed_done = 1;
(void)SetErrorMode(SEM_FAILCRITICALERRORS);
parse_embedded_dlls();
# ifndef MZ_NO_LIBRACKET_DLL
/* Order matters: load dependencies first */
# ifndef MZ_PRECISE_GC
@ -327,6 +336,8 @@ void load_delayed()
# endif
record_dll_path();
register_embedded_dll_hooks();
register_win_tls();
}
#endif

33
racket/src/racket/src/file.c
View File

@ -5098,6 +5098,9 @@ void scheme_set_addon_dir(Scheme_Object *p)
#ifdef DOS_FILE_SYSTEM
static scheme_dll_open_proc alt_dll_open;
static scheme_dll_find_object_proc alt_find_obj;
void scheme_set_dll_path(wchar_t *p)
{
rktio_set_dll_path(p);
@ -5117,4 +5120,34 @@ wchar_t *scheme_get_dll_path(wchar_t *p)
return r2;
}
void scheme_set_dll_procs(scheme_dll_open_proc dll_open, scheme_dll_find_object_proc find_obj)
{
rktio_set_dll_procs(dll_open, find_obj);
alt_dll_open = dll_open;
alt_find_obj = find_obj;
}
HANDLE scheme_dll_load_library(const char *s, const wchar_t *ws, int *_mode)
{
if (alt_dll_open) {
void *h;
h = alt_dll_open(s, 0);
if (h) {
*_mode = 1;
return (HANDLE)h;
}
}
*_mode = 0;
return LoadLibraryW(ws);
}
void *scheme_dll_get_proc_address(HANDLE m, const char *name, int dll_mode)
{
if (dll_mode)
return alt_find_obj((void *)m, name);
else
return GetProcAddress(m, name);
}
#endif

6
racket/src/racket/src/longdouble/longdouble.c
View File

@ -737,12 +737,14 @@ static void fail_sprint(char* buffer, int digits, long_double ld)
void scheme_load_long_double_dll()
{
HANDLE m;
m = LoadLibraryW(scheme_get_dll_path(L"longdouble.dll"));
int dll_mode;
m = scheme_dll_load_library("longdouble.dll", L"longdouble.dll", &dll_mode);
if (m) long_double_dll_available = 1;
# define EXTRACT_LDBL(name, fail) \
_imp_ ## name = (name ##_t)(m ? GetProcAddress(m, # name) : NULL); \
_imp_ ## name = (name ##_t)(m ? scheme_dll_get_proc_address(m, # name, dll_mode) : NULL); \
if (!(_imp_ ## name)) _imp_ ## name = (name ##_t)fail;
EXTRACT_LDBL(get_long_double_infinity_val, fail_long_double_infinity);

17
racket/src/racket/src/salloc.c
View File

@ -74,6 +74,8 @@ uintptr_t scheme_tls_delta;
int scheme_tls_index;
# elif defined(IMPLEMENT_THREAD_LOCAL_VIA_WIN_TLS_FUNC)
DWORD scheme_thread_local_key;
# elif defined(IMPLEMENT_THREAD_LOCAL_VIA_OFFSET)
SHARED_OK THREAD_LOCAL Thread_Local_Variables scheme_thread_locals_space;
# else
SHARED_OK THREAD_LOCAL Thread_Local_Variables scheme_thread_locals;
# endif
@ -193,6 +195,8 @@ int scheme_main_setup(int no_auto_statics, Scheme_Env_Main _main, int argc, char
return scheme_main_stack_setup(no_auto_statics, call_with_basic, &d);
}
extern int _tls_index;
static int do_main_stack_setup(int no_auto_statics, Scheme_Nested_Main _main, void *data)
{
void *stack_start;
@ -232,6 +236,19 @@ Thread_Local_Variables *scheme_external_get_thread_local_variables() XFORM_SKIP_
{
return scheme_get_thread_local_variables();
}
#elif defined(IMPLEMENT_THREAD_LOCAL_VIA_OFFSET)
int scheme_tls_delta;
extern int _tls_index;
void scheme_register_tls_space(void *tls_space, int tls_index) XFORM_SKIP_PROC
{
if (_tls_index == 0) {
/* The Racket DLL didn't get its own index, which means that it's
being instantiated in-memory instead of loaded from a ".dll" file.
Use space reserved by the application for thread-local variables. */
scheme_tls_delta = ((char *)tls_space - (char *)&scheme_thread_locals_space);
} else
scheme_tls_delta = 0;
}
#else
void scheme_register_tls_space(void *tls_space, int tls_index) XFORM_SKIP_PROC
{

5
racket/src/racket/src/schpriv.h
View File

@ -3987,4 +3987,9 @@ void scheme_process_global_unlock(void);
Scheme_Object *scheme_expander_syntax_to_datum(Scheme_Object *v);
int scheme_is_syntax(Scheme_Object *v);
#ifdef DOS_FILE_SYSTEM
HANDLE scheme_dll_load_library(const char *s, const wchar_t *ws, int *_mode);
void *scheme_dll_get_proc_address(HANDLE m, const char *name, int dll_mode);
#endif
#endif /* __mzscheme_private__ */

15
racket/src/racket/win_tls.inc
View File

@ -35,5 +35,18 @@ static void register_win_tls()
}
#else
static void register_win_tls() {}
/* For emebdded-DLL mode, make sure there's a thread-local space to
be taken ovver by the Racket DLL */
# ifdef USE_THREAD_LOCAL
static __declspec(thread) Thread_Local_Variables tls_space;
static void register_win_tls() {
scheme_register_tls_space(&tls_space, 0);
}
# else
static void register_win_tls() { }
# endif
#endif

6
racket/src/rktio/rktio.h
View File

@ -1167,6 +1167,12 @@ RKTIO_EXTERN char *rktio_dll_get_error(rktio_t *rktio);
if no error string is available or has already been returned.
See `rktio_dll_open` for more information. */
typedef void *(*dll_open_proc)(rktio_const_string_t name, rktio_bool_t as_global);
typedef void *(*dll_find_object_proc)(void *h, rktio_const_string_t name);
RKTIO_EXTERN void rktio_set_dll_procs(dll_open_proc dll_open, dll_find_object_proc dll_find_object);
/* Installs procedures that are tried before native mechanisms,
currently only supported for Windows. */
/*************************************************/
/* Errors */

48
racket/src/rktio/rktio_convert.c
View File

@ -70,16 +70,24 @@ static int iconv_ready = 0;
static void init_iconv()
{
HMODULE m;
HMODULE m = NULL;
wchar_t *p;
p = rktio_get_dll_path(L"iconv.dll");
if (p) {
m = LoadLibraryW(p);
free(p);
} else
m = NULL;
int hook_handle = 0;
/* Try embedded "libiconv-2.dll", first: */
m = rktio_load_library("libiconv-2.dll");
if (m)
hook_handle = 1;
if (!m) {
p = rktio_get_dll_path(L"iconv.dll");
if (p) {
m = LoadLibraryW(p);
free(p);
} else
m = NULL;
}
if (!m) {
p = rktio_get_dll_path(L"libiconv.dll");
if (p) {
@ -106,10 +114,17 @@ static void init_iconv()
m = LoadLibraryW(L"libiconv-2.dll");
if (m) {
iconv = (iconv_proc_t)GetProcAddress(m, "libiconv");
iconv_open = (iconv_open_proc_t)GetProcAddress(m, "libiconv_open");
iconv_close = (iconv_close_proc_t)GetProcAddress(m, "libiconv_close");
locale_charset = (locale_charset_proc_t)GetProcAddress(m, "locale_charset");
if (hook_handle) {
iconv = (iconv_proc_t)rktio_get_proc_address(m, "libiconv");
iconv_open = (iconv_open_proc_t)rktio_get_proc_address(m, "libiconv_open");
iconv_close = (iconv_close_proc_t)rktio_get_proc_address(m, "libiconv_close");
locale_charset = (locale_charset_proc_t)rktio_get_proc_address(m, "locale_charset");
} else {
iconv = (iconv_proc_t)GetProcAddress(m, "libiconv");
iconv_open = (iconv_open_proc_t)GetProcAddress(m, "libiconv_open");
iconv_close = (iconv_close_proc_t)GetProcAddress(m, "libiconv_close");
locale_charset = (locale_charset_proc_t)GetProcAddress(m, "locale_charset");
}
/* Make sure we have all of them or none: */
if (!iconv || !iconv_open || !iconv_close) {
iconv = NULL;
@ -119,7 +134,10 @@ static void init_iconv()
}
if (iconv) {
iconv_errno = (errno_proc_t)GetProcAddress(m, "_errno");
if (hook_handle)
iconv_errno = (errno_proc_t)rktio_get_proc_address(m, "_errno");
else
iconv_errno = (errno_proc_t)GetProcAddress(m, "_errno");
if (!iconv_errno) {
/* The iconv.dll distributed with Racket links to msvcrt.dll.
It's a slighly dangerous assumption that whatever iconv we
@ -349,7 +367,7 @@ char *rktio_system_language_country(rktio_t *rktio)
llen = GetLocaleInfoW(l, LOCALE_SENGLANGUAGE, NULL, 0);
lang = malloc(llen * sizeof(wchar_t));
GetLocaleInfo(l, LOCALE_SENGLANGUAGE, lang, llen);
GetLocaleInfoW(l, LOCALE_SENGLANGUAGE, lang, llen);
if (llen)
llen -= 1; /* drop nul terminator */

68
racket/src/rktio/rktio_dll.c
View File

@ -20,10 +20,15 @@ typedef void *dll_handle_t;
#ifdef RKTIO_SYSTEM_WINDOWS
typedef HANDLE dll_handle_t;
static dll_open_proc LoadLibraryHook;
static dll_find_object_proc GetProcAddressHook;
#endif
struct rktio_dll_t {
void *handle;
#ifdef RKTIO_SYSTEM_WINDOWS
int hook_handle;
#endif
char *name;
rktio_hash_t *objects_by_name;
rktio_dll_object_t *all_objects;
@ -38,7 +43,10 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo
intptr_t key;
dll_handle_t handle;
int null_ok = 0;
#ifdef RKTIO_SYSTEM_WINDOWS
int hook_handle = 0;
#endif
if (!rktio->dlls_by_name)
rktio->dlls_by_name = rktio_hash_new();
@ -76,13 +84,21 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo
#ifdef RKTIO_SYSTEM_WINDOWS
if (!name) {
/* openning the executable is marked by a NULL handle */
/* opening the executable is marked by a NULL handle */
handle = NULL;
null_ok = 1;
} else {
handle = LoadLibraryW(WIDE_PATH_temp(name));
if (!handle)
get_windows_error();
if (LoadLibraryHook)
handle = LoadLibraryHook(name, as_global);
else
handle = NULL;
if (handle) {
hook_handle = 1;
} else {
handle = LoadLibraryW(WIDE_PATH_temp(name));
if (!handle)
get_windows_error();
}
}
#endif
@ -91,6 +107,9 @@ rktio_dll_t *rktio_dll_open(rktio_t *rktio, rktio_const_string_t name, rktio_boo
dll = malloc(sizeof(rktio_dll_t));
dll->handle = handle;
#ifdef RKTIO_SYSTEM_WINDOWS
dll->hook_handle = hook_handle;
#endif
dll->name = (name ? MSC_IZE(strdup)(name) : NULL);
dll->objects_by_name = rktio_hash_new();
dll->all_objects = NULL;
@ -236,9 +255,12 @@ void *rktio_dll_find_object(rktio_t *rktio, rktio_dll_t *dll, rktio_const_string
#endif
#ifdef RKTIO_SYSTEM_WINDOWS
if (dll->handle)
address = GetProcAddress(dll->handle, name);
else {
if (dll->handle) {
if (dll->hook_handle)
address = GetProcAddressHook(dll->handle, name);
else
address = GetProcAddress(dll->handle, name);
} else {
/* this is for the executable-open case, which was marked by a NULL
* handle; deal with it by searching all current modules */
# define NUM_QUICK_MODS 16
@ -266,6 +288,8 @@ void *rktio_dll_find_object(rktio_t *rktio, rktio_dll_t *dll, rktio_const_string
address = NULL;
if (mods != quick_mods)
free(mods);
if (!address && GetProcAddressHook)
address = GetProcAddressHook(NULL, name);
}
if (!address) {
@ -319,6 +343,34 @@ RKTIO_EXTERN char *rktio_dll_get_error(rktio_t *rktio)
#endif
}
/*========================================================================*/
/* Windows hooks */
/*========================================================================*/
/* Support in-memory DLLs and similar by allowing the application to
install replacements for LoadLibrary and GetProcAddress. */
void rktio_set_dll_procs(dll_open_proc dll_open, dll_find_object_proc dll_find_object)
{
#ifdef RKTIO_SYSTEM_WINDOWS
LoadLibraryHook = dll_open;
GetProcAddressHook = dll_find_object;
#endif
}
#ifdef RKTIO_SYSTEM_WINDOWS
HANDLE rktio_load_library(rktio_const_string_t name)
{
if (!LoadLibraryHook) return NULL;
return (HANDLE)LoadLibraryHook(name, 1);
}
void *rktio_get_proc_address(HANDLE m, rktio_const_string_t name)
{
return GetProcAddressHook((void *)m, name);
}
#endif
/*========================================================================*/
/* Clean up */
/*========================================================================*/

4
racket/src/rktio/rktio_private.h
View File

@ -298,6 +298,10 @@ void rktio_set_windows_error(rktio_t *rktio, int errid);
void rktio_error_clean(rktio_t *rktio);
void rktio_dll_clean(rktio_t *rktio);
#ifdef RKTIO_SYSTEM_WINDOWS
HANDLE rktio_load_library(rktio_const_string_t name);
void *rktio_get_proc_address(HANDLE m, rktio_const_string_t name);
#endif
#if defined(USE_FNDELAY_O_NONBLOCK)
# define RKTIO_NONBLOCKING FNDELAY

9
racket/src/rktio/rktio_process.c
View File

@ -820,7 +820,8 @@ rktio_status_t *rktio_process_status(rktio_t *rktio, rktio_process_t *sp)
get_windows_error();
return NULL;
}
}
} else
status = -1;
# endif
#endif
@ -986,7 +987,7 @@ void rktio_process_deinit(rktio_t *rktio)
/*========================================================================*/
#ifdef RKTIO_SYSTEM_WINDOWS
static char *cmdline_protect(char *s)
static char *cmdline_protect(const char *s)
{
char *naya;
int ds;
@ -1292,7 +1293,7 @@ rktio_process_result_t *rktio_process(rktio_t *rktio,
for (i = 0; i < argc; i++) {
new_argv[i] = cmdline_protect(argv[i]);
}
argv = new_argv;
argv = (rktio_const_string_t *)new_argv;
}
pid = 0;
@ -1310,7 +1311,7 @@ rktio_process_result_t *rktio_process(rktio_t *rktio,
if (!windows_exact_cmdline) {
for (i = 0; i < argc; i++) {
free(argv[i]);
free((char *)argv[i]);
}
free(argv);
}

1207
racket/src/start/MemoryModule.c Normal file
View File

File diff suppressed because it is too large Load Diff

168
racket/src/start/MemoryModule.h Normal file
View File

@ -0,0 +1,168 @@
/*
* Memory DLL loading code
* Version 0.0.4
*
* Copyright (c) 2004-2015 by Joachim Bauch / mail@joachim-bauch.de
* http://www.joachim-bauch.de
*
* The contents of this file are subject to the Mozilla Public License Version
* 2.0 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is MemoryModule.h
*
* The Initial Developer of the Original Code is Joachim Bauch.
*
* Portions created by Joachim Bauch are Copyright (C) 2004-2015
* Joachim Bauch. All Rights Reserved.
*
*/
#ifndef __MEMORY_MODULE_HEADER
#define __MEMORY_MODULE_HEADER
#include <windows.h>
typedef void *HMEMORYMODULE;
typedef void *HMEMORYRSRC;
typedef void *HCUSTOMMODULE;
#ifdef __cplusplus
extern "C" {
#endif
typedef LPVOID (*CustomAllocFunc)(LPVOID, SIZE_T, DWORD, DWORD, void*);
typedef BOOL (*CustomFreeFunc)(LPVOID, SIZE_T, DWORD, void*);
typedef HCUSTOMMODULE (*CustomLoadLibraryFunc)(LPCSTR, void *);
typedef FARPROC (*CustomGetProcAddressFunc)(HCUSTOMMODULE, LPCSTR, void *);
typedef void (*CustomFreeLibraryFunc)(HCUSTOMMODULE, void *);
/**
* Load EXE/DLL from memory location with the given size.
*
* All dependencies are resolved using default LoadLibrary/GetProcAddress
* calls through the Windows API.
*/
HMEMORYMODULE MemoryLoadLibrary(const void *, size_t);
/**
* Load EXE/DLL from memory location with the given size using custom dependency
* resolvers.
*
* Dependencies will be resolved using passed callback methods.
*/
HMEMORYMODULE MemoryLoadLibraryEx(const void *, size_t,
CustomAllocFunc,
CustomFreeFunc,
CustomLoadLibraryFunc,
CustomGetProcAddressFunc,
CustomFreeLibraryFunc,
void *);
/**
* Get address of exported method. Supports loading both by name and by
* ordinal value.
*/
FARPROC MemoryGetProcAddress(HMEMORYMODULE, LPCSTR);
/**
* Free previously loaded EXE/DLL.
*/
void MemoryFreeLibrary(HMEMORYMODULE);
/**
* Execute entry point (EXE only). The entry point can only be executed
* if the EXE has been loaded to the correct base address or it could
* be relocated (i.e. relocation information have not been stripped by
* the linker).
*
* Important: calling this function will not return, i.e. once the loaded
* EXE finished running, the process will terminate.
*
* Returns a negative value if the entry point could not be executed.
*/
int MemoryCallEntryPoint(HMEMORYMODULE);
/**
* Find the location of a resource with the specified type and name.
*/
HMEMORYRSRC MemoryFindResource(HMEMORYMODULE, LPCTSTR, LPCTSTR);
/**
* Find the location of a resource with the specified type, name and language.
*/
HMEMORYRSRC MemoryFindResourceEx(HMEMORYMODULE, LPCTSTR, LPCTSTR, WORD);
/**
* Get the size of the resource in bytes.
*/
DWORD MemorySizeofResource(HMEMORYMODULE, HMEMORYRSRC);
/**
* Get a pointer to the contents of the resource.
*/
LPVOID MemoryLoadResource(HMEMORYMODULE, HMEMORYRSRC);
/**
* Load a string resource.
*/
int MemoryLoadString(HMEMORYMODULE, UINT, LPTSTR, int);
/**
* Load a string resource with a given language.
*/
int MemoryLoadStringEx(HMEMORYMODULE, UINT, LPTSTR, int, WORD);
/**
* Default implementation of CustomAllocFunc that calls VirtualAlloc
* internally to allocate memory for a library
*
* This is the default as used by MemoryLoadLibrary.
*/
LPVOID MemoryDefaultAlloc(LPVOID, SIZE_T, DWORD, DWORD, void *);
/**
* Default implementation of CustomFreeFunc that calls VirtualFree
* internally to free the memory used by a library
*
* This is the default as used by MemoryLoadLibrary.
*/
BOOL MemoryDefaultFree(LPVOID, SIZE_T, DWORD, void *);
/**
* Default implementation of CustomLoadLibraryFunc that calls LoadLibraryA
* internally to load an additional libary.
*
* This is the default as used by MemoryLoadLibrary.
*/
HCUSTOMMODULE MemoryDefaultLoadLibrary(LPCSTR, void *);
/**
* Default implementation of CustomGetProcAddressFunc that calls GetProcAddress
* internally to get the address of an exported function.
*
* This is the default as used by MemoryLoadLibrary.
*/
FARPROC MemoryDefaultGetProcAddress(HCUSTOMMODULE, LPCSTR, void *);
/**
* Default implementation of CustomFreeLibraryFunc that calls FreeLibrary
* internally to release an additional libary.
*
* This is the default as used by MemoryLoadLibrary.
*/
void MemoryDefaultFreeLibrary(HCUSTOMMODULE, void *);
#ifdef __cplusplus
}
#endif
#endif // __MEMORY_MODULE_HEADER

16
racket/src/start/config.inc
View File

@ -133,7 +133,7 @@ static long get_segment_offset()
#endif
#ifdef DOS_FILE_SYSTEM
wchar_t *get_self_executable_path()
wchar_t *get_self_executable_path() XFORM_SKIP_PROC
{
wchar_t *path;
DWORD r, sz = 1024;
@ -152,7 +152,7 @@ wchar_t *get_self_executable_path()
return path;
}
static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id)
static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id) XFORM_SKIP_PROC
{
DWORD got, val;
WORD name_count, id_count;
@ -175,9 +175,9 @@ static DWORD find_by_id(HANDLE fd, DWORD rsrcs, DWORD pos, int id)
return 0;
}
static long get_segment_offset()
static long find_resource_offset(int id) XFORM_SKIP_PROC
{
/* Find the resource of type 257 */
/* Find the resource of type `id` */
wchar_t *path;
HANDLE fd;
@ -221,7 +221,7 @@ static long get_segment_offset()
SetFilePointer(fd, rsrcs, 0, FILE_BEGIN);
/* We're at the resource table; step through 3 layers */
pos = find_by_id(fd, rsrcs, rsrcs, 257);
pos = find_by_id(fd, rsrcs, rsrcs, id);
if (pos) {
pos = find_by_id(fd, rsrcs, pos, 1);
if (pos) {
@ -250,6 +250,12 @@ static long get_segment_offset()
return 0;
}
}
static long get_segment_offset() XFORM_SKIP_PROC
{
return find_resource_offset(257);
}
#endif
static void extract_built_in_arguments(char **_prog, char **_sprog, int *_argc, char ***_argv)

243
racket/src/start/embedded_dll.inc Normal file
View File

@ -0,0 +1,243 @@
#include "MemoryModule.h"
#define noisy_embedded 0
typedef struct embedded_dll_entry_t {
char *name;
long pos;
HMEMORYMODULE loaded_h;
} embedded_dll_entry_t;
static embedded_dll_entry_t *embedded_dlls;
extern void *__pfnDliNotifyHook2;
static FARPROC WINAPI delayHook(unsigned dliNotify, void *pdli);
static HCUSTOMMODULE LoadLibraryHook(LPCSTR, void *);
static FARPROC GetProcAddressHook(HCUSTOMMODULE, LPCSTR, void *);
static HANDLE open_self()
{
wchar_t *path;
HANDLE fd;
path = get_self_executable_path();
fd = CreateFileW(path, GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE,
NULL,
OPEN_EXISTING,
0,
NULL);
free(path);
return fd;
}
static void parse_embedded_dlls()
{
long rsrc_pos;
rsrc_pos = find_resource_offset(258);
if (rsrc_pos) {
HANDLE fd = open_self();
if (fd != INVALID_HANDLE_VALUE) {
long pos;
DWORD count, got, i;
short name_len;
char *name;
SetFilePointer(fd, rsrc_pos, 0, FILE_BEGIN);
ReadFile(fd, &count, sizeof(DWORD), &got, NULL);
embedded_dlls = malloc(sizeof(embedded_dll_entry_t) * (count + 1));
for (i = 0; i < count; i++) {
ReadFile(fd, &name_len, sizeof(short), &got, NULL);
name = malloc(name_len + 1);
ReadFile(fd, name, name_len, &got, NULL);
name[name_len] = 0;
embedded_dlls[i].name = name;
if (noisy_embedded)
fprintf(stderr, "embedded %s\n", name);
}
embedded_dlls[count].name = NULL;
for (i = 0; i < count+1; i++) {
ReadFile(fd, &pos, sizeof(pos), &got, NULL);
embedded_dlls[i].pos = pos + rsrc_pos;
embedded_dlls[i].loaded_h = NULL;
}
CloseHandle(fd);
__pfnDliNotifyHook2 = delayHook;
}
}
}
static void *in_memory_open(const char *name, int as_global)
{
int i;
for (i = 0; embedded_dlls[i].name; i++) {
if (!_stricmp(embedded_dlls[i].name, name)) {
HMEMORYMODULE loaded_h = (void *)embedded_dlls[i].loaded_h;
if (!loaded_h) {
HANDLE fd = open_self();
if (fd != INVALID_HANDLE_VALUE) {
void *p;
DWORD got;
long len = embedded_dlls[i+1].pos - embedded_dlls[i].pos;
SetFilePointer(fd, embedded_dlls[i].pos, 0, FILE_BEGIN);
p = malloc(len);
ReadFile(fd, p, len, &got, NULL);
CloseHandle(fd);
if (got != len)
fprintf(stderr, "partial load %d vs %ld\n", got, len);
loaded_h = MemoryLoadLibraryEx(p, len,
MemoryDefaultAlloc, MemoryDefaultFree,
LoadLibraryHook, GetProcAddressHook,
MemoryDefaultFreeLibrary, NULL);
if (noisy_embedded) {
if (!loaded_h) {
fprintf(stderr, "failed %s %d\n", name, GetLastError());
} else
fprintf(stderr, "ok %s\n", name);
}
free(p);
embedded_dlls[i].loaded_h = loaded_h;
}
}
return (void *)loaded_h;
}
}
return NULL;
}
static void *in_memory_find_object(void *h, const char *name)
{
if (h)
return MemoryGetProcAddress((HMEMORYMODULE)h, name);
else {
/* Search all loaded DLLs */
int i;
for (i = 0; embedded_dlls[i].name; i++) {
if (embedded_dlls[i].loaded_h) {
void *v = MemoryGetProcAddress((HMEMORYMODULE)embedded_dlls[i].loaded_h, name);
if (v)
return v;
}
}
return NULL;
}
}
static void register_embedded_dll_hooks()
{
if (embedded_dlls) {
scheme_set_dll_procs(in_memory_open, in_memory_find_object);
}
}
/**************************************************************/
typedef struct custom_module_t {
int hooked;
void *h;
} custom_module_t;
static HCUSTOMMODULE LoadLibraryHook(LPCSTR name, void *data)
{
void *h;
int hooked = 1;
custom_module_t *m;
h = (HANDLE)in_memory_open(name, 0);
if (h)
hooked = 1;
else {
h = MemoryDefaultLoadLibrary(name, data);
hooked = 0;
}
if (!h)
return NULL;
m = malloc(sizeof(custom_module_t));
m->hooked = hooked;
m->h = h;
return (HCUSTOMMODULE)m;
}
static FARPROC GetProcAddressHook(HCUSTOMMODULE _m, LPCSTR name, void *data)
{
custom_module_t *m = (custom_module_t *)_m;
if (m->hooked)
return in_memory_find_object(m->h, name);
else
return MemoryDefaultGetProcAddress(m->h, name, data);
}
/*************************************************************/
/* Set a delay-load hook to potentially redirect to an embedded DLL */
/* From Microsoft docs: */
typedef struct mz_DelayLoadProc {
BOOL fImportByName;
union {
LPCSTR szProcName;
DWORD dwOrdinal;
};
} mz_DelayLoadProc;
typedef struct Mz_DelayLoadInfo {
DWORD cb; // size of structure
void *pidd; // raw form of data (everything is there)
FARPROC * ppfn; // points to address of function to load
LPCSTR szDll; // name of dll
mz_DelayLoadProc dlp; // name or ordinal of procedure
HMODULE hmodCur; // the hInstance of the library we have loaded
FARPROC pfnCur; // the actual function that will be called
DWORD dwLastError;// error received (if an error notification)
} mz_DelayLoadInfo;
# define mz_dliNotePreLoadLibrary 1
# define mz_dliNotePreGetProcAddress 2
FARPROC WINAPI delayHook(unsigned dliNotify, void *_dli)
{
mz_DelayLoadInfo *dli = (mz_DelayLoadInfo *)_dli;
switch (dliNotify) {
case mz_dliNotePreLoadLibrary:
return in_memory_open(dli->szDll, 0);
break;
case mz_dliNotePreGetProcAddress:
{
void *h;
h = in_memory_open(dli->szDll, 0);
if (h) {
if (dli->dlp.fImportByName)
return in_memory_find_object(h, dli->dlp.szProcName);
else
return in_memory_find_object(h, (char *)(intptr_t)dli->dlp.dwOrdinal);
}
}
default:
break;
}
return NULL;
}

6
racket/src/worksp/gc2/make.rkt
View File

@ -363,7 +363,8 @@
(link-exe (list
"racket.res"
"xsrc/main.obj")
"xsrc/main.obj"
(find-build-file "racket" "MemoryModule.obj"))
null
exe
"")
@ -394,7 +395,8 @@
(link-exe (list
"gracket.res"
"xsrc/grmain.obj")
"xsrc/grmain.obj"
(find-build-file "racket" "MemoryModule.obj"))
'("advapi32.lib")
"../../../lib/GRacket.exe"
" /subsystem:windows")

4
racket/src/worksp/gracket/gracket.vcproj
View File

@ -473,6 +473,10 @@
RelativePath="..\..\gracket\grmain.c"
>
</File>
<File
RelativePath="..\..\start\MemoryModule.c"
>
</File>
</Filter>
<Filter
Name="Header Files"

1
racket/src/worksp/gracket/gracket.vcxproj
View File

@ -186,6 +186,7 @@ addman.bat
</ItemGroup>
<ItemGroup>
<ClCompile Include="..\..\gracket\grmain.c" />
<ClCompile Include="..\..\start\MemoryModule.c" />
</ItemGroup>
<ItemGroup>
<None Include="BULLSEYE.CUR" />

4
racket/src/worksp/racket/racket.vcproj
View File

@ -466,6 +466,10 @@
RelativePath="..\..\racket\main.c"
>
</File>
<File
RelativePath="..\..\start\MemoryModule.c"
>
</File>
<File
RelativePath=".\racket.rc"
>

1
racket/src/worksp/racket/racket.vcxproj
View File

@ -191,6 +191,7 @@ addman.bat
</ItemDefinitionGroup>
<ItemGroup>
<ClCompile Include="..\..\racket\main.c" />
<ClCompile Include="..\..\start\MemoryModule.c" />
</ItemGroup>
<ItemGroup>
<ResourceCompile Include="racket.rc" />