Logo Search packages:      
Sourcecode: gambc version File versions  Download package

main.c

/* File: "main.c", Time-stamp: <2006-09-25 12:14:31 feeley> */

/* Copyright (C) 1994-2006 by Marc Feeley, All Rights Reserved. */

/* This is the driver of the Gambit-C system */

#define ___INCLUDED_FROM_MAIN
#define ___VERSION 400000
#include "gambit.h"

#include "os_base.h"
#include "os_shell.h"
#include "setup.h"


/**********************************/
#ifdef ___DEBUG
#ifdef ___DEBUG_ALLOC_MEM_TRACE
#define ___alloc_mem(bytes) ___alloc_mem_debug(bytes,__LINE__,__FILE__)
#endif
#endif


/*---------------------------------------------------------------------------*/


___HIDDEN ___UCS_2 gambcopt_env_name[] =
{ 'G', 'A', 'M', 'B', 'C', 'O', 'P', 'T', '\0' };


___HIDDEN ___SCMOBJ usage_err
   ___P((int debug_settings),
        (debug_settings)
int debug_settings;)
{
  ___setup_params.debug_settings = debug_settings;

  if (___DEBUG_SETTINGS_LEVEL(debug_settings) != 0)
    {
      char *msgs[2];
      msgs[0] =
        "Usage: program [-:OPTION,OPTION...] ...\n"
        "where OPTION is one of:\n"
        "  mHEAPSIZE    set minimum heap size in kilobytes\n"
        "  hHEAPSIZE    set maximum heap size in kilobytes\n"
        "  lLIVEPERCENT set heap live ratio after GC in percent\n"
        "  s/S          set standard Scheme mode (on/off)\n"
        "  d[OPT...]    set debugging options; OPT is one of:\n"
        "                 p/a       treat uncaught exceptions as errors\n"
        "                           (primordial-thread only/all threads)\n"
        "                 r/s/q     error handling (create a new REPL/start in\n"
        "                           single-step mode/quit with error status)\n"
        "                 i/c/-     select REPL interaction channel\n"
        "                           (ide/console/standard input and output)\n"
        "                 0..9      verbosity level\n"
        "  =DIRECTORY   override Gambit installation directory\n"
        "  +ARGUMENT    add ARGUMENT to the command line before other arguments\n"
        "  f[OPT...]    set file options; see below for OPT\n"
        "  t[OPT...]    set terminal options; see below for OPT\n"
        "  -[OPT...]    set standard input and output options; see below for OPT\n"
        "where OPT is one of:\n"
        "  A/1/2/4/6/8  character encoding (ASCII/ISO-8859-1/UCS-2/UCS-4/UTF-16/UTF-8)\n"
        "  l/c/cl       end-of-line encoding (LF/CR/CR-LF)\n"
        "  u/n/f        buffering (unbuffered/newline buffered/fully buffered)\n"
        "  e/E          [for terminals only] enable line-editing (on/off)\n";
      msgs[1] = 0;
      ___display_error (msgs);
    }

  return ___FIXADD(___FIX(___EXIT_CODE_USAGE),___FIX(1));
}


___HIDDEN ___UCS_2STRING extract_string
   ___P((___UCS_2STRING *start),
        (start)
___UCS_2STRING *start;)
{
  ___UCS_2 c;
  ___UCS_2STRING p1 = *start;
  ___UCS_2STRING p2;
  int n = 0;
  ___UCS_2STRING result;

  while ((c = *p1) != '\0' && c != ',')
    {
      p1++;
      if (c == '\\')
        {
          if ((c = *p1) == '\0')
            break;
          p1++;
        }
      n++;
    }

  p2 = *start;
  *start = p1;

  result = ___CAST(___UCS_2STRING,
                   ___alloc_mem ((n+1) * sizeof (___UCS_2)));

  if (result != 0)
    {
      p1 = result;
      while ((c = *p2) != '\0' && c != ',')
        {
          p2++;
          if (c == '\\')
            {
              if ((c = *p2) == '\0')
                break;
              p2++;
            }
          *p1++ = c;
        }
      *p1++ = '\0';
    }

  return result;
}


