Add support for MacOSX application bundles.

diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac
index 2f97b7111b25384055d6841cba4fcdc38f8304e5..1747ef2fa4a0357606392a2594c41e9b0051a554 100644 (file)
--- a/src/microcode/configure.ac
+++ b/src/microcode/configure.ac
@@ -378,6 +378,7 @@ darwin*)
        AC_MSG_ERROR([No MacOSX SDK for version: ${MACOSX}])
     fi
     MACOSX_CFLAGS="${MACOSX_CFLAGS} -isysroot ${MACOSX_SYSROOT}"
+    MACOSX_CFLAGS="${MACOSX_CFLAGS} -fconstant-cfstrings"
     AC_MSG_NOTICE([Compiling for MacOSX version ${MACOSX}])
     if test "${SCM_ARCH}" = i386; then
        MACOSX_CFLAGS="-arch i386 ${MACOSX_CFLAGS}"
@@ -386,6 +387,7 @@ darwin*)
     fi
     CFLAGS="${CFLAGS} ${MACOSX_CFLAGS}"
     LDFLAGS="${LDFLAGS} ${MACOSX_CFLAGS} -Wl,-syslibroot,${MACOSX_SYSROOT}"
+    LDFLAGS="${LDFLAGS} -framework CoreFoundation"
     MODULE_LDFLAGS="${MODULE_LDFLAGS} -bundle -bundle_loader "'${SCHEME_EXE}'
     ;;
 netbsd*)

diff --git a/src/microcode/option.c b/src/microcode/option.c
index 4c71c0b1071e6d2e9a580a74d06565e43bfbbea1..ef0159d89384227afb9ad969ea8c7bd00633fcf7 100644 (file)
--- a/src/microcode/option.c
+++ b/src/microcode/option.c
@@ -73,6 +73,10 @@ USA.
 #endif
 
 #define FILE_READABLE(filename) (OS_file_access ((filename), 4))
+
+#ifdef __APPLE__
+   extern const char * macosx_main_bundle_dir (void);
+#endif
 \f
 static bool option_summary;
 
@@ -493,10 +497,9 @@ parse_path_string (const char * path)
 {
   const char * start = path;
   /* It is important that this get_wd be called here to make sure that
-     the the unix getcwd is called now, before it allocates heap space
+     the unix getcwd is called now, before it allocates heap space.
      This is because getcwd forks off a new process and we want to do
-     that before the scheme process gets too big
-  */
+     that before the scheme process gets too big.  */
   const char * wd = (get_wd ());
   unsigned int lwd = (strlen (wd));
   while (1)
@@ -791,15 +794,32 @@ read_command_line_options (int argc, const char ** argv)
   bool band_sizes_valid = false;
   unsigned long band_constant_size = 0;
   unsigned long band_heap_size = 0;
+  const char * default_library_path = DEFAULT_LIBRARY_PATH;
 
   parse_standard_options (argc, argv);
   if (option_library_path != 0)
     free_parsed_path (option_library_path);
+#ifdef __APPLE__
+  const char * main_bundle_path = (macosx_main_bundle_dir ());
+  if (main_bundle_path != 0)
+    {
+      unsigned int n_chars =
+       ((strlen (main_bundle_path))
+        + (strlen (default_library_path))
+        + 2);
+      char * new_path = (OS_malloc (n_chars));
+      strcpy (new_path, main_bundle_path);
+      strcat (new_path, ":");
+      strcat (new_path, default_library_path);
+      xfree (main_bundle_path);
+      default_library_path = new_path;
+    }
+#endif
   option_library_path
     = (parse_path_string
        (standard_string_option (option_raw_library,
                                LIBRARY_PATH_VARIABLE,
-                               DEFAULT_LIBRARY_PATH)));
+                               default_library_path)));
 
   if (option_band_file != 0)
     {

diff --git a/src/microcode/pruxenv.c b/src/microcode/pruxenv.c
index e539921999a9ab30597a5e96198be57d2f6426c0..37baaddb3594071d19efa36270496ea5ddbf4d3b 100644 (file)
--- a/src/microcode/pruxenv.c
+++ b/src/microcode/pruxenv.c
@@ -36,6 +36,10 @@ extern const char * OS_current_user_home_directory (void);
 #ifdef HAVE_SOCKETS
 #  include "uxsock.h"
 #endif
+
+#ifdef __APPLE__
+#  include <CoreServices/CoreServices.h>
+#endif
 \f
 DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1,
   "Convert a file system time stamp into a date/time string.")
