/*-----------------------------------------------------------------*-C-*---
 * File:    handc/runtime/init.c
 *
 *          Copyright (C)1997 Donovan Kolbly <d.kolbly@rscheme.org>
 *          as part of the RScheme project, licensed for free use.
 *          See <http://www.rscheme.org/> for the latest information.
 *
 * File version:     1.17
 * File mod date:    1997.11.29 23:10:48
 * System build:     v0.7.2, 97.12.21
 *
 * Purpose:          RScheme initialization code
 *------------------------------------------------------------------------*/

#include <stdio.h>
#include <signal.h>
#include <string.h>

#include <rscheme.h>
#include <rscheme/regs.h>
#include <rscheme/scheme.h>
#include <rscheme/osglue.h>
#include <rscheme/heapi.h>
#include <rscheme/rlseconf.h>
#include <rscheme/api.h>
#include "intrs.h"

#ifdef TIMEPOINT
void timepoint( int id );
#else
#define timepoint( id ) (void)0
#endif

char *rs_install_dir = NULL;

/* #define DEBUG_0 */

#ifdef STEP_DUMP
extern int do_step_dump;
extern FILE *step_dump_file;
extern const char *step_dump_filename;

void init_step_dump( void )
{
    if (!step_dump_filename)
	step_dump_filename = "stepdump.tra";
    step_dump_file = NULL;
}
#endif

      
static void load_rscheme_globals( obj init_globals )
{
  UINT_32 i, n;
  obj *dest;

  n = SIZEOF_PTR( init_globals );
  if (n > SLOT(NUM_RSCHEME_GLOBALS))
    {
      fprintf( stderr, "warning: %u initial globals supplied (max %u)\n",
	       n / SLOT(1), NUM_RSCHEME_GLOBALS );
      n = SLOT(NUM_RSCHEME_GLOBALS);
    }

  /* note that we skip copying SLOT(0) & SLOT(1).  
     This is because rscheme_global[0] is "boot_image", which is to be
     a pointer to the actual image that was loaded, 
     and rscheme_global[1] is "boot_args", which will
     be initialized to the argv passed to init_scheme()
  */
  dest = rscheme_global+2;
  for (i=SLOT(2); i<n; i+=SLOT(1))
    {
      *dest++ = gvec_read( init_globals, i );
    }
}

static obj prepend_pre_args( obj rest, obj src )
{
  if (PAIR_P(src))
    {
      timepoint( 308 );
      return cons( pair_car( src ), 
		   prepend_pre_args( rest, pair_cdr(src) ) );
    }
  else
    {
      return rest;
    }
}

#ifdef SPEW_LOADED_IMAGE_AS_TEXT

/* steals the GC's word just before the object to record information;
   works at least with the IRC; no other guarantees!
*/

#define FBIT 0x40000000
#define SHOVE(x) (((UINT_32 *)PTR_TO_HDRPTR(x))[-1])
#define SHOVED(x) (SHOVE(x) >= FBIT)

void dump_image_as_text( obj root )
{
  obj *i, *queue_p, *queue;

  FILE *f = fopen( "/tmp/image.txt", "w" );
  if (!f)
    {
      perror( "/tmp/image.txt" );
      exit(1);
    }
  queue = malloc( 200000 * 4 );
  queue_p = queue;

  *queue_p++ = root;
  SHOVE(root) = 0 + FBIT;

  for (i=queue; i<queue_p; i++)
    {
      obj item = *i;

      fprintf( f, "-- %#x <%d> --\n ==> ", item, i-queue );
      fprinto( f, item );
      fprintf( f, "class %#x =? %#x\n", CLASSOF_PTR(item), vector_class );
      fprintf( f, "\n" );
      if (GVEC_P(item))
	{
	  int k;

	  for (k=-SLOT(1); k<SIZEOF_PTR(item); k+=SLOT(1))
	    {
	      obj t = gvec_ref( item, k );

	      if (k < 0)
		fprintf( f, " class = " );
	      else
		fprintf( f, "   [%d] = ", k/SLOT(1) );

	      if (OBJ_ISA_PTR(t))
		{
		  UINT_32 tx;
		  if (SHOVED(t))
		    {
		      tx = SHOVE(t) - FBIT;
		    }
		  else
		    {
		      tx = queue_p - queue;
		      SHOVE(t) = tx + FBIT;
		      *queue_p++ = t;
		    }
		  fprintf( f, "%#x <%d> = ", t, tx );
		}
	      fprinto( f, t );
	      fputc( '\n', f );
	    }
	  fputc( '\n', f );
	}
    }
  fclose(f);
  exit(0);
}
#endif /* SPEW_LOADED_IMAGE_AS_TEXT */

obj init_scheme( int argc, const char **argv,
		 const char *boot_image_path,
		 rs_bool verbose, 
		 struct module_descr **module_tab )
{
  obj start;
  obj args, pre_args;

  timepoint( 300 );
  switch_hw_regs_into_scheme();
  init_regs();
  timepoint( 301 );
  init_linkage( module_tab );
  timepoint( 302 );
  init_runtim( );
  timepoint( 303 );
  
#ifdef STEP_DUMP
  init_step_dump();
#endif /* STEP_DUMP */
  

  /*
   * this initializes the GC as well as loading the initial
   * image (two functions glommed together because somethimes
   * they ARE the same operation)
   */

  pre_args = NIL_OBJ;
  timepoint( 304 );
  boot_image = load_initial_heap( boot_image_path, 
				  &pre_args, 
				  verbose );
  timepoint( 305 );
  
  if (EQ(boot_image,FALSE_OBJ))
    return FALSE_OBJ;
  
  /* so far, we don't actually have any type information; the
     well-known classes have been loaded, but we need to store
     them in the rscheme_globals[] array
     */
  
  load_rscheme_globals( gvec_read( boot_image, SLOT(0) ) );
  timepoint( 306 );
  
  /* now, we have type information... */
#ifdef SPEW_LOADED_IMAGE_AS_TEXT
  dump_image_as_text( boot_image );
#endif /* SPEW_LOADED_IMAGE_AS_TEXT */

  init_os();
  init_math();

  init_interrupts();
  timepoint( 307 );
  
  args = NIL_OBJ;
  while (argc > 0)
    args = cons( make_string( argv[--argc] ), args );
  boot_args = args;

  install_dir = make_string( rs_install_dir ? rs_install_dir : "install" );
  rs_init_c_signals();

  timepoint( 309 );
  
  start = gvec_read( boot_image, SLOT(2) );

  switch_hw_regs_back_to_os();
  timepoint( 310 );
  
  return start;
}