| 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 | //
 | 
|---|
| 7 | // stdlib.c --
 | 
|---|
| 8 | //
 | 
|---|
| 9 | // Author           : Peter A. Buhr
 | 
|---|
| 10 | // Created On       : Thu Jan 28 17:10:29 2016
 | 
|---|
| 11 | // Last Modified By : Peter A. Buhr
 | 
|---|
| 12 | // Last Modified On : Sun Apr 21 16:17:22 2024
 | 
|---|
| 13 | // Update Count     : 700
 | 
|---|
| 14 | //
 | 
|---|
| 15 | 
 | 
|---|
| 16 | #include "stdlib.hfa"
 | 
|---|
| 17 | #include "bits/random.hfa"
 | 
|---|
| 18 | #include "concurrency/invoke.h"                                                 // random_state
 | 
|---|
| 19 | 
 | 
|---|
| 20 | //---------------------------------------
 | 
|---|
| 21 | 
 | 
|---|
| 22 | #include <string.h>                                                                             // memcpy, memset
 | 
|---|
| 23 | #include <complex.h>                                                                    // _Complex_I
 | 
|---|
| 24 | #include <assert.h>
 | 
|---|
| 25 | #include <ctype.h>                                                                              // isblank
 | 
|---|
| 26 | 
 | 
|---|
| 27 | #pragma GCC visibility push(default)
 | 
|---|
| 28 | 
 | 
|---|
| 29 | //---------------------------------------
 | 
|---|
| 30 | 
 | 
|---|
| 31 | // Cforall allocation/deallocation and constructor/destructor, array types
 | 
|---|
| 32 | 
 | 
|---|
| 33 | forall( T & | sized(T), Parms ... | { void ?{}( T &, Parms ); } )
 | 
|---|
| 34 | T * anew( size_t dim, Parms p ) {
 | 
|---|
| 35 |         T * arr = alloc( dim );
 | 
|---|
| 36 |         for ( i; dim ) {
 | 
|---|
| 37 |                 (arr[i]){ p };                                                                  // run constructor
 | 
|---|
| 38 |         } // for
 | 
|---|
| 39 |         return arr;
 | 
|---|
| 40 | } // anew
 | 
|---|
| 41 | 
 | 
|---|
| 42 | forall( T & | sized(T) | { void ^?{}( T & ); } )
 | 
|---|
| 43 | void adelete( T arr[] ) {
 | 
|---|
| 44 |         if ( arr ) {                                                                            // ignore null
 | 
|---|
| 45 |                 size_t dim = malloc_size( arr ) / sizeof( T );
 | 
|---|
| 46 |                 for ( i; 0 -~= dim - 1 ) {                                              // reverse allocation order, must be unsigned
 | 
|---|
| 47 |                         ^(arr[i]){};                                                            // run destructor
 | 
|---|
| 48 |                 } // for
 | 
|---|
| 49 |                 free( arr );
 | 
|---|
| 50 |         } // if
 | 
|---|
| 51 | } // adelete
 | 
|---|
| 52 | 
 | 
|---|
| 53 | forall( T & | sized(T) | { void ^?{}( T & ); }, List ... | { void adelete( List ); } )
 | 
|---|
| 54 | void adelete( T arr[], List rest ) {
 | 
|---|
| 55 |         if ( arr ) {                                                                            // ignore null
 | 
|---|
| 56 |                 size_t dim = malloc_size( arr ) / sizeof( T );
 | 
|---|
| 57 |                 for ( i; 0 -~= dim - 1 ) {                                              // reverse allocation order, must be unsigned
 | 
|---|
| 58 |                         ^(arr[i]){};                                                            // run destructor
 | 
|---|
| 59 |                 } // for
 | 
|---|
| 60 |                 free( arr );
 | 
|---|
| 61 |         } // if
 | 
|---|
| 62 |         adelete( rest );
 | 
|---|
| 63 | } // adelete
 | 
|---|
| 64 | 
 | 
|---|
| 65 | //---------------------------------------
 | 
|---|
| 66 | 
 | 
|---|
| 67 | // Check if all string characters are a specific kind, e.g., checkif( s, isblank )
 | 
|---|
| 68 | 
 | 
