Lhogho  0.0.028
 All Data Structures Files Functions Variables Typedefs Macros Pages
numbers.c File Reference

Go to the source code of this file.

Macros

#define EPSILON   1E-64
 used for numerical comparison More...
 
#define DUMP_BUF_SIZE   128
 
#define DUMP_BUF_SIZE   128
 
#define DUMP_BUF_SIZE   128
 

Functions

void delete_numeric (atom_t a)
 deletes numeric atom More...
 
atom_t new_integer (int64_t data)
 creates a new integer atom More...
 
atom_t new_float (float64_t data)
 creates a new floating-point atom More...
 
void dump_integer (atom_t a, int level)
 dumps integer atom More...
 
void dump_integer_const (int a)
 dumps integer constant More...
 
void dump_float (atom_t a, int level)
 dumps float atom More...
 
int atom_to_float (atom_t a, float64_t *np)
 convert atom to a float More...
 
int atom_to_int (atom_t a, int64_t *np)
 convert atom to an integer More...
 
int atom_to_integer (atom_t a, int *np)
 convert atom to an 32-bit integer More...
 

Macro Definition Documentation

#define EPSILON   1E-64

Definition at line 72 of file numbers.c.

#define DUMP_BUF_SIZE   128
#define DUMP_BUF_SIZE   128
#define DUMP_BUF_SIZE   128

Function Documentation

void delete_numeric ( atom_t  a)
Parameters
aatom to delete

Deletes integer or float atom by returning it back to the data pool.

Definition at line 83 of file numbers.c.

84 {
86 }
atom_t new_integer ( int64_t  data)
Parameters
data64-bit integer
Returns
integer atom

Creates an integer atom with reference count 1.

Definition at line 99 of file numbers.c.

100 {
102 
103  REF(a) = 1;
104  ID(a) = INTEGER_ID;
105  INTEGER(a) = data;
106 
107  #ifdef DEBUG_ATOM
108  printf("<ATOM> [%08x] integer=%I64d\n",(int)a,data);
109  #endif //DEBUG_ATOM
110 
111  #ifdef ADVANCED
112  stats[ID(a)].allocs++;
113  if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
114  stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
115  stats_free--;
116  #endif //ADVANCED
117 
118  #ifdef DEBUG_RUNTIME_ATOMS
120  {
121  outter( TEXT("<RUNTIME> new "), -1 );
122  dump_atom_address( a );
123  dump_atom( a, 1 );
124  outter( TEXT("\n"), -1 );
125  }
126  #endif
127  #ifdef DEBUG_COMPILETIME_ATOMS
128  if( compiling_code )
129  {
130  outter( TEXT("<COMPILETIME> new "), -1 );
131  dump_atom_address( a );
132  dump_atom( a, 1 );
133  outter( TEXT("\n"), -1 );
134  }
135  #endif
136 
137  return a;
138 }
atom_t new_float ( float64_t  data)
Parameters
data64-bit floating-point
Returns
float atom

Creates an floating-point atom with reference count 1.

Definition at line 152 of file numbers.c.

153 {
155 
156  REF(a) = 1;
157  ID(a) = FLOAT_ID;
158  FLOAT(a) = data;
159 
160 //if( IS_FLOAT(a) )
161 //{
162 //printf("SET.FLT[%08x] %0.14f ref %d\n", (int)a, FLOAT(a), REF(a) );
163 //}
164 
165  #ifdef DEBUG_ATOM
166  printf("<ATOM> [%08x] float=%Lf\n",(int)a,data);
167  #endif //DEBUG_ATOM
168 
169  #ifdef ADVANCED
170  stats[ID(a)].allocs++;
171  if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
172  stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
173  stats_free--;
174  #endif //ADVANCED
175 
176  #ifdef DEBUG_RUNTIME_ATOMS
178  {
179  outter( TEXT("<RUNTIME> new "), -1 );
180  dump_atom_address( a );
181  dump_atom( a, 1 );
182  outter( TEXT("\n"), -1 );
183  }
184  #endif
185  #ifdef DEBUG_COMPILETIME_ATOMS
186  if( compiling_code )
187  {
188  outter( TEXT("<COMPILETIME> new "), -1 );
189  dump_atom_address( a );
190  dump_atom( a, 1 );
191  outter( TEXT("\n"), -1 );
192  }
193  #endif
194 
195  return a;
196 }
void dump_integer ( atom_t  a,
int  level 
)
Parameters
aatom to dump
leveldump level

Dumps integer atom through the current outter function.

Definition at line 209 of file numbers.c.

