| [bd85400] | 1 | //
 | 
|---|
 | 2 | // Cforall Version 1.0.0 Copyright (C) 2016 University of Waterloo
 | 
|---|
 | 3 | //
 | 
|---|
 | 4 | // The contents of this file are covered under the licence agreement in the
 | 
|---|
 | 5 | // file "LICENCE" distributed with Cforall.
 | 
|---|
 | 6 | //
 | 
|---|
| [f4a6101] | 7 | // stdlib.c --
 | 
|---|
| [bd85400] | 8 | //
 | 
|---|
 | 9 | // Author           : Peter A. Buhr
 | 
|---|
 | 10 | // Created On       : Thu Jan 28 17:10:29 2016
 | 
|---|
 | 11 | // Last Modified By : Peter A. Buhr
 | 
|---|
| [e3fea42] | 12 | // Last Modified On : Tue Feb  4 08:27:08 2020
 | 
|---|
 | 13 | // Update Count     : 486
 | 
|---|
| [bd85400] | 14 | //
 | 
|---|
 | 15 | 
 | 
|---|
| [58b6d1b] | 16 | #include "stdlib.hfa"
 | 
|---|
| [bd85400] | 17 | 
 | 
|---|
 | 18 | //---------------------------------------
 | 
|---|
 | 19 | 
 | 
|---|
 | 20 | #define _XOPEN_SOURCE 600                                                               // posix_memalign, *rand48
 | 
|---|
| [f3fc631f] | 21 | #include <string.h>                                                                             // memcpy, memset
 | 
|---|
| [bd85400] | 22 | #include <malloc.h>                                                                             // malloc_usable_size
 | 
|---|
| [89124ff] | 23 | //#include <math.h>                                                                             // fabsf, fabs, fabsl
 | 
|---|
| [6e991d6] | 24 | #include <complex.h>                                                                    // _Complex_I
 | 
|---|
| [e672372] | 25 | #include <assert.h>
 | 
|---|
| [bd85400] | 26 | 
 | 
|---|
| [f4a6101] | 27 | //---------------------------------------
 | 
|---|
 | 28 | 
 | 
|---|
| [cafb687] | 29 | forall( dtype T | sized(T) ) {
 | 
|---|
 | 30 |         T * alloc_set( T ptr[], size_t dim, char fill ) {       // realloc array with fill
 | 
|---|
 | 31 |                 size_t olen = malloc_usable_size( ptr );                // current allocation
 | 
|---|
| [d74369b] | 32 |                 void * nptr = (void *)realloc( (void *)ptr, dim * sizeof(T) ); // C realloc
 | 
|---|
| [cafb687] | 33 |                 size_t nlen = malloc_usable_size( nptr );               // new allocation
 | 
|---|
 | 34 |                 if ( nlen > olen ) {                                                    // larger ?
 | 
|---|
| [d74369b] | 35 |                         memset( (char *)nptr + olen, (int)fill, nlen - olen ); // initialize added storage
 | 
|---|
| [cafb687] | 36 |                 } // if
 | 
|---|
 | 37 |                 return (T *)nptr;
 | 
|---|
 | 38 |         } // alloc_set
 | 
|---|
 | 39 | 
 | 
|---|
 | 40 |         T * alloc_align_set( T ptr[], size_t align, char fill ) { // aligned realloc with fill
 | 
|---|
 | 41 |                 size_t olen = malloc_usable_size( ptr );                // current allocation
 | 
|---|
| [d74369b] | 42 |                 void * nptr = (void *)realloc( (void *)ptr, align, sizeof(T) ); // CFA realloc
 | 
|---|
 | 43 |                 // char * nptr = alloc_align( ptr, align );
 | 
|---|
| [cafb687] | 44 |                 size_t nlen = malloc_usable_size( nptr );               // new allocation
 | 
|---|
 | 45 |                 if ( nlen > olen ) {                                                    // larger ?
 | 
|---|
| [d74369b] | 46 |                         memset( (char *)nptr + olen, (int)fill, nlen - olen ); // initialize added storage
 | 
|---|
| [cafb687] | 47 |                 } // if
 | 
|---|
 | 48 |                 return (T *)nptr;
 | 
|---|
 | 49 |         } // alloc_align_set
 | 
|---|
 | 50 | } // distribution
 | 
