Move most of the guts of shell command processing into libguile,

so guile.c can be very small (and eventuallly auto-generated.  (I
mean, generated mechanically, not self-generated.  Hmm.))
* guile.c, script.c, script.h: New source files.
* init.c (scm_boot_guile_1): Call scm_init_script.
* libguile.h: #include "script.h".
* Makefile.am (bin_PROGRAMS, guile_SOURCES, guile_LDADD): New
targets, for new executable.
(libguile_la_SOURCES): Mention script.c.
(modinclude_HEADERS): Add script.h.
* configure.in: Always check for -lm, -lsocket, -lnsl, whether or
not dynamic linking is enabled.  This is because we're generating
executables now.  Move CY_AC_WITH_THREADS call after those, so the
values of cy_cv_threads_libs captures the libs chosen above.
* Makefile.in, configure, aclocal.m4: Regenerated.

2 files changed, 876 insertions, 0 deletions

diff --git a/libguile/script.c b/libguile/script.c
new file mode 100644
index 000000000..acf8bbaf9
--- /dev/null
+++ b/libguile/script.c
@@ -0,0 +1,816 @@
+/* Copyright (C) 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
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+/* "script.c" argv tricks for `#!' scripts.
+   Author: Aubrey Jaffer */
+
+#include <stdio.h>
+#include <ctype.h>
+#include "_scm.h"
+#include "gh.h"
+#include "load.h"
+
+#include "script.h"
+
+#ifdef __IBMC__
+#include <io.h>
+#endif /* def __IBMC__ */
+
+#ifdef linux
+#include <unistd.h>		/* for X_OK define */
+#endif /* def linux */
+#ifdef __svr4__
+#include <unistd.h>		/* for X_OK define */
+#else
+#ifdef __sgi__
+#include <unistd.h>		/* for X_OK define */
+#endif /* def __sgi__ */
+#endif /* def __svr4__ */
+#ifdef hpux
+#define const
+/**/
+#endif
+
+/* Concatentate str2 onto str1 at position n and return concatenated
+   string if file exists; 0 otherwise. */
+
+static 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, (scm_sizet) (len + n + 1));
+      if (!str1)
+	return 0L;
+      strncat (str1 + len, str2, n);
+      return str1;
+    }
+  str1 = (char *) malloc ((scm_sizet) (n + 1));
+  if (!str1)
+    return 0L;
+  str1[0] = 0;
+  strncat (str1, str2, n);
+  return str1;
+}
+
+#if 0 
+static char *
+scm_try_path (path)
+     char *path;
+{
+  FILE *f;
+  /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
+  if (!path)
+    return 0L;
+  SCM_SYSCALL (f = fopen (path, "r");
+    );
+  if (f)
+    {
+      fclose (f);
+      return path;
+    }
+  free (path);
+  return 0L;
+}
+
+static 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);
+}
+#endif 
+
+#ifndef LINE_INCREMENTORS
+#define LINE_INCREMENTORS  '\n'
+#ifdef MSDOS
+#define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
+#else
+#define WHITE_SPACES  ' ':case '\t':case '\r':case '\f'
+#endif /* def MSDOS */
+#endif /* ndef LINE_INCREMENTORS */
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 80
+#endif /* ndef MAXPATHLEN */
+#ifndef X_OK
+#define X_OK 1
+#endif /* ndef X_OK */
+
+#ifdef unix
+#include <stdio.h>
+
+char *
+scm_find_executable (name)
+     const char *name;
+{
+  char tbuf[MAXPATHLEN];
+  int i = 0;
+  FILE *f;
+
+  /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
+  if (access (name, X_OK))
+    return 0L;
+  f = fopen (name, "r");
+  if (!f)
+    return 0L;
+  if ((fgetc (f) == '#') && (fgetc (f) == '!'))
+    {
+      while (1)
+	switch (tbuf[i++] = fgetc (f))
+	  {
+	  case /*WHITE_SPACES */ ' ':
+	  case '\t':
+	  case '\r':
+	  case '\f':
+	  case EOF:
+	    tbuf[--i] = 0;
+	    fclose (f);
+	    return scm_cat_path (0L, tbuf, 0L);
+	  }
+    }
+  fclose (f);
+  return scm_cat_path (0L, name, 0L);
+}
+#endif /* unix */
+
+#ifdef MSDOS
+
+#define DEFAULT_PATH "C:\\DOS"
+#define PATH_DELIMITER ';'
+#define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \
+				     || (fname[0] && (fname[1] == ':')))
+
+char *
+dld_find_executable (file)
+     const char *file;
+{
+  /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */
+  return scm_cat_path (0L, file, 0L);
+}
+#endif /* def MSDOS */
+
+#if 0
+/* This code was originally borrowed from SCM; Guile sees things
+   differently.  */
+
+/* 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;
+  /* fprintf(stderr, "dld_find_e %s\n", exec_path); fflush(stderr); */
+  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 /* def MSDOS */
+
+      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 /* def MSDOS */
+    }
+  else
+    {
+
+      /* 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 0L;
+}
+#endif /* 0 */
+
+
+/* Read a \nnn-style escape.  We've just read the backslash.  */
+static int
+script_get_octal (f)
+     FILE *f;
+{
+  int i;
+  int value = 0;
+
+  for (i = 0; i < 3; i++)
+    {
+      int c = getc (f);
+      if ('0' <= c && c <= '7')
+	value = (value * 8) + (c - '0');
+      else
+	scm_wta (SCM_UNDEFINED,
+		 "malformed script: bad octal backslash escape",
+		 "script argument parser");
+    }
+  return value;
+}
+
+
+static int
+script_get_backslash (f)
+     FILE *f;
+{
+  int c = getc (f);
+
+  switch (c)
+    {
+    case 'a': return '\a';
+    case 'b': return '\b';
+    case 'f': return '\f';
+    case 'n': return '\n';
+    case 'r': return '\r';
+    case 't': return '\t';
+    case 'v': return '\v';
+
+    case '\\':
+    case ' ':
+    case '\t':
+    case '\n':
+      return c;
+
+    case '0': case '1': case '2': case '3':
+    case '4': case '5': case '6': case '7':
+      ungetc (c, f);
+      return script_get_octal (f);
+	    
+    case EOF:
+      scm_wta (SCM_UNDEFINED,
+	       "malformed script: backslash followed by EOF",
+	       "script argument parser");
+      return 0; /* not reached? */
+
+    default:
+      scm_wta (SCM_UNDEFINED,
+	       "malformed script: bad backslash sequence",
+	       "script argument parser");
+      return 0; /* not reached? */
+    }
+}
+
+
+static char *
+script_read_arg (f)
+     FILE *f;
+{
+  int size = 7;
+  char *buf = malloc (size + 1);
+  int len = 0;
+
+  if (! buf)
+    return 0;
+
+  for (;;)
+    {
+      int c = getc (f);
+      switch (c)
+	{
+	case '\\':
+	  c = script_get_backslash (f);
+	  /* The above produces a new character to add to the argument.
+             Fall through.  */
+	default:
+	  if (len >= size)
+	    {
+	      size = (size + 1) * 2;
+	      buf = realloc (buf, size);
+	      if (! buf)
+		return 0;
+	    }
+	  buf[len++] = c;
+	  break;
+
+	case '\n':
+	  /* This may terminate an arg now, but it will terminate the
+             entire list next time through.  */
+	  ungetc ('\n', f);
+	case EOF:
+	  if (len == 0)
+	    {
+	      free (buf);
+	      return 0;
+	    }
+	  /* Otherwise, those characters terminate the argument; fall
+             through.  */
+	case ' ':
+	  buf[len] = '\0';
+	  return buf;
+
+	case '\t':
+	  free (buf);
+	  scm_wta (SCM_UNDEFINED,
+		   "malformed script: TAB in meta-arguments",
+		   "argument parser");
+	  return 0; /* not reached? */
+	}
+    }
+}
+
+
+static int
+script_meta_arg_P (arg)
+     char *arg;
+{
+  if ('\\' != arg[0])
+    return 0L;
+#ifdef MSDOS
+  return !arg[1];
+#else
+  switch (arg[1])
+    {
+    case 0:
+    case '%':
+    case WHITE_SPACES:
+      return !0;
+    default:
+      return 0L;
+    }
+#endif
+}
+
+char **
+scm_get_meta_args (argc, argv)
+     int argc;
+     char **argv;
+{
+  int nargc = argc, argi = 1, nargi = 1;
+  char *narg, **nargv;
+  if (!(argc > 2 && script_meta_arg_P (argv[1])))
+    return 0L;
+  if (!(nargv = (char **) malloc ((1 + nargc) * sizeof (char *))))
+      return 0L;
+  nargv[0] = argv[0];
+  while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
+    {
+      FILE *f = fopen (argv[++argi], "r");
+      if (f)
+	{
+	  nargc--;		/* to compensate for replacement of '\\' */
+	  while (1)
+	    switch (getc (f))
+	      {
+	      case EOF:
+		return 0L;
+	      default:
+		continue;
+	      case '\n':
+		goto found_args;
+	      }
+	found_args:
+	  while ((narg = script_read_arg (f)))
+	    if (!(nargv = (char **) realloc (nargv,
+					     (1 + ++nargc) * sizeof (char *))))
+	        return 0L;
+	    else
+	      nargv[nargi++] = narg;
+	  fclose (f);
+	  nargv[nargi++] = argv[argi++];
+	}
+    }
+  while (argi <= argc)
+    nargv[nargi++] = argv[argi++];
+  return nargv;
+}
+
+int
+scm_count_argv (argv)
+     char **argv;
+{
+  int argc = 0;
+  while (argv[argc])
+    argc++;
+  return argc;
+}
+
+
+/* For use in error messages.  */
+char *scm_usage_name = 0;
+
+void
+scm_shell_usage (int fatal, char *message)
+{
+  if (message)
+    fprintf (stderr, "%s\n", message);
+
+  fprintf (stderr, 
+           "Usage: %s OPTION ...\n"
+           "Evaluate Scheme code, interactively or from a script.\n"
+           "\n"
+           "  -s SCRIPT      load Scheme source code from FILE, and exit\n"
+           "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
+           "  --             stop scanning arguments; run interactively\n"
+           "The above switches stop argument processing, and pass all\n"
+           "remaining arguments as the value of (command-line).\n"
+           "\n"
+           "  -l FILE        load Scheme source code from FILE\n"
+           "  -e FUNCTION    after reading script, apply FUNCTION to\n"
+           "                 command line arguments\n"
+           "  -ds            do -s script at this point\n"
+           "  --emacs        enable Emacs protocol (experimental)\n"
+           "  -h, --help     display this help and exit\n"
+           "  -v, --version  display version information and exit\n"
+	   "  \\              read arguments from following script lines\n",
+           scm_usage_name);
+
+  if (fatal)
+    exit (1);
+}
+
+
+/* Some symbols used by the command-line compiler.  */
+SCM_SYMBOL (sym_load, "load");
+SCM_SYMBOL (sym_eval_string, "eval-string");
+SCM_SYMBOL (sym_command_line, "command-line");
+SCM_SYMBOL (sym_begin, "begin");
+SCM_SYMBOL (sym_load_user_init, "load-user-init");
+SCM_SYMBOL (sym_top_repl, "top-repl");
+SCM_SYMBOL (sym_quit, "quit");
+
+
+/* Given an array of command-line switches, return a Scheme expression
+   to carry out the actions specified by the switches.
+
+   If you told me this should have been written in Scheme, I'd
+   probably agree.  I'd say I didn't feel comfortable doing that in
+   the present system.  You'd say, well, fix the system so you are
+   comfortable doing that.  I'd agree again.  *shrug*
+
+   We load the ice-9 system from here.  It might be nicer if the
+   libraries initialized from the inner_main function in guile.c (which
+   will be auto-generated eventually) could assume ice-9 were already
+   loaded.  Then again, it might be nice if ice-9 could assume that
+   certain libraries were already loaded.  The solution is to break up
+   ice-9 into modules which can be frozen and statically linked like any
+   other module.  Then all the modules can describe their dependencies in
+   the usual way, and the auto-generated inner_main will do the right
+   thing.  */
+
+SCM
+scm_compile_shell_switches (int argc, char **argv)
+{
+  SCM tail = SCM_EOL;		/* We accumulate the list backwards,
+				   and then reverse! it before we
+				   return it.  */
+  SCM do_script = SCM_EOL;	/* The element of the list containing
+				   the "load" command, in case we get
+				   the "-ds" switch.  */
+  SCM entry_point = SCM_EOL;	/* for -e switch */
+  int interactive = 1;		/* Should we go interactive when done? */
+  int use_emacs_interface = 0;
+  int i;
+  char *argv0;
+
+  if (argc > 0)
+    {
+      scm_usage_name = strrchr (argv[0], '/');
+      if (! scm_usage_name)
+	scm_usage_name = argv[0];
+      else
+	scm_usage_name++;
+    }
+  if (! scm_usage_name)
+    scm_usage_name = "guile";
+  argv0 = scm_usage_name;
+  
+  for (i = 1; i < argc; i++)
+    {
+      if (! strcmp (argv[i], "-s")) /* load script */
+	{
+	  if (++i >= argc)
+	    scm_shell_usage (1, "missing argument to `-s' switch");
+
+	  /* If we specified the -ds option, do_script points to the
+	     cdr of an expression like (load #f); we replace the car
+	     (i.e., the #f) with the script name.  */
+	  if (do_script != SCM_EOL)
+	    {
+	      SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
+	      do_script = SCM_EOL;
+	    }
+	  else
+	    /* Construct an application of LOAD to the script name.  */
+	    tail = scm_cons (scm_cons2 (sym_load,
+					scm_makfrom0str (argv[i]),
+					SCM_EOL),
+			       tail);
+	  argv0 = argv[i];
+	  i++;
+	  interactive = 0;
+	  break;
+	}
+
+      else if (! strcmp (argv[i], "-c")) /* evaluate expr */
+	{
+	  if (++i >= argc)
+	    scm_shell_usage (1, "missing argument to `-c' switch");
+	  tail = scm_cons (scm_cons2 (sym_eval_string,
+				      scm_makfrom0str (argv[i]),
+				      SCM_EOL),
+			   tail);
+	  i++;
+	  interactive = 0;
+	  break;
+	}
+
+      else if (! strcmp (argv[i], "--")) /* end args; go interactive */
+	{
+	  i++;
+	  break;
+	}
+
+      else if (! strcmp (argv[i], "-l")) /* load a file */
+	{
+	  if (++i < argc)
+	    tail = scm_cons (scm_cons2 (sym_load,
+					scm_makfrom0str (argv[i]),
+					SCM_EOL),
+			     tail);
+	  else
+	    scm_shell_usage (1, "missing argument to `-l' switch");
+	}	  
+
+      else if (! strcmp (argv[i], "-e")) /* entry point */
+	{
+	  if (++i < argc)
+	    entry_point = gh_symbol2scm (argv[i]);
+	  else
+	    scm_shell_usage (1, "missing argument to `-e' switch");
+	}
+
+      else if (! strcmp (argv[i], "-ds")) /* do script here */
+	{
+	  /* We put a dummy "load" expression, and let the -s put the
+             filename in.  */
+	  if (do_script != SCM_EOL)
+	    scm_shell_usage (1, "the -ds switch may only be specified once");
+	  do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
+	  tail = scm_cons (scm_cons (sym_load, do_script),
+			   tail);
+	}
+
+      else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ 
+	use_emacs_interface = 1;
+
+      else if (! strcmp (argv[i], "-h")
+	       || ! strcmp (argv[i], "--help"))
+	{
+	  scm_shell_usage (0, 0);
+	  exit (0);
+	}
+
+      else if (! strcmp (argv[i], "-v")
+	       || ! strcmp (argv[i], "--version"))
+	{
+	  /* Print version number.  */
+	  printf ("Guile %s\n"
+		  "Copyright (c) 1995, 1996 Free Software Foundation\n"
+		  "Guile may be distributed under the terms of the GNU General Public Licence;\n"
+		  "certain other uses are permitted as well.  For details, see the file\n"
+		  "`COPYING', which is included in the Guile distribution.\n"
+		  "There is no warranty, to the extent permitted by law.\n",
+		  GUILE_VERSION);
+	  exit (0);
+	}
+
+      else
+	{
+	  fprintf (stderr, "%s: Unrecognized switch `%s'\n",
+		   scm_usage_name, argv[i]);
+	  scm_shell_usage (1, 0);
+	}
+    }
+
+  /* Check to make sure the -ds got a -s. */
+  if (do_script != SCM_EOL)
+    scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
+
+  /* Make any remaining arguments available to the
+     script/command/whatever.  */
+  scm_set_program_arguments (argc - i, argv + i, argv0);
+  
+  /* If the --emacs switch was set, now is when we process it.  */
+  scm_sysintern ("use-emacs-interface",
+		 (use_emacs_interface) ? SCM_BOOL_T : SCM_BOOL_F);
+
+  /* Handle the `-e' switch, if it was specified.  */
+  if (entry_point != SCM_EOL)
+    tail = scm_cons (scm_cons2 (entry_point,
+				scm_cons (sym_command_line, SCM_EOL),
+				SCM_EOL),
+		       tail);
+
+  /* If we didn't end with a -c or a -s, load the user's customization
+     file, and start the repl.  */
+  if (interactive)
+    {
+      tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
+      tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
+    }
+
+  /* After doing all the other actions prescribed by the command line,
+     quit.  */
+  tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
+		   tail);
+      
+  {
+    /* We want a path only containing directories from SCHEME_LOAD_PATH,
+       SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
+       file, so we do this before loading Ice-9.  */
+    SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
+
+    /* Load Ice-9.  */
+    scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
+
+    /* Load the init.scm file.  */
+    if (SCM_NFALSEP (init_path))
+      scm_primitive_load (init_path);
+  }
+
+  {
+    SCM val = scm_cons (sym_begin, scm_list_reverse_x (tail, SCM_UNDEFINED));
+
+    scm_write (val, SCM_UNDEFINED);
+    scm_newline (SCM_UNDEFINED);
+    
+    return val;
+  }
+}
+
+
+void
+scm_shell (argc, argv)
+     int argc;
+     char **argv;
+{
+  /* If present, add SCSH-style meta-arguments from the top of the
+     script file to the argument vector.  See the SCSH manual: "The
+     meta argument" for more details.  */
+  {
+    char **new_argv = scm_get_meta_args (argc, argv);
+
+    if (new_argv)
+      {
+	argv = new_argv;
+	argc = scm_count_argv (new_argv);
+      }
+  }
+
+  scm_eval_x (scm_compile_shell_switches (argc, argv));
+}
+
+
+void
+scm_init_script ()
+{
+#include "script.x"
+}
diff --git a/libguile/script.h b/libguile/script.h
new file mode 100644
index 000000000..406e76645
--- /dev/null
+++ b/libguile/script.h
@@ -0,0 +1,60 @@
+/* classes: h_files */
+
+#ifndef SCRIPTH
+#define SCRIPTH
+/*	Copyright (C) 1995,1996 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
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  
+ */
+
+#include "libguile/__scm.h"
+
+
+extern char *scm_find_executable SCM_P ((const char *name));
+extern char *scm_find_impl_file SCM_P ((char *exec_path,
+					const char *generic_name,
+					const char *initname,
+					const char *sep));
+extern char **scm_get_meta_args SCM_P ((int argc, char **argv));
+extern int scm_count_argv SCM_P ((char **argv));
+extern void scm_shell SCM_P ((int argc, char **argv));
+extern char *scm_usage_name;
+extern void scm_init_script ();
+
+#endif  /* SCRIPTH */