___HIDDEN ___BOOL extend_argv
   ___P((___UCS_2STRING **argv,
         int pos,
         int nb_to_add,
         ___BOOL free_old),
        (argv,
         pos,
         nb_to_add,
         free_old)
___UCS_2STRING **argv;
int pos;
int nb_to_add;
___BOOL free_old;)
{
  int i;
  int n = 0;
  ___UCS_2STRING *old_argv = *argv;
  ___UCS_2STRING *new_argv;

  while (old_argv[n++] != 0) ;

  new_argv = ___CAST(___UCS_2STRING*,
                     ___alloc_mem ((n+nb_to_add) * sizeof (___UCS_2STRING)));

  if (new_argv == 0)
    return 0;

  for (i=pos; i<n; i++)
    new_argv[i+nb_to_add] = old_argv[i];

  for (i=0; i<pos; i++)
    new_argv[i] = old_argv[i];

  *argv = new_argv;

  if (free_old)
    ___free_mem (old_argv);

  return 1;
}


int ___main
   ___P((___mod_or_lnk (*linker)(___global_state_struct*)),
        (linker)
___mod_or_lnk (*linker)();)
{
#define LARGEST_ULONG (unsigned long)(~___CAST(unsigned long,0))

  ___UCS_2STRING *argv;
  ___UCS_2STRING *current_argv;
  ___UCS_2STRING runtime_options;
  int extra_arg_pos;
  int contract_argv;
  int options_source;
  ___UCS_2STRING gambcdir;
  ___UCS_2STRING gambcopt;
  unsigned long min_heap_len;
  unsigned long max_heap_len;
  int live_percent;
  int standard_level;
  int debug_settings;
  int file_settings;
  int terminal_settings;
  int stdio_settings;
  ___SCMOBJ e;
  ___setup_params_struct setup_params;

  /* handle arguments to runtime */

  argv = ___program_startup_info.argv;
  gambcdir = 0;
  gambcopt = 0;
  min_heap_len = 0;
  max_heap_len = 0;
  live_percent = 0;
  standard_level = 0;
  debug_settings = ___DEBUG_SETTINGS_INITIAL;
  file_settings = ___FILE_SETTINGS_INITIAL;
  terminal_settings = ___TERMINAL_SETTINGS_INITIAL;
  stdio_settings = ___STDIO_SETTINGS_INITIAL;

  if (argv != 0
      && (runtime_options = argv[1]) != 0
      && runtime_options[0] == '-'
      && runtime_options[1] == ':')
    runtime_options += 2;
  else
    runtime_options = 0;

  current_argv = argv;
  extra_arg_pos = 1;
  contract_argv = (runtime_options != 0);

  for (options_source=0; options_source<3; options_source++)
    {
      ___UCS_2STRING arg;

      if (options_source == 0)
        {
          if ((e = ___getenv_UCS_2 (gambcopt_env_name, &gambcopt))
              != ___FIX(___NO_ERR))
            goto after_setup;
          arg = gambcopt;
        }
      else if (options_source == 1)
        {
          arg = ___program_startup_info.script_line;

          if (arg != 0)
            {
              for (;;)
                {
                  if (*arg == '\0')
                    {
                      arg = 0;
                      break;
                    }
                  if (arg[0] == ' '
                      && arg[1] == '-'
                      && arg[2] == ':')
                    {
                      arg += 3;
                      break;
                    }
                  arg++;
                }
            }
        }
      else
        arg = runtime_options;

      if (arg == 0)
        continue;

      do
        {
          ___UCS_2STRING s = arg++;
          switch (*s)
            {
            case 'm':
            case 'h':
            case 'l':
              {
                unsigned long argval = 0;
                while (*arg >= '0' && *arg <= '9')
                  {
                    unsigned int n = *arg - '0';
                    if (argval > (LARGEST_ULONG>>10)/10 ||
                        (argval == (LARGEST_ULONG>>10)/10 &&
                         n > ((LARGEST_ULONG>>10)-argval*10)))
                      {
                        e = usage_err (debug_settings);
                        goto after_setup;
                      }
                    argval = argval*10 + n;
                    arg++;
                  }
                if (arg == s+1)
                  {
                    e = usage_err (debug_settings);
                    goto after_setup;
                  }
                switch (*s)
                  {
                  case 'm': min_heap_len = argval<<10;
                            break;
                  case 'h': max_heap_len = argval<<10;
                            break;
                  case 'l': if (argval > 100)
                              argval = 100;
                            live_percent = argval;
                            break;
                  }
                break;
              }

            case 's':
              standard_level = 5;
              break;

            case 'S':
              standard_level = 1;
              break;

            case 'd':
              {
                if (*arg == '\0' || *arg == ' ' || *arg == ',')
                  debug_settings = ___DEBUG_SETTINGS_DEFAULT;
                else
                  while (*arg != '\0' && *arg != ' ' && *arg != ',')
                    {
                      if (*arg >= '0' && *arg <= '9')
                        debug_settings =
                          (debug_settings & ~___DEBUG_SETTINGS_LEVEL_MASK)
                          | ((*arg - '0') << ___DEBUG_SETTINGS_LEVEL_SHIFT);
                      else
                        switch (*arg)
                          {
                          case 'p': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_UNCAUGHT_MASK)
                                      | (___DEBUG_SETTINGS_UNCAUGHT_PRIMORDIAL
                                         << ___DEBUG_SETTINGS_UNCAUGHT_SHIFT);
                                    break;
                          case 'a': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_UNCAUGHT_MASK)
                                      | (___DEBUG_SETTINGS_UNCAUGHT_ALL
                                         << ___DEBUG_SETTINGS_UNCAUGHT_SHIFT);
                                    break;
                          case 'r': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_ERROR_MASK)
                                      | (___DEBUG_SETTINGS_ERROR_REPL
                                         << ___DEBUG_SETTINGS_ERROR_SHIFT);
                                    break;
                          case 's': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_ERROR_MASK)
                                      | (___DEBUG_SETTINGS_ERROR_SINGLE_STEP
                                         << ___DEBUG_SETTINGS_ERROR_SHIFT);
                                    break;
                          case 'q': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_ERROR_MASK)
                                      | (___DEBUG_SETTINGS_ERROR_QUIT
                                         << ___DEBUG_SETTINGS_ERROR_SHIFT);
                                    break;
                          case 'i': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_REPL_MASK)
                                      | (___DEBUG_SETTINGS_REPL_IDE
                                         << ___DEBUG_SETTINGS_REPL_SHIFT);
                                    break;
                          case 'c': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_REPL_MASK)
                                      | (___DEBUG_SETTINGS_REPL_CONSOLE
                                         << ___DEBUG_SETTINGS_REPL_SHIFT);
                                    break;
                          case '-': debug_settings =
                                      (debug_settings
                                       & ~___DEBUG_SETTINGS_REPL_MASK)
                                      | (___DEBUG_SETTINGS_REPL_STDIO
                                         << ___DEBUG_SETTINGS_REPL_SHIFT);
                                    break;
                          default:
                            e = usage_err (debug_settings);
                            goto after_setup;
                          }
                      arg++;
                    }
                break;
              }

            case '=':
              {
                ___free_UCS_2STRING (gambcdir);
                gambcdir = extract_string (&arg);
                if (gambcdir == 0)
                  {
                    e = ___FIX(___HEAP_OVERFLOW_ERR);
                    goto after_setup;
                  }
                break;
              }

            case '+':
              {
                ___UCS_2STRING extra_arg;

                if (!extend_argv (&current_argv,
                                  extra_arg_pos,
                                  1 - contract_argv,
                                  current_argv != argv))
                  {
                    e = ___FIX(___HEAP_OVERFLOW_ERR);
                    goto after_setup;
                  }

                contract_argv = 0;

                if ((extra_arg = extract_string (&arg)) == 0)
                  {
                    e = ___FIX(___HEAP_OVERFLOW_ERR);
                    goto after_setup;
                  }

                current_argv[extra_arg_pos++] = extra_arg;

                break;
              }

            case 't':
            case 'f':
            case '-':
              {
                int settings = 0;

                switch (*s)
                  {
                  case 'f':
                    settings = file_settings;
                    break;
                  case 't':
                    settings = terminal_settings;
                    break;
                  case '-':
                    settings = stdio_settings;
                    break;
                  }

                while (*arg != '\0' && *arg != ' ' && *arg != ',')
                  {
                    switch (*arg++)
                      {
                      case 'A': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_ASCII;
                                break;
                      case '1': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_ISO_8859_1;
                                break;
                      case '2': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_UCS_2;
                                break;
                      case '4': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_UCS_4;
                                break;
                      case '6': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_UTF_16;
                                break;
                      case '8': settings = ___CHAR_ENCODING_MASK(settings)
                                           |___CHAR_ENCODING_UTF_8;
                                break;
                      case 'l': settings = ___EOL_ENCODING_MASK(settings)
                                           |((___EOL_ENCODING(settings)
                                              ==___EOL_ENCODING_CR)
                                             ?___EOL_ENCODING_CRLF
                                             :___EOL_ENCODING_LF);
                                break;
                      case 'c': settings = ___EOL_ENCODING_MASK(settings)
                                           |___EOL_ENCODING_CR;
                                break;
                      case 'u': settings = ___BUFFERING_MASK(settings)
                                           |___NO_BUFFERING;
                                break;
                      case 'n': settings = ___BUFFERING_MASK(settings)
                                           |___LINE_BUFFERING;
                                break;
                      case 'f': settings = ___BUFFERING_MASK(settings)
                                           |___FULL_BUFFERING;
                                break;
                      case 'e':
                      case 'E': if (*s != 't')
                                  {
                                    e = usage_err (debug_settings);
                                    goto after_setup;
                                  }
                                settings =
                                  ___TERMINAL_LINE_EDITING_MASK(settings)
                                  |((arg[-1] == 'e')
                                    ?___TERMINAL_LINE_EDITING_ON
                                    :___TERMINAL_LINE_EDITING_OFF);
                                break;
                      default:
                        e = usage_err (debug_settings);
                        goto after_setup;
                      }
                  }

                switch (*s)
                  {
                  case 'f':
                    file_settings = settings;
                    break;
                  case 't':
                    terminal_settings = settings;
                    break;
                  case '-':
                    stdio_settings = settings;
                    break;
                  }

                break;
              }

            default:
              {
                arg--;
                break;
              }
            }
        } while (*arg++ == ',');

      if (arg[-1] != '\0' && arg[-1] != ' ')
        {
          e = usage_err (debug_settings);
          goto after_setup;
        }
    }

  if (contract_argv != 0)
    {
      if (!extend_argv (&current_argv,
                        extra_arg_pos,
                        -1,
                        0)) /* we know that current_argv == argv */
        {
          e = ___FIX(___HEAP_OVERFLOW_ERR);
          goto after_setup;
        }
    }

