libguile/script.c

   1 /* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
   2  * This program is free software; you can redistribute it and/or modify
   3  * it under the terms of the GNU General Public License as published by
   4  * the Free Software Foundation; either version 2, or (at your option)
   5  * any later version.
   6  *
   7  * This program 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
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this software; see the file COPYING.  If not, write to
  14  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  15  *
  16  * As a special exception, the Free Software Foundation gives permission
  17  * for additional uses of the text contained in its release of GUILE.
  18  *
  19  * The exception is that, if you link the GUILE library with other files
  20  * to produce an executable, this does not by itself cause the
  21  * resulting executable to be covered by the GNU General Public License.
  22  * Your use of that executable is in no way restricted on account of
  23  * linking the GUILE library code into it.
  24  *
  25  * This exception does not however invalidate any other reasons why
  26  * the executable file might be covered by the GNU General Public License.
  27  *
  28  * This exception applies only to the code released by the
  29  * Free Software Foundation under the name GUILE.  If you copy
  30  * code from other Free Software Foundation releases into a copy of
  31  * GUILE, as the General Public License permits, the exception does
  32  * not apply to the code that you add in this way.  To avoid misleading
  33  * anyone as to the status of such modified files, you must delete
  34  * this exception notice from them.
  35  *
  36  * If you write modifications of your own for GUILE, it is your choice
  37  * whether to permit this exception to apply to your modifications.
  38  * If you do not wish that, delete this exception notice.
  39  */
  40
  41 /* "script.c" argv tricks for `#!' scripts.
  42    Author: Aubrey Jaffer */
  43
  44 #include <stdio.h>
  45 #include <ctype.h>
  46 #include "_scm.h"
  47 #include "gh.h"
  48 #include "load.h"
  49
  50 #include "script.h"
  51
  52 #ifdef __IBMC__
  53 #include <io.h>
  54 #endif /* def __IBMC__ */
  55
  56 #ifdef linux
  57 #include <unistd.h>             /* for X_OK define */
  58 #endif /* def linux */
  59 #ifdef __svr4__
  60 #include <unistd.h>             /* for X_OK define */
  61 #else
  62 #ifdef __sgi__
  63 #include <unistd.h>             /* for X_OK define */
  64 #endif /* def __sgi__ */
  65 #endif /* def __svr4__ */
  66 #ifdef hpux
  67 #define const
  68 /**/
  69 #endif
  70
  71 /* Concatentate str2 onto str1 at position n and return concatenated
  72    string if file exists; 0 otherwise. */
  73
  74 static char *
  75 scm_cat_path (str1, str2, n)
  76      char *str1;
  77      const char *str2;
  78      long n;
  79 {
  80   if (!n)
  81     n = strlen (str2);
  82   if (str1)
  83     {
  84       long len = strlen (str1);
  85       str1 = (char *) realloc (str1, (scm_sizet) (len + n + 1));
  86       if (!str1)
  87         return 0L;
  88       strncat (str1 + len, str2, n);
  89       return str1;
  90     }
  91   str1 = (char *) malloc ((scm_sizet) (n + 1));
  92   if (!str1)
  93     return 0L;
  94   str1[0] = 0;
  95   strncat (str1, str2, n);
  96   return str1;
  97 }
  98
  99 #if 0
 100 static char *
 101 scm_try_path (path)
 102      char *path;
 103 {
 104   FILE *f;
 105   /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
 106   if (!path)
 107     return 0L;
 108   SCM_SYSCALL (f = fopen (path, "r");
 109     );
 110   if (f)
 111     {
 112       fclose (f);
 113       return path;
 114     }
 115   free (path);
 116   return 0L;
 117 }
 118
 119 static char *
 120 scm_sep_init_try (path, sep, initname)
 121      char *path;
 122      const char *sep, *initname;
 123 {
 124   if (path)
 125     path = scm_cat_path (path, sep, 0L);
 126   if (path)
 127     path = scm_cat_path (path, initname, 0L);
 128   return scm_try_path (path);
 129 }
 130 #endif
 131
 132 #ifndef LINE_INCREMENTORS
 133 #define LINE_INCREMENTORS  '\n'
 134 #ifdef MSDOS
 135 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f':case 26
 136 #else
 137 #define WHITE_SPACES  ' ':case '\t':case '\r':case '\f'
 138 #endif /* def MSDOS */
 139 #endif /* ndef LINE_INCREMENTORS */
 140
 141 #ifndef MAXPATHLEN
 142 #define MAXPATHLEN 80
 143 #endif /* ndef MAXPATHLEN */
 144 #ifndef X_OK
 145 #define X_OK 1
 146 #endif /* ndef X_OK */
 147
 148 #ifdef unix
 149 #include <stdio.h>
 150
 151 char *
 152 scm_find_executable (name)
 153      const char *name;
 154 {
 155   char tbuf[MAXPATHLEN];
 156   int i = 0;
 157   FILE *f;
 158
 159   /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
 160   if (access (name, X_OK))
 161     return 0L;
 162   f = fopen (name, "r");
 163   if (!f)
 164     return 0L;
 165   if ((fgetc (f) == '#') && (fgetc (f) == '!'))
 166     {
 167       while (1)
 168         switch (tbuf[i++] = fgetc (f))
 169           {
 170           case /*WHITE_SPACES */ ' ':
 171           case '\t':
 172           case '\r':
 173           case '\f':
 174           case EOF:
 175             tbuf[--i] = 0;
 176             fclose (f);
 177             return scm_cat_path (0L, tbuf, 0L);
 178           }
 179     }
 180   fclose (f);
 181   return scm_cat_path (0L, name, 0L);
 182 }
 183 #endif /* unix */
 184
 185 #ifdef MSDOS
 186
 187 #define DEFAULT_PATH "C:\\DOS"
 188 #define PATH_DELIMITER ';'
 189 #define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \
 190                                      || (fname[0] && (fname[1] == ':')))
 191
 192 char *
 193 dld_find_executable (file)
 194      const char *file;
 195 {
 196   /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */
 197   return scm_cat_path (0L, file, 0L);
 198 }
 199 #endif /* def MSDOS */
 200
 201 #if 0
 202 /* This code was originally borrowed from SCM; Guile sees things
 203    differently.  */
 204
 205 /* Given dld_find_executable()'s best guess for the pathname of this
 206    executable, find (and verify the existence of) initname in the
 207    implementation-vicinity of this program.  Returns a newly allocated
 208    string if successful, 0 if not */
 209
 210 char *
 211 scm_find_impl_file (exec_path, generic_name, initname, sep)
 212      char *exec_path;
 213      const char *generic_name, *initname, *sep;
 214 {
 215   char *sepptr = strrchr (exec_path, sep[0]);
 216   char *extptr = exec_path + strlen (exec_path);
 217   char *path = 0;
 218   /* fprintf(stderr, "dld_find_e %s\n", exec_path); fflush(stderr); */
 219   if (sepptr)
 220     {
 221       long sepind = sepptr - exec_path + 1L;
 222
 223       /* In case exec_path is in the source directory, look first in
 224          exec_path's directory. */
 225       path = scm_cat_path (0L, exec_path, sepind - 1L);
 226       path = scm_sep_init_try (path, sep, initname);
 227       if (path)
 228         return path;
 229
 230 #ifdef MSDOS
 231       if (!strcmp (extptr - 4, ".exe") || !strcmp (extptr - 4, ".com") ||
 232           !strcmp (extptr - 4, ".EXE") || !strcmp (extptr - 4, ".COM"))
 233         extptr = extptr - 4;
 234 #endif /* def MSDOS */
 235
 236       if (generic_name &&
 237           !strncmp (exec_path + sepind, generic_name, extptr - exec_path))
 238         generic_name = 0;
 239
 240       /* If exec_path is in directory "exe" or "bin": */
 241       path = scm_cat_path (0L, exec_path, sepind - 1L);
 242       sepptr = path + sepind - 4;
 243       if (!strcmp (sepptr, "exe") || !strcmp (sepptr, "bin") ||
 244           !strcmp (sepptr, "EXE") || !strcmp (sepptr, "BIN"))
 245         {
 246           char *peer;
 247
 248           /* Look for initname in peer directory "lib". */
 249           if (path)
 250             {
 251               strncpy (sepptr, "lib", 3);
 252               path = scm_sep_init_try (path, sep, initname);
 253               if (path)
 254                 return path;
 255             }
 256
 257           /* Look for initname in peer directories "lib" and "src" in
 258              subdirectory with the name of the executable (sans any type
 259              extension like .EXE). */
 260           for (peer = "lib"; !0; peer = "src")
 261             {
 262               path = scm_cat_path (0L, exec_path, extptr - exec_path + 0L);
 263               if (path)
 264                 {
 265                   strncpy (path + sepind - 4, peer, 3);
 266                   path[extptr - exec_path] = 0;
 267                   path = scm_sep_init_try (path, sep, initname);
 268                   if (path)
 269                     return path;
 270                 }
 271               if (!strcmp (peer, "src"))
 272                 break;
 273             }
 274
 275           if (generic_name)
 276             {
 277
 278               /* Look for initname in peer directories "lib" and "src" in
 279                  subdirectory with the generic name. */
 280               for (peer = "lib"; !0; peer = "src")
 281                 {
 282                   path = scm_cat_path (0L, exec_path, sepind);
 283                   if (path)
 284                     {
 285                       strncpy (path + sepind - 4, "lib", 3);
 286                       path = scm_cat_path (path, generic_name, 0L);
 287                       path = scm_sep_init_try (path, sep, initname);
 288                       if (path)
 289                         return path;
 290                     }
 291                   if (!strcmp (peer, "src"))
 292                     break;
 293                 }
 294             }
 295         }
 296
 297 #ifdef MSDOS
 298       if (strlen (extptr))
 299         {
 300           /* If exec_path has type extension, look in a subdirectory with
 301              the name of the executable sans the executable file's type
 302              extension. */
 303           path = scm_cat_path (0L, exec_path, extptr - exec_path + 0L);
 304           path = scm_sep_init_try (path, sep, initname);
 305           if (path)
 306             return path;
 307
 308           if (generic_name)
 309             {
 310
 311               /* Also look in generic_name subdirectory. */
 312               path = scm_cat_path (0L, exec_path, sepind);
 313               if (path)
 314                 path = scm_cat_path (path, generic_name, 0L);
 315               path = scm_sep_init_try (path, sep, initname);
 316               if (path)
 317                 return path;
 318             }
 319         }
 320 #endif /* def MSDOS */
 321     }
 322   else
 323     {
 324
 325       /* We don't have a parse-able exec_path.  The only path to try is
 326          just initname. */
 327       path = scm_cat_path (0L, initname, 0L);
 328       if (path)
 329         path = scm_try_path (path);
 330       if (path)
 331         return path;
 332     }
 333   return 0L;
 334 }
 335 #endif /* 0 */
 336
 337
 338 /* Read a \nnn-style escape.  We've just read the backslash.  */
 339 static int
 340 script_get_octal (f)
 341      FILE *f;
 342 {
 343   int i;
 344   int value = 0;
 345
 346   for (i = 0; i < 3; i++)
 347     {
 348       int c = getc (f);
 349       if ('0' <= c && c <= '7')
 350         value = (value * 8) + (c - '0');
 351       else
 352         scm_wta (SCM_UNDEFINED,
 353                  "malformed script: bad octal backslash escape",
 354                  "script argument parser");
 355     }
 356   return value;
 357 }
 358
 359
 360 static int
 361 script_get_backslash (f)
 362      FILE *f;
 363 {
 364   int c = getc (f);
 365
 366   switch (c)
 367     {
 368     case 'a': return '\a';
 369     case 'b': return '\b';
 370     case 'f': return '\f';
 371     case 'n': return '\n';
 372     case 'r': return '\r';
 373     case 't': return '\t';
 374     case 'v': return '\v';
 375
 376     case '\\':
 377     case ' ':
 378     case '\t':
 379     case '\n':
 380       return c;
 381
 382     case '0': case '1': case '2': case '3':
 383     case '4': case '5': case '6': case '7':
 384       ungetc (c, f);
 385       return script_get_octal (f);
 386
 387     case EOF:
 388       scm_wta (SCM_UNDEFINED,
 389                "malformed script: backslash followed by EOF",
 390                "script argument parser");
 391       return 0; /* not reached? */
 392
 393     default:
 394       scm_wta (SCM_UNDEFINED,
 395                "malformed script: bad backslash sequence",
 396                "script argument parser");
 397       return 0; /* not reached? */
 398     }
 399 }
 400
 401
 402 static char *
 403 script_read_arg (f)
 404      FILE *f;
 405 {
 406   int size = 7;
 407   char *buf = malloc (size + 1);
 408   int len = 0;
 409
 410   if (! buf)
 411     return 0;
 412
 413   for (;;)
 414     {
 415       int c = getc (f);
 416       switch (c)
 417         {
 418         case '\\':
 419           c = script_get_backslash (f);
 420           /* The above produces a new character to add to the argument.
 421              Fall through.  */
 422         default:
 423           if (len >= size)
 424             {
 425               size = (size + 1) * 2;
 426               buf = realloc (buf, size);
 427               if (! buf)
 428                 return 0;
 429             }
 430           buf[len++] = c;
 431           break;
 432
 433         case '\n':
 434           /* This may terminate an arg now, but it will terminate the
 435              entire list next time through.  */
 436           ungetc ('\n', f);
 437         case EOF:
 438           if (len == 0)
 439             {
 440               free (buf);
 441               return 0;
 442             }
 443           /* Otherwise, those characters terminate the argument; fall
 444              through.  */
 445         case ' ':
 446           buf[len] = '\0';
 447           return buf;
 448
 449         case '\t':
 450           free (buf);
 451           scm_wta (SCM_UNDEFINED,
 452                    "malformed script: TAB in meta-arguments",
 453                    "argument parser");
 454           return 0; /* not reached? */
 455         }
 456     }
 457 }
 458
 459
 460 static int
 461 script_meta_arg_P (arg)
 462      char *arg;
 463 {
 464   if ('\\' != arg[0])
 465     return 0L;
 466 #ifdef MSDOS
 467   return !arg[1];
 468 #else
 469   switch (arg[1])
 470     {
 471     case 0:
 472     case '%':
 473     case WHITE_SPACES:
 474       return !0;
 475     default:
 476       return 0L;
 477     }
 478 #endif
 479 }
 480
 481 char **
 482 scm_get_meta_args (argc, argv)
 483      int argc;
 484      char **argv;
 485 {
 486   int nargc = argc, argi = 1, nargi = 1;
 487   char *narg, **nargv;
 488   if (!(argc > 2 && script_meta_arg_P (argv[1])))
 489     return 0L;
 490   if (!(nargv = (char **) malloc ((1 + nargc) * sizeof (char *))))
 491       return 0L;
 492   nargv[0] = argv[0];
 493   while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))
 494     {
 495       FILE *f = fopen (argv[++argi], "r");
 496       if (f)
 497         {
 498           nargc--;              /* to compensate for replacement of '\\' */
 499           while (1)
 500             switch (getc (f))
 501               {
 502               case EOF:
 503                 return 0L;
 504               default:
 505                 continue;
 506               case '\n':
 507                 goto found_args;
 508               }
 509         found_args:
 510           while ((narg = script_read_arg (f)))
 511             if (!(nargv = (char **) realloc (nargv,
 512                                              (1 + ++nargc) * sizeof (char *))))
 513                 return 0L;
 514             else
 515               nargv[nargi++] = narg;
 516           fclose (f);
 517           nargv[nargi++] = argv[argi++];
 518         }
 519     }
 520   while (argi <= argc)
 521     nargv[nargi++] = argv[argi++];
 522   return nargv;
 523 }
 524
 525 int
 526 scm_count_argv (argv)
 527      char **argv;
 528 {
 529   int argc = 0;
 530   while (argv[argc])
 531     argc++;
 532   return argc;
 533 }
 534
 535
 536 /* For use in error messages.  */
 537 char *scm_usage_name = 0;
 538
 539 void
 540 scm_shell_usage (int fatal, char *message)
 541 {
 542   if (message)
 543     fprintf (stderr, "%s\n", message);
 544
 545   fprintf (stderr,
 546            "Usage: %s OPTION ...\n"
 547            "Evaluate Scheme code, interactively or from a script.\n"
 548            "\n"
 549            "  -s SCRIPT      load Scheme source code from FILE, and exit\n"
 550            "  -c EXPR        evalute Scheme expression EXPR, and exit\n"
 551            "  --             stop scanning arguments; run interactively\n"
 552            "The above switches stop argument processing, and pass all\n"
 553            "remaining arguments as the value of (command-line).\n"
 554            "\n"
 555            "  -l FILE        load Scheme source code from FILE\n"
 556            "  -e FUNCTION    after reading script, apply FUNCTION to\n"
 557            "                 command line arguments\n"
 558            "  -ds            do -s script at this point\n"
 559            "  --emacs        enable Emacs protocol (experimental)\n"
 560            "  -h, --help     display this help and exit\n"
 561            "  -v, --version  display version information and exit\n"
 562            "  \\              read arguments from following script lines\n",
 563            scm_usage_name);
 564
 565   if (fatal)
 566     exit (1);
 567 }
 568
 569
 570 /* Some symbols used by the command-line compiler.  */
 571 SCM_SYMBOL (sym_load, "load");
 572 SCM_SYMBOL (sym_eval_string, "eval-string");
 573 SCM_SYMBOL (sym_command_line, "command-line");
 574 SCM_SYMBOL (sym_begin, "begin");
 575 SCM_SYMBOL (sym_load_user_init, "load-user-init");
 576 SCM_SYMBOL (sym_top_repl, "top-repl");
 577 SCM_SYMBOL (sym_quit, "quit");
 578
 579
 580 /* Given an array of command-line switches, return a Scheme expression
 581    to carry out the actions specified by the switches.
 582
 583    If you told me this should have been written in Scheme, I'd
 584    probably agree.  I'd say I didn't feel comfortable doing that in
 585    the present system.  You'd say, well, fix the system so you are
 586    comfortable doing that.  I'd agree again.  *shrug*
 587
 588    We load the ice-9 system from here.  It might be nicer if the
 589    libraries initialized from the inner_main function in guile.c (which
 590    will be auto-generated eventually) could assume ice-9 were already
 591    loaded.  Then again, it might be nice if ice-9 could assume that
 592    certain libraries were already loaded.  The solution is to break up
 593    ice-9 into modules which can be frozen and statically linked like any
 594    other module.  Then all the modules can describe their dependencies in
 595    the usual way, and the auto-generated inner_main will do the right
 596    thing.  */
 597
 598 SCM
 599 scm_compile_shell_switches (int argc, char **argv)
 600 {
 601   SCM tail = SCM_EOL;           /* We accumulate the list backwards,
 602                                    and then reverse! it before we
 603                                    return it.  */
 604   SCM do_script = SCM_EOL;      /* The element of the list containing
 605                                    the "load" command, in case we get
 606                                    the "-ds" switch.  */
 607   SCM entry_point = SCM_EOL;    /* for -e switch */
 608   int interactive = 1;          /* Should we go interactive when done? */
 609   int use_emacs_interface = 0;
 610   int i;
 611   char *argv0;
 612
 613   if (argc > 0)
 614     {
 615       scm_usage_name = strrchr (argv[0], '/');
 616       if (! scm_usage_name)
 617         scm_usage_name = argv[0];
 618       else
 619         scm_usage_name++;
 620     }
 621   if (! scm_usage_name)
 622     scm_usage_name = "guile";
 623   argv0 = scm_usage_name;
 624
 625   for (i = 1; i < argc; i++)
 626     {
 627       if (! strcmp (argv[i], "-s")) /* load script */
 628         {
 629           if (++i >= argc)
 630             scm_shell_usage (1, "missing argument to `-s' switch");
 631
 632           /* If we specified the -ds option, do_script points to the
 633              cdr of an expression like (load #f); we replace the car
 634              (i.e., the #f) with the script name.  */
 635           if (do_script != SCM_EOL)
 636             {
 637               SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
 638               do_script = SCM_EOL;
 639             }
 640           else
 641             /* Construct an application of LOAD to the script name.  */
 642             tail = scm_cons (scm_cons2 (sym_load,
 643                                         scm_makfrom0str (argv[i]),
 644                                         SCM_EOL),
 645                                tail);
 646           argv0 = argv[i];
 647           i++;
 648           interactive = 0;
 649           break;
 650         }
 651
 652       else if (! strcmp (argv[i], "-c")) /* evaluate expr */
 653         {
 654           if (++i >= argc)
 655             scm_shell_usage (1, "missing argument to `-c' switch");
 656           tail = scm_cons (scm_cons2 (sym_eval_string,
 657                                       scm_makfrom0str (argv[i]),
 658                                       SCM_EOL),
 659                            tail);
 660           i++;
 661           interactive = 0;
 662           break;
 663         }
 664
 665       else if (! strcmp (argv[i], "--")) /* end args; go interactive */
 666         {
 667           i++;
 668           break;
 669         }
 670
 671       else if (! strcmp (argv[i], "-l")) /* load a file */
 672         {
 673           if (++i < argc)
 674             tail = scm_cons (scm_cons2 (sym_load,
 675                                         scm_makfrom0str (argv[i]),
 676                                         SCM_EOL),
 677                              tail);
 678           else
 679             scm_shell_usage (1, "missing argument to `-l' switch");
 680         }
 681
 682       else if (! strcmp (argv[i], "-e")) /* entry point */
 683         {
 684           if (++i < argc)
 685             entry_point = gh_symbol2scm (argv[i]);
 686           else
 687             scm_shell_usage (1, "missing argument to `-e' switch");
 688         }
 689
 690       else if (! strcmp (argv[i], "-ds")) /* do script here */
 691         {
 692           /* We put a dummy "load" expression, and let the -s put the
 693              filename in.  */
 694           if (do_script != SCM_EOL)
 695             scm_shell_usage (1, "the -ds switch may only be specified once");
 696           do_script = scm_cons (SCM_BOOL_F, SCM_EOL);
 697           tail = scm_cons (scm_cons (sym_load, do_script),
 698                            tail);
 699         }
 700
 701       else if (! strcmp (argv[i], "--emacs")) /* use emacs protocol */
 702         use_emacs_interface = 1;
 703
 704       else if (! strcmp (argv[i], "-h")
 705                || ! strcmp (argv[i], "--help"))
 706         {
 707           scm_shell_usage (0, 0);
 708           exit (0);
 709         }
 710
 711       else if (! strcmp (argv[i], "-v")
 712                || ! strcmp (argv[i], "--version"))
 713         {
 714           /* Print version number.  */
 715           printf ("Guile %s\n"
 716                   "Copyright (c) 1995, 1996 Free Software Foundation\n"
 717                   "Guile may be distributed under the terms of the GNU General Public Licence;\n"
 718                   "certain other uses are permitted as well.  For details, see the file\n"
 719                   "`COPYING', which is included in the Guile distribution.\n"
 720                   "There is no warranty, to the extent permitted by law.\n",
 721                   GUILE_VERSION);
 722           exit (0);
 723         }
 724
 725       else
 726         {
 727           fprintf (stderr, "%s: Unrecognized switch `%s'\n",
 728                    scm_usage_name, argv[i]);
 729           scm_shell_usage (1, 0);
 730         }
 731     }
 732
 733   /* Check to make sure the -ds got a -s. */
 734   if (do_script != SCM_EOL)
 735     scm_shell_usage (1, "the `-ds' switch requires the use of `-s' as well");
 736
 737   /* Make any remaining arguments available to the
 738      script/command/whatever.  */
 739   scm_set_program_arguments (argc - i, argv + i, argv0);
 740
 741   /* If the --emacs switch was set, now is when we process it.  */
 742   scm_sysintern ("use-emacs-interface",
 743                  (use_emacs_interface) ? SCM_BOOL_T : SCM_BOOL_F);
 744
 745   /* Handle the `-e' switch, if it was specified.  */
 746   if (entry_point != SCM_EOL)
 747     tail = scm_cons (scm_cons2 (entry_point,
 748                                 scm_cons (sym_command_line, SCM_EOL),
 749                                 SCM_EOL),
 750                        tail);
 751
 752   /* If we didn't end with a -c or a -s, load the user's customization
 753      file, and start the repl.  */
 754   if (interactive)
 755     {
 756       tail = scm_cons (scm_cons (sym_load_user_init, SCM_EOL), tail);
 757       tail = scm_cons (scm_cons (sym_top_repl, SCM_EOL), tail);
 758     }
 759
 760   /* After doing all the other actions prescribed by the command line,
 761      quit.  */
 762   tail = scm_cons (scm_cons (sym_quit, SCM_EOL),
 763                    tail);
 764
 765   {
 766     /* We want a path only containing directories from SCHEME_LOAD_PATH,
 767        SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
 768        file, so we do this before loading Ice-9.  */
 769     SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
 770
 771     /* Load Ice-9.  */
 772     scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
 773
 774     /* Load the init.scm file.  */
 775     if (SCM_NFALSEP (init_path))
 776       scm_primitive_load (init_path);
 777   }
 778
 779   {
 780     SCM val = scm_cons (sym_begin, scm_list_reverse_x (tail, SCM_UNDEFINED));
 781
 782     scm_write (val, SCM_UNDEFINED);
 783     scm_newline (SCM_UNDEFINED);
 784
 785     return val;
 786   }
 787 }
 788
 789
 790 void
 791 scm_shell (argc, argv)
 792      int argc;
 793      char **argv;
 794 {
 795   /* If present, add SCSH-style meta-arguments from the top of the
 796      script file to the argument vector.  See the SCSH manual: "The
 797      meta argument" for more details.  */
 798   {
 799     char **new_argv = scm_get_meta_args (argc, argv);
 800
 801     if (new_argv)
 802       {
 803         argv = new_argv;
 804         argc = scm_count_argv (new_argv);
 805       }
 806   }
 807
 808   scm_eval_x (scm_compile_shell_switches (argc, argv));
 809 }
 810
 811
 812 void
 813 scm_init_script ()
 814 {
 815 #include "script.x"
 816 }