|---|
| 69 | bool checkif( const char s[], int (* kind)( int ) ) {
 | 
|---|
| 70 |         for () {
 | 
|---|
| 71 |                 if ( *s == '\0' ) return true;
 | 
|---|
| 72 |                 if ( ! kind( *s ) ) return false;
 | 
|---|
| 73 |                 s += 1;
 | 
|---|
| 74 |         } // for
 | 
|---|
| 75 | } // checkif
 | 
|---|
| 76 | 
 | 
|---|
| 77 | bool checkif( const char s[], int (* kind)( int, locale_t ), locale_t locale ) {
 | 
|---|
| 78 |         for () {
 | 
|---|
| 79 |                 if ( *s == '\0' ) return true;
 | 
|---|
| 80 |                 if ( ! kind( *s, locale ) ) return false;
 | 
|---|
| 81 |                 s += 1;
 | 
|---|
| 82 |         } // for
 | 
|---|
| 83 | } // checkif
 | 
|---|
| 84 | 
 | 
|---|
| 85 | //---------------------------------------
 | 
|---|
| 86 | 
 | 
|---|
| 87 | float _Complex strto( const char sptr[], char * eptr[] ) {
 | 
|---|
| 88 |         float re, im;
 | 
|---|
| 89 |         char * eeptr;
 | 
|---|
| 90 |         errno = 0;                                                                                      // reset
 | 
|---|
| 91 |         re = strtof( sptr, &eeptr );
 | 
|---|
| 92 |         if ( sptr != eeptr ) {
 | 
|---|
| 93 |                 im = strtof( eeptr, &eeptr );
 | 
|---|
| 94 |                 if ( sptr != eeptr ) {
 | 
|---|
| 95 |                         if ( *eeptr == 'i' ) {
 | 
|---|
| 96 |                                 if ( eptr != 0p ) *eptr = eeptr + 1;
 | 
|---|
| 97 |                                 return re + im * _Complex_I;
 | 
|---|
| 98 |                         } // if
 | 
|---|
| 99 |                 } // if
 | 
|---|
| 100 |         } // if
 | 
|---|
| 101 |         if ( eptr != 0p ) *eptr = eeptr;                                        // error case
 | 
|---|
| 102 |         return 0.0f + 0.0f * _Complex_I;
 | 
|---|
| 103 | } // strto
 | 
|---|
| 104 | 
 | 
|---|
| 105 | double _Complex strto( const char sptr[], char * eptr[] ) {
 | 
|---|
| 106 |         double re, im;
 | 
|---|
| 107 |         char * eeptr;
 | 
|---|
| 108 |         re = strtod( sptr, &eeptr );
 | 
|---|
| 109 |         if ( sptr != eeptr ) {
 | 
|---|
| 110 |                 im = strtod( eeptr, &eeptr );
 | 
|---|
| 111 |                 if ( sptr != eeptr ) {
 | 
|---|
| 112 |                         if ( *eeptr == 'i' ) {
 | 
|---|
| 113 |                                 if ( eptr != 0p ) *eptr = eeptr + 1;
 | 
|---|
| 114 |                                 return re + im * _Complex_I;
 | 
|---|
| 115 |                         } // if
 | 
|---|
| 116 |                 } // if
 | 
|---|
| 117 |         } // if
 | 
|---|
| 118 |         if ( eptr != 0p ) *eptr = eeptr;                                        // error case
 | 
|---|
| 119 |         return 0.0 + 0.0 * _Complex_I;
 | 
|---|
| 120 | } // strto
 | 
|---|
| 121 | 
 | 
|---|
| 122 | long double _Complex strto( const char sptr[], char * eptr[] ) {
 | 
|---|
| 123 |         long double re, im;
 | 
|---|
| 124 |         char * eeptr;
 | 
|---|
| 125 |         re = strtold( sptr, &eeptr );
 | 
|---|
| 126 |         if ( sptr != eeptr ) {
 | 
|---|
| 127 |                 im = strtold( eeptr, &eeptr );
 | 
|---|
| 128 |                 if ( sptr != eeptr ) {
 | 
|---|
| 129 |                         if ( *eeptr == 'i' ) {
 | 
|---|
| 130 |                                 if ( eptr != 0p ) *eptr = eeptr + 1;
 | 
|---|
| 131 |                                 return re + im * _Complex_I;
 | 
|---|
| 132 |                         } // if
 | 
|---|
| 133 |                 } // if
 | 
|---|
| 134 |         } // if
 | 
|---|
| 135 |         if ( eptr != 0p ) *eptr = eeptr;                                        // error case
 | 
|---|
| 136 |         return 0.0L + 0.0L * _Complex_I;
 | 
|---|
| 137 | } // strto
 | 