|---|
| [f3ddc21] | 51 | 
 | 
|---|
| [6065b3aa] | 52 | // allocation/deallocation and constructor/destructor, non-array types
 | 
|---|
| [aca65621] | 53 | forall( dtype T | sized(T), ttype Params | { void ?{}( T &, Params ); } )
 | 
|---|
| [627f585] | 54 | T * new( Params p ) {
 | 
|---|
| [cafb687] | 55 |         return &(*malloc()){ p };                                                       // run constructor
 | 
|---|
| [f3ddc21] | 56 | } // new
 | 
|---|
| [627f585] | 57 | 
 | 
|---|
| [83a071f9] | 58 | forall( dtype T | sized(T) | { void ^?{}( T & ); } )
 | 
|---|
| [627f585] | 59 | void delete( T * ptr ) {
 | 
|---|
| [6065b3aa] | 60 |         if ( ptr ) {                                                                            // ignore null
 | 
|---|
| [cafb687] | 61 |                 ^(*ptr){};                                                                              // run destructor
 | 
|---|
| [f3ddc21] | 62 |                 free( ptr );
 | 
|---|
| [f3fc631f] | 63 |         } // if
 | 
|---|
| [f3ddc21] | 64 | } // delete
 | 
|---|
| [627f585] | 65 | 
 | 
|---|
| [83a071f9] | 66 | forall( dtype T, ttype Params | sized(T) | { void ^?{}( T & ); void delete( Params ); } )
 | 
|---|
| [bf76eab] | 67 | void delete( T * ptr, Params rest ) {
 | 
|---|
| [6065b3aa] | 68 |         if ( ptr ) {                                                                            // ignore null
 | 
|---|
| [cafb687] | 69 |                 ^(*ptr){};                                                                              // run destructor
 | 
|---|
| [bf76eab] | 70 |                 free( ptr );
 | 
|---|
| [f3fc631f] | 71 |         } // if
 | 
|---|
| [bf76eab] | 72 |         delete( rest );
 | 
|---|
| [f3ddc21] | 73 | } // delete
 | 
|---|
| [bf76eab] | 74 | 
 | 
|---|
| [6065b3aa] | 75 | 
 | 
|---|
 | 76 | // allocation/deallocation and constructor/destructor, array types
 | 
|---|
| [aca65621] | 77 | forall( dtype T | sized(T), ttype Params | { void ?{}( T &, Params ); } )
 | 
|---|
| [6065b3aa] | 78 | T * anew( size_t dim, Params p ) {
 | 
|---|
| [6887a99] | 79 |         T * arr = alloc( dim );
 | 
|---|
| [6065b3aa] | 80 |         for ( unsigned int i = 0; i < dim; i += 1 ) {
 | 
|---|
| [a493682] | 81 |                 (arr[i]){ p };                                                                  // run constructor
 | 
|---|
| [6065b3aa] | 82 |         } // for
 | 
|---|
 | 83 |         return arr;
 | 
|---|
 | 84 | } // anew
 | 
|---|
 | 85 | 
 | 
|---|
| [aca65621] | 86 | forall( dtype T | sized(T) | { void ^?{}( T & ); } )
 | 
|---|
| [6065b3aa] | 87 | void adelete( size_t dim, T arr[] ) {
 | 
|---|
 | 88 |         if ( arr ) {                                                                            // ignore null
 | 
|---|
 | 89 |                 for ( int i = dim - 1; i >= 0; i -= 1 ) {               // reverse allocation order, must be unsigned
 | 
|---|
| [a493682] | 90 |                         ^(arr[i]){};                                                            // run destructor
 | 
|---|
| [6065b3aa] | 91 |                 } // for
 | 
|---|
 | 92 |                 free( arr );
 | 
|---|
 | 93 |         } // if
 | 
|---|
 | 94 | } // adelete
 | 
|---|
 | 95 | 
 | 
|---|
| [aca65621] | 96 | forall( dtype T | sized(T) | { void ^?{}( T & ); }, ttype Params | { void adelete( Params ); } )
 | 