210 {
211  if( IS_UNBOUND(a) )
212  {
213  outter( TEXT("(unbound)"), 9 );
214  outter_size += 9;
215  }
216  else
217  if( IS_STOPPED(a) )
218  {
219  outter( TEXT("(stopped)"), 9 );
220  outter_size += 9;
221  }
222  else
223  {
224  #define DUMP_BUF_SIZE 128
225  char_t buf[DUMP_BUF_SIZE];
226  int n;
227 
228  n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_INT, INTEGER(a) );
229 
230  int limit = print_width_limit;
231 
232  if( 0<=limit && limit<10 ) limit=10;
233 
234  if( 0<=limit && limit<n )
235  {
236  outter( buf, limit );
237  outter( TEXT("..."), 3 );
238  outter_size += limit+3;
239  }
240  else
241  {
242  outter( buf, n );
243  outter_size += n;
244  }
245 
246  #undef DUMP_BUF_SIZE
247  }
248 }
void dump_integer_const ( int  a)
Parameters
avalue to dump

Dumps integer constant through the current outter function.

Definition at line 260 of file numbers.c.

261 {
262  #define DUMP_BUF_SIZE 128
263  char_t buf[DUMP_BUF_SIZE];
264  int n;
265 
266  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("%d"), a );
267  outter( buf, n );
268 
269  #undef DUMP_BUF_SIZE
270 }
void dump_float ( atom_t  a,
int  level 
)
Parameters
aatom to dump
leveldump level

Dumps float atom through the current outter function.

Definition at line 311 of file numbers.c.

312 {
313  // In Window infinities are printed as "1.#INF" instead
314  // of just "inf", and "-1.#IND" instead of "nan". So let's fix this.
315  // In some Linuxes sqrt(-1) is "nan" in others it is "-nan".
316  // Let's make "-nan" be "nan"
317  #ifdef WINDOWS
318  if( isinf(FLOAT(a))!=0 && FLOAT(a)>0 )
319  {
320  outter( TEXT("inf"), 3 );
321  outter_size += 3;
322  return;
323  }
324 
325  if( isinf(FLOAT(a))!=0 && FLOAT(a)<0 )
326  {
327  outter( TEXT("-inf"), 4 );
328  outter_size += 4;
329  return;
330  }
331  #endif //WINDOWS
332 
333  // Convert "-nan" to "nan"
334  if( isnan(FLOAT(a))!=0 )
335  {
336  outter( TEXT("nan"), 3 );
337  outter_size += 3;
338  return;
339  }
340 
341  #define DUMP_BUF_SIZE 128
342  char_t buf[DUMP_BUF_SIZE];
343  int n;
344  float64_t x = FLOAT(a);
345  if( x==0 && signbit(x) ) x = 0;
346 
347  // remove trailing zeros and decimal point
348  if( (x>=1e23) || (x<=-1e23) || ((x>=-1e-23) && (x<=1e-23)) )
349  n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_EXTRA_FP, x );
350  else
351  {
352  n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_FP, x );
353 
354  //if( !buf[n-1] ) n--; // remove trailing null character (should not appear, but it does!)
355  while( buf[n-1]==L'0' ) n--; // remove trailing zero
356  if( buf[n-1]==L'.' ) n--; // remove default decimal point
357  if( (unsigned char)buf[n-1]<128
358  && buf[n-1]==*(locale_info->decimal_point) ) n--;
359  }
360 
361 
362  int limit = print_width_limit;
363 
364  if( 0<=limit && limit<10 ) limit=10;
365 
366  if( 0<=limit && limit<n )
367  {
368  outter( buf, limit );
369  outter( TEXT("..."), 3 );
370  outter_size += limit+3;
371  }
372  else
373  {
374  outter( buf, n );
375  outter_size += n;
376  }
377 
378 
379  #undef DUMP_BUF_SIZE
380 }
int atom_to_float ( atom_t  a,
float64_t np 
)
Parameters
aatom to convert
nppointer where to put the number
Returns
returns 1 if conversion was successful.

Converts an atom to a floating point number. If conversion is possible, then *np will contain the number and the return value will be 1. Otherwise *np will be uninitialized and the return value will be 0.

Definition at line 398 of file numbers.c.

