/*=====================================================================*/
/*    serrano/prgm/project/bigloo/bde/bmem/lib/init.c                  */
/*    -------------------------------------------------------------    */
/*    Author      :  Manuel Serrano                                    */
/*    Creation    :  Sun Apr 13 06:28:06 2003                          */
/*    Last change :  Wed Aug 13 08:46:13 2003 (serrano)                */
/*    Copyright   :  2003 Manuel Serrano                               */
/*    -------------------------------------------------------------    */
/*    Allocation profiling initialization                              */
/*=====================================================================*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <bmem.h>

#include <dlfcn.h>
#ifndef RTLD_LAZY
#   define RTLD_LAZY 0
#endif

/*---------------------------------------------------------------------*/
/*    Importations                                                     */
/*---------------------------------------------------------------------*/
extern void *string_to_symbol( char * );

/*---------------------------------------------------------------------*/
/*    Global variables                                                 */
/*---------------------------------------------------------------------*/
int bmem_debug = 0;
int bmem_thread = 0;
pthread_key_t bmem_key;

/* garbage collector */
void *(*____GC_malloc)( size_t ) = 0;
void *(*____GC_malloc_atomic)( size_t ) = 0;
void (*____GC_gcollect)() = 0;
void *(*____GC_add_gc_hook)( void (*)() ) = 0;
char **____executable_name = 0;
void *____command_line = 0;

/* inline allocations */
void *(*____make_pair)( void *, void * ) = 0;
void *(*____make_cell)( void * ) = 0;
void *(*____make_real)( double ) = 0;

/* string */
void *(*____string_to_bstring)( char * ) = 0;
void *(*____string_to_bstring_len)( char *, int ) = 0;
void *(*____make_string)( int, char ) = 0;
void *(*____make_string_sans_fill)( int ) = 0;
void *(*____string_append)( void *, void * ) = 0;
void *(*____string_append_3)( void *, void *, void * ) = 0;
void *(*____c_substring)( void *, int, int ) = 0;
void *(*____escape_C_string)( char * ) = 0;
void *(*____escape_scheme_string)( char * ) = 0;

/* vector */
void *(*____create_vector)( int ) = 0;
void *(*____make_vector)( int, void * ) = 0;

/* procedure */
void *(*____make_fx_procedure)( void *(*)(), int, int );
void *(*____make_va_procedure)( void *(*)(), int, int );

/* output port */
void *(*____make_output_port)( char *, FILE *, void * );
void *(*____open_output_file)( void * );
void *(*____append_output_file)( void * );
void *(*____open_output_string)( void * );
void *(*____strport_grow)( void * );

/* input port */
void *(*____make_input_port)( char *, FILE *, void *, long );
void *(*____open_input_pipe)( void *, void * );
void *(*____open_input_file)( void *, void * );
void *(*____open_input_console)();
void *(*____file_to_buffered_input_port)( FILE *, long );
void *(*____file_to_input_port)( FILE * );
void *(*____open_input_string)( void * );
void *(*____open_input_c_string)( char * );
void *(*____reopen_input_c_string)( void *, char * );

/* thread */
void *(*____bglthread_new)( void * );
void *(*____bglthread_new_with_name)( void *, void * );
void *(*____scheduler_start)( void * );
void *(*_____scheduler_start)( void *, void * );
void *(*____scheduler_react)( void * );
void *(*_____scheduler_react)( void *, void * );
void *(*____bglthread_id_get)();
int (*____bglthread_key_create)( pthread_key_t *, void * );
int (*____bglthread_setspecific)( pthread_key_t, void * );
void *(*____bglthread_getspecific)( pthread_key_t );
void (*____bglthread_switch)( void *, void * );
void (*____bglasync_scheduler_notify)( void * );

/* dynamic environment */
void *(*____make_dynamic_env)();
void (*____bgl_init_dynamic_env)();
void *(*____bgl_dup_dynamic_env)( void * );

/* struct */
void *(*____create_struct)( void *, int );
void *(*____make_struct)( void *, int, void * );

