make path to original exe relative in Windows launchers

svn: r2800

collects/compiler/embed-unit.ss

@@ -118,6 +118,16 @@
 		"can't find ~a position in executable"
 		what)))))
 
+
+      (define (relativize exec-name dest adjust)
+	(let ([p (find-relative-path
+		  (let-values ([(dir name dir?) (split-path (normalize-path dest))])
+			      dir)
+		  (normalize-path exec-name))])
+	  (if (relative-path? p)
+	      (adjust p)
+	      p)))
+
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
       (define (prepare-macosx-mred exec-name dest aux variant)
@@ -259,13 +269,9 @@
 			  `((assoc-pair "executable name"
 					,(path->string 
 					  (if relative?
-					      (let ([p (find-relative-path
+					      (relativize exec-name dest
-							(let-values ([(dir name dir?) (split-path (normalize-path dest))])
+							  (lambda (p)
-							  dir)
+							    (build-path 'up 'up 'up p)))
-							(normalize-path exec-name))])
-						(if (relative-path? p)
-						    (build-path 'up 'up 'up p)
-						    p))
 					      exec-name))))
 			  null)
 		    (assoc-pair "stored arguments"
@@ -527,6 +533,8 @@
 				       (not (cdr m))))))
 	  (define long-cmdline? (or (eq? (system-type) 'windows)
 				    (and mred? (eq? 'macosx (system-type)))))
+	  (define relative? (let ([m (assq 'relative? aux)])
+			      (and m (cdr m))))
 	  (define lib-path-bytes (and lib-path
 				      (if (path? lib-path)
 					  (path->bytes lib-path)
@@ -611,14 +619,17 @@
 					   (if launcher?
 					       (if (and (eq? 'windows (system-type))
 							keep-exe?)
-						   (list (path->string exe)) ; argv[0]
+						   ;; argv[0] replacement:
+						   (list (path->string 
+							  (if relative?
+							      (relativize exe dest-exe values)
+							      exe)))
+						   ;; No argv[0]:
 						   null)
 					       (list "-k" start-s end-s))
 					   cmdline)])
 			(if osx?
-			    (finish-osx-mred dest full-cmdline exe keep-exe?
+			    (finish-osx-mred dest full-cmdline exe keep-exe? relative?)
-					     (let ([m (assq 'relative? aux)])
-					       (and m (cdr m))))
 			    (let ([cmdpos (with-input-from-file dest-exe 
 					    (lambda () (find-cmdline 
 							"cmdline"

src/mzscheme/cmdline.inc

@@ -537,7 +537,8 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	 The cmdline is appended to the end of the binary.
 	 The long integer at cmdline_exe_hack[4] says
 	 where the old end was, and cmdline_exe_hack[8]
-	 says how long the cmdline string is. */
+	 says how long the cmdline string is. It might
+	 be relative to the executable. */
       char *path;
       HANDLE fd;
 
@@ -566,6 +567,26 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  /* "*" means that the first item is argv[0] replacement: */
 	  sprog = prog;
 	  prog = (char *)p + 4;
+
+	  if ((prog[0] == '\\')
+	      || ((((prog[0] >= 'a') && (prog[0] <= 'z'))
+		   || 	((prog[0] >= 'A') && (prog[0] <= 'Z')))
+		  && (prog[1] == ':'))) {
+	    /* Absolute path */
+	  } else {
+	    /* Make it absolute, relative to this executable */
+	    int plen = strlen(prog);
+	    int mlen = strlen(path);
+	    char *s2;
+	    while (mlen && (path[mlen - 1] != '\\')) {
+	      mlen--;
+	    }
+	    s2 = (char *)malloc(mlen + plen + 1);
+	    memcpy(s2, path, mlen);
+	    memcpy(s2 + mlen, prog, plen + 1);
+	    prog = s2;
+	  }
+
 	  p += (p[0]
 		+ (((long)p[1]) << 8)
 		+ (((long)p[2]) << 16)