Import Upstream version 5b3upstream/5b3

1 files changed, 45 insertions, 191 deletions

diff --git a/scm.c b/scm.c
index ce8e834..5f305a8 100644
--- a/scm.c
+++ b/scm.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -56,9 +56,10 @@
 	unsigned int sleep P((unsigned int seconds));
 	char *getenv P((const char *name));
 	int system P((const char *));
-#endif
-#ifdef hpux
-# define const /**/
+#else /* added by Denys Duchier */
+# ifdef SVR4
+#  include <unistd.h>
+# endif
 #endif
 
 void	final_repl P((void));
@@ -82,7 +83,7 @@ void init_banner()
 {
   fputs("SCM version ", stderr);
   fputs(SCMVERSION, stderr);
-  fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 \
+  fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 \
 Free Software Foundation.\n\
 SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.\n\
 This is free software, and you are welcome to redistribute it\n\
@@ -232,8 +233,8 @@ SCM l_sleep(i)
   SYSCALL(j = sleep(INUM(i)););
 #   endif
   return MAKINUM(j);
-}
 #  endif
+}
 # endif
 #endif
 
@@ -581,190 +582,46 @@ SCM softtype()
 #endif
 }
 
-/* Concatentate str2 onto str1 at position n and return concatenated
-   string if file exists; 0 otherwise. */
-
-char *scm_cat_path(str1, str2, n)
-     char *str1;
-     const char *str2;
-     long n;
-{
-  if (!n) n = strlen(str2);
-  if (str1)
-    {
-      long len = strlen(str1);
-      str1 = (char *)realloc(str1, (sizet)(len + n + 1));
-      if (!str1) return 0;
-      strncat(str1 + len, str2, n);
-      return str1;
-    }
-  str1 = (char *)malloc((sizet)(n + 1));
-  if (!str1) return 0;
-  str1[0] = 0;
-  strncat(str1, str2, n);
-  return str1;
-}
-
-char *scm_try_path(path)
-     char *path;
-{
-  FILE *f;
-  /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
-  if (!path) return 0;
-  SYSCALL(f = fopen(path, "r"););
-  if (f) {
-    fclose(f);
-    return path;
-  }
-  free(path);
-  return 0;
-}
-
-char *scm_sep_init_try(path, sep, initname)
-     char *path;
-     const char *sep, *initname;
-{
-  if (path) path = scm_cat_path(path, sep, 0L);
-  if (path) path = scm_cat_path(path, initname, 0L);
-  return scm_try_path(path);
-}
-
-#ifdef MSDOS
-char *dld_find_executable(file)
-     const char *file;
-{
-  return scm_cat_path(0L, file, 0L);
-}
-#endif
-
-#ifndef INIT_FILE_NAME
-# define INIT_FILE_NAME "Init.scm"
-#endif
-#ifndef DIRSEP
-# define DIRSEP "/"
-#endif
-#ifndef GENERIC_NAME
-# define GENERIC_NAME "scm"
-#endif
-
-/* Given dld_find_executable()'s best guess for the pathname of this
-   executable, find (and verify the existence of) initname in the
-   implementation-vicinity of this program.  Returns a newly allocated
-   string if successful, 0 if not */
-
-char *scm_find_impl_file(exec_path, generic_name, initname, sep)
-     char *exec_path;
-     const char *generic_name, *initname, *sep;
-{
-  char *sepptr = strrchr(exec_path, sep[0]);
-  char *extptr = exec_path + strlen(exec_path);
-  char *path = 0;
-  if (sepptr) {
-    long sepind = sepptr - exec_path + 1L;
-
-    /* In case exec_path is in the source directory, look first in
-       exec_path's directory. */
-    path = scm_cat_path(0L, exec_path, sepind - 1L);
-    path = scm_sep_init_try(path, sep, initname);
-    if (path) return path;
-
-#ifdef MSDOS
-    if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") ||
-	!strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM"))
-      extptr = extptr - 4;
-#endif
-
-    if (generic_name &&
-	!strncmp(exec_path + sepind, generic_name, extptr - exec_path))
-      generic_name = 0;
-
-    /* If exec_path is in directory "exe" or "bin": */
-    path = scm_cat_path(0L, exec_path, sepind - 1L);
-    sepptr = path + sepind - 4;
-    if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") ||
-	!strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) {
-      char *peer;
-
-      /* Look for initname in peer directory "lib". */
-      if (path) {
-	strncpy(sepptr, "lib", 3);
-	path = scm_sep_init_try(path, sep, initname);
-	if (path) return path;
-      }
-
-      /* Look for initname in peer directories "lib" and "src" in
-	 subdirectory with the name of the executable (sans any type
-	 extension like .EXE). */
-      for(peer="lib";!0;peer="src") {
-	path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
-	if (path) {
-	  strncpy(path + sepind - 4, peer, 3);
-	  path[extptr - exec_path] = 0;
-	  path = scm_sep_init_try(path, sep, initname);
-	  if (path) return path;
-	}
-	if (!strcmp(peer,"src")) break;
-      }
-
-      if (generic_name) {
-
-	/* Look for initname in peer directories "lib" and "src" in
-	   subdirectory with the generic name. */
-	for(peer="lib";!0;peer="src") {
-	  path = scm_cat_path(0L, exec_path, sepind);
-	  if (path) {
-	    strncpy(path + sepind - 4, "lib", 3);
-	    path = scm_cat_path(path, generic_name, 0L);
-	    path = scm_sep_init_try(path, sep, initname);
-	    if (path) return path;
-	  }
-	  if (!strcmp(peer,"src")) break;
-	}}}
-
-#ifdef MSDOS
-    if (strlen(extptr)) {
-      /* If exec_path has type extension, look in a subdirectory with
-	 the name of the executable sans the executable file's type
-	 extension. */
-      path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
-      path = scm_sep_init_try(path, sep, initname);
-      if (path) return path;
-
-      if (generic_name) {
-
-	/* Also look in generic_name subdirectory. */
-	path = scm_cat_path(0L, exec_path, sepind);
-	if (path) path = scm_cat_path(path, generic_name, 0L);
-	path = scm_sep_init_try(path, sep, initname);
-	if (path) return path;
-      }}
-#endif
-  }
-  else {
+#ifndef RTL
 
-    /* We don't have a parse-able exec_path.  The only path to try is
-       just initname. */
-    path = scm_cat_path(0L, initname, 0L);
-    if (path) path = scm_try_path(path);
-    if (path) return path;
-  }
-  return 0;
-}
+# ifndef INIT_FILE_NAME
+#  define INIT_FILE_NAME "Init.scm"
+# endif
+# ifndef DIRSEP
+#  define DIRSEP "/"
+# endif
+# ifndef GENERIC_NAME
+#  define GENERIC_NAME "scm"
+# endif
 
