/*=====================================================================*/
/*    serrano/prgm/project/bigloo/runtime/Clib/inline-alloc.c          */
/*    -------------------------------------------------------------    */
/*    Author      :  Manuel Serrano                                    */
/*    Creation    :  Wed Sep 21 15:33:10 1994                          */
/*    Last change :  Fri Nov 14 21:31:11 2003 (serrano)                */
/*    -------------------------------------------------------------    */
/*    On fait des fonctions d'allocations specialisees pour les cons   */
/*    et les flottants.                                                */
/*=====================================================================*/
#ifndef GC_PRIVATE_H
#  include <private/gc_priv.h>
#endif
#undef abs

#include <bigloo.h>

#if( THE_GC == BOEHM_GC && !defined( GC_THREADS ))
#  define NUMBER_OF_CONS_WORDS (long)ALIGNED_WORDS( PAIR_SIZE )
#  define NUMBER_OF_FLOAT_WORDS (long)ALIGNED_WORDS( REAL_SIZE )
#  define NUMBER_OF_CELL_WORDS (long)ALIGNED_WORDS( CELL_SIZE )

#  ifdef PROFILE
extern long GC_words_allocd_byte;
#  endif

/*---------------------------------------------------------------------*/
/*    alloc_make_pair ...                                              */
/*---------------------------------------------------------------------*/
static obj_t 
alloc_make_pair( obj_t car, obj_t cdr ) {
   obj_t pair;

   pair = (obj_t)GC_generic_malloc_words_small( NUMBER_OF_CONS_WORDS, NORMAL );

#if( !defined( TAG_PAIR ) )
   pair->pair_t.header = MAKE_HEADER( PAIR_TYPE, PAIR_SIZE );
#endif
   pair->pair_t.car    = car;
   pair->pair_t.cdr    = cdr;
   
   return BGL_HEAP_DEBUG_MARK_OBJ( BPAIR( pair ) );
}   

/*---------------------------------------------------------------------*/
/*    make_pair ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t 
make_pair( obj_t car, obj_t cdr ) {
   obj_t pair;
   ptr_t op;
   ptr_t *opp;
   DCL_LOCK_STATE;
#ifdef PROFILE
   GC_words_allocd_byte += PAIR_SIZE;
#endif
   opp = &(GC_objfreelist[ NUMBER_OF_CONS_WORDS ]);
   FASTLOCK();
   if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
      FASTUNLOCK();
      return alloc_make_pair( car, cdr );
   } else {
      *opp = obj_link( op );
      GC_words_allocd += NUMBER_OF_CONS_WORDS;
      FASTUNLOCK();

      pair = (obj_t)op;

#if( !defined( TAG_PAIR ) )
      pair->pair_t.header = MAKE_HEADER( PAIR_TYPE, PAIR_SIZE );
#endif
      pair->pair_t.car    = car;
      pair->pair_t.cdr    = cdr;
   
      return BGL_HEAP_DEBUG_MARK_OBJ( BPAIR( pair ) );
   }
}

/*---------------------------------------------------------------------*/
/*    alloc_make_cell ...                                              */
/*---------------------------------------------------------------------*/
static obj_t 
alloc_make_cell( obj_t val ) {
   obj_t cell;

   cell = (obj_t)GC_generic_malloc_words_small( NUMBER_OF_CELL_WORDS, NORMAL );

#if( !defined( TAG_CELL ) )
   cell->cell_t.header = MAKE_HEADER( CELL_TYPE, CELL_SIZE );
#endif
   cell->cell_t.val    = val;
   
   return BGL_HEAP_DEBUG_MARK_OBJ( BCELL( cell ) );
}   

/*---------------------------------------------------------------------*/
/*    make_cell ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t 
make_cell( obj_t val ) {
   obj_t cell;
   ptr_t op;
   ptr_t *opp;
   DCL_LOCK_STATE;
#ifdef PROFILE
   GC_words_allocd_byte += CELL_SIZE;
#endif
   opp = &(GC_objfreelist[ NUMBER_OF_CONS_WORDS ]);
   FASTLOCK();
   if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
      FASTUNLOCK();
      return alloc_make_cell( val );
   } else {
      *opp = obj_link( op );
      GC_words_allocd += NUMBER_OF_CONS_WORDS;
      FASTUNLOCK();

      cell = (obj_t)op;

#if( !defined( TAG_CELL ) )
      cell->cell_t.header = MAKE_HEADER( CELL_TYPE, CELL_SIZE );
#endif
      cell->cell_t.val    = val;
   
      return BGL_HEAP_DEBUG_MARK_OBJ( BCELL( cell ) );
   }
}

/*---------------------------------------------------------------------*/
/*    alloc_make_real ...                                              */
/*---------------------------------------------------------------------*/
static obj_t
alloc_make_real( double d ) {
   obj_t real;

   real = (obj_t)GC_generic_malloc_words_small(NUMBER_OF_FLOAT_WORDS, PTRFREE);
   
#if( !defined( TAG_REAL ) || defined( BUMPY_GC ) )
   real->real_t.header = MAKE_HEADER( REAL_TYPE, REAL_SIZE );
#endif
   real->real_t.real   = d;

   return BGL_HEAP_DEBUG_MARK_OBJ( BREAL( real ) );
}

/*---------------------------------------------------------------------*/
/*    make_real ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t
make_real( double d ) {
   obj_t real;
   ptr_t op;
   ptr_t *opp;
   DCL_LOCK_STATE;
   
#ifdef PROFILE
   GC_words_allocd_byte += REAL_SIZE;
#endif
   
   opp = &(GC_aobjfreelist[ NUMBER_OF_FLOAT_WORDS ]);

   FASTLOCK();

   if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
      FASTUNLOCK();
      return alloc_make_real( d );
   } else {
      *opp = obj_link(op);
      GC_words_allocd += NUMBER_OF_FLOAT_WORDS;
      FASTUNLOCK();

      real = (obj_t)op;

#if( !defined( TAG_REAL ) )
      real->real_t.header = MAKE_HEADER( REAL_TYPE, REAL_SIZE );
#endif
      real->real_t.real   = d;

      return BGL_HEAP_DEBUG_MARK_OBJ( BREAL( real ) );
   }
}

#else

/*---------------------------------------------------------------------*/
/*    make_pair ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t
make_pair( obj_t car, obj_t cdr ) {
   obj_t pair;

#ifdef PROFILE
   GC_words_allocd_byte += PAIR_SIZE;
#endif

#if( defined( GC_THREADS ) && defined( THREAD_LOCAL_ALLOC ) )
   pair = GC_THREAD_MALLOC( PAIR_SIZE );
#else      
   pair = GC_MALLOC( PAIR_SIZE );
#endif      
#if( !defined( TAG_PAIR ) )
   pair->pair_t.header = MAKE_HEADER( PAIR_TYPE, PAIR_SIZE );
#endif
   pair->pair_t.car    = car;
   pair->pair_t.cdr    = cdr;
   
   return BGL_HEAP_DEBUG_MARK_OBJ( BPAIR( pair ) );
}

/*---------------------------------------------------------------------*/
/*    make_cell ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t
make_cell( obj_t val ) {
   obj_t cell;

#ifdef PROFILE
   GC_words_allocd_byte += CELL_SIZE;
#endif

#if( defined( GC_THREADS ) && defined( THREAD_LOCAL_ALLOC ) )
   cell = GC_THREAD_MALLOC( CELL_SIZE );
#else      
   cell = GC_MALLOC( CELL_SIZE );
#endif      
#if( !defined( TAG_CELL ) )
   cell->cell_t.header = MAKE_HEADER( CELL_TYPE, CELL_SIZE );
#endif
   cell->cell_t.val    = val;
   
   return BGL_HEAP_DEBUG_MARK_OBJ( BCELL( cell ) );
}

/*---------------------------------------------------------------------*/
/*    make_real ...                                                    */
/*---------------------------------------------------------------------*/
GC_API
obj_t
make_real( double real )
{
   obj_t a_real;

#ifdef PROFILE
   GC_words_allocd_byte += REAL_SIZE;
#endif
#if( defined( GC_THREADS ) && defined( THREAD_LOCAL_ALLOC ) )
   a_real = GC_THREAD_MALLOC_ATOMIC( REAL_SIZE );
#else
   a_real = GC_MALLOC_ATOMIC( REAL_SIZE );
#endif
   
#if( !defined( TAG_REAL ) )
   a_real->real_t.header = MAKE_HEADER( REAL_TYPE, REAL_SIZE );
#endif
   a_real->real_t.real = real;
	
   return BGL_HEAP_DEBUG_MARK_OBJ( BREAL( a_real ) );
}
#endif

/*---------------------------------------------------------------------*/
/*    ginit                                                            */
/*    -------------------------------------------------------------    */
/*    The two function definitions have to stay empty.                 */
/*---------------------------------------------------------------------*/
void bgl_gc_profile_threads_init() { ; }
void bgl_gc_profile_nothreads_init() { ; }
void (*ginit)() = 0;

/*---------------------------------------------------------------------*/
/*    void                                                             */
/*    bgl_gc_init ...                                                  */
/*    -------------------------------------------------------------    */
/*    All this mess is a bad trick for enabling the Bigloo rts         */
/*    to call either bgl_gc_threads_init or bgl_gc_nothreads_init      */
/*    depending on the compilation flags. It is important that         */
/*    the compiler can't determine which of these two functions is     */
/*    called because the call is intercepted with a LD_PRELOAD         */
/*    in the bmem profiler.                                            */
/*---------------------------------------------------------------------*/
void
bgl_gc_profile_init() {
   if( !ginit ) {
#if defined( GC_THREADS )
      ginit = &bgl_gc_profile_threads_init;
#else
      ginit = &bgl_gc_profile_nothreads_init;
#endif
   }

   ginit();
}