|---|
| 138 | 
 | 
|---|
| 139 | forall( T | { T strto( const char sptr[], char * eptr[], int ); } )
 | 
|---|
| 140 | T convert( const char sptr[] ) {                                                // integral
 | 
|---|
| 141 |         char * eptr;
 | 
|---|
| 142 |         errno = 0;                                                                                      // reset
 | 
|---|
| 143 |         T val = strto( sptr, &eptr, 10 );                                       // attempt conversion
 | 
|---|
| 144 |         if ( errno == ERANGE ) throw ExceptionInst( out_of_range );
 | 
|---|
| 145 |         if ( eptr == sptr ||                                                            // conversion failed, no characters generated
 | 
|---|
| 146 |                  eptr[0] != '\0' && ! checkif( eptr, isblank ) ) throw ExceptionInst( invalid_argument ); // not at end of blank str ?
 | 
|---|
| 147 |         return val;
 | 
|---|
| 148 | } // convert
 | 
|---|
| 149 | 
 | 
|---|
| 150 | forall( T | { T strto( const char sptr[], char * eptr[] ); } )
 | 
|---|
| 151 | T convert( const char sptr[] ) {                                                // floating-point
 | 
|---|
| 152 |         char * eptr;
 | 
|---|
| 153 |         errno = 0;                                                                                      // reset
 | 
|---|
| 154 |         T val = strto( sptr, &eptr );                                           // attempt conversion
 | 
|---|
| 155 |         if ( errno == ERANGE ) throw ExceptionInst( out_of_range );
 | 
|---|
| 156 |         if ( eptr == sptr ||                                                            // conversion failed, no characters generated
 | 
|---|
| 157 |                  eptr[0] != '\0' && ! checkif( eptr, isblank ) ) throw ExceptionInst( invalid_argument ); // not at end of blank str ?
 | 
|---|
| 158 |         return val;
 | 
|---|
| 159 | } // convert
 | 
|---|
| 160 | 
 | 
|---|
| 161 | //---------------------------------------
 | 
|---|
| 162 | 
 | 
|---|
| 163 | forall( E | { int ?<?( E, E ); } ) {
 | 
|---|
| 164 |         E * bsearch( E key, const E * vals, size_t dim ) {
 | 
|---|
| 165 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
| 166 |                         return *(E *)t1 < *(E *)t2 ? -1 : *(E *)t2 < *(E *)t1 ? 1 : 0;
 | 
|---|
| 167 |                 } // cmp
 | 
|---|
| 168 |                 return (E *)bsearch( &key, vals, dim, sizeof(E), cmp );
 | 
|---|
| 169 |         } // bsearch
 | 
|---|
| 170 | 
 | 
|---|
| 171 |         size_t bsearch( E key, const E * vals, size_t dim ) {
 | 
|---|
| 172 |                 E * result = bsearch( key, vals, dim );
 | 
|---|
| 173 |                 return result ? result - vals : dim;                    // pointer subtraction includes sizeof(E)
 | 
|---|
| 174 |         } // bsearch
 | 
|---|
| 175 | 
 | 
|---|
| 176 |         size_t bsearchl( E key, const E * vals, size_t dim ) {
 | 
|---|
| 177 |                 size_t l = 0, m, h = dim;
 | 
|---|
| 178 |                 while ( l < h ) {
 | 
|---|
| 179 |                         m = (l + h) / 2;
 | 
|---|
| 180 |                         if ( (E &)(vals[m]) < key ) {                           // cast away const
 | 
|---|
| 181 |                                 l = m + 1;
 | 
|---|
| 182 |                         } else {
 | 
|---|
| 183 |                                 h = m;
 | 
|---|
| 184 |                         } // if
 | 
|---|
| 185 |                 } // while
 | 
|---|
| 186 |                 return l;
 | 
|---|
| 187 |         } // bsearchl
 | 
