scsh-0.5/main.c

/* Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.
   See file COPYING. */

/* Modified by Olin Shivers.
****************************
** New flag set:
**   \	<fname>		meta-arg (a single backslash char)
**   -i <image>		terminates arg scanning (necessary for scripts)
*/

#include <stdio.h>
#include <stdlib.h>

/* I bumped this up from 1.5 Mcell because the debugging info put us over
** the top. -Olin
*/
#if !defined(DEFAULT_HEAP_SIZE)
/* 2.5 megacell = 10 megabytes (5 meg per semispace) */
#define DEFAULT_HEAP_SIZE 2500000L
#endif

#if !defined(DEFAULT_STACK_SIZE)
/* 2500 cells = 10000 bytes */
#define DEFAULT_STACK_SIZE 2500L
#endif

#if defined(STATIC_AREAS)
#define DEFAULT_IMAGE_NAME NULL
#else

/* DEFAULT_IMAGE_NAME should be defined using the -D switch to cc. */
#if !defined(DEFAULT_IMAGE_NAME)
#define DEFAULT_IMAGE_NAME "s48.image"
#endif

#endif /* STATIC_AREAS */

#define streq(a,b) (strcmp((a),(b))==0)

char *object_file;   /* specified via a command line argument */
char *reloc_file;    /* dynamic loading will set this */

static char *prog_name;

static void usage(void)
{
  fprintf(stderr, "Usage: %s [meta-arg] [vm-option+] [end-option scheme-args]\n"
		  "meta-arg:    \\ <script file name>\n"
		  "\n"
	    	  "vm-option: -h <total heap size in words>\n"
	          "           -s <stack size in words>\n"
	          "           -o <object file name>\n"
		  "\n"
	          "end-option: -i <image file name>\n"
	          "            -- (Terminates vm args.)\n"
	          "            -a (Terminates vm args. Obsolete.)\n",
	  prog_name);
}

static void bad_args(void) { usage(); exit(1); }

main(argc, argv)
     int argc; char **argv;
{
  extern char **process_meta_arg(char **);
  char *image_name = DEFAULT_IMAGE_NAME;
  long heap_size = DEFAULT_HEAP_SIZE;    /* in numbers of cells */
  long stack_size = DEFAULT_STACK_SIZE;  /* in numbers of cells */
  char **argp;
  long return_value;
  extern void sysdep_init();
  extern long required_init_space();
  extern void initialize_vm();
  extern long call_startup_procedure();
  extern long check_image_header();
  extern long read_image();
  extern void register_static_areas();
  void *heap, *stack;
  long required_heap_size, startup_proc;

#if defined(STATIC_AREAS)
  extern long entry;
  extern long p_count, *p_areas[], p_sizes[];
  extern long i_count, *i_areas[], i_sizes[];
#endif

  long vm_argc = 0;
  prog_name = *argv++;		/* Save program name. */

  object_file = reloc_file = NULL;

  /* Handle an initial \ <fname> meta-arg expansion. */
  while ( *argv && streq(*argv, "\\") ) {
      argv++;
      if( !*argv ) bad_args();	/* die */
      argv = process_meta_arg(argv);
      if( !argv ) {
	  fprintf(stderr, "%s: \\ <fname> expansion failed.\n",
		  prog_name);
	  exit(1);
	  }
      }

  for (; *argv; argv++)
      if( argv[0][0] != '-' )
	  bad_args(); /* die */
      else
	  switch (argv[0][1]) {
	  default:
	      bad_args(); /* die */
	      break;

	  case 'h': /* heapsize */
	    argv++;
	    if( !*argv ) bad_args(); /* die */
	    heap_size = atoi(*argv);
	    if( heap_size <= 0 ) bad_args();
	    break;

	  case 's':
	      argv++;
	      if( !*argv ) bad_args(); /* die */
	      stack_size = atoi(*argv);
	      if (stack_size <= 0) bad_args();
	      break;

	  case 'o': /* object file */
	    argv++;
	    if( !*argv ) bad_args(); /* die */
	    object_file = *argv;
	    break;

	  /* These switches terminate arg scanning. */
	  case 'i':
	    argv++;
	    if( !*argv ) bad_args(); /* die */
	    image_name = *argv++;
	    goto args_done;

	  case '-':
	  case 'a':
	    argv++;
	    goto args_done;
	    }

 args_done:
  for(argc=0, argp=argv; *argp; argc++, argp++); /* Recompute argc. */

  sysdep_init();
  scheme48_init();

  if (image_name == NULL)
    required_heap_size = 0;
  else {
    /* check_image_header returns number of bytes; required_heap_size
       is number of cells. */
    required_heap_size = check_image_header(image_name) >> 2;
    if (-1 == required_heap_size) {
      fprintf(stderr, "image file %s is unusable\n", image_name);
      return 1; }
  }

  required_heap_size += required_init_space(argv, vm_argc);
  
  /* two semi-spaces, plus we want some room to maneuver */
  if (heap_size < 4 * required_heap_size) {
    fprintf(stderr, "heap size %ld cells is too small, using %ld cells\n",
	    heap_size, 4 * required_heap_size);
    heap_size = 4 * required_heap_size; }

  heap = (void *) malloc(heap_size * sizeof(long));
  stack = (void *) malloc(stack_size * sizeof(long));
    
  if (!heap || !stack) {
    fprintf(stderr, "system is out of memory\n");
    return 1; }

  initialize_vm(heap, heap_size, stack, stack_size);

#if defined(STATIC_AREAS)
  if (image_name == NULL) {
    register_static_areas(p_count, p_areas, p_sizes,
			  i_count, i_areas, i_sizes);
    startup_proc = entry;
  } else
    startup_proc = read_image(image_name, 0L);
#else
  startup_proc = read_image(image_name, 0L);
#endif

  return_value = call_startup_procedure(startup_proc, argv, argc);

  if (reloc_file != NULL)
    if (0 != unlink(reloc_file))
      fprintf(stderr, "unable to delete file %s\n", reloc_file);

  return(return_value);
}