[Openmcl-cvs-notifications] r11012 - /trunk/source/lisp-kernel/pmcl-kernel.c

[gb at clozure.com]

Author: gb
Date: Tue Oct  7 18:58:38 2008
New Revision: 11012

Log:
Prefer the convention of deriving the heap image name from the kernel
name by appending ".image".  On platfroms where we've traditionally
used case-inversion, fall back to that if the .image doesn't exist
and the inverted name does.

(Need to compile this on a few platffors; not sure how easy it is to
use vanilla 'stat' on Windows.)

Also need to change the defaults in compile-ccl.lisp, and change the
documentation.

Modified:
    trunk/source/lisp-kernel/pmcl-kernel.c

Modified: trunk/source/lisp-kernel/pmcl-kernel.c
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lisp-kernel/pmcl-kernel.c (original)
+++ trunk/source/lisp-kernel/pmcl-kernel.c Tue Oct  7 18:58:38 2008
@@ -115,6 +115,7 @@
 #include "Threads.h"
 =

 #include <fenv.h>
+#include <sys/stat.h>
 =

 #ifndef MAP_NORESERVE
 #define MAP_NORESERVE (0)
@@ -791,7 +792,18 @@
 set_nil(LispObj);
 =

 =

-#if defined(DARWIN) || defined(WINDOWS)
+/* Check for the existence of a file named by 'path'; return true
+   if it seems to exist, without checking size, permissions, or
+   anything else. */
+Boolean
+probe_file(char *path)
+{
+  struct stat st;
+
+  return (stat(path,&st) =3D=3D 0);
+}
+
+
 #ifdef WINDOWS
 /* Chop the trailing ".exe" from the kernel image name */
 char *
@@ -809,6 +821,41 @@
 }
 #endif
 =

+char *
+path_by_appending_image(char *path)
+{
+  int len =3D strlen(path) + strlen(".image") + 1;
+  char *copy =3D (char *) malloc(len);
+
+  if (copy) {
+    strcpy(copy, path);
+    strcat(copy, ".image");
+  }
+  return copy;
+}
+
+char *
+case_inverted_path(char *path)
+{
+  char *copy =3D strdup(path), *base =3D copy, *work =3D copy, c;
+  if (copy =3D=3D NULL) {
+    return NULL;
+  }
+  while(*work) {
+    if (*work++ =3D=3D '/') {
+      base =3D work;
+    }
+  }
+  work =3D base;
+  while ((c =3D *work) !=3D '\0') {
+    if (islower(c)) {
+      *work++ =3D toupper(c);
+    } else {
+      *work++ =3D tolower(c);
+    }
+  }
+  return copy;
+}
 /* =

    The underlying file system may be case-insensitive (e.g., HFS),
    so we can't just case-invert the kernel's name.
@@ -822,40 +869,18 @@
 #else
   char *path =3D orig;
 #endif
-  int len =3D strlen(path) + strlen(".image") + 1;
-  char *copy =3D (char *) malloc(len);
-
-  if (copy) {
-    strcpy(copy, path);
-    strcat(copy, ".image");
-  }
-  return copy;
-}
-
-#else
-char *
-default_image_name(char *orig)
-{
-  char *copy =3D strdup(orig), *base =3D copy, *work =3D copy, c;
-  if (copy =3D=3D NULL) {
-    return NULL;
-  }
-  while(*work) {
-    if (*work++ =3D=3D '/') {
-      base =3D work;
-    }
-  }
-  work =3D base;
-  while ((c =3D *work) !=3D '\0') {
-    if (islower(c)) {
-      *work++ =3D toupper(c);
-    } else {
-      *work++ =3D tolower(c);
-    }
-  }
-  return copy;
-}
-#endif
+  char *image_name =3D path_by_appending_image(path);
+#if !defined(WINDOWS) && !defined(DARWIN)
+  if (!probe_file(image_name)) {
+    char *legacy =3D case_inverted_path(path);
+    if (probe_file(legacy)) {
+      image_name =3D legacy;
+    }
+  }
+#endif
+  return image_name;
+}
+
 =

 =

 char *program_name =3D NULL;