|---|
| [6065b3aa] | 97 | void adelete( size_t dim, T arr[], Params rest ) {
 | 
|---|
 | 98 |         if ( arr ) {                                                                            // ignore null
 | 
|---|
 | 99 |                 for ( int i = dim - 1; i >= 0; i -= 1 ) {               // reverse allocation order, must be unsigned
 | 
|---|
| [a493682] | 100 |                         ^(arr[i]){};                                                            // run destructor
 | 
|---|
| [6065b3aa] | 101 |                 } // for
 | 
|---|
 | 102 |                 free( arr );
 | 
|---|
 | 103 |         } // if
 | 
|---|
 | 104 |         adelete( rest );
 | 
|---|
 | 105 | } // adelete
 | 
|---|
 | 106 | 
 | 
|---|
| [bd85400] | 107 | //---------------------------------------
 | 
|---|
 | 108 | 
 | 
|---|
| [e3fea42] | 109 | float _Complex strto( const char sptr[], char ** eptr ) {
 | 
|---|
| [bd85400] | 110 |         float re, im;
 | 
|---|
| [e672372] | 111 |         char * eeptr;
 | 
|---|
 | 112 |         re = strtof( sptr, &eeptr );
 | 
|---|
| [bbf3fda] | 113 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0f + 0.0f * _Complex_I; }
 | 
|---|
| [e672372] | 114 |         im = strtof( eeptr, &eeptr );
 | 
|---|
| [bbf3fda] | 115 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0f + 0.0f * _Complex_I; }
 | 
|---|
| [e672372] | 116 |         if ( *eeptr != 'i' ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0f + 0.0f * _Complex_I; }
 | 
|---|
| [bd85400] | 117 |         return re + im * _Complex_I;
 | 
|---|
| [f3ddc21] | 118 | } // strto
 | 
|---|
 | 119 | 
 | 
|---|
| [e3fea42] | 120 | double _Complex strto( const char sptr[], char ** eptr ) {
 | 
|---|
| [bd85400] | 121 |         double re, im;
 | 
|---|
| [e672372] | 122 |         char * eeptr;
 | 
|---|
 | 123 |         re = strtod( sptr, &eeptr );
 | 
|---|
| [bbf3fda] | 124 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0 + 0.0 * _Complex_I; }
 | 
|---|
| [e672372] | 125 |         im = strtod( eeptr, &eeptr );
 | 
|---|
| [bbf3fda] | 126 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0 + 0.0 * _Complex_I; }
 | 
|---|
| [e672372] | 127 |         if ( *eeptr != 'i' ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0 + 0.0 * _Complex_I; }
 | 
|---|
| [bd85400] | 128 |         return re + im * _Complex_I;
 | 
|---|
| [f3ddc21] | 129 | } // strto
 | 
|---|
 | 130 | 
 | 
|---|
| [e3fea42] | 131 | long double _Complex strto( const char sptr[], char ** eptr ) {
 | 
|---|
| [bd85400] | 132 |         long double re, im;
 | 
|---|
| [e672372] | 133 |         char * eeptr;
 | 
|---|
 | 134 |         re = strtold( sptr, &eeptr );
 | 
|---|
| [bbf3fda] | 135 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0L + 0.0L * _Complex_I; }
 | 
|---|
| [e672372] | 136 |         im = strtold( eeptr, &eeptr );
 | 
|---|
| [bbf3fda] | 137 |         if ( sptr == eeptr ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0L + 0.0L * _Complex_I; }
 | 
|---|
| [e672372] | 138 |         if ( *eeptr != 'i' ) { if ( eptr != 0 ) *eptr = eeptr; return 0.0L + 0.0L * _Complex_I; }
 | 
|---|
| [bd85400] | 139 |         return re + im * _Complex_I;
 | 
|---|
| [f3ddc21] | 140 | } // strto
 | 
|---|
| [bd85400] | 141 | 
 | 
|---|
 | 142 | //---------------------------------------
 | 
|---|
 | 143 | 
 | 
|---|
| [3ce0d440] | 144 | forall( otype E | { int ?<?( E, E ); } ) {
 | 
|---|
 | 145 |         E * bsearch( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 146 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
 | 147 |                         return *(E *)t1 < *(E *)t2 ? -1 : *(E *)t2 < *(E *)t1 ? 1 : 0;
 | 
|---|
 | 148 |                 } // cmp
 | 
|---|
 | 149 |                 return (E *)bsearch( &key, vals, dim, sizeof(E), cmp );
 | 
|---|
 | 150 |         } // bsearch
 | 
