Changes from arch/CVS synchronization
[bpt/guile.git] / libguile / script.c
index ef57ff5..b024378 100644 (file)
@@ -1,94 +1,68 @@
-/* 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.
+/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
  *
- * 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.
+ * This library 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
+ * Lesser General Public License for more details.
  *
- * 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.  
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 /* "script.c" argv tricks for `#!' scripts.
-   Author: Aubrey Jaffer */
+   Authors: Aubrey Jaffer and Jim Blandy */
+
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
 
 #include <stdio.h>
+#include <errno.h>
 #include <ctype.h>
-#include "_scm.h"
-#include "gh.h"
-#include "load.h"
 
-#include "script.h"
+#include "libguile/_scm.h"
+#include "libguile/gh.h"
+#include "libguile/load.h"
+#include "libguile/version.h"
 
-#ifdef __IBMC__
-#include <io.h>
-#endif /* def __IBMC__ */
+#include "libguile/validate.h"
+#include "libguile/script.h"
 
-#ifdef linux
-#include <unistd.h>            /* for X_OK define */
-#endif /* def linux */
-#ifdef __svr4__
-#include <unistd.h>            /* for X_OK define */
-#else
-#ifdef __sgi__
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
 #include <unistd.h>            /* for X_OK define */
-#endif /* def __sgi__ */
-#endif /* def __svr4__ */
-#ifdef hpux
-#define const
-/**/
+#endif
+
+#ifdef HAVE_IO_H
+#include <io.h>
 #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;
+scm_cat_path (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));
+      size_t len = strlen (str1);
+      str1 = (char *) realloc (str1, (size_t) (len + n + 1));
       if (!str1)
        return 0L;
       strncat (str1 + len, str2, n);
       return str1;
     }
-  str1 = (char *) malloc ((scm_sizet) (n + 1));
+  str1 = (char *) scm_malloc ((size_t) (n + 1));
   if (!str1)
     return 0L;
   str1[0] = 0;
@@ -98,8 +72,7 @@ scm_cat_path (str1, str2, n)
 
 #if 0 
 static char *
-scm_try_path (path)
-     char *path;
+scm_try_path (char *path)
 {
   FILE *f;
   /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
@@ -117,9 +90,7 @@ scm_try_path (path)
 }
 
 static char *
-scm_sep_init_try (path, sep, initname)
-     char *path;
-     const char *sep, *initname;
+scm_sep_init_try (char *path, const char *sep, const char *initname)
 {
   if (path)
     path = scm_cat_path (path, sep, 0L);
@@ -145,15 +116,11 @@ scm_sep_init_try (path, sep, initname)
 #define X_OK 1
 #endif /* ndef X_OK */
 
-#ifdef unix
-#include <stdio.h>
-
 char *
-scm_find_executable (name)
-     const char *name;
+scm_find_executable (const char *name)
 {
   char tbuf[MAXPATHLEN];
-  int i = 0;
+  int i = 0, c;
   FILE *f;
 
   /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
@@ -165,180 +132,30 @@ scm_find_executable (name)
   if ((fgetc (f) == '#') && (fgetc (f) == '!'))
     {
       while (1)
-       switch (tbuf[i++] = fgetc (f))
+       switch (c = fgetc (f))
          {
          case /*WHITE_SPACES */ ' ':
          case '\t':
          case '\r':
          case '\f':
          case EOF:
-           tbuf[--i] = 0;
+           tbuf[i] = 0;
            fclose (f);
            return scm_cat_path (0L, tbuf, 0L);
+         default:
+           tbuf[i++] = c;
+           break;
          }
     }
   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;
+script_get_octal (FILE *f)
+#define FUNC_NAME "script_get_octal"
 {
   int i;
   int value = 0;
@@ -349,17 +166,17 @@ script_get_octal (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");
+       SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
+                       SCM_EOL);
     }
   return value;
 }
+#undef FUNC_NAME
 
 
 static int
-script_get_backslash (f)
-     FILE *f;
+script_get_backslash (FILE *f)
+#define FUNC_NAME "script_get_backslash"
 {
   int c = getc (f);
 
@@ -383,29 +200,26 @@ script_get_backslash (f)
     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");
+      SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
       return 0; /* not reached? */
 
     default:
-      scm_wta (SCM_UNDEFINED,
-              "malformed script: bad backslash sequence",
-              "script argument parser");
+      SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
       return 0; /* not reached? */
     }
 }
