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