diff --git a/collects/compiler/commands/exe.rkt b/collects/compiler/commands/exe.rkt index 28d53e2ace..0ac336f9a5 100644 --- a/collects/compiler/commands/exe.rkt +++ b/collects/compiler/commands/exe.rkt @@ -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 as main collects for executable" (exe-embedded-collects-path path)] [("--collects-dest") dir "Write collection code to " @@ -70,27 +73,38 @@ (extract-base-filename/ss source-file (string->symbol (short-program+command-name)))) (gui))]) - (mzc:create-embedding-executable - dest - #:mred? (gui) - #:variant (if (3m) '3m 'cgc) - #:verbose? (very-verbose) - #:modules (cons `(#%mzc: (file ,source-file)) - (map (lambda (l) `(#t (lib ,l))) - (exe-embedded-libraries))) - #:configure-via-first-module? #t - #:literal-expression - (parameterize ([current-namespace (make-base-namespace)]) - (compile - `(namespace-require - '',(string->symbol - (format "#%mzc:~a" - (let-values ([(base name dir?) - (split-path source-file)]) - (path->bytes (path-replace-suffix name #"")))))))) - #:cmdline (exe-embedded-flags) - #:collects-path (exe-embedded-collects-path) - #:collects-dest (exe-embedded-collects-dest) - #:aux (exe-aux)) + (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) + #:variant (if (3m) '3m 'cgc) + #:verbose? (very-verbose) + #:modules (cons `(#%mzc: (file ,source-file)) + (map (lambda (l) `(#t (lib ,l))) + (exe-embedded-libraries))) + #:configure-via-first-module? #t + #:literal-expression + (parameterize ([current-namespace (make-base-namespace)]) + (compile + `(namespace-require + '',(string->symbol + (format "#%mzc:~a" + (let-values ([(base name dir?) + (split-path source-file)]) + (path->bytes (path-replace-suffix name #"")))))))) + #:cmdline (exe-embedded-flags) + #:collects-path (exe-embedded-collects-path) + #:collects-dest (exe-embedded-collects-dest) + #:aux (exe-aux))]) (when (verbose) (printf " [output to \"~a\"]\n" dest))) diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index 315ea20fd1..60b8fa2b7c 100644 --- a/collects/compiler/embed-unit.rkt +++ b/collects/compiler/embed-unit.rkt @@ -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)]) - (values start - (+ start decl-len) - (+ start (bytes-length s)) - #f)))) + (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)) + (+ 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 () diff --git a/collects/compiler/embed.rkt b/collects/compiler/embed.rkt index 066c2309ec..74c8cb3727 100644 --- a/collects/compiler/embed.rkt +++ b/collects/compiler/embed.rkt @@ -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?) diff --git a/collects/launcher/launcher-unit.rkt b/collects/launcher/launcher-unit.rkt index 57964541d7..a26bad8890 100644 --- a/collects/launcher/launcher-unit.rkt +++ b/collects/launcher/launcher-unit.rkt @@ -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") diff --git a/collects/scribblings/raco/exe-api.scrbl b/collects/scribblings/raco/exe-api.scrbl index 13184f47bf..7e35e91b71 100644 --- a/collects/scribblings/raco/exe-api.scrbl +++ b/collects/scribblings/raco/exe-api.scrbl @@ -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].} diff --git a/collects/scribblings/raco/exe.scrbl b/collects/scribblings/raco/exe.scrbl index 89d6136bbe..636398526f 100644 --- a/collects/scribblings/raco/exe.scrbl +++ b/collects/scribblings/raco/exe.scrbl @@ -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"] diff --git a/collects/scribblings/raco/launcher.scrbl b/collects/scribblings/raco/launcher.scrbl index 226679d767..f9cc66170c 100644 --- a/collects/scribblings/raco/launcher.scrbl +++ b/collects/scribblings/raco/launcher.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 diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index 290f04768d..c35cf88c4d 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -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 diff --git a/collects/tests/racket/embed.rktl b/collects/tests/racket/embed.rktl index be92fb8b7b..79e882b036 100644 --- a/collects/tests/racket/embed.rktl +++ b/collects/tests/racket/embed.rktl @@ -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) - (try-one-exe exe expect mred?) +(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: #\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?)) diff --git a/src/racket/cmdline.inc b/src/racket/cmdline.inc index 13284350ac..a79fa7bad7 100644 --- a/src/racket/cmdline.inc +++ b/src/racket/cmdline.inc @@ -56,6 +56,12 @@ static int _coldir_offset = 19; /* Skip permanent tag */ # define XFORM_OK_PLUS + #endif +#ifdef OS_X +# include +# include +# include +#endif + #ifdef DOS_FILE_SYSTEM # include @@ -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); @@ -638,7 +680,7 @@ static int run_from_cmd_line(int argc, char *_argv[], } } #endif - + /* If scheme_cmdline_exe_hack is changed, then we extract built-in arguments. */ if (scheme_cmdline_exe_hack[0] != '[') { @@ -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;