+#undef FUNC_NAME
 
 
 static char *
-script_read_arg (f)
-     FILE *f;
+script_read_arg (FILE *f)
+#define FUNC_NAME "script_read_arg"
 {
-  int size = 7;
-  char *buf = malloc (size + 1);
-  int len = 0;
+  size_t size = 7;
+  char *buf = scm_malloc (size + 1);
+  size_t len = 0;
 
   if (! buf)
     return 0;
@@ -448,18 +262,16 @@ script_read_arg (f)
 
        case '\t':
          free (buf);
-         scm_wta (SCM_UNDEFINED,
-                  "malformed script: TAB in meta-arguments",
-                  "argument parser");
+         SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
          return 0; /* not reached? */
        }
     }
 }
+#undef FUNC_NAME
 
 
 static int
-script_meta_arg_P (arg)
-     char *arg;
+script_meta_arg_P (char *arg)
 {
   if ('\\' != arg[0])
     return 0L;
@@ -479,15 +291,13 @@ script_meta_arg_P (arg)
 }
 
 char **
-scm_get_meta_args (argc, argv)
-     int argc;
-     char **argv;
+scm_get_meta_args (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 *))))
+  if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
       return 0L;
   nargv[0] = argv[0];
   while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
@@ -523,8 +333,7 @@ scm_get_meta_args (argc, argv)
 }
 
 int