-#ifndef RTL
 char *execpath = 0;
-int main( argc, argv )
+int main(argc, argv)
      int argc;
      char **argv;
 {
-  int retval, buf0stdin = 0;
-  char *getenvpath, *implpath = 0;
+  int retval, buf0stdin = 0, nargc;
+  char *getenvpath, *implpath = 0, **nargv;
+  
+  execpath = 0;
+  if ((nargv = script_process_argv(argc, argv))) {
+    nargc = script_count_argv(nargv);
+# ifdef unix
+#  ifndef MSDOS
+    execpath = script_find_executable(argv[2]);
+#  endif
+# endif
+  }
+  else {
+    nargv = argv;
+    nargc = argc;
+  }
+  /* fprintf(stderr, "execpath = %s\n", execpath); fflush(stderr); */
+  if (!execpath) execpath = dld_find_executable(argv[0]);
 
 # ifndef nosve
   getenvpath = getenv("SCM_INIT_PATH");
   if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L);
   if (implpath) {
-
     /* The value of the environment variable supersedes other
        locations, as long as the file exists. */
     implpath = scm_try_path(implpath);
@@ -776,18 +633,14 @@ int main( argc, argv )
   }
 # endif
 
-  if (!implpath) {
-    execpath = dld_find_executable(argv[0]);
-    if (execpath) {
-      /* fprintf(stderr, "dld found exe \"%s\"\n", execpath); fflush(stderr); */
-      implpath = scm_find_impl_file(execpath,
-				    GENERIC_NAME, INIT_FILE_NAME, DIRSEP);
-      /* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */
-    }
+  if (execpath && (!implpath)) {
+    implpath = scm_find_impl_file(execpath,
+				  GENERIC_NAME, INIT_FILE_NAME, DIRSEP);
+    /* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */
+  }
 # ifdef IMPLINIT
-    if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L);
+  if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L);
 # endif
-  }
 # ifndef GO32
   if (isatty(fileno(stdin))) {
     buf0stdin = !0;		/* stdin gets marked BUF0 in init_scm() */
@@ -808,13 +661,14 @@ int main( argc, argv )
   }
 #  endif
 # endif
-  retval = run_scm(argc, argv,
+  retval = run_scm(nargc, nargv,
 		   (isatty(fileno(stdin)) && isatty(fileno(stdout)))
-		   ? (argc <= 1) ? 2 : 1 : 0,
+		   ? (nargc <= 1) ? 2 : 1 : 0,
 		   buf0stdin,
 		   implpath ? implpath : "");
   if (implpath) free(implpath);
   if (execpath) free(execpath);
+  execpath = 0;
   return retval;
 }
 #endif