summaryrefslogtreecommitdiffstats
path: root/scm.c
diff options
context:
space:
mode:
Diffstat (limited to 'scm.c')
-rw-r--r--scm.c236
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