libguile/script.c

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