|---|
| 188 | 
 | 
|---|
| 189 |         E * bsearchl( E key, const E * vals, size_t dim ) {
 | 
|---|
| 190 |                 size_t posn = bsearchl( key, vals, dim );
 | 
|---|
| 191 |                 return (E *)(&vals[posn]);                                              // cast away const
 | 
|---|
| 192 |         } // bsearchl
 | 
|---|
| 193 | 
 | 
|---|
| 194 |         size_t bsearchu( E key, const E * vals, size_t dim ) {
 | 
|---|
| 195 |                 size_t l = 0, m, h = dim;
 | 
|---|
| 196 |                 while ( l < h ) {
 | 
|---|
| 197 |                         m = (l + h) / 2;
 | 
|---|
| 198 |                         if ( ! ( key < (E &)(vals[m]) ) ) {                     // cast away const
 | 
|---|
| 199 |                                 l = m + 1;
 | 
|---|
| 200 |                         } else {
 | 
|---|
| 201 |                                 h = m;
 | 
|---|
| 202 |                         } // if
 | 
|---|
| 203 |                 } // while
 | 
|---|
| 204 |                 return l;
 | 
|---|
| 205 |         } // bsearchu
 | 
|---|
| 206 | 
 | 
|---|
| 207 |         E * bsearchu( E key, const E * vals, size_t dim ) {
 | 
|---|
| 208 |                 size_t posn = bsearchu( key, vals, dim );
 | 
|---|
| 209 |                 return (E *)(&vals[posn]);
 | 
|---|
| 210 |         } // bsearchu
 | 
|---|
| 211 | 
 | 
|---|
| 212 | 
 | 
|---|
| 213 |         void qsort( E * vals, size_t dim ) {
 | 
|---|
| 214 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
| 215 |                         return *(E *)t1 < *(E *)t2 ? -1 : *(E *)t2 < *(E *)t1 ? 1 : 0;
 | 
|---|
| 216 |                 } // cmp
 | 
|---|
| 217 |                 qsort( vals, dim, sizeof(E), cmp );
 | 
|---|
| 218 |         } // qsort
 | 
|---|
| 219 | } // distribution
 | 
|---|
| 220 | 
 | 
|---|
| 221 | 
 | 
|---|
| 222 | forall( K, E | { int ?<?( K, K ); K getKey( const E & ); } ) {
 | 
|---|
| 223 |         E * bsearch( K key, const E * vals, size_t dim ) {
 | 
|---|
| 224 |                 int cmp( const void * t1, const void * t2 ) {
 | 
|---|
| 225 |                         return *(K *)t1 < getKey( *(E *)t2 ) ? -1 : getKey( *(E *)t2 ) < *(K *)t1 ? 1 : 0;
 | 
|---|
| 226 |                 } // cmp
 | 
|---|
| 227 |                 return (E *)bsearch( &key, vals, dim, sizeof(E), cmp );
 | 
|---|
| 228 |         } // bsearch
 | 
|---|
| 229 | 
 | 
|---|
| 230 |         size_t bsearch( K key, const E * vals, size_t dim ) {
 | 
|---|
| 231 |                 E * result = bsearch( key, vals, dim );
 | 
|---|
| 232 |                 return result ? result - vals : dim;                    // pointer subtraction includes sizeof(E)
 | 
|---|
| 233 |         } // bsearch
 | 
|---|
| 234 | 
 | 
|---|
| 235 |         size_t bsearchl( K key, const E * vals, size_t dim ) {
 | 
|---|
| 236 |                 size_t l = 0, m, h = dim;
 | 
|---|
| 237 |                 while ( l < h ) {
 | 
|---|
| 238 |                         m = (l + h) / 2;
 | 
|---|
| 239 |                         if ( getKey( vals[m] ) < key ) {
 | 
|---|
| 240 |                                 l = m + 1;
 | 
|---|
| 241 |                         } else {
 | 
|---|
| 242 |                                 h = m;
 | 
|---|
| 243 |                         } // if
 | 
|---|
| 244 |                 } // while
 | 
|---|
| 245 |                 return l;
 | 
|---|
| 246 |         } // bsearchl
 | 
|---|
| 247 | 
 | 
|---|
| 248 |         E * bsearchl( K key, const E * vals, size_t dim ) {
 | 
|---|
| 249 |                 size_t posn = bsearchl( key, vals, dim );
 | 
|---|
| 250 |                 return (E *)(&vals[posn]);                                              // cast away const
 | 
|---|
| 251 |         } // bsearchl
 | 
|---|
| 252 | 
 | 
|---|
| 253 |         size_t bsearchu( K key, const E * vals, size_t dim ) {
 | 
|---|
| 254 |                 size_t l = 0, m, h = dim;
 | 
|---|
| 255 |                 while ( l < h ) {
 | 
|---|
| 256 |                         m = (l + h) / 2;
 | 
|---|
| 257 |                         if ( ! ( key < getKey( vals[m] ) ) ) {
 | 
|---|
| 258 |                                 l = m + 1;
 | 
|---|
| 259 |                         } else {
 | 
|---|
| 260 |                                 h = m;
 | 
|---|
| 261 |                         } // if
 | 
|---|
| 262 |                 } // while
 | 
|---|
| 263 |                 return l;
 | 
|---|
| 264 |         } // bsearchu
 | 
|---|
| 265 | 
 | 
|---|
| 266 |         E * bsearchu( K key, const E * vals, size_t dim ) {
 | 
|---|
| 267 |                 size_t posn = bsearchu( key, vals, dim );
 | 
|---|
| 268 |                 return (E *)(&vals[posn]);
 | 
|---|
| 269 |         } // bsearchu
 | 
|---|
| 270 | } // distribution
 | 