/* socket */
void *(*____make_client_socket)( void *, int, char );
void *(*____make_server_socket)( int );
void *(*____socket_dup)( void * );
void *(*____socket_accept)( void *, char, int );

/* classes */
void *(*____register_class)( void *, void *, void *, void *, long, void *, void *, void * );
int (*____bgl_types_number)();
long (*____get_hash_power_number)( char *, unsigned long );
void *(*____bgl_get_symtab)() = 0;
void *(*____bgl_get_current_dynamic_env)() = 0;
void (*____bgl_init_objects)() = 0;
void *unknown_ident;

/*---------------------------------------------------------------------*/
/*    void *                                                           */
/*    open_shared_library ...                                          */
/*---------------------------------------------------------------------*/
static void *open_shared_library( char *lib ) {
   void *handle;
   
   if( !(handle = dlopen( lib,  RTLD_LAZY ) ) ) {
      FAIL( IDENT, "Can't open library", lib );
      exit( -1 );
   }
   
   return handle;
}

/*---------------------------------------------------------------------*/
/*    static void *(*)()                                               */
/*    get_function ...                                                 */
/*---------------------------------------------------------------------*/
static fun_t
get_function( void *handle, char *id ) {
   char *err;
   fun_t fun = dlsym( handle, id );

   fprintf( stderr, "  %s...", id );
   if( !fun || (err = dlerror()) ) {
      FAIL( IDENT, "Can't find function", id );
      exit( -2 );
   } else {
      fprintf( stderr, "ok\n", id );
      return fun;
   }
}

/*---------------------------------------------------------------------*/
/*    static void *                                                    */
/*    get_variable ...                                                 */
/*---------------------------------------------------------------------*/
static void *
get_variable( void *handle, char *id ) {
   char *err;
   fun_t fun = dlsym( handle, id );

   fprintf( stderr, "  %s...", id );
   if( !fun || (err = dlerror()) ) {
      FAIL( IDENT, "Can't find variable", id );
      exit( -2 );
   } else {
      fprintf( stderr, "ok\n", id );
      return fun;
   }
}

/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    dump_statistics ...                                              */
/*---------------------------------------------------------------------*/
static void
dump_statistics() {
   char *n = getenv( "BMEMMON" );
   FILE *f;

   if( !n ) {
      if( *____executable_name ) {
	 char *s1 = rindex( *____executable_name, '/' );
	 char *s2 = rindex( s1 ? s1 + 1: *____executable_name,  '.' );
	 char *s = s1 ? s1 + 1: *____executable_name;
	 int l = strlen( s );
	 char *r = malloc( l + 6 );

	 if( s2 ) {
	    strcpy( r, s );
	    strcpy( &r[ s2 - s ], ".bmem" );
	 } else {
	    sprintf( r, "%s.bmem", s );
	 }

	 n = r;
      } else {
	 n = "a.bmem";
      }
   }

   fprintf( stderr, "Dumping file...%s\n", n );
   
   if( !(f = fopen( n, "w" )) ) {
      FAIL( IDENT, "Can't open output file", n );
   }
   fprintf( f, ";; size are expressed in work (i.e. 4 bytes)\n" );
   fprintf( f, "(monitor\n" );
   fprintf( f, "  (info (exec \"%s\")\n", *____executable_name ); 
   fprintf( f, "        (sizeof-word %d))\n", BMEMSIZEOFWORD  ); 
   GC_dump_statistics( f );
   alloc_dump_statistics( f );
   type_dump( f );
   thread_dump_statistics( f );
   fprintf( f, ")\n" );
   
   fclose( f );
}

/*---------------------------------------------------------------------*/
/*    int                                                              */
/*    bigloo_abort ...                                                 */
/*---------------------------------------------------------------------*/
int
bigloo_abort( long n ) {
   return n;
}

/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    bmem_dump ...                                                    */
/*---------------------------------------------------------------------*/
static void
bmem_dump() {
   ____GC_gcollect();
   dump_statistics();
}
   