#ifdef ___FORCE_MAX_HEAP
  if (max_heap_len == 0 || max_heap_len > (___FORCE_MAX_HEAP<<10))
    max_heap_len = ___FORCE_MAX_HEAP<<10;
#endif

  /* Setup program, run it and perform any cleanup necessary. */

  ___setup_params_reset (&setup_params);

  setup_params.version           = ___VERSION;
  setup_params.argv              = current_argv;
  setup_params.min_heap          = min_heap_len;
  setup_params.max_heap          = max_heap_len;
  setup_params.live_percent      = live_percent;
  setup_params.standard_level    = standard_level;
  setup_params.debug_settings    = debug_settings;
  setup_params.file_settings     = file_settings;
  setup_params.terminal_settings = terminal_settings;
  setup_params.stdio_settings    = stdio_settings;
  setup_params.gambcdir          = gambcdir;
  setup_params.linker            = linker;

  e = ___setup (&setup_params);

 after_setup:

  while (extra_arg_pos > 1)
    ___free_UCS_2STRING (current_argv[--extra_arg_pos]);

  if (current_argv != argv)
    ___free_mem (current_argv);

  ___free_UCS_2STRING (gambcdir);
  ___free_UCS_2STRING (gambcopt);

  if (e == ___FIX(___NO_ERR))
    {
      ___cleanup ();
      e = ___FIX(___EXIT_CODE_OK);
    }
  else if (e > ___FIX(___NO_ERR))
    e = ___FIXSUB(e,___FIX(1));
  else
    {
#ifdef ___DEBUG
      fprintf (stderr, "___setup returned error code %d\n", ___INT(e));
      fflush (stderr);
#endif
      e = ___FIX(___EXIT_CODE_OSERR);
    }

  return ___INT(e);
}


/*---------------------------------------------------------------------------*/

Generated by  Doxygen 1.6.0   Back to index