libguile/script.c

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