/*---------------------------------------------------------------------*/
/*    void                                                             */
/*    bgl_gc_profile_threads_init ...                                  */
/*    -------------------------------------------------------------    */
/*    This function is called by the GC initialization that takes      */
/*    place in runtime/Clib/inline-alloc.c:bgl_gc_profile_init         */
/*    when the GC is compiled for multi-threading.                     */
/*---------------------------------------------------------------------*/
void
bgl_gc_profile_threads_init() {
   bmem_thread = 1;
}

/*---------------------------------------------------------------------*/
/*    void                                                             */
/*    bgl_gc_profile_nothreads_init ...                                */
/*    -------------------------------------------------------------    */
/*    This function is called by the GC initialization that takes      */
/*    place in runtime/Clib/inline-alloc.c:bgl_gc_profile_init         */
/*    when the GC is compiled for single-threading.                    */
/*---------------------------------------------------------------------*/
void
bgl_gc_profile_nothreads_init() {
}

/*---------------------------------------------------------------------*/
/*    static void                                                      */
/*    bgl_init_objects ...                                             */
/*---------------------------------------------------------------------*/
void
bgl_init_objects() {
   void *hdl;
   char bigloo_lib[ 1000 ];
   char bigloofth_lib[ 1000 ];
   char gc_lib[ 1000 ];

   if( getenv( "BMEMLIBBIGLOO" ) ) {
      strcpy( bigloo_lib, getenv( "BMEMLIBBIGLOO" ) );
   } else {
      sprintf( bigloo_lib, "%s/libbigloo_s-%s.%s",
	       LIBRARY_DIRECTORY, BGL_RELEASE_NUMBER,
	       SHARED_LIB_SUFFIX );
   }

   if( getenv( "BMEMLIBBIGLOOFTH" ) ) {
      strcpy( bigloofth_lib, getenv( "BMEMLIBBIGLOOFTH" ) );
   } else {
      sprintf( bigloofth_lib, "%s/libbigloofth_s-%s.%s",
	       LIBRARY_DIRECTORY, BGL_RELEASE_NUMBER,
	       SHARED_LIB_SUFFIX );
   }

#if( BGL_GC_CUSTOM == 1 )
   if( getenv( "BMEMLIBBIGLOOGC" ) ) {
      strcpy( gc_lib, getenv( "BMEMLIBBIGLOOGC" ) );
   } else {
      sprintf( gc_lib, "%s/lib%s%s-%s.%s",
	       LIBRARY_DIRECTORY,
	       BGL_GC_LIBRARY,
	       bmem_thread ? "_fth" : "",
	       BGL_RELEASE_NUMBER,
	       SHARED_LIB_SUFFIX );
   }
#else
   sprintf( gc_lib, "%s", BGL_GC_LIBRARY );
#endif

   if( getenv( "BMEMDEBUG" ) )
      bmem_debug = atoi( getenv( "BMEMDEBUG" ) );

   /* The GC library */
   fprintf( stderr, "Loading library %s...\n", gc_lib );
   hdl = open_shared_library( gc_lib );
   ____GC_malloc = get_function( hdl, "GC_malloc" );
   ____GC_malloc_atomic = get_function( hdl, "GC_malloc_atomic" );
   ____GC_add_gc_hook = get_function( hdl, "GC_add_gc_hook" );
   ____GC_gcollect = (void (*)())get_function( hdl, "GC_gcollect" );
   ____make_pair = get_function( hdl, "make_pair" );
   ____make_cell = get_function( hdl, "make_cell" );
   ____make_real = get_function( hdl, "make_real" );
   ____GC_add_gc_hook( GC_collect_hook );

   /* The Bigloo library */
   fprintf( stderr, "Loading library %s...\n", bigloo_lib );
   hdl = open_shared_library( bigloo_lib );
   ____bgl_get_current_dynamic_env = get_function( hdl, "bgl_get_current_dynamic_env" );
   ____executable_name = get_variable( hdl, "executable_name" );
   ____command_line = get_variable( hdl, "command_line" );
   ____bgl_init_objects = (void (*)())get_function( hdl, "bgl_init_objects" );
   ____get_hash_power_number = (long (*)())get_function( hdl, "get_hash_power_number" );
   ____bgl_get_symtab = get_function( hdl, "bgl_get_symtab" );
   /* string */
   ____string_to_bstring = get_function( hdl, "string_to_bstring" );
   ____string_to_bstring_len = get_function( hdl, "string_to_bstring_len" );
   ____make_string = (void *(*)(int, char))get_function( hdl, "make_string" );
   ____make_string_sans_fill = get_function( hdl, "make_string_sans_fill" );
   ____string_append = get_function( hdl, "string_append" );
   ____string_append_3 = get_function( hdl, "string_append_3" );
   ____c_substring = get_function( hdl, "c_substring" );
   ____escape_C_string = get_function( hdl, "escape_C_string" );
   ____escape_scheme_string = get_function( hdl, "escape_scheme_string" );
   /* vector */
   ____create_vector = get_function( hdl, "create_vector" );
   ____make_vector = get_function( hdl, "make_vector" );
   /* procedure */
   ____make_fx_procedure = get_function( hdl, "make_fx_procedure" );
   ____make_va_procedure = get_function( hdl, "make_va_procedure" );
   /* output port */
   ____make_output_port = (void *(*)( char *, FILE *, void * ))get_function( hdl, "make_output_port" );
   ____open_output_file = (void *(*)( void * ))get_function( hdl, "open_output_file" );
   ____append_output_file = (void *(*)( void * ))get_function( hdl, "append_output_file" );
   ____open_output_string = (void *(*)( void * ))get_function( hdl, "open_output_string" );
   ____strport_grow = (void *(*)( void * ))get_function( hdl, "strport_grow" );
   /* input port */
   ____make_input_port = (void *(*)( char *, FILE *, void *, long ))get_function( hdl, "make_input_port" );
   ____open_input_pipe = (void *(*)( void *, void * ))get_function( hdl, "open_input_pipe" );
   ____open_input_file = (void *(*)( void *, void * ))get_function( hdl, "open_input_file" );
   ____open_input_console = (void *(*)())get_function( hdl, "open_input_console" );
   ____file_to_buffered_input_port = (void *(*)( FILE *, long ))get_function( hdl, "file_to_buffered_input_port" );
   ____file_to_input_port = (void *(*)( FILE * ))get_function( hdl, "file_to_input_port" );
   ____open_input_string = (void *(*)( void * ))get_function( hdl, "open_input_string" );
   ____open_input_c_string = (void *(*)( char * ))get_function( hdl, "open_input_c_string" );
   ____reopen_input_c_string = (void *(*)( void *, char * ))get_function( hdl, "reopen_input_c_string" );
   /* struct */
   ____create_struct = (void *(*)( void *, int ))get_function( hdl, "create_struct" );
   ____make_struct = (void *(*)( void *, int, void * ))get_function( hdl, "make_struct" );
   /* socket */
   ____make_client_socket = (void *(*)( void *, int, char ))get_function( hdl, "make_client_socket" );
   ____make_server_socket = (void *(*)( int ))get_function( hdl, "make_server_socket" );
   ____socket_dup = get_function( hdl, "socket_dup" );
   ____socket_accept = (void *(*)( void *, char, int ))get_function( hdl, "socket_accept" );
   
   /* class */
   ____register_class = get_function( hdl, "BGl_registerzd2classz12zc0zz__objectz00" );
   ____bgl_types_number = (int (*)())get_function( hdl, "bgl_types_number" );
   
   /* dynamic environment */
   ____make_dynamic_env = (void *(*)())get_function( hdl, "make_dynamic_env" );
   ____bgl_init_dynamic_env = (void (*)())get_function( hdl, "bgl_init_dynamic_env" );
   ____bgl_dup_dynamic_env = (void *(*)( void *))get_function( hdl, "bgl_dup_dynamic_env" );
   
   /* The Bigloo thread library */
   if( bmem_thread ) {
      fprintf( stderr, "Loading library %s...\n", bigloofth_lib );
      hdl = open_shared_library( bigloofth_lib );
      ____bglthread_new = (void *(*)( void * ))get_function( hdl, "bglthread_new" );
      ____bglthread_new_with_name = (void *(*)( void *, void * ))get_function( hdl, "bglthread_new_with_name" );
      ____scheduler_start = get_function( hdl, "BGl_schedulerzd2startz12zc0zz__ft_schedulerz00" );
      ____scheduler_react = get_function( hdl, "BGl_schedulerzd2reactz12zc0zz__ft_schedulerz00" );
      ____bglthread_id_get = get_function( hdl, "bglthread_id_get" );
      ____bglthread_key_create = (int (*)( pthread_key_t *, void * ))get_function( hdl, "bglthread_key_create" );
      ____bglthread_setspecific = (int (*)( pthread_key_t, void *))get_function( hdl, "bglthread_setspecific" );
      ____bglthread_getspecific = (void *(*)( pthread_key_t ))get_function( hdl, "bglthread_getspecific" );
      ____bglthread_switch = (void (*)( void *, void * ))get_function( hdl, "bglthread_switch" );
      ____bglasync_scheduler_notify = (void (*)( void * ))get_function( hdl, "bglasync_scheduler_notify" );

      if( ____bglthread_key_create( &bmem_key, 0 ) ) {
	 FAIL( IDENT, "Can't get thread key", "bmem_key" );
	 exit( -2 );
      }
   }
   
   /* declare types */
   declare_type( UNKNOWN_TYPE_NUM, "unknown" );
   declare_type( _DYNAMIC_ENV_TYPE_NUM, "%dynamic-env" );
   declare_type( _THREAD_TYPE_NUM, "%native-thread" );
   declare_type( ROWSTRING_TYPE_NUM, "char *" );
   declare_type( LLONG_TYPE_NUM, "llong" );
   declare_type( ELONG_TYPE_NUM, "elong" );
   declare_type( PROCEDURE_LIGHT_TYPE_NUM, "procedure-light" );
   declare_type( TSTRUCT_TYPE_NUM, "tstruct" );
   declare_type( TVECTOR_TYPE_NUM, "tvector" );
   declare_type( EXTENDED_PAIR_TYPE_NUM, "epair" );
   declare_type( BINARY_PORT_TYPE_NUM, "binary-port" );
   declare_type( OUTPUT_STRING_PORT_TYPE_NUM, "output-string-port" );
   declare_type( FOREIGN_TYPE_NUM, "foreign" );
   declare_type( PROCESS_TYPE_NUM, "process" );
   declare_type( REAL_TYPE_NUM, "real" );
   declare_type( STRUCT_TYPE_NUM, "struct" );
   declare_type( SOCKET_TYPE_NUM, "socket" );
   declare_type( CELL_TYPE_NUM, "cell" );
   declare_type( DATE_TYPE_NUM, "date" );
   declare_type( OUTPUT_PORT_TYPE_NUM, "output-port" );
   declare_type( INPUT_PORT_TYPE_NUM, "input-port" );
   declare_type( STACK_TYPE_NUM, "stack" );
   declare_type( SYMBOL_TYPE_NUM, "symbol" );
   declare_type( KEYWORD_TYPE_NUM, "keyword" );
   declare_type( CUSTOM_TYPE_NUM, "custom" );
   declare_type( OPAQUE_TYPE_NUM, "opaque" );
   declare_type( UCS2_STRING_TYPE_NUM, "ucs2-string" );
   declare_type( PROCEDURE_TYPE_NUM, "procedure" );
   declare_type( VECTOR_TYPE_NUM, "vector" );
   declare_type( STRING_TYPE_NUM, "string" );
   declare_type( PAIR_TYPE_NUM, "pair" );

   /* initialize the runtime system */
   ____bgl_init_objects();
   unknown_ident = string_to_symbol( "unknown_function" );
   mark_function( unknown_ident, 0, ante_bgl_init_dsz, 0, -1, -1, -1 );

   /* signal registration */
   signal( 2, bmem_dump );
   
   /* exit registration */
   atexit( bmem_dump );
}