399 {
400  // test for unbound
401  if( IS_UNBOUND(a) )
402  {
403  return 0;
404  }
405 
406  // convert integer->float
407  if( IS_INTEGER(a) )
408  {
409  *np = INTEGER(a);
410  return 1;
411  }
412 
413  // convert float->float
414  if( IS_FLOAT(a) )
415  {
416  *np = FLOAT(a);
417  return 1;
418  }
419 
420  // fail if not a word
421  if( !IS_ANY_WORD(a) )
422  {
423  return 0;
424  }
425 
426  // convert word->float
427  int cnt = LENGTH(a);
428  chars_t ptr = STRING(a);
429  char_t chr = *(ptr+cnt);
430  char_t *end;
431  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */
432 
433  if( (*ptr==TEXT('0')) && ((*(ptr+1)==TEXT('x')) || (*(ptr+1)==TEXT('X'))))
434  { // it is a hex number
435  *np = STRTOL(ptr,&end);
436  }
437  else
438  { // it is a dec number
439  *np = STRTOD(ptr,&end);
440  }
441  *(ptr+cnt) = chr; /* recover the original string */
442 
443  // test for successful conversion
444  if( end-ptr==cnt ) return 1;
445 
446 
447  // test for infinities/nonanumbers in Windows
448 #ifdef WINDOWS
449  if( LENGTH(a)==3 &&
450  same_strings(1,STRING(a),TEXT("inf"),3) )
451  {
452  *np = INFINITY;
453  return 1;
454  }
455  if( LENGTH(a)==4 &&
456  same_strings(1,STRING(a),TEXT("-inf"),4) )
457  {
458  *np = -INFINITY;
459  return 1;
460  }
461  if( LENGTH(a)==3 &&
462  same_strings(1,STRING(a),TEXT("nan"),3) )
463  {
464  *np = NAN;
465  return 1;
466  }
467 #endif //WINDOWS
468 
469  return 0;
470 }
int atom_to_int ( atom_t  a,
int64_t *  np 
)
Parameters
aatom to convert
nppointer where to put the number
Returns
returns 1 if conversion was successful.

Converts an atom to a 64-bit integer number. If conversion is possible, then *np will contain the number and the return value will be 1. Otherwise *np is uninitialized and the return value will be set to 0.

Definition at line 488 of file numbers.c.

489 {
490  // test for unbound
491  if( IS_UNBOUND(a) )
492  {
493  return 0;
494  }
495 
496  // convert integer->float
497  if( IS_INTEGER(a) )
498  {
499  *np = INTEGER(a);
500  return 1;
501  }
502 
503  // convert float->float
504  if( IS_FLOAT(a) )
505  {
506  *np = FLOAT(a);
507  return abs(*np-FLOAT(a))<EPSILON;
508  }
509 
510  // fail if not a word
511  if( !IS_ANY_WORD(a) )
512  {
513  return 0;
514  }
515 
516  // convert word->float
517  int cnt = LENGTH(a);
518  chars_t ptr = STRING(a);
519  char_t chr = *(ptr+cnt);
520  char_t *end;
521  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */
522  *np = STRTOL(ptr,&end);
523  *(ptr+cnt) = chr; /* recover the original string */
524 
525  // test for successful conversion
526  if( end-ptr==cnt ) return 1;
527 
528  return 0;
529 }
int atom_to_integer ( atom_t  a,
int *  np 
)
Parameters
aatom to convert
nppointer where to put the number
Returns
returns 1 if conversion was successful.

Converts an atom to a 32-bit integer number. If conversion is possible, then *np will contain the number and the return value will be 1. Otherwise *np will be set to -1 and the return value will be set to 0.

Definition at line 546 of file numbers.c.

547 {
548  *np = -1;
549 
550  // test for unbound
551  if( IS_UNBOUND(a) )
552  {
553  return 0;
554  }
555 
556  // convert integer->float
557  if( IS_INTEGER(a) )
558  {
559  *np = INTEGER(a);
560  return 1;
561  }
562 
563  // convert float->float
564  if( IS_FLOAT(a) )
565  {
566  *np = FLOAT(a);
567  return abs(*np-FLOAT(a))<EPSILON;
568  }
569 
570  // fail if not a word
571  if( !IS_ANY_WORD(a) )
572  {
573  return 0;
574  }
575 
576  // convert word->float
577  int cnt = LENGTH(a);
578  chars_t ptr = STRING(a);
579  char_t chr = *(ptr+cnt);
580  char_t *end;
581  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */
582  *np = STRTOL(ptr,&end);
583  *(ptr+cnt) = chr; /* recover the original string */
584 
585  // test for successful conversion
586  if( end-ptr==cnt ) return 1;
587 
588  return 0;
589 }

[ HOME | INDEX | ATOMS | VARS | REFERENCE ]
Lhogho Developer's Documentation
Wed Jul 10 2013