|---|
 | 151 | 
 | 
|---|
 | 152 |         size_t bsearch( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 153 |                 E * result = bsearch( key, vals, dim );
 | 
|---|
 | 154 |                 return result ? result - vals : dim;                    // pointer subtraction includes sizeof(E)
 | 
|---|
 | 155 |         } // bsearch
 | 
|---|
 | 156 | 
 | 
|---|
 | 157 |         size_t bsearchl( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 158 |                 size_t l = 0, m, h = dim;
 | 
|---|
 | 159 |                 while ( l < h ) {
 | 
|---|
 | 160 |                         m = (l + h) / 2;
 | 
|---|
 | 161 |                         if ( (E &)(vals[m]) < key ) {                           // cast away const
 | 
|---|
 | 162 |                                 l = m + 1;
 | 
|---|
 | 163 |                         } else {
 | 
|---|
 | 164 |                                 h = m;
 | 
|---|
 | 165 |                         } // if
 | 
|---|
 | 166 |                 } // while
 | 
|---|
 | 167 |                 return l;
 | 
|---|
 | 168 |         } // bsearchl
 | 
|---|
 | 169 | 
 | 
|---|
 | 170 |         E * bsearchl( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 171 |                 size_t posn = bsearchl( key, vals, dim );
 | 
|---|
 | 172 |                 return (E *)(&vals[posn]);                                              // cast away const
 | 
|---|
 | 173 |         } // bsearchl
 | 
|---|
 | 174 | 
 | 
|---|
 | 175 |         size_t bsearchu( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 176 |                 size_t l = 0, m, h = dim;
 | 
|---|
 | 177 |                 while ( l < h ) {
 | 
|---|
 | 178 |                         m = (l + h) / 2;
 | 
|---|
 | 179 |                         if ( ! ( key < (E &)(vals[m]) ) ) {                     // cast away const
 | 
|---|
 | 180 |                                 l = m + 1;
 | 
|---|
 | 181 |                         } else {
 | 
|---|
 | 182 |                                 h = m;
 | 
|---|
 | 183 |                         } // if
 | 
|---|
 | 184 |                 } // while
 | 
|---|
 | 185 |                 return l;
 | 
|---|
 | 186 |         } // bsearchu
 | 
|---|
 | 187 | 
 | 
|---|
 | 188 |         E * bsearchu( E key, const E * vals, size_t dim ) {
 | 
|---|
 | 189 |                 size_t posn = bsearchu( key, vals, dim );
 | 
|---|
 | 190 |                 return (E *)(&vals[posn]);
 | 
|---|
 | 191 |         } // bsearchu
 | 
|---|
 | 192 | 
 | 
|---|
 | 193 | 
 | 
|---|
 | 194 |         void qsort( E * vals, size_t dim ) {
 | 
|---|
 | 195 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
 | 196 |                         return *(E *)t1 < *(E *)t2 ? -1 : *(E *)t2 < *(E *)t1 ? 1 : 0;
 | 
|---|
 | 197 |                 } // cmp
 | 
|---|
 | 198 |                 qsort( vals, dim, sizeof(E), cmp );
 | 
|---|
 | 199 |         } // qsort
 | 
|---|
 | 200 | } // distribution
 | 
|---|
 | 201 | 
 | 
|---|
 | 202 | 
 | 
|---|
 | 203 | forall( otype K, otype E | { int ?<?( K, K ); K getKey( const E & ); } ) {
 | 
|---|
 | 204 |         E * bsearch( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 205 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
 | 206 |                         return *(K *)t1 < getKey( *(E *)t2 ) ? -1 : getKey( *(E *)t2 ) < *(K *)t1 ? 1 : 0;
 | 
|---|
 | 207 |                 } // cmp
 | 
|---|
 | 208 |                 return (E *)bsearch( &key, vals, dim, sizeof(E), cmp );
 | 
|---|
 | 209 |         } // bsearch
 | 
|---|
 | 210 | 
 | 
