* Eliminate some calls to scm_wta.
[bpt/guile.git] / libguile / script.c
index 786dc5a..5e56c03 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000 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)
 /* "script.c" argv tricks for `#!' scripts.
    Authors: Aubrey Jaffer and Jim Blandy */
 
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
 #include <stdio.h>
 #include <ctype.h>
-#include "_scm.h"
-#include "gh.h"
-#include "load.h"
-#include "version.h"
+#include "libguile/_scm.h"
+#include "libguile/gh.h"
+#include "libguile/load.h"
+#include "libguile/version.h"
+
+#include "libguile/validate.h"
+#include "libguile/script.h"
 
-#include "script.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>            /* for X_OK define */
    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);
@@ -84,8 +89,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); */
@@ -103,9 +107,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);
@@ -131,7 +133,6 @@ scm_sep_init_try (path, sep, initname)
 #define X_OK 1
 #endif /* ndef X_OK */
 
-#ifdef unix
 char *
 scm_find_executable (const char *name)
 {
@@ -163,29 +164,12 @@ scm_find_executable (const char *name)
   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 */
 
 
 /* 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;
@@ -196,17 +180,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);
 
@@ -230,25 +214,22 @@ 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);
@@ -295,18 +276,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;
@@ -326,9 +305,7 @@ 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;
@@ -370,8 +347,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])
@@ -403,6 +379,8 @@ scm_shell_usage (int fatal, char *message)
            "  -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"
+          "  -q             inhibit loading of user init file\n"
            "  --emacs        enable Emacs protocol (experimental)\n"
            "  -h, --help     display this help and exit\n"
            "  -v, --version  display version information and exit\n"
@@ -424,12 +402,6 @@ 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.  The unexec code
-   uses this, to keep ice_9 from being loaded into dumped guile
-   executables.  */
-int scm_ice_9_already_loaded = 0;
-
 /* Given an array of command-line switches, return a Scheme expression
    to carry out the actions specified by the switches.
 
@@ -461,6 +433,7 @@ scm_compile_shell_switches (int argc, char **argv)
                                   the "-ds" switch.  */
   SCM entry_point = SCM_EOL;   /* for -e 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 i;
   char *argv0 = guile;
@@ -487,7 +460,7 @@ scm_compile_shell_switches (int argc, char **argv)
          /* 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_NULLP (do_script))
            {
              SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
              do_script = SCM_EOL;
@@ -546,16 +519,27 @@ 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_NULLP (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")) /* debug eval + backtraces */
+       {
+         SCM_DEVAL_P = 1;
+         SCM_BACKTRACE_P = 1;
+         SCM_RECORD_POSITIONS_P = 1;
+         SCM_RESET_DEBUG_MODE;
+       }
+
       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 (! strcmp (argv[i], "-h")
               || ! strcmp (argv[i], "--help"))
        {
@@ -568,12 +552,12 @@ scm_compile_shell_switches (int argc, char **argv)
        {
          /* Print version number.  */
          printf ("Guile %s\n"
-                 "Copyright (c) 1995, 1996, 1997 Free Software Foundation\n"
+                 "Copyright (c) 1995, 1996, 1997, 2000 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",
-                 SCM_CHARS (scm_version ()));
+                 SCM_STRING_CHARS (scm_version ()));
          exit (0);
        }
 
@@ -586,7 +570,7 @@ scm_compile_shell_switches (int argc, char **argv)
     }
 
   /* Check to make sure the -ds got a -s. */
-  if (do_script != SCM_EOL)
+  if (!SCM_NULLP (do_script))
     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 
   /* Make any remaining arguments available to the
@@ -594,21 +578,18 @@ scm_compile_shell_switches (int argc, char **argv)
   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_sysintern ("use-emacs-interface", SCM_BOOL (use_emacs_interface));
 
   /* Handle the `-e' switch, if it was specified.  */
-  if (entry_point != SCM_EOL)
+  if (!SCM_NULLP (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
@@ -616,27 +597,23 @@ 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);
       /* Allow asyncs (signal handlers etc.) to be run.  */
       scm_mask_ints = 0;
     }
-  {
-    /* We want a path only containing directories from GUILE_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);
-  }
+
+  /* After the following line, actions will be added to the front. */
+  tail = scm_reverse_x (tail, SCM_UNDEFINED);
+  
+  /* 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);
+    }
 
   {
-    SCM val = scm_cons (sym_begin, scm_reverse_x (tail, SCM_UNDEFINED));
+    SCM val = scm_cons (sym_begin, tail);
 
 #if 0
     scm_write (val, SCM_UNDEFINED);
@@ -649,9 +626,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
@@ -666,12 +641,21 @@ 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_the_root_module ())));
 }
 
 
 void
 scm_init_script ()
 {
-#include "script.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/script.x"
+#endif
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/