-scm_count_argv (argv)
-     char **argv;
+scm_count_argv (char **argv)
 {
   int argc = 0;
   while (argv[argc])
@@ -539,31 +348,46 @@ char *scm_usage_name = 0;
 void
 scm_shell_usage (int fatal, char *message)
 {
+  FILE  *fp = (fatal ? stderr : stdout);
+
   if (message)
-    fprintf (stderr, "%s\n", message);
+    fprintf (fp, "%s\n", message);
 
-  fprintf (stderr
+  fprintf (fp
            "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"
+           "  [-s] FILE      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"
+           "If FILE begins with `-' the -s switch is mandatory.\n"
            "\n"
+           "  -L DIRECTORY   add DIRECTORY to the front of the module load path\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"
+           "  --debug        start with debugging evaluator and backtraces\n"
+           "  --no-debug     start with normal evaluator\n"
+           "                 Default is to enable debugging for interactive\n"
+           "                 use, but not for `-s' and `-c'.\n"
+          "  -q             inhibit loading of user init file\n"
            "  --emacs        enable Emacs protocol (experimental)\n"
+          "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
+          "                 which is a list of numbers like \"2,13,14\"\n"
            "  -h, --help     display this help and exit\n"
            "  -v, --version  display version information and exit\n"
-          "  \\              read arguments from following script lines\n",
+          "  \\              read arguments from following script lines\n"
+           "\n"
+          "Please report bugs to bug-guile@gnu.org.  (Note that you must\n"
+          "be subscribed to this list first, in order to successfully send\n"
+          "a report to it).\n",
            scm_usage_name);
 
   if (fatal)
-    exit (1);
+    exit (fatal);
 }
 
 
@@ -572,15 +396,17 @@ 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_turn_on_debugging, "turn-on-debugging");
 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 SCM_SYMBOL (sym_top_repl, "top-repl");
 SCM_SYMBOL (sym_quit, "quit");
-
-
-/* The boot code "ice-9/boot-9" is only loaded by
-   SCM_COMPILE_SHELL_SWITCHES when this is false. */
-
-int scm_ice_9_already_loaded = 0;
+SCM_SYMBOL (sym_use_srfis, "use-srfis");
+SCM_SYMBOL (sym_load_path, "%load-path");
+SCM_SYMBOL (sym_set_x, "set!");
+SCM_SYMBOL (sym_cons, "cons");
+SCM_SYMBOL (sym_at, "@");
+SCM_SYMBOL (sym_atat, "@@");
+SCM_SYMBOL (sym_main, "main");
 
 /* Given an array of command-line switches, return a Scheme expression
    to carry out the actions specified by the switches.
@@ -589,16 +415,21 @@ int scm_ice_9_already_loaded = 0;
    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. */
+static char guile[] = "guile";
+
+static int
+all_symbols (SCM list)
+{
+  while (scm_is_pair (list))
+    {
+      if (!scm_is_symbol (SCM_CAR (list)))
+       return 0;
+      list = SCM_CDR (list);
+    }
+  return 1;
+}
 
 SCM
 scm_compile_shell_switches (int argc, char **argv)
@@ -610,13 +441,19 @@ scm_compile_shell_switches (int argc, char **argv)
                                   the "load" command, in case we get
                                   the "-ds" switch.  */
   SCM entry_point = SCM_EOL;   /* for -e switch */
+  SCM user_load_path = SCM_EOL; /* for -L switch */
   int interactive = 1;         /* Should we go interactive when done? */
+  int inhibit_user_init = 0;   /* Don't load user init file */
   int use_emacs_interface = 0;
+  int turn_on_debugging = 0;
+  int dont_turn_on_debugging = 0;
+
   int i;
-  char *argv0;
+  char *argv0 = guile;
 
   if (argc > 0)
     {
+      argv0 = argv[0];
       scm_usage_name = strrchr (argv[0], '/');
       if (! scm_usage_name)
        scm_usage_name = argv[0];
@@ -624,28 +461,27 @@ scm_compile_shell_switches (int argc, char **argv)
        scm_usage_name++;
     }
   if (! scm_usage_name)
-    scm_usage_name = "guile";
-  argv0 = scm_usage_name;
+    scm_usage_name = guile;
   
   for (i = 1; i < argc; i++)
     {
-      if (! strcmp (argv[i], "-s")) /* load script */
+      if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
        {
-         if (++i >= argc)
+         if ((argv[i][0] == '-') && (++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)
+         if (!scm_is_null (do_script))
            {
-             SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
+             SCM_SETCAR (do_script, scm_from_locale_string (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_from_locale_string (argv[i]),
                                        SCM_EOL),
                               tail);
          argv0 = argv[i];
@@ -659,7 +495,7 @@ scm_compile_shell_switches (int argc, char **argv)
          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_from_locale_string (argv[i]),
                                      SCM_EOL),
                           tail);
          i++;
@@ -677,17 +513,49 @@ scm_compile_shell_switches (int argc, char **argv)
        {
          if (++i < argc)
            tail = scm_cons (scm_cons2 (sym_load,
-                                       scm_makfrom0str (argv[i]),
+                                       scm_from_locale_string (argv[i]),
                                        SCM_EOL),
                             tail);
          else
            scm_shell_usage (1, "missing argument to `-l' switch");
        }         
 
+      else if (! strcmp (argv[i], "-L")) /* add to %load-path */
+       {
+         if (++i < argc)
+           user_load_path =
+             scm_cons (scm_list_3 (sym_set_x, 
+                                   sym_load_path, 
+                                   scm_list_3 (sym_cons,
+                                               scm_from_locale_string (argv[i]),
+                                               sym_load_path)),
+                       user_load_path);
+         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]);
+           {
+             SCM port 
+               = scm_open_input_string (scm_from_locale_string (argv[i]));
+             SCM arg1 = scm_read (port);
+             SCM arg2 = scm_read (port);
+
+             /* Recognize syntax of certain versions of Guile 1.4 and
+                transform to (@ MODULE-NAME FUNC).
+              */
+             if (scm_is_false (scm_eof_object_p (arg2)))
+               entry_point = scm_list_3 (sym_at, arg1, arg2);
+             else if (scm_is_pair (arg1)
+                      && !(scm_is_eq (SCM_CAR (arg1), sym_at)
+                           || scm_is_eq (SCM_CAR (arg1), sym_atat))
+                      && all_symbols (arg1))
+               entry_point = scm_list_3 (sym_at, arg1, sym_main);
+             else
+               entry_point = arg1;
+           }
          else
            scm_shell_usage (1, "missing argument to `-e' switch");
        }
@@ -696,16 +564,65 @@ scm_compile_shell_switches (int argc, char **argv)
        {
          /* We put a dummy "load" expression, and let the -s put the
              filename in.  */
-         if (do_script != SCM_EOL)
+         if (!scm_is_null (do_script))
            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], "--debug"))