|---|
 | 211 |         size_t bsearch( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 212 |                 E * result = bsearch( key, vals, dim );
 | 
|---|
 | 213 |                 return result ? result - vals : dim;                    // pointer subtraction includes sizeof(E)
 | 
|---|
 | 214 |         } // bsearch
 | 
|---|
 | 215 | 
 | 
|---|
 | 216 |         size_t bsearchl( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 217 |                 size_t l = 0, m, h = dim;
 | 
|---|
 | 218 |                 while ( l < h ) {
 | 
|---|
 | 219 |                         m = (l + h) / 2;
 | 
|---|
 | 220 |                         if ( getKey( vals[m] ) < key ) {
 | 
|---|
 | 221 |                                 l = m + 1;
 | 
|---|
 | 222 |                         } else {
 | 
|---|
 | 223 |                                 h = m;
 | 
|---|
 | 224 |                         } // if
 | 
|---|
 | 225 |                 } // while
 | 
|---|
 | 226 |                 return l;
 | 
|---|
 | 227 |         } // bsearchl
 | 
|---|
 | 228 | 
 | 
|---|
 | 229 |         E * bsearchl( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 230 |                 size_t posn = bsearchl( key, vals, dim );
 | 
|---|
 | 231 |                 return (E *)(&vals[posn]);                                              // cast away const
 | 
|---|
 | 232 |         } // bsearchl
 | 
|---|
 | 233 | 
 | 
|---|
 | 234 |         size_t bsearchu( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 235 |                 size_t l = 0, m, h = dim;
 | 
|---|
 | 236 |                 while ( l < h ) {
 | 
|---|
 | 237 |                         m = (l + h) / 2;
 | 
|---|
 | 238 |                         if ( ! ( key < getKey( vals[m] ) ) ) {
 | 
|---|
 | 239 |                                 l = m + 1;
 | 
|---|
 | 240 |                         } else {
 | 
|---|
 | 241 |                                 h = m;
 | 
|---|
 | 242 |                         } // if
 | 
|---|
 | 243 |                 } // while
 | 
|---|
 | 244 |                 return l;
 | 
|---|
 | 245 |         } // bsearchu
 | 
|---|
 | 246 | 
 | 
|---|
 | 247 |         E * bsearchu( K key, const E * vals, size_t dim ) {
 | 
|---|
 | 248 |                 size_t posn = bsearchu( key, vals, dim );
 | 
|---|
 | 249 |                 return (E *)(&vals[posn]);
 | 
|---|
 | 250 |         } // bsearchu
 | 
|---|
 | 251 | } // distribution
 | 
|---|
| [bd85400] | 252 | 
 | 
|---|
 | 253 | //---------------------------------------
 | 
|---|
 | 254 | 
 | 
|---|
| [bbe1a87] | 255 | extern "C" {                                                                                    // override C version
 | 
|---|
 | 256 |         void srandom( unsigned int seed ) { srand48( (long int)seed ); }
 | 
|---|
 | 257 |         long int random( void ) { return mrand48(); }
 | 
|---|
 | 258 | } // extern "C"
 | 
|---|
 | 259 | 
 | 
|---|
| [e672372] | 260 | float random( void ) { return (float)drand48(); }               // cast otherwise float uses lrand48
 | 
|---|
| [70e4895d] | 261 | double random( void ) { return drand48(); }
 | 
|---|
 | 262 | float _Complex random( void ) { return (float)drand48() + (float _Complex)(drand48() * _Complex_I); }
 | 
|---|
 | 263 | double _Complex random( void ) { return drand48() + (double _Complex)(drand48() * _Complex_I); }
 | 
|---|
| [e672372] | 264 | long double _Complex random( void ) { return (long double)drand48() + (long double _Complex)(drand48() * _Complex_I); }
 | 
|---|
| [a9f2c13] | 265 | 
 | 
|---|
| [2026bb6] | 266 | //---------------------------------------
 | 
|---|
 | 267 | 
 | 
|---|
 | 268 | bool threading_enabled(void) __attribute__((weak)) {
 | 
|---|
 | 269 |         return false;
 | 
|---|
 | 270 | }
 | 
|---|
| [bd85400] | 271 | 
 | 
|---|
 | 272 | // Local Variables: //
 | 
|---|
 | 273 | // tab-width: 4 //
 | 
|---|
 | 274 | // End: //
 | 
|---|