add --launcher'/-l' flag to `raco exe' to create launchers
This addition triggered several other changes: * -k for a Mac OS X embedding is now relative to the __PLTSCHEME segment (which means that executables won't break if you strip them, for example) * the command-line no longer has a limited size for Mac OS X launchers and embedding executables * Mac OS X GUI and Windows launchers record the creation-time collection path, unless they are created as "relative" launchers
This commit is contained in:
Matthew Flatt
parent
573ce9492a
commit
2c479683d1
|
|
@ -10,6 +10,7 @@
|
|||
|
||||
(define gui (make-parameter #f))
|
||||
(define 3m (make-parameter #t))
|
||||
(define launcher (make-parameter #f))
|
||||
|
||||
(define exe-output (make-parameter #f))
|
||||
(define exe-embedded-flags (make-parameter '("-U" "--")))
|
||||
|
|
@ -26,6 +27,8 @@
|
|||
(exe-output file)]
|
||||
[("--gui") "Generate GUI executable"
|
||||
(gui #t)]
|
||||
[("-l" "--launcher") "Generate a launcher"
|
||||
(launcher #t)]
|
||||
[("--collects-path") path "Set <path> as main collects for executable"
|
||||
(exe-embedded-collects-path path)]
|
||||
[("--collects-dest") dir "Write collection code to <dir>"
|
||||
|
|
@ -70,6 +73,17 @@
|
|||
(extract-base-filename/ss source-file
|
||||
(string->symbol (short-program+command-name))))
|
||||
(gui))])
|
||||
(cond
|
||||
[(launcher)
|
||||
(parameterize ([current-launcher-variant (if (3m) '3m 'cgc)])
|
||||
((if (gui)
|
||||
make-gracket-launcher
|
||||
make-racket-launcher)
|
||||
(append (list "-t" (path->string (path->complete-path source-file)))
|
||||
(exe-embedded-flags))
|
||||
dest
|
||||
(exe-aux)))]
|
||||
[else
|
||||
(mzc:create-embedding-executable
|
||||
dest
|
||||
#:mred? (gui)
|
||||
|
|
@ -91,6 +105,6 @@
|
|||
#:cmdline (exe-embedded-flags)
|
||||
#:collects-path (exe-embedded-collects-path)
|
||||
#:collects-dest (exe-embedded-collects-dest)
|
||||
#:aux (exe-aux))
|
||||
#:aux (exe-aux))])
|
||||
(when (verbose)
|
||||
(printf " [output to \"~a\"]\n" dest)))
|
||||
|
|
|
|||
|
|
@ -1048,7 +1048,8 @@
|
|||
cmdline
|
||||
[aux null]
|
||||
[launcher? #f]
|
||||
[variant (system-type 'gc)])
|
||||
[variant (system-type 'gc)]
|
||||
[collects-path #f])
|
||||
(create-embedding-executable dest
|
||||
#:mred? mred?
|
||||
#:verbose? verbose?
|
||||
|
|
@ -1058,7 +1059,8 @@
|
|||
#:cmdline cmdline
|
||||
#:aux aux
|
||||
#:launcher? launcher?
|
||||
#:variant variant)))
|
||||
#:variant variant
|
||||
#:collects-path collects-path)))
|
||||
|
||||
;; Use `write-module-bundle', but figure out how to put it into an executable
|
||||
(define (create-embedding-executable dest
|
||||
|
|
@ -1096,7 +1098,7 @@
|
|||
(or (not m)
|
||||
(not (cdr m))))))
|
||||
(define long-cmdline? (or (eq? (system-type) 'windows)
|
||||
(and use-starter-info? mred? (eq? 'macosx (system-type)))
|
||||
(eq? (system-type) 'macosx)
|
||||
unix-starter?))
|
||||
(define relative? (let ([m (assq 'relative? aux)])
|
||||
(and m (cdr m))))
|
||||
|
|
@ -1227,19 +1229,40 @@
|
|||
(relativize dir dest-exe values)
|
||||
dir)
|
||||
"")))
|
||||
full-cmdline))))])
|
||||
full-cmdline))))]
|
||||
[write-cmdline
|
||||
(lambda (full-cmdline out)
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(fprintf out "~a~a~c"
|
||||
(integer->integer-bytes
|
||||
(add1 (bytes-length (string->bytes/utf-8 s)) )
|
||||
4 #t #f)
|
||||
s
|
||||
#\000))
|
||||
full-cmdline)
|
||||
(display "\0\0\0\0" out))])
|
||||
(let-values ([(start decl-end end cmdline-end)
|
||||
(if (and (eq? (system-type) 'macosx)
|
||||
(not unix-starter?))
|
||||
;; For Mach-O, we know how to add a proper segment
|
||||
(let ([s (open-output-bytes)])
|
||||
(define decl-len (write-module s))
|
||||
(let ([s (get-output-bytes s)])
|
||||
(let ([start (add-plt-segment dest-exe s)])
|
||||
(let* ([s (get-output-bytes s)]
|
||||
[cl (let ([o (open-output-bytes)])
|
||||
;; position is relative to __PLTSCHEME:
|
||||
(write-cmdline (make-full-cmdline 0 decl-len (bytes-length s)) o)
|
||||
(get-output-bytes o))])
|
||||
(let ([start (add-plt-segment
|
||||
dest-exe
|
||||
(bytes-append
|
||||
s
|
||||
cl))])
|
||||
(let ([start 0]) ; i.e., relative to __PLTSCHEME
|
||||
(values start
|
||||
(+ start decl-len)
|
||||
(+ start (bytes-length s))
|
||||
#f))))
|
||||
(+ start (bytes-length s) (bytes-length cl)))))))
|
||||
;; Unix starter: Maybe ELF, in which case we
|
||||
;; can add a proper section
|
||||
(let-values ([(s e dl p)
|
||||
|
|
@ -1336,7 +1359,8 @@
|
|||
(lambda () (find-cmdline
|
||||
"instance-check"
|
||||
#"yes, please check for another"))))]
|
||||
[out (open-output-file dest-exe #:exists 'update)])
|
||||
[out (open-output-file dest-exe #:exists 'update)]
|
||||
[cmdline-done? cmdline-end])
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
|
|
@ -1345,28 +1369,22 @@
|
|||
(write-bytes #"no," out))
|
||||
(if long-cmdline?
|
||||
;; write cmdline at end:
|
||||
(file-position out end)
|
||||
(unless cmdline-done?
|
||||
(file-position out end))
|
||||
(begin
|
||||
;; write (short) cmdline in the normal position:
|
||||
(file-position out cmdpos)
|
||||
(display "!" out)))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(fprintf out "~a~a~c"
|
||||
(integer->integer-bytes
|
||||
(add1 (bytes-length (string->bytes/utf-8 s)) )
|
||||
4 #t #f)
|
||||
s
|
||||
#\000))
|
||||
full-cmdline)
|
||||
(display "\0\0\0\0" out)
|
||||
(unless cmdline-done?
|
||||
(write-cmdline full-cmdline out))
|
||||
(when long-cmdline?
|
||||
;; cmdline written at the end;
|
||||
;; now put forwarding information at the normal cmdline pos
|
||||
(let ([new-end (file-position out)])
|
||||
(let ([new-end (or cmdline-end
|
||||
(file-position out))])
|
||||
(file-position out cmdpos)
|
||||
(fprintf out "~a...~a~a"
|
||||
(if keep-exe? "*" "?")
|
||||
(if (and keep-exe? (eq? 'windows (system-type))) "*" "?")
|
||||
(integer->integer-bytes end 4 #t #f)
|
||||
(integer->integer-bytes (- new-end end) 4 #t #f)))))
|
||||
(lambda ()
|
||||
|
|
|
|||
|
|
@ -19,7 +19,10 @@
|
|||
(listof string?))
|
||||
((listof (cons/c symbol? any/c))
|
||||
any/c
|
||||
symbol?)
|
||||
symbol?
|
||||
(or/c #f
|
||||
path-string?
|
||||
(listof path-string?)))
|
||||
void?)]
|
||||
[create-embedding-executable
|
||||
(->* (path-string?)
|
||||
|
|
|
|||
|
|
@ -379,8 +379,12 @@
|
|||
(if (not (and (let ([m (assq 'independent? aux)])
|
||||
(and m (cdr m)))))
|
||||
;; Normal launcher:
|
||||
(make-embedding-executable
|
||||
dest (eq? kind 'mred) #f null null null flags aux #t variant)
|
||||
(make-embedding-executable dest (eq? kind 'mred)
|
||||
#f null null null flags aux #t variant
|
||||
(if (let ([a (assq 'relative? aux)])
|
||||
(and a (cdr a)))
|
||||
#f
|
||||
(find-collects-dir)))
|
||||
;; Independent launcher (needed for Setup PLT):
|
||||
(begin
|
||||
(install-template dest kind "mzstart.exe" "mrstart.exe")
|
||||
|
|
@ -465,7 +469,11 @@
|
|||
flags
|
||||
aux
|
||||
#t
|
||||
variant)))
|
||||
variant
|
||||
(if (let ([a (assq 'relative? aux)])
|
||||
(and a (cdr a)))
|
||||
#f
|
||||
(find-collects-dir)))))
|
||||
|
||||
(define (make-macos-launcher kind variant flags dest aux)
|
||||
(install-template dest kind "GoMr" "GoMr")
|
||||
|
|
|
|||
|
|
@ -286,8 +286,8 @@ is initialized to an empty list and
|
|||
@racket[use-collection-link-paths] is set to false to disable the
|
||||
use of @tech[#:doc reference-doc]{collection links files}.
|
||||
|
||||
If the @racket[#:launcher?] argument is @racket[#t], then no
|
||||
@racket[module]s should be null, @racket[literal-files] should be
|
||||
If the @racket[#:launcher?] argument is @racket[#t], then
|
||||
@racket[lid-list] should be null, @racket[literal-files] should be
|
||||
null, @racket[literal-sexp] should be @racket[#f], and the platform
|
||||
should be Windows or Mac OS X. The embedding executable is created in
|
||||
such a way that @racket[(find-system-path 'exec-file)] produces the
|
||||
|
|
@ -355,7 +355,11 @@ have been applied as needed to refer to the existing file).}
|
|||
[cmdline (listof string?)]
|
||||
[aux (listof (cons/c symbol? any/c)) null]
|
||||
[launcher? any/c #f]
|
||||
[variant (one-of/c 'cgc '3m) (system-type 'gc)])
|
||||
[variant (one-of/c 'cgc '3m) (system-type 'gc)]
|
||||
[collects-path (or/c #f
|
||||
path-string?
|
||||
(listof path-string?))
|
||||
#f])
|
||||
void?]{
|
||||
|
||||
Old (keywordless) interface to @racket[create-embedding-executable].}
|
||||
|
|
|
|||
|
|
@ -71,6 +71,10 @@ attaches information to the executable based on the auxilliary file's
|
|||
suffix; see @racket[extract-aux-from-path] for a list of recognized
|
||||
suffixes and meanings.
|
||||
|
||||
The @Flag{l} or @DFlag{launcher} flag creates a @tech{launcher}
|
||||
instead of a stand-alone executable. See @secref["launcher"] for more
|
||||
information on launchers. The @DFlag{lib} has no effect in that case.
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@include-section["exe-api.scrbl"]
|
||||
|
|
|
|||
|
|
@ -10,14 +10,19 @@
|
|||
|
||||
@title[#:tag "launcher"]{Installation-Specific Launchers}
|
||||
|
||||
A @deftech{launcher} is similar to a stand-alone executable, but a
|
||||
launcher is usually smaller and can be created more quickly, because
|
||||
it depends permanently on the local Racket installation and the
|
||||
program's sources. In the case of Unix, a launcher is simply a shell
|
||||
script that runs @exec{racket} or @exec{gracket}. Launchers
|
||||
@emph{cannot} be packaged into a distribution using @exec{raco
|
||||
distribute}. The @exec{raco exe} command creates a launcher when the
|
||||
@Flag{l} or @DFlag{launcher} flag is specified.
|
||||
|
||||
@defmodule[launcher/launcher]
|
||||
|
||||
The @racketmodname[launcher/launcher] library provides functions for
|
||||
creating @defterm{launchers}, which are similar to stand-alone
|
||||
executables, but sometimes smaller because they depend permanently on
|
||||
the local Racket installation. In the case of Unix, in particular,
|
||||
a launcher is simply a shell script. The @exec{raco exe} command provides no
|
||||
direct support for creating launchers.
|
||||
creating @tech{launchers}.
|
||||
|
||||
@section{Creating Launchers}
|
||||
|
||||
|
|
@ -44,8 +49,8 @@ the following additional associations apply to launchers:
|
|||
@itemize[
|
||||
|
||||
@item{@racket['independent?] (Windows) --- a boolean; @racket[#t]
|
||||
creates an old-style launcher that is independent of the
|
||||
MzRacket or GRacket binary, like @exec{setup-plt.exe}. No other
|
||||
creates an old-style launcher that work with any
|
||||
Racket or GRacket binary, like @exec{setup-plt.exe}. No other
|
||||
@racket[aux] associations are used for an old-style launcher.}
|
||||
|
||||
@item{@racket['exe-name] (Mac OS X, @racket['script-3m] or
|
||||
|
|
|
|||
|
|
@ -168,12 +168,13 @@ flags:
|
|||
|
||||
@item{@FlagFirst{k} @nonterm{n} @nonterm{m} @nonterm{p} : Loads code
|
||||
embedded in the executable from file position @nonterm{n} to
|
||||
@nonterm{m} and from @nonterm{m} to @nonterm{p}. The first
|
||||
range is loaded in every new @tech{place}, and any modules
|
||||
declared in that range are considered predefined in the sense
|
||||
of @racket[module-predefined?]. This option is normally
|
||||
embedded in a stand-alone binary that also embeds Racket
|
||||
code.}
|
||||
@nonterm{m} and from @nonterm{m} to @nonterm{p}. (On Mac OS X,
|
||||
@nonterm{n}, @nonterm{m}, and @nonterm{p} are relative to a
|
||||
@tt{__PLTSCHEME} segment in the executable.) The first range
|
||||
is loaded in every new @tech{place}, and any modules declared
|
||||
in that range are considered predefined in the sense of
|
||||
@racket[module-predefined?]. This option is normally embedded
|
||||
in a stand-alone binary that also embeds Racket code.}
|
||||
|
||||
@item{@FlagFirst{m} or @DFlagFirst{main} : Evaluates a call to
|
||||
@racketidfont{main} as bound in the top-level environment. All
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
(require compiler/embed
|
||||
mzlib/file
|
||||
mzlib/process
|
||||
launcher
|
||||
compiler/distribute)
|
||||
|
||||
(define (mk-dest-bin mred?)
|
||||
|
|
@ -67,12 +68,9 @@
|
|||
(test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout")
|
||||
(lambda () (read-string 5000)))))
|
||||
|
||||
(define try-exe
|
||||
(case-lambda
|
||||
[(exe expect mred?)
|
||||
(try-exe exe expect mred? void)]
|
||||
[(exe expect mred? dist-hook . collects)
|
||||
(define (try-exe exe expect mred? [dist-hook void] #:dist? [dist? #t] . collects)
|
||||
(try-one-exe exe expect mred?)
|
||||
(when dist?
|
||||
;; Build a distirbution directory, and try that, too:
|
||||
(printf " ... from distribution ...\n")
|
||||
(when (directory-exists? dist-dir)
|
||||
|
|
@ -84,7 +82,7 @@
|
|||
dist-mred-exe
|
||||
dist-mz-exe))
|
||||
expect mred?)
|
||||
(delete-directory/files dist-dir)]))
|
||||
(delete-directory/files dist-dir)))
|
||||
|
||||
(define (base-compile e)
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
|
|
@ -109,6 +107,13 @@
|
|||
`(,(flags "l") ,(string-append "tests/racket/" filename)))
|
||||
(try-exe dest expect mred?)
|
||||
|
||||
;; As a launcher:
|
||||
(prepare dest filename)
|
||||
((if mred? make-gracket-launcher make-racket-launcher)
|
||||
(list "-l" (string-append "tests/racket/" filename))
|
||||
dest)
|
||||
(try-exe dest expect mred? #:dist? #f)
|
||||
|
||||
;; Try explicit prefix:
|
||||
(printf ">>>explicit prefix\n")
|
||||
(let ([w/prefix
|
||||
|
|
@ -250,16 +255,38 @@
|
|||
`("-l" "tests/racket/embed-me5.rkt"))
|
||||
(try-exe mr-dest "This is 5: #<class:button%>\n" #t)))
|
||||
|
||||
;; Try the mzc interface:
|
||||
;; Try the raco interface:
|
||||
(require setup/dirs
|
||||
mzlib/file)
|
||||
(define mzc (build-path (find-console-bin-dir) (if (eq? 'windows (system-type))
|
||||
"mzc.exe"
|
||||
"mzc")))
|
||||
(define raco (build-path (find-console-bin-dir) (if (eq? 'windows (system-type))
|
||||
"raco.exe"
|
||||
"raco")))
|
||||
|
||||
(define (mzc-tests mred?)
|
||||
(parameterize ([current-directory (find-system-path 'temp-dir)])
|
||||
|
||||
;; raco exe
|
||||
(system* raco
|
||||
"exe"
|
||||
"-o" (path->string (mk-dest mred?))
|
||||
(if mred? "--gui" "--")
|
||||
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
|
||||
(try-exe (mk-dest mred?) "This is 1\n" mred?)
|
||||
|
||||
;;raco exe --launcher
|
||||
(system* raco
|
||||
"exe"
|
||||
"--launcher"
|
||||
"-o" (path->string (mk-dest mred?))
|
||||
(if mred? "--gui" "--")
|
||||
(path->string (build-path (collection-path "tests" "racket") "embed-me1.rkt")))
|
||||
(try-exe (mk-dest mred?) "This is 1\n" mred? #:dist? #f)
|
||||
|
||||
;; the rest use mzc...
|
||||
|
||||
(system* mzc
|
||||
(if mred? "--gui-exe" "--exe")
|
||||
(path->string (mk-dest mred?))
|
||||
|
|
|
|||
|
|
@ -56,6 +56,12 @@ static int _coldir_offset = 19; /* Skip permanent tag */
|
|||
# define XFORM_OK_PLUS +
|
||||
#endif
|
||||
|
||||
#ifdef OS_X
|
||||
# include <mach-o/getsect.h>
|
||||
# include <mach-o/dyld.h>
|
||||
# include <fcntl.h>
|
||||
#endif
|
||||
|
||||
#ifdef DOS_FILE_SYSTEM
|
||||
# include <Windows.h>
|
||||
|
||||
|
|
@ -85,6 +91,22 @@ END_XFORM_SKIP;
|
|||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef OS_X
|
||||
static long get_segment_offset()
|
||||
{
|
||||
# ifdef __x86_64__
|
||||
const struct segment_command_64 *seg;
|
||||
# else
|
||||
const struct segment_command *seg;
|
||||
#endif
|
||||
seg = getsegbyname("__PLTSCHEME");
|
||||
if (seg)
|
||||
return seg->fileoff;
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifndef DONT_PARSE_COMMAND_LINE
|
||||
static int is_number_arg(const char *s)
|
||||
{
|
||||
|
|
@ -108,11 +130,31 @@ static int is_number_arg(const char *s)
|
|||
return 1;
|
||||
}
|
||||
|
||||
#ifdef OS_X
|
||||
char *add_to_str(const char *addr, long amt)
|
||||
{
|
||||
long addr_v;
|
||||
char buf[32];
|
||||
addr_v = atoi(addr) + amt;
|
||||
sprintf(buf, "%ld", addr_v);
|
||||
return strdup(buf);
|
||||
}
|
||||
#endif
|
||||
|
||||
static char *make_embedded_load(const char *start, const char *end)
|
||||
{
|
||||
char *s;
|
||||
int slen, elen;
|
||||
|
||||
#ifdef OS_X
|
||||
{
|
||||
long fileoff;
|
||||
fileoff = get_segment_offset();
|
||||
start = add_to_str(start, fileoff);
|
||||
end = add_to_str(end, fileoff);
|
||||
}
|
||||
#endif
|
||||
|
||||
slen = strlen(start);
|
||||
elen = strlen(end);
|
||||
|
||||
|
|
@ -648,6 +690,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
|
|||
GC_CAN_IGNORE unsigned char *orig_p;
|
||||
char **argv2;
|
||||
|
||||
p = NULL;
|
||||
#ifdef DOS_FILE_SYSTEM
|
||||
if ((scheme_cmdline_exe_hack[0] == '?')
|
||||
|| (scheme_cmdline_exe_hack[0] == '*')) {
|
||||
|
|
@ -723,8 +766,33 @@ static int run_from_cmd_line(int argc, char *_argv[],
|
|||
+ 4);
|
||||
}
|
||||
}
|
||||
} else
|
||||
}
|
||||
#endif
|
||||
#ifdef OS_X
|
||||
if (scheme_cmdline_exe_hack[0] == '?') {
|
||||
long fileoff, cmdoff, cmdlen;
|
||||
int fd;
|
||||
fileoff = get_segment_offset();
|
||||
|
||||
p = (unsigned char *)scheme_cmdline_exe_hack + 4;
|
||||
cmdoff = (p[0]
|
||||
+ (((long)p[1]) << 8)
|
||||
+ (((long)p[2]) << 16)
|
||||
+ (((long)p[3]) << 24));
|
||||
cmdlen = (p[4]
|
||||
+ (((long)p[5]) << 8)
|
||||
+ (((long)p[6]) << 16)
|
||||
+ (((long)p[7]) << 24));
|
||||
p = malloc(cmdlen);
|
||||
|
||||
fd = open(_dyld_get_image_name(0), O_RDONLY);
|
||||
lseek(fd, fileoff + cmdoff, 0);
|
||||
read(fd, p, cmdlen);
|
||||
close(fd);
|
||||
}
|
||||
#endif
|
||||
|
||||
if (!p)
|
||||
p = (unsigned char *)scheme_cmdline_exe_hack + 1;
|
||||
|
||||
/* Command line is encoded as a sequence of pascal-style strings;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user