@@ -236,3 +240,73 @@ DEFINE_PRIMITIVE ("INSTRUCTION-ADDRESS->COMPILED-CODE-BLOCK",
   PRIMITIVE_RETURN (UNSPECIFIC);
 #endif
 }
+
+#ifdef __APPLE__
+const char *
+macosx_main_bundle_dir (void)
+{
+  CFBundleRef bundle;
+  CFURLRef url;
+  UInt8 buffer [4096];
+  char * bp;
+  char * result;
+
+  bundle = (CFBundleGetMainBundle());
+  if (bundle == 0)
+    return (0);
+
+  url = (CFBundleCopyResourceURL
+        (bundle, (CFSTR ("utabmd")), (CFSTR ("bin")), 0));
+  if (url == 0)
+    return (0);
+
+  if (!CFURLGetFileSystemRepresentation (url, true, buffer, (sizeof (buffer))))
+    {
+      CFRelease (url);
+      return (0);
+    }
+  CFRelease (url);
+  bp = ((char *) buffer);
+
+  /* Discard everything after the final slash.  */
+  {
+    char * slash = (strrchr (bp, '/'));
+    if (slash != 0)
+      (*slash) = '\0';
+  }
+
+  result = (UX_malloc ((strlen (bp)) + 1));
+  if (result != 0)
+    strcpy (result, bp);
+
+  return (result);
+}
+#endif
+
+DEFINE_PRIMITIVE ("MACOSX-MAIN-BUNDLE-DIR",
+                 Prim_macosx_main_bundle_dir, 0, 0, 0)
+{
+  PRIMITIVE_HEADER (0);
+#ifdef __APPLE__
+  {
+    const char * path = (macosx_main_bundle_dir ());
+    unsigned int n_words;
+    SCHEME_OBJECT result;
+
+    if (path == 0)
+      PRIMITIVE_RETURN (SHARP_F);
+    n_words = (1 + (STRING_LENGTH_TO_GC_LENGTH (strlen (path))));
+    if (GC_NEEDED_P (n_words))
+      {
+       UX_free ((void *) path);
+       Primitive_GC (n_words);
+      }
+    result = (char_pointer_to_string_no_gc (path));
+    UX_free ((void *) path);
+    PRIMITIVE_RETURN (result);
+  }
+#else
+  error_unimplemented_primitive ();
+  PRIMITIVE_RETURN (UNSPECIFIC);
+#endif
+}

diff --git a/src/runtime/pathnm.scm b/src/runtime/pathnm.scm
index 4f73f086201aad2bfef728c40eb3830839817fe5..47ba8be9f3428d568af65c3eda0f4c0d12ddd1af 100644 (file)
--- a/src/runtime/pathnm.scm
+++ b/src/runtime/pathnm.scm
@@ -590,21 +590,21 @@ these rules:
     ((host-type/operation/init-file-pathname (host/type host)) host)))
 
 (define (system-library-pathname pathname #!optional required?)
-  (let ((pathname* (merge-pathnames pathname (%find-library-directory)))
-       (required? (if (default-object? required?) #t required?)))
-    (if (and required? (not (file-exists? pathname*)))
-       (system-library-pathname
-        (error:file-operation pathname*
-                              "find"
-                              "file"
-                              "no such file in system library path"
-                              system-library-pathname
-                              (list pathname required?)))
-       pathname*)))
+  (if (if (default-object? required?) #t required?)
+      (or (%find-library-file pathname)
+         (system-library-pathname
+          (error:file-operation pathname*
+                                "find"
+                                "file"
+                                "no such file in system library path"
+                                system-library-pathname
+                                (list pathname required?))
+          required?))
+      (merge-pathnames pathname (%find-library-directory))))
 
 (define (system-library-directory-pathname #!optional pathname required?)
   (if (if (default-object? pathname) #f pathname)
-      (let ((dir (system-library-pathname pathname #f)))
+      (let ((dir (%find-library-file pathname)))
        (cond ((file-directory? dir)
               (pathname-as-directory dir))
              ((if (default-object? required?) #f required?)
@@ -625,6 +625,14 @@ these rules:
    (or (find-matching-item library-directory-path file-directory?)
        (error "Can't find library directory."))))
 
+(define (%find-library-file pathname)
+  (let loop ((path library-directory-path))
+    (and (pair? path)
+        (let ((p (merge-pathnames pathname (car path))))
+          (if (file-exists? p)
+              p
+              (loop (cdr path)))))))
+
 (define library-directory-path)
 \f
 (define known-host-types