guile18/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 #ifdef 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\n",
 385            scm_usage_name);
 386
 387   if (fatal)
 388     exit (fatal);
 389 }
 390
 391
 392 /* Some symbols used by the command-line compiler.  */
 393 SCM_SYMBOL (sym_load, "load");
 394 SCM_SYMBOL (sym_eval_string, "eval-string");
 395 SCM_SYMBOL (sym_command_line, "command-line");
 396 SCM_SYMBOL (sym_begin, "begin");
 397 SCM_SYMBOL (sym_turn_on_debugging, "turn-on-debugging");
 398 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 399 SCM_SYMBOL (sym_top_repl, "top-repl");
 400 SCM_SYMBOL (sym_quit, "quit");
 401 SCM_SYMBOL (sym_use_srfis, "use-srfis");
 402 SCM_SYMBOL (sym_load_path, "%load-path");
 403 SCM_SYMBOL (sym_set_x, "set!");
 404 SCM_SYMBOL (sym_cons, "cons");
 405 SCM_SYMBOL (sym_at, "@");
 406 SCM_SYMBOL (sym_atat, "@@");
 407 SCM_SYMBOL (sym_main, "main");
 408
 409 /* Given an array of command-line switches, return a Scheme expression
 410    to carry out the actions specified by the switches.
 411
 412    If you told me this should have been written in Scheme, I'd
 413    probably agree.  I'd say I didn't feel comfortable doing that in
 414    the present system.  You'd say, well, fix the system so you are
 415    comfortable doing that.  I'd agree again.  *shrug*
 416  */
 417
 418 static char guile[] = "guile";
 419
 420 static int
 421 all_symbols (SCM list)
 422 {
 423   while (scm_is_pair (list))
 424     {
 425       if (!scm_is_symbol (SCM_CAR (list)))
 426         return 0;
 427       list = SCM_CDR (list);
 428     }
 429   return 1;
 430 }
 431
 432 SCM
 433 scm_compile_shell_switches (int argc, char **argv)
 434 {
 435   SCM tail = SCM_EOL;           /* We accumulate the list backwards,
 436                                    and then reverse! it before we
 437                                    return it.  */
 438   SCM do_script = SCM_EOL;      /* The element of the list containing
 439                                    the "load" command, in case we get
 440                                    the "-ds" switch.  */
 441   SCM entry_point = SCM_EOL;    /* for -e switch */
 442   SCM user_load_path = SCM_EOL; /* for -L switch */
 443   int interactive = 1;          /* Should we go interactive when done? */
 444   int inhibit_user_init = 0;    /* Don't load user init file */
 445   int use_emacs_interface = 0;
 446   int turn_on_debugging = 0;
 447   int dont_turn_on_debugging = 0;
 448
 449   int i;
 450   char *argv0 = guile;
 451
 452   if (argc > 0)
 453     {
 454       argv0 = argv[0];
 455       scm_usage_name = strrchr (argv[0], '/');
 456       if (! scm_usage_name)
 457         scm_usage_name = argv[0];
 458       else
 459         scm_usage_name++;
 460     }
 461   if (! scm_usage_name)
 462     scm_usage_name = guile;
 463
 464   for (i = 1; i < argc; i++)
 465     {
 466       if ((! strcmp (argv[i], "-s")) || (argv[i][0] != '-')) /* load script */
 467         {
 468           if ((argv[i][0] == '-') && (++i >= argc))
 469             scm_shell_usage (1, "missing argument to `-s' switch");
 470
 471           /* If we specified the -ds option, do_script points to the
 472              cdr of an expression like (load #f); we replace the car
 473              (i.e., the #f) with the script name.  */
 474           if (!scm_is_null (do_script))
 475             {
 476               SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
 477               do_script = SCM_EOL;
 478             }
 479           else
 480             /* Construct an application of LOAD to the script name.  */
 481             tail = scm_cons (scm_cons2 (sym_load,
 482                                         scm_from_locale_string (argv[i]),
 483                                         SCM_EOL),
 484                                tail);
 485           argv0 = argv[i];
 486           i++;
 487           interactive = 0;
 488           break;
 489         }
 490
 491       else if (! strcmp (argv[i], "-c")) /* evaluate expr */
 492         {
 493           if (++i >= argc)
 494             scm_shell_usage (1, "missing argument to `-c' switch");
 495           tail = scm_cons (scm_cons2 (sym_eval_string,
 496                                       scm_from_locale_string (argv[i]),
 497                                       SCM_EOL),
 498                            tail);
 499           i++;
 500           interactive = 0;
 501           break;
 502         }
 503
 504       else if (! strcmp (argv[i], "--")) /* end args; go interactive */
 505         {
 506           i++;
 507           break;
 508         }
 509
 510       else if (! strcmp (argv[i], "-l")) /* load a file */
 511         {
 512           if (++i < argc)
 513             tail = scm_cons (scm_cons2 (sym_load,
 514                                         scm_from_locale_string (argv[i]),
 515                                         SCM_EOL),
 516                              tail);
 517           else
 518             scm_shell_usage (1, "missing argument to `-l' switch");
 519         }
 520
 521       else if (! strcmp (argv[i], "-L")) /* add to %load-path */
 522         {
 523           if (++i < argc)
 524             user_load_path =
 525               scm_cons (scm_list_3 (sym_set_x,
 526                                     sym_load_path,
 527                                     scm_list_3 (sym_cons,
 528                                                 scm_from_locale_string (argv[i]),
 529                                                 sym_load_path)),
 530                         user_load_path);
 531           else
 532             scm_shell_usage (1, "missing argument to `-L' switch");
 533         }
 534
 535       else if (! strcmp (argv[i], "-e")) /* entry point */
 536         {
 537           if (++i < argc)
 538             {
 539               SCM port
 540                 = scm_open_input_string (scm_from_locale_string (argv[i]));
 541               SCM arg1 = scm_read (port);
 542               SCM arg2 = scm_read (port);
 543
 544               /* Recognize syntax of certain versions of Guile 1.4 and
 545                  transform to (@ MODULE-NAME FUNC).
 546                */
 547               if (scm_is_false (scm_eof_object_p (arg2)))
 548                 entry_point = scm_list_3 (sym_at, arg1, arg2);
 549               else if (scm_is_pair (arg1)
 550                        && !(scm_is_eq (SCM_CAR (arg1), sym_at)
 551                             || scm_is_eq (SCM_CAR (arg1), sym_atat))
 552                        && all_symbols (arg1))
 553                 entry_point = scm_list_3 (sym_at, arg1, sym_main);
 554               else
 555                 entry_point = arg1;
 556             }
 557           else
 558             scm_shell_usage (1, "missing argument to `-e' switch");
 559         }
 560
 561       else if (! strcmp (argv[i], "-ds")) /* do script here */
 562         {
 563           /* We put a dummy "load" expression, and let the -s put the
 564              filename in.  */
 565           if (!scm_is_null (do_script))
 566             scm_shell_usage (1, "the -ds switch may only be specified once");
 567           do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
 568           tail = scm_cons (scm_cons (sym_load, do_script),
 569                            tail);
 570         }
 571
 572       else if (! strcmp (argv[i], "--debug"))
 573         {
 574           turn_on_debugging = 1;
 575           dont_turn_on_debugging = 0;
 576         }
 577
 578       else if (! strcmp (argv[i], "--no-debug"))
 579         {
 580           dont_turn_on_debugging = 1;
 581           turn_on_debugging = 0;
 582         }
 583
 584       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
 585         use_emacs_interface = 1;
 586
 587       else if (! strcmp (argv[i], "-q")) /* don't load user init */
 588         inhibit_user_init = 1;
 589
 590       else if (! strncmp (argv[i], "--use-srfi=", 11)) /* load SRFIs */
 591         {
 592           SCM srfis = SCM_EOL;  /* List of requested SRFIs.  */
 593           char * p = argv[i] + 11;
 594           while (*p)
 595             {
 596               long num;
 597               char * end;
 598
 599               num = strtol (p, &end, 10);
 600               if (end - p > 0)
 601                 {
 602                   srfis = scm_cons (scm_from_long (num), srfis);
 603                   if (*end)
 604                     {
 605                       if (*end == ',')
 606                         p = end + 1;
 607                       else
 608                         scm_shell_usage (1, "invalid SRFI specification");
 609                     }
 610                   else
 611                     break;
 612                 }
 613               else
 614                 scm_shell_usage (1, "invalid SRFI specification");
 615             }
 616           if (scm_ilength (srfis) <= 0)
 617             scm_shell_usage (1, "invalid SRFI specification");
 618           srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
 619           tail = scm_cons (scm_list_2 (sym_use_srfis,
 620                                        scm_list_2 (scm_sym_quote, srfis)),
 621                            tail);
 622         }
 623
 624       else if (! strcmp (argv[i], "-h")
 625                || ! strcmp (argv[i], "--help"))
 626         {
 627           scm_shell_usage (0, 0);
 628           exit (0);
 629         }
 630
 631       else if (! strcmp (argv[i], "-v")
 632                || ! strcmp (argv[i], "--version"))
 633         {
 634           /* Print version number.  */
 635           printf ("Guile %s\n"
 636                   "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation\n"
 637                   "Guile may be distributed under the terms of the GNU General Public Licence;\n"
 638                   "certain other uses are permitted as well.  For details, see the file\n"
 639                   "`COPYING', which is included in the Guile distribution.\n"
 640                   "There is no warranty, to the extent permitted by law.\n",
 641                   scm_to_locale_string (scm_version ()));
 642           exit (0);
 643         }
 644
 645       else
 646         {
 647           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 648                    scm_usage_name, argv[i]);
 649           scm_shell_usage (1, 0);
 650         }
 651     }
 652
 653   /* Check to make sure the -ds got a -s. */
 654   if (!scm_is_null (do_script))
 655     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 656
 657   /* Make any remaining arguments available to the
 658      script/command/whatever.  */
 659   scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
 660
 661   /* If the --emacs switch was set, now is when we process it.  */
 662   scm_c_define ("use-emacs-interface", scm_from_bool (use_emacs_interface));
 663
 664   /* Handle the `-e' switch, if it was specified.  */
 665   if (!scm_is_null (entry_point))
 666     tail = scm_cons (scm_cons2 (entry_point,
 667                                 scm_cons (sym_command_line, SCM_EOL),
 668                                 SCM_EOL),
 669                        tail);
 670
 671   /* If we didn't end with a -c or a -s, start the repl.  */
 672   if (interactive)
 673     {
 674       tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
 675     }
 676   else
 677     {
 678       /* After doing all the other actions prescribed by the command line,
 679          quit.  */
 680       tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 681                        tail);
 682     }
 683
 684   /* After the following line, actions will be added to the front. */
 685   tail = scm_reverse_x (tail, SCM_UNDEFINED);
 686
 687   /* add the user-specified load path here, so it won't be in effect
 688      during the loading of the user's customization file. */
 689   if(!scm_is_null(user_load_path))
 690     {
 691       tail = scm_append_x( scm_cons2(user_load_path, tail, SCM_EOL) );
 692     }
 693
 694   /* If we didn't end with a -c or a -s and didn't supply a -q, load
 695      the user's customization file.  */
 696   if (interactive && !inhibit_user_init)
 697     {
 698       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 699     }
 700
 701   /* If debugging was requested, or we are interactive and debugging
 702      was not explicitly turned off, turn on debugging. */
 703   if (turn_on_debugging || (interactive && !dont_turn_on_debugging))
 704     {
 705       tail = scm_cons (scm_cons (sym_turn_on_debugging, SCM_EOL), tail);
 706     }
 707
 708   {
 709     SCM val = scm_cons (sym_begin, tail);
 710
 711 #if 0
 712     scm_write (val, SCM_UNDEFINED);
 713     scm_newline (SCM_UNDEFINED);
 714 #endif
 715
 716     return val;
 717   }
 718 }
 719
 720
 721 void
 722 scm_shell (int argc, char **argv)
 723 {
 724   /* If present, add SCSH-style meta-arguments from the top of the
 725      script file to the argument vector.  See the SCSH manual: "The
 726      meta argument" for more details.  */
 727   {
 728     char **new_argv = scm_get_meta_args (argc, argv);
 729
 730     if (new_argv)
 731       {
 732         argv = new_argv;
 733         argc = scm_count_argv (new_argv);
 734       }
 735   }
 736
 737   exit (scm_exit_status (scm_eval_x (scm_compile_shell_switches (argc, argv),
 738                                      scm_current_module ())));
 739 }
 740
 741
 742 void
 743 scm_init_script ()
 744 {
 745 #include "libguile/script.x"
 746 }
 747
 748 /*
 749   Local Variables:
 750   c-file-style: "gnu"
 751   End:
 752 */