|---|
| 271 | 
 | 
|---|
| 272 | //---------------------------------------
 | 
|---|
| 273 | 
 | 
|---|
| 274 | extern "C" {                                                                                    // override C version
 | 
|---|
| 275 |         void srandom( unsigned int seed ) { srand48( (long int)seed ); }
 | 
|---|
| 276 |         long int random( void ) { return mrand48(); }           // GENERATES POSITIVE AND NEGATIVE VALUES
 | 
|---|
| 277 | } // extern "C"
 | 
|---|
| 278 | 
 | 
|---|
| 279 | float random( void ) { return (float)drand48(); }               // cast otherwise float uses lrand48
 | 
|---|
| 280 | double random( void ) { return drand48(); }
 | 
|---|
| 281 | float _Complex random( void ) { return (float)drand48() + (float _Complex)(drand48() * _Complex_I); }
 | 
|---|
| 282 | double _Complex random( void ) { return drand48() + (double _Complex)(drand48() * _Complex_I); }
 | 
|---|
| 283 | long double _Complex random( void ) { return (long double)drand48() + (long double _Complex)(drand48() * _Complex_I); }
 | 
|---|
| 284 | 
 | 
|---|
| 285 | //---------------------------------------
 | 
|---|
| 286 | 
 | 
|---|
| 287 | // would be cool to make hidden but it's needed for libcfathread
 | 
|---|
| 288 | __attribute__((visibility("default"))) size_t __global_random_seed; // sequential/concurrent
 | 
|---|
| 289 | __attribute__((visibility("hidden"))) PRNG_STATE_T __global_random_state; // sequential only
 | 
|---|
| 290 | 
 | 
|---|
| 291 | void set_seed( size_t seed ) {
 | 
|---|
| 292 |         __global_random_seed = seed;
 | 
|---|
| 293 |         PRNG_SET_SEED( __global_random_state, seed );
 | 
|---|
| 294 | } // set_seed
 | 
|---|
| 295 | 
 | 
|---|
| 296 | size_t get_seed() { return __global_random_seed; }
 | 
|---|
| 297 | size_t prng( void ) { return PRNG_NAME( __global_random_state ); } // [0,UINT_MAX]
 | 
|---|
| 298 | 
 | 
|---|
| 299 | //---------------------------------------
 | 
|---|
| 300 | 
 | 
|---|
| 301 | bool threading_enabled( void ) __attribute__(( weak )) { return false; }
 | 
|---|
| 302 | 
 | 
|---|
| 303 | // Local Variables: //
 | 
|---|
| 304 | // tab-width: 4 //
 | 
|---|
| 305 | // End: //
 | 
|---|