libguile/script.c

   1 /* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   2  * This library is free software; you can redistribute it and/or
   3  * modify it under the terms of the GNU Lesser General Public License
   4  * as published by the Free Software Foundation; either version 3 of
   5  * the License, or (at your option) any later version.
   6  *
   7  * This library is distributed in the hope that it will be useful, but
   8  * WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  10  * Lesser General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU Lesser General Public
  13  * License along with this library; if not, write to the Free Software
  14  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  15  * 02110-1301 USA
  16  */
  17
  18 /* "script.c" argv tricks for `#!' scripts.
  19    Authors: Aubrey Jaffer and Jim Blandy */
  20
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <stdlib.h>
  26 #include <stdio.h>
  27 #include <errno.h>
  28 #include <ctype.h>
  29
  30 #include <version-etc.h>
  31
  32 #include "libguile/_scm.h"
  33 #include "libguile/eval.h"
  34 #include "libguile/feature.h"
  35 #include "libguile/load.h"
  36 #include "libguile/private-gc.h" /* scm_getenv_int */
  37 #include "libguile/read.h"
  38 #include "libguile/script.h"
  39 #include "libguile/strings.h"
  40 #include "libguile/strports.h"
  41 #include "libguile/validate.h"
  42 #include "libguile/version.h"
  43 #include "libguile/vm.h"
  44
  45 #ifdef HAVE_STRING_H
  46 #include <string.h>
  47 #endif
  48
  49 #ifdef HAVE_UNISTD_H
  50 #include <unistd.h>             /* for X_OK define */
  51 #endif
  52
  53 #ifdef HAVE_IO_H
  54 #include <io.h>
  55 #endif
  56
  57 /* Concatentate str2 onto str1 at position n and return concatenated
  58    string if file exists; 0 otherwise. */
  59
  60 static char *
  61 scm_cat_path (char *str1, const char *str2, long n)
  62 {
  63   if (!n)
  64     n = strlen (str2);
  65   if (str1)
  66     {
  67       size_t len = strlen (str1);
  68       str1 = (char *) realloc (str1, (size_t) (len + n + 1));
  69       if (!str1)
  70         return 0L;
  71       strncat (str1 + len, str2, n);
  72       return str1;
  73     }
  74   str1 = (char *) scm_malloc ((size_t) (n + 1));
  75   if (!str1)
  76     return 0L;
  77   str1[0] = 0;
  78   strncat (str1, str2, n);
  79   return str1;
  80 }
  81
  82 #if 0
  83 static char *
  84 scm_try_path (char *path)
  85 {
  86   FILE *f;
  87   /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
  88   if (!path)
  89     return 0L;
  90   SCM_SYSCALL (f = fopen (path, "r");
  91     );
  92   if (f)
  93     {
  94       fclose (f);
  95       return path;
  96     }
  97   free (path);
  98   return 0L;
  99 }
 100
 101 static char *
 102 scm_sep_init_try (char *path, const char *sep, const char *initname)
 103 {
 104   if (path)
 105     path = scm_cat_path (path, sep, 0L);
 106   if (path)
 107     path = scm_cat_path (path, initname, 0L);
 108   return scm_try_path (path);
 109 }
 110 #endif
 111
 112 #ifndef LINE_INCREMENTORS
 113 #define LINE_INCREMENTORS  '\n'
 114 #ifdef MSDOS
 115 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
 116 #else
 117 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f'
 118 #endif /* def MSDOS */
 119 #endif /* ndef LINE_INCREMENTORS */
 120
 121 #ifndef MAXPATHLEN
 122 #define MAXPATHLEN 80
 123 #endif /* ndef MAXPATHLEN */
 124 #ifndef X_OK
 125 #define X_OK 1
 126 #endif /* ndef X_OK */
 127
 128 char *
 129 scm_find_executable (const char *name)
 130 {
 131   char tbuf[MAXPATHLEN];
 132   int i = 0, c;
 133   FILE *f;
 134
 135   /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
 136   if (access (name, X_OK))
 137     return 0L;
 138   f = fopen (name, "r");
 139   if (!f)
 140     return 0L;
 141   if ((fgetc (f) == '#') && (fgetc (f) == '!'))
 142     {
 143       while (1)
 144         switch (c = fgetc (f))
 145           {
 146           case /*WHITE_SPACES */ ' ':
 147           case '\t':
 148           case '\r':
 149           case '\f':
 150           case EOF:
 151             tbuf[i] = 0;
 152             fclose (f);
 153             return scm_cat_path (0L, tbuf, 0L);
 154           default:
 155             tbuf[i++] = c;
 156             break;
 157           }
 158     }
 159   fclose (f);
 160   return scm_cat_path (0L, name, 0L);
 161 }
 162
 163
 164 /* Read a \nnn-style escape.  We've just read the backslash.  */
 165 static int
 166 script_get_octal (FILE *f)
 167 #define FUNC_NAME "script_get_octal"
 168 {
 169   int i;
 170   int value = 0;
 171
 172   for (i = 0; i < 3; i++)
 173     {
 174       int c = getc (f);
 175       if ('0' <= c && c <= '7')
 176         value = (value * 8) + (c - '0');
 177       else
 178         SCM_MISC_ERROR ("malformed script: bad octal backslash escape",
 179                         SCM_EOL);
 180     }
 181   return value;
 182 }
 183 #undef FUNC_NAME
 184
 185
 186 static int
 187 script_get_backslash (FILE *f)
 188 #define FUNC_NAME "script_get_backslash"
 189 {
 190   int c = getc (f);
 191
 192   switch (c)
 193     {
 194     case 'a': return '\a';
 195     case 'b': return '\b';
 196     case 'f': return '\f';
 197     case 'n': return '\n';
 198     case 'r': return '\r';
 199     case 't': return '\t';
 200     case 'v': return '\v';
 201
 202     case '\\':
 203     case ' ':
 204     case '\t':
 205     case '\n':
 206       return c;
 207
 208     case '0': case '1': case '2': case '3':
 209     case '4': case '5': case '6': case '7':
 210       ungetc (c, f);
 211       return script_get_octal (f);
 212
 213     case EOF:
 214       SCM_MISC_ERROR ("malformed script: backslash followed by EOF", SCM_EOL);
 215       return 0; /* not reached? */
 216
 217     default:
 218       SCM_MISC_ERROR ("malformed script: bad backslash sequence", SCM_EOL);
 219       return 0; /* not reached? */
 220     }
 221 }
 222 #undef FUNC_NAME
 223
 224
 225 static char *
 226 script_read_arg (FILE *f)
 227 #define FUNC_NAME "script_read_arg"
 228 {
 229   size_t size = 7;
 230   char *buf = scm_malloc (size + 1);
 231   size_t len = 0;
 232
 233   if (! buf)
 234     return 0;
 235
 236   for (;;)
 237     {
 238       int c = getc (f);
 239       switch (c)
 240         {
 241         case '\\':
 242           c = script_get_backslash (f);
 243           /* The above produces a new character to add to the argument.
 244              Fall through.  */
 245         default:
 246           if (len >= size)
 247             {
 248               size = (size + 1) * 2;
 249               buf = realloc (buf, size);
 250               if (! buf)
 251                 return 0;
 252             }
 253           buf[len++] = c;
 254           break;
 255
 256         case '\n':
 257           /* This may terminate an arg now, but it will terminate the
 258              entire list next time through.  */
 259           ungetc ('\n', f);
 260         case EOF:
 261           if (len == 0)
 262             {
 263               free (buf);
 264               return 0;
 265             }
 266           /* Otherwise, those characters terminate the argument; fall
 267              through.  */
 268         case ' ':
 269           buf[len] = '\0';
 270           return buf;
 271
 272         case '\t':
 273           free (buf);
 274           SCM_MISC_ERROR ("malformed script: TAB in meta-arguments", SCM_EOL);
 275           return 0; /* not reached? */
 276         }
 277     }
 278 }
 279 #undef FUNC_NAME
 280
 281
 282 static int
 283 script_meta_arg_P (char *arg)
 284 {
 285   if ('\\' != arg[0])
 286     return 0L;
 287 #ifdef MSDOS
 288   return !arg[1];
 289 #else
 290   switch (arg[1])
 291     {
 292     case 0:
 293     case '%':
 294     case WHITE_SPACES:
 295       return !0;
 296     default:
 297       return 0L;
 298     }
 299 #endif
 300 }
 301
 302 char **
 303 scm_get_meta_args (int argc, char **argv)
 304 {
 305   int nargc = argc, argi = 1, nargi = 1;
 306   char *narg, **nargv;
 307   if (!(argc > 2 && script_meta_arg_P (argv[1])))
 308     return 0L;
 309   if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
 310       return 0L;
 311   nargv[0] = argv[0];
 312   while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
 313     {
 314       FILE *f = fopen (argv[++argi], "r");
 315       if (f)
 316         {
 317           nargc--;              /* to compensate for replacement of '\\' */
 318           while (1)
 319             switch (getc (f))
 320               {
 321               case EOF:
 322                 return 0L;
 323               default:
 324                 continue;
 325               case '\n':
 326                 goto found_args;
 327               }
 328         found_args:
 329           while ((narg = script_read_arg (f)))
 330             if (!(nargv = (char **) realloc (nargv,
 331                                              (1 + ++nargc) * sizeof (char *))))
 332                 return 0L;
 333             else
 334               nargv[nargi++] = narg;
 335           fclose (f);
 336           nargv[nargi++] = argv[argi++];
 337         }
 338     }
 339   while (argi <= argc)
 340     nargv[nargi++] = argv[argi++];
 341   return nargv;
 342 }
 343
 344 int
 345 scm_count_argv (char **argv)
 346 {
 347   int argc = 0;
 348   while (argv[argc])
 349     argc++;
 350   return argc;
 351 }
 352
 353
 354 /* For use in error messages.  */
 355 char *scm_usage_name = 0;
 356
 357 void
 358 scm_shell_usage (int fatal, char *message)
 359 {
 360   FILE  *fp = (fatal ? stderr : stdout);
 361
 362   if (message)
 363     fprintf (fp, "%s\n", message);
 364
 365   fprintf (fp,
 366            "Usage: %s [OPTION]... [FILE]...\n"
 367            "Evaluate Scheme code, interactively or from a script.\n"
 368            "\n"
 369            "  [-s] FILE      load Scheme source code from FILE, and exit\n"
 370            "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
 371            "  --             stop scanning arguments; run interactively\n\n"
 372            "The above switches stop argument processing, and pass all\n"
 373            "remaining arguments as the value of (command-line).\n"
 374            "If FILE begins with `-' the -s switch is mandatory.\n"
 375            "\n"
 376            "  -L DIRECTORY   add DIRECTORY to the front of the module load path\n"
 377            "  -l FILE        load Scheme source code from FILE\n"
 378            "  -e FUNCTION    after reading script, apply FUNCTION to\n"
 379            "                 command line arguments\n"
 380            "  -ds            do -s script at this point\n"
 381            "  --debug        start with debugging evaluator and backtraces\n"
 382            "  --no-debug     start with normal evaluator\n"
 383            "                 Default is to enable debugging for interactive\n"
 384            "                 use, but not for `-s' and `-c'.\n"
 385            "  --autocompile  compile source files automatically\n"
 386            "  --no-autocompile  disable automatic source file compilation\n"
 387            "                 Default is to enable autocompilation of source\n"
 388            "                 files.\n"
 389            "  -q             inhibit loading of user init file\n"
 390            "  --use-srfi=LS  load SRFI modules for the SRFIs in LS,\n"
 391            "                 which is a list of numbers like \"2,13,14\"\n"
 392            "  -h, --help     display this help and exit\n"
 393            "  -v, --version  display version information and exit\n"
 394            "  \\              read arguments from following script lines\n",
 395            scm_usage_name);
 396
 397   emit_bug_reporting_address ();
 398
 399   if (fatal)
 400     exit (fatal);
 401 }
 402
 403
 404 /* Some symbols used by the command-line compiler.  */
 405 SCM_SYMBOL (sym_load, "load");
 406 SCM_SYMBOL (sym_eval_string, "eval-string");
 407 SCM_SYMBOL (sym_command_line, "command-line");
 408 SCM_SYMBOL (sym_begin, "begin");
 409 SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
 410 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 411 SCM_SYMBOL (sym_ice_9, "ice-9");
 412 SCM_SYMBOL (sym_top_repl, "top-repl");
 413 SCM_SYMBOL (sym_quit, "quit");
 414 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 415 SCM_SYMBOL (sym_load_path, "%load-path");
 416 SCM_SYMBOL (sym_set_x, "set!");
 417 SCM_SYMBOL (sym_sys_load_should_autocompile, "%load-should-autocompile");
 418 SCM_SYMBOL (sym_cons, "cons");
 419 SCM_SYMBOL (sym_at, "@");
 420 SCM_SYMBOL (sym_atat, "@@");
 421 SCM_SYMBOL (sym_main, "main");
 422
 423 /* Given an array of command-line switches, return a Scheme expression
 424    to carry out the actions specified by the switches.
 425
 426    If you told me this should have been written in Scheme, I'd
 427    probably agree.  I'd say I didn't feel comfortable doing that in
 428    the present system.  You'd say, well, fix the system so you are
 429    comfortable doing that.  I'd agree again.  *shrug*
 430  */
 431
 432 static char guile[] = "guile";
 433
 434 static int
 435 all_symbols (SCM list)
 436 {
 437   while (scm_is_pair (list))
 438     {
 439       if (!scm_is_symbol (SCM_CAR (list)))
 440         return 0;
 441       list = SCM_CDR (list);
 442     }
 443   return 1;
 444 }
 445
 446 SCM
 447 scm_compile_shell_switches (int argc, char **argv)
 448 {
 449   SCM tail = SCM_EOL;           /* We accumulate the list backwards,
 450                                    and then reverse! it before we
 451                                    return it.  */
 452   SCM do_script = SCM_EOL;      /* The element of the list containing
 453                                    the "load" command, in case we get
 454                                    the "-ds" switch.  */
 455   SCM entry_point = SCM_EOL;    /* for -e switch */
 456   SCM user_load_path = SCM_EOL; /* for -L switch */
 457   int interactive = 1;          /* Should we go interactive when done? */
 458   int inhibit_user_init = 0;    /* Don't load user init file */
 459   int turn_on_debugging = 0;
 460   int dont_turn_on_debugging = 0;
 461
 462   int i;
 463   char *argv0 = guile;
 464
 465   if (argc > 0)
 466     {
 467       argv0 = argv[0];
 468       scm_usage_name = strrchr (argv[0], '/');
 469       if (! scm_usage_name)
 470         scm_usage_name = argv[0];
 471       else
 472         scm_usage_name++;
 473     }
 474   if (! scm_usage_name)
 475     scm_usage_name = guile;
 476
 477   for (i = 1; i < argc; i++)
 478     {
 479       if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
 480         {
 481           if ((argv[i][0] == '-') && (++i >= argc))
 482             scm_shell_usage (1, "missing argument to `-s' switch");
 483
 484           /* If we specified the -ds option, do_script points to the
 485              cdr of an expression like (load #f); we replace the car
 486              (i.e., the #f) with the script name.  */
 487           if (!scm_is_null (do_script))
 488             {
 489               SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
 490               do_script = SCM_EOL;
 491             }
 492           else
 493             /* Construct an application of LOAD to the script name.  */
 494             tail = scm_cons (scm_cons2 (sym_load,
 495                                         scm_from_locale_string (argv[i]),
 496                                         SCM_EOL),
 497                                tail);
 498           argv0 = argv[i];
 499           i++;
 500           interactive = 0;
 501           break;
 502         }
 503
 504       else if (! strcmp (argv[i], "-c")) /* evaluate expr */
 505         {
 506           if (++i >= argc)
 507             scm_shell_usage (1, "missing argument to `-c' switch");
 508           tail = scm_cons (scm_cons2 (sym_eval_string,
 509                                       scm_from_locale_string (argv[i]),
 510                                       SCM_EOL),
 511                            tail);
 512           i++;
 513           interactive = 0;
 514           break;
 515         }
 516
 517       else if (! strcmp (argv[i], "--")) /* end args; go interactive */
 518         {
 519           i++;
 520           break;
 521         }
 522
 523       else if (! strcmp (argv[i], "-l")) /* load a file */
 524         {
 525           if (++i < argc)
 526             tail = scm_cons (scm_cons2 (sym_load,
 527                                         scm_from_locale_string (argv[i]),
 528                                         SCM_EOL),
 529                              tail);
 530           else
 531             scm_shell_usage (1, "missing argument to `-l' switch");
 532         }
 533
 534       else if (! strcmp (argv[i], "-L")) /* add to %load-path */
 535         {
 536           if (++i < argc)
 537             user_load_path =
 538               scm_cons (scm_list_3 (sym_set_x,
 539                                     sym_load_path,
 540                                     scm_list_3 (sym_cons,
 541                                                 scm_from_locale_string (argv[i]),
 542                                                 sym_load_path)),
 543                         user_load_path);
 544           else
 545             scm_shell_usage (1, "missing argument to `-L' switch");
 546         }
 547
 548       else if (! strcmp (argv[i], "-e")) /* entry point */
 549         {
 550           if (++i < argc)
 551             {
 552               SCM port
 553                 = scm_open_input_string (scm_from_locale_string (argv[i]));
 554               SCM arg1 = scm_read (port);
 555               SCM arg2 = scm_read (port);
 556
 557               /* Recognize syntax of certain versions of Guile 1.4 and
 558                  transform to (@ MODULE-NAME FUNC).
 559                */
 560               if (scm_is_false (scm_eof_object_p (arg2)))
 561                 entry_point = scm_list_3 (sym_at, arg1, arg2);
 562               else if (scm_is_pair (arg1)
 563                        && !(scm_is_eq (SCM_CAR (arg1), sym_at)
 564                             || scm_is_eq (SCM_CAR (arg1), sym_atat))
 565                        && all_symbols (arg1))
 566                 entry_point = scm_list_3 (sym_at, arg1, sym_main);
 567               else
 568                 entry_point = arg1;
 569             }
 570           else
 571             scm_shell_usage (1, "missing argument to `-e' switch");
 572         }
 573
 574       else if (! strcmp (argv[i], "-ds")) /* do script here */
 575         {
 576           /* We put a dummy "load" expression, and let the -s put the
 577              filename in.  */
 578           if (!scm_is_null (do_script))
 579             scm_shell_usage (1, "the -ds switch may only be specified once");
 580           do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
 581           tail = scm_cons (scm_cons (sym_load, do_script),
 582                            tail);
 583         }
 584
 585       else if (! strcmp (argv[i], "--debug"))
 586         {
 587           turn_on_debugging = 1;
 588           dont_turn_on_debugging = 0;
 589         }
 590
 591       else if (! strcmp (argv[i], "--no-debug"))
 592         {
 593           dont_turn_on_debugging = 1;
 594           turn_on_debugging = 0;
 595         }
 596
 597       /* Do autocompile on/off now, because the form itself might need this
 598          decision. */
 599       else if (! strcmp (argv[i], "--autocompile"))
 600         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 601                             SCM_BOOL_T);
 602
 603       else if (! strcmp (argv[i], "--no-autocompile"))
 604         scm_variable_set_x (scm_c_lookup ("%load-should-autocompile"),
 605                             SCM_BOOL_F);
 606
 607       else if (! strcmp (argv[i], "-q")) /* don't load user init */
 608         inhibit_user_init = 1;
 609
 610       else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
 611         {
 612           SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
 613           char * p = argv[i] + 11;
 614           while (*p)
 615             {
 616               long num;
 617               char * end;
 618
 619               num = strtol (p, &end, 10);
 620               if (end - p > 0)
 621                 {
 622                   srfis = scm_cons (scm_from_long (num), srfis);
 623                   if (*end)
 624                     {
 625                       if (*end == ',')
 626                         p = end + 1;
 627                       else
 628                         scm_shell_usage (1, "invalid SRFI specification");
 629                     }
 630                   else
 631                     break;
 632                 }
 633               else
 634                 scm_shell_usage (1, "invalid SRFI specification");
 635             }
 636           if (scm_ilength (srfis) <= 0)
 637             scm_shell_usage (1, "invalid SRFI specification");
 638           srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
 639           tail = scm_cons (scm_list_2 (sym_use_srfis,
 640                                        scm_list_2 (scm_sym_quote, srfis)),
 641                            tail);
 642         }
 643
 644       else if (! strcmp (argv[i], "-h")
 645                || ! strcmp (argv[i], "--help"))
 646         {
 647           scm_shell_usage (0, 0);
 648           exit (EXIT_SUCCESS);
 649         }
 650
 651       else if (! strcmp (argv[i], "-v")
 652                || ! strcmp (argv[i], "--version"))
 653         {
 654           /* Print version number.  */
 655           version_etc (stdout, scm_usage_name, PACKAGE_NAME, PACKAGE_VERSION,
 656                        /* XXX: Use gettext for the string below.  */
 657                        "the Guile developers", NULL);
 658           exit (EXIT_SUCCESS);
 659         }
 660
 661       else
 662         {
 663           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 664                    scm_usage_name, argv[i]);
 665           scm_shell_usage (1, 0);
 666         }
 667     }
 668
 669   /* Check to make sure the -ds got a -s. */
 670   if (!scm_is_null (do_script))
 671     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 672
 673   /* Make any remaining arguments available to the
 674      script/command/whatever.  */
 675   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 676
 677   /* Handle the `-e' switch, if it was specified.  */
 678   if (!scm_is_null (entry_point))
 679     tail = scm_cons (scm_cons2 (entry_point,
 680                                 scm_cons (sym_command_line, SCM_EOL),
 681                                 SCM_EOL),
 682                        tail);
 683
 684   /* If we didn't end with a -c or a -s, start the repl.  */
 685   if (interactive)
 686     {
 687       tail = scm_cons (scm_list_1 (scm_list_3
 688                                    (sym_at,
 689                                     scm_list_2 (sym_ice_9, sym_top_repl),
 690                                     sym_top_repl)),
 691                        tail);
 692     }
 693   else
 694     {
 695       /* After doing all the other actions prescribed by the command line,
 696          quit.  */
 697       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 698                        tail);
 699     }
 700
 701   /* After the following line, actions will be added to the front. */
 702   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 703
 704   /* add the user-specified load path here, so it won't be in effect
 705      during the loading of the user's customization file. */
 706   if(!scm_is_null(user_load_path))
 707     {
 708       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 709     }
 710
 711   /* If we didn't end with a -c or a -s and didn't supply a -q, load
 712      the user's customization file.  */
 713   if (interactive && !inhibit_user_init)
 714     {
 715       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 716     }
 717
 718   /* If debugging was requested, or we are interactive and debugging
 719      was not explicitly turned off, turn on debugging. */
 720   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 721     {
 722       /* FIXME: backtraces and positions should always be on (?) */
 723       tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
 724       scm_c_set_default_vm_engine_x (SCM_VM_DEBUG_ENGINE);
 725       scm_c_set_vm_engine_x (scm_the_vm (), SCM_VM_DEBUG_ENGINE);
 726     }
 727
 728   {
 729     SCM val = scm_cons (sym_begin, tail);
 730
 731     /* Wrap the expression in a prompt. */
 732     val = scm_list_2 (scm_list_3 (scm_sym_at,
 733                                       scm_list_2 (scm_from_locale_symbol ("ice-9"),
 734                                                   scm_from_locale_symbol ("control")),
 735                                       scm_from_locale_symbol ("%")),
 736                       val);
 737
 738 #if 0
 739     scm_write (val, SCM_UNDEFINED);
 740     scm_newline (SCM_UNDEFINED);
 741 #endif
 742
 743     return val;
 744   }
 745 }
 746
 747
 748 void
 749 scm_shell (int argc, char **argv)
 750 {
 751   /* If present, add SCSH-style meta-arguments from the top of the
 752      script file to the argument vector.  See the SCSH manual: "The
 753      meta argument" for more details.  */
 754   {
 755     char **new_argv = scm_get_meta_args (argc, argv);
 756
 757     if (new_argv)
 758       {
 759         argv = new_argv;
 760         argc = scm_count_argv (new_argv);
 761       }
 762   }
 763
 764   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 765                                      scm_current_module ())));
 766 }
 767
 768
 769 void
 770 scm_init_script ()
 771 {
 772 #include "libguile/script.x"
 773 }
 774
 775 /*
 776   Local Variables:
 777   c-file-style: "gnu"
 778   End:
 779 */