+       {
+         turn_on_debugging = 1;
+         dont_turn_on_debugging = 0;
+       }
+
+      else if (! strcmp (argv[i], "--no-debug"))
+       {
+         dont_turn_on_debugging = 1;
+         turn_on_debugging = 0;
+       }
+
       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */ 
        use_emacs_interface = 1;
 
+      else if (! strcmp (argv[i], "-q")) /* don't load user init */ 
+       inhibit_user_init = 1;
+
+      else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */ 
+       {
+         SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
+         char * p = argv[i] + 11;
+         while (*p)
+           {
+             long num;
+             char * end;
+
+             num = strtol (p, &end, 10);
+             if (end - p > 0)
+               {
+                 srfis = scm_cons (scm_from_long (num), srfis);
+                 if (*end)
+                   {
+                     if (*end == ',')
+                       p = end + 1;
+                     else
+                       scm_shell_usage (1, "invalid SRFI specification");
+                   }
+                 else
+                   break;
+               }
+             else
+               scm_shell_usage (1, "invalid SRFI specification");
+           }
+         if (scm_ilength (srfis) <= 0)
+           scm_shell_usage (1, "invalid SRFI specification");
+         srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
+         tail = scm_cons (scm_list_2 (sym_use_srfis,
+                                      scm_list_2 (scm_sym_quote, srfis)),
+                          tail);
+       }
+
       else if (! strcmp (argv[i], "-h")
               || ! strcmp (argv[i], "--help"))
        {
@@ -718,12 +635,12 @@ scm_compile_shell_switches (int argc, char **argv)
        {
          /* Print version number.  */
          printf ("Guile %s\n"
-                 "Copyright (c) 1995, 1996 Free Software Foundation\n"
+                 "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 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);
+                 scm_to_locale_string (scm_version ()));
          exit (0);
        }
 
@@ -736,29 +653,26 @@ scm_compile_shell_switches (int argc, char **argv)
     }
 
   /* Check to make sure the -ds got a -s. */
-  if (do_script != SCM_EOL)
+  if (!scm_is_null (do_script))
     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);
+  scm_set_program_arguments (argc ? argc - i : 0, 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);
+  scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface));
 
   /* Handle the `-e' switch, if it was specified.  */
-  if (entry_point != SCM_EOL)
+  if (!scm_is_null (entry_point))
     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 we didn't end with a -c or a -s, 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);
     }
   else
@@ -766,25 +680,35 @@ scm_compile_shell_switches (int argc, char **argv)
       /* After doing all the other actions prescribed by the command line,
         quit.  */
       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
-                  tail);
+                      tail);
+    }
+
+  /* After the following line, actions will be added to the front. */
+  tail = scm_reverse_x (tail, SCM_UNDEFINED);
+
+  /* add the user-specified load path here, so it won't be in effect
+     during the loading of the user's customization file. */
+  if(!scm_is_null(user_load_path)) 
+    {
+      tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
+    }
+  
+  /* If we didn't end with a -c or a -s and didn't supply a -q, load
+     the user's customization file.  */
+  if (interactive && !inhibit_user_init)
+    {
+      tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
+    }
+
+  /* If debugging was requested, or we are interactive and debugging
+     was not explicitly turned off, turn on debugging. */
+  if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
+    {
+      tail = scm_cons (scm_cons (sym_turn_on_debugging, 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.  */
-    if (!scm_ice_9_already_loaded)
-      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 val = scm_cons (sym_begin, tail);
 
 #if 0
     scm_write (val, SCM_UNDEFINED);
@@ -797,9 +721,7 @@ scm_compile_shell_switches (int argc, char **argv)
 
 
 void
-scm_shell (argc, argv)
-     int argc;
-     char **argv;
+scm_shell (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
@@ -814,12 +736,19 @@ scm_shell (argc, argv)
       }
   }
 
-  exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc,argv))));
+  exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
+                                    scm_current_module ())));
 }
 
 
 void
 scm_init_script ()
 {
-#include "script.x"
+#include "libguile/script.x"
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/