Defines
#define	INTEGER(x) ((x)->unode.i[1])
#define	FLOAT(x) ((x)->unode.f[1])
#define	IS_INTEGER(x) (ID(x)==INTEGER_ID)
#define	IS_FLOAT(x) (ID(x)==FLOAT_ID)
#define	REPCOUNT(x) ((x)->unode.n[2])
#define	REPLIMIT(x) ((x)->unode.n[3])
#define	FORMAT_INT TEXT("%Ld")
#define	FORMAT_FP TEXT("%0.14f")
#define	FORMAT_EXTRA_FP TEXT("%g")
Functions
atom_t	new_integer (int64_t data)
	creates a new integer atom
atom_t	new_float (float64_t data)
	creates a new floating-point atom
void	delete_numeric (atom_t a)
	deletes numeric atom
void	dump_integer (atom_t a, int level)
	dumps integer atom
void	dump_integer_const (int a)
	dumps integer constant
void	dump_float (atom_t a, int level)
	dumps float atom
int	atom_to_float (atom_t a, float64_t *np)
	convert atom to a float
int	atom_to_int (atom_t a, int64_t *np)
	convert atom to an integer
int	atom_to_integer (atom_t a, int *np)
	convert atom to an 32-bit integer
Variables
int	stats_free
	statistics for free atoms (of any type)

Define Documentation

#define INTEGER ( x ) ((x)->unode.i[1])

#define FLOAT ( x ) ((x)->unode.f[1])

#define IS_INTEGER ( x ) (ID(x)==INTEGER_ID)

#define IS_FLOAT ( x ) (ID(x)==FLOAT_ID)

#define REPCOUNT ( x ) ((x)->unode.n[2])

#define REPLIMIT ( x ) ((x)->unode.n[3])

#define FORMAT_INT TEXT("%Ld")

#define FORMAT_FP TEXT("%0.14f")

#define FORMAT_EXTRA_FP TEXT("%g")

Function Documentation

atom_t new_integer ( int64_t data )

Parameters:

data	64-bit integer

Returns:: integer atom

Creates an integer atom with reference count 1.

{
  atom_t a = (atom_t)take_from_pool( &data_pool );

  REF(a)     = 1;
  ID(a)       = INTEGER_ID;
  INTEGER(a) = data;

  #ifdef DEBUG_ATOM
    printf("<ATOM>  [%08x] integer=%I64d\n",(int)a,data);
  #endif //DEBUG_ATOM

  #ifdef ADVANCED
    stats[ID(a)].allocs++;
    if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
      stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
    stats_free--;
  #endif //ADVANCED

  #ifdef DEBUG_RUNTIME_ATOMS
  if( running_compiled_code )
    {
      outter( TEXT("<RUNTIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif
  #ifdef DEBUG_COMPILETIME_ATOMS
  if( compiling_code )
    {
      outter( TEXT("<COMPILETIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif

  return a;
}

atom_t new_float ( float64_t data )

Parameters:

data	64-bit floating-point

Returns:: float atom

Creates an floating-point atom with reference count 1.

{
  atom_t a = (atom_t)take_from_pool( &data_pool );

  REF(a)   = 1;
  ID(a)    = FLOAT_ID;
  FLOAT(a) = data;

//if( IS_FLOAT(a) )
//{
//printf("SET.FLT[%08x] %0.14f ref %d\n", (int)a, FLOAT(a), REF(a) );
//}

  #ifdef DEBUG_ATOM
    printf("<ATOM>  [%08x] float=%Lf\n",(int)a,data);
  #endif //DEBUG_ATOM

  #ifdef ADVANCED
    stats[ID(a)].allocs++;
    if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
      stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
    stats_free--;
  #endif //ADVANCED

  #ifdef DEBUG_RUNTIME_ATOMS
  if( running_compiled_code )
    {
      outter( TEXT("<RUNTIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif
  #ifdef DEBUG_COMPILETIME_ATOMS
  if( compiling_code )
    {
      outter( TEXT("<COMPILETIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif

  return a;
}

void delete_numeric ( atom_t a )

Parameters:

a	atom to delete

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

{
  return_to_pool( &data_pool, a );
}

void dump_integer	(	atom_t	a,
		int	level
	)

Parameters:

a	atom to dump
level	dump level

Dumps integer atom through the current outter function.

{
  if( IS_UNBOUND(a) )
    {
      outter( TEXT("(unbound)"), 9 );
      outter_size += 9;
    }
  else
  if( IS_STOPPED(a) )
    {
      outter( TEXT("(stopped)"), 9 );
      outter_size += 9;
    }
  else
    {
      #define DUMP_BUF_SIZE 128
      char_t buf[DUMP_BUF_SIZE];
      int n;

      n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_INT, INTEGER(a) );

      int limit = print_width_limit;

      if( 0<=limit && limit<10 ) limit=10;

      if( 0<=limit && limit<n )
   {
     outter( buf, limit );
     outter( TEXT("..."), 3 );
     outter_size += limit+3;
   }
      else
   {
     outter( buf, n );
     outter_size += n;
   }

      #undef DUMP_BUF_SIZE
    }
}

void dump_integer_const ( int a )

Parameters:

a	value to dump

Dumps integer constant through the current outter function.

{
  #define DUMP_BUF_SIZE 128
  char_t buf[DUMP_BUF_SIZE];
  int n;

  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("%d"), a );
  outter( buf, n );

  #undef DUMP_BUF_SIZE
}

void dump_float	(	atom_t	a,
		int	level
	)

Parameters:

a	atom to dump
level	dump level

Dumps float atom through the current outter function.

{
  // In Window infinities are printed as "1.#INF" instead
  // of just "inf", and "-1.#IND" instead of "nan". So let's fix this.
  #ifdef WINDOWS
  if( isinf(FLOAT(a))!=0 && FLOAT(a)>0 )
    {
      outter( TEXT("inf"), 3 );
      outter_size += 3;
      return;
    }

  if( isinf(FLOAT(a))!=0 && FLOAT(a)<0 )
    {
      outter( TEXT("-inf"), 4 );
      outter_size += 4;
      return;
    }
  if( isnan(FLOAT(a))!=0 )
   {
      outter( TEXT("nan"), 3 );
      outter_size += 3;
      return;
    }
  #endif //WINDOWS

  #define DUMP_BUF_SIZE 128
  char_t buf[DUMP_BUF_SIZE];
  int n;
  float64_t x = FLOAT(a);
  if( x==0 && signbit(x) ) x = 0;

  // remove trailing zeros and decimal point
  if( (x>=1e23) || (x<=-1e23) || ((x>=-1e-23) && (x<=1e-23)) )
    n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_EXTRA_FP, x );
  else
    {
      n = SPRINTF( buf, DUMP_BUF_SIZE, FORMAT_FP, x );
     
      //if( !buf[n-1] ) n--;  // remove trailing null character (should not appear, but it does!)
      while( buf[n-1]==L'0' ) n--;  // remove trailing zero
      if( buf[n-1]==L'.' ) n--;  // remove default decimal point
      if( (unsigned char)buf[n-1]<128
          && buf[n-1]==*(locale_info->decimal_point) ) n--;
    }


  int limit = print_width_limit;

  if( 0<=limit && limit<10 ) limit=10;

  if( 0<=limit && limit<n )
    {
      outter( buf, limit );
      outter( TEXT("..."), 3 );
      outter_size += limit+3;
    }
  else
    {
      outter( buf, n );
      outter_size += n;
    }


  #undef DUMP_BUF_SIZE
}

int atom_to_float	(	atom_t	a,
		float64_t *	np
	)

Parameters:

a	atom to convert
np	pointer 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.

{
  // test for unbound
  if( IS_UNBOUND(a) )
    {
      return 0;
    }

  // convert integer->float
  if( IS_INTEGER(a) ) 
    {
      *np = INTEGER(a);
      return 1;
    }

  // convert float->float
  if( IS_FLOAT(a) ) 
    {
      *np = FLOAT(a);
      return 1;
    }

  // fail if not a word
  if( !IS_ANY_WORD(a) )
    {
      return 0;
    }

  // convert word->float
  int     cnt = LENGTH(a);
  chars_t ptr = STRING(a);
  char_t  chr = *(ptr+cnt);
  char_t  *end;
  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */

  if( (*ptr==TEXT('0')) && ((*(ptr+1)==TEXT('x')) || (*(ptr+1)==TEXT('X'))))
    { // it is a hex number
      *np = STRTOL(ptr,&end);
    }
  else
    { // it is a dec number
      *np = STRTOD(ptr,&end);
    }
  *(ptr+cnt) = chr;     /* recover the original string  */

  // test for successful conversion
  if( end-ptr==cnt ) return 1;


  // test for infinities/nonanumbers in Windows
#ifdef WINDOWS
  if( LENGTH(a)==3 &&
      same_strings(1,STRING(a),TEXT("inf"),3) )
    {
      *np = INFINITY;
      return 1;
    }
  if( LENGTH(a)==4 &&
      same_strings(1,STRING(a),TEXT("-inf"),4) )
    {
      *np = -INFINITY;
      return 1;
    }
  if( LENGTH(a)==3 &&
      same_strings(1,STRING(a),TEXT("nan"),3) )
    {
      *np = NAN;
      return 1;
    }
#endif //WINDOWS

  return 0;
}

int atom_to_int	(	atom_t	a,
		int64_t *	np
	)

Parameters:

a	atom to convert
np	pointer 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.

{
  // test for unbound
  if( IS_UNBOUND(a) )
    {
      return 0;
    }

  // convert integer->float
  if( IS_INTEGER(a) ) 
    {
      *np = INTEGER(a);
      return 1;
    }

  // convert float->float
  if( IS_FLOAT(a) ) 
    {
      *np = FLOAT(a);
      return abs(*np-FLOAT(a))<EPSILON;
    }

  // fail if not a word
  if( !IS_ANY_WORD(a) )
    {
      return 0;
    }

  // convert word->float
  int     cnt = LENGTH(a);
  chars_t ptr = STRING(a);
  char_t  chr = *(ptr+cnt);
  char_t  *end;
  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */
  *np = STRTOL(ptr,&end);
  *(ptr+cnt) = chr;     /* recover the original string  */

  // test for successful conversion
  if( end-ptr==cnt ) return 1;

  return 0;
}

int atom_to_integer	(	atom_t	a,
		int *	np
	)

Parameters:

a	atom to convert
np	pointer 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.

{
  *np = -1;

  // test for unbound
  if( IS_UNBOUND(a) )
    {
      return 0;
    }

  // convert integer->float
  if( IS_INTEGER(a) ) 
    {
      *np = INTEGER(a);
      return 1;
    }

  // convert float->float
  if( IS_FLOAT(a) ) 
    {
      *np = FLOAT(a);
      return abs(*np-FLOAT(a))<EPSILON;
    }

  // fail if not a word
  if( !IS_ANY_WORD(a) )
    {
      return 0;
    }

  // convert word->float
  int     cnt = LENGTH(a);
  chars_t ptr = STRING(a);
  char_t  chr = *(ptr+cnt);
  char_t  *end;
  *(ptr+cnt) = TEXT('\0'); /* set artificial end of string */
  *np = STRTOL(ptr,&end);
  *(ptr+cnt) = chr;     /* recover the original string  */

  // test for successful conversion
  if( end-ptr==cnt ) return 1;

  return 0;
}

Variable Documentation

int stats_free

Defines

Functions

Variables

Define Documentation

Function Documentation

Variable Documentation