00001 #define _MCW_MALLOC_HEADER_
00002 #include "mrilib.h"
00003 
00004 #if defined(LINUX)
00005 # include <malloc.h>
00006 #endif
00007 
00008 /*--------------------------------------------------------------------
00009    Code to provide runtime fixups for various machines
00010    (things that can't be fixed by declarations in machdep.h).
00011    This should be called at the start of every program.
00012 ----------------------------------------------------------------------*/
00013 
00014 void machdep()
00015 {
00016    /*-- force use of mcw_malloc.c functions - 05 Nov 2001 --*/
00017 
00018 #ifdef USING_MCW_MALLOC
00019    if( AFNI_yesenv("AFNI_FORCE_MCW_MALLOC") ) enable_mcw_malloc();
00020 #endif
00021 
00022    /*-- disable mmap() in malloc() [21 Aug 2002: mostly] --*/
00023 
00024 #if defined(LINUX) && defined(M_MMAP_MAX)
00025    mallopt( M_MMAP_MAX , 1 ) ;
00026 #endif
00027 
00028 }
00029 
00030 /*-------------------------------------------------------------------
00031   To use the random()/srandom() library instead of srand48, do
00032     #define USE_RANDOM
00033   in machdep.h for your machine -- RWCox - 04 Sep 2001
00034 ---------------------------------------------------------------------*/
00035 #ifdef USE_RANDOM
00036 void srand48( long int s ){ srandom((unsigned int) s); }
00037 
00038 double drand48(void){ return (((double)random())/LONG_MAX); }
00039 
00040 long int lrand48(void){ return random(); }
00041 #endif /* USE_RANDOM */
00042 
00043 /*-------------------------------------------------------------------
00044   If the system doesn't provide this function for some reason ...
00045 ---------------------------------------------------------------------*/
00046 
00047 #ifdef NEED_XSETLOCALE
00048 #include <locale.h>
00049 char * _Xsetlocale( int category, const char * locale)
00050 { return setlocale(category,locale) ; }
00051 #endif
00052 
00053 /*----- 09 Apr 2002 -----*/
00054 
00055 #ifdef NEED_NL_LANGINFO
00056 char * nl_langinfo(){ return "ISO-8859-1"; }
00057 #endif
00058 
00059 #ifdef NO_GAMMA
00060 /*-------------------------------------------------------------------*/
00061 /* If the system doesn't provide lgamma() for some reason.
00062 ---------------------------------------------------------------------*/
00063 
00064 /** log of gamma, for argument between 1 and 2 **/
00065 
00066 static double gamma_12( double y )
00067 {
00068    double x , g ;
00069    x = y - 1.0 ;
00070    g = ((((((( 0.035868343 * x - 0.193527818 ) * x
00071                                + 0.482199394 ) * x
00072                                - 0.756704078 ) * x
00073                                + 0.918206857 ) * x
00074                                - 0.897056937 ) * x
00075                                + 0.988205891 ) * x
00076                                - 0.577191652 ) * x + 1.0 ;
00077    return log(g) ;
00078 }
00079 
00080 /** asymptotic expansion of ln(gamma(x)) for large positive x **/
00081 
00082 #define LNSQRT2PI 0.918938533204672  /* ln(sqrt(2*PI)) */
00083 
00084 static double gamma_asympt(double x)
00085 {
00086    double sum ;
00087 
00088    sum = (x-0.5)*log(x) - x + LNSQRT2PI + 1.0/(12.0*x) - 1./(360.0*x*x*x) ;
00089    return sum ;
00090 }
00091 /** log of gamma, argument positive (not very efficient!) **/
00092 
00093 double lgamma( double x )
00094 {
00095    double w , g ;
00096 
00097    if( x <= 0.0 ){
00098       fprintf(stderr,"Internal gamma: argument %g <= 0\a\n",x) ;
00099       return 0.0 ;
00100    }
00101 
00102    if( x <  1.0 ) return gamma_12( x+1.0 ) - log(x) ;
00103    if( x <= 2.0 ) return gamma_12( x ) ;
00104    if( x >= 6.0 ) return gamma_asympt(x) ;
00105 
00106    g = 0 ; w = x ;
00107    while( w > 2.0 ){
00108       w -= 1.0 ; g += log(w) ;
00109    }
00110    return ( gamma_12(w) + g ) ;
00111 }
00112 #endif  /* NO_GAMMA */