diff options
Diffstat (limited to 'scm.c')
| -rw-r--r-- | scm.c | 236 |
1 files changed, 45 insertions, 191 deletions
@@ -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 |