Data Structures
struct	typeid_rec
Defines
#define	C_TYPE_UNKNOWN 0
	unknown C-type
#define	C_TYPE_STRUCT 1
	struct C-type
#define	C_TYPE_SIGNED 2
	signed integer C-type
#define	C_TYPE_UNSIGNED 3
	unsigned integer C-type
#define	C_TYPE_FLOAT 4
	float or double C-type
#define	C_TYPE_VOID 5
	void C-type
#define	C_TYPE_POINTER 6
	pointer C-type
#define	C_TYPE_STRING 7
	string C-type
#define	C_TYPE_ATOM 8
	Lhogho atom.
Typedefs
typedef struct typeid_rec	typeid_t
	description structure of a C-type identifiers
Functions
int	get_c_type (int static_link, atom_t parent, atom_t type)
	gets the C-type of a type
atom_t	traverse_pack (int static_link, atom_t parent, atom_t prototype, atom_t protodata, char *ptr, int mode)
	traverses packed data
Variables
typeid_t	c_types []

Define Documentation

#define C_TYPE_UNKNOWN 0

#define C_TYPE_STRUCT 1

#define C_TYPE_SIGNED 2

#define C_TYPE_UNSIGNED 3

#define C_TYPE_FLOAT 4

#define C_TYPE_VOID 5

#define C_TYPE_POINTER 6

#define C_TYPE_STRING 7

#define C_TYPE_ATOM 8

Typedef Documentation

typedef struct typeid_rec typeid_t

Function Documentation

int get_c_type	(	int	static_link,
		atom_t	parent,
		atom_t	type
	)

Parameters:

static_link	static link from the current frame
parent	current parent
type	word containing type name

Returns:: index of C-type

This function finds the C-type index of a type. This index can be used with c_types[] array to get additional information about the C-type.

This function does not recurse into struct types.

{
  int c_type;
  
try_again:
  c_type = type_info( type );
  if( c_type==C_TYPE_UNKNOWN )
  {
    type = type_value( static_link, parent, type );
    if( IS_UNBOUND(type) ) return C_TYPE_UNKNOWN;
    goto try_again;
  }
  return c_type;
}

atom_t traverse_pack	(	int	static_link,
		atom_t	parent,
		atom_t	prototype,
		atom_t	protodata,
		char *	ptr,
		int	mode
	)

Parameters:

static_link	static link from the current frame
parent	current parent
prototype	list describing the c-type in the pack
protodata	list containing the Logo data
ptr	pointer to memory with C data
mode	mode of traversal

Returns:: traversal result (depends on the mode)

This function traverses a structure defined by c-type prototype and performs an action determined by mode.

If mode is MEM_STRUCT_SIZE then only the size of the packed data is calculated. Parameters protodata and ptr are not used. The returned value is an integer atom containing the size.

If mode is MEM_STRUCT_PACK then Logo data from protodata is packed into the memory pointed to by ptr using the structure described in prototype. The result is unbound atom.

If mode is MEM_STRUCT_UNPACK then packed data from ptr is unpacked into a list of Logo data using the structure described in prototype . The result of traverse_pack is the list of Logo data.

{
  int ofs = 0;
  atom_t new_type;
  
  atom_t traverse( atom_t prototype, atom_t protodata )
  {
    atom_t result = unbound;
    atom_t result_end;
    
    // check prototype list
    if (IS_ERROR( prototype )) return prototype;
    if (!IS_LIST( prototype )) return new_error( ERROR_NOT_A_LIST, prototype );

    // check data list
    if (IS_ERROR( protodata )) return protodata;
    if (!IS_LIST( protodata )) return new_error( ERROR_NOT_A_LIST, protodata );

    if( mode==MEM_STRUCT_UNPACK )
    {
      result = empty_list;
      result_end = empty_list;
    }
    
    int count = 1;
    
#define GET_NEXT_TYPE   prototype = CDR( prototype )
#define GET_NEXT_DATA   protodata = CDR( protodata )

    // scan all elements of the prototype
    for (; IS_NOT_EMPTY( prototype ); )
    {
      atom_t type = CAR( prototype );
      atom_t data = CAR( protodata );

try_again:

      // list prototypes are processed recursively
      if( IS_LIST(type) )
      {
        atom_t res = traverse( type, data );
        if( IS_ERROR(res) ) return res;
        if( mode==MEM_STRUCT_UNPACK ) append( res, &result, &result_end );
        goto to_continue;
      }

      // other non-word prototypes are not accepted
      if( IS_INTEGER(type) || IS_FLOAT(type) ) goto its_a_number;
      if( !IS_ANY_WORD(type) ) return new_error(ERROR_NOT_A_TYPE_NAME,type);

      int type_id = type_info( type );
      int type_size = c_types[type_id].size;
      switch( c_types[type_id].class )
      {
        case C_TYPE_POINTER:
          {
            int64_t i = 0;
            if( mode==MEM_STRUCT_PACK )
            {
              if( !IS_EMPTY( data ) )
              {
                if( IS_MEM(data) )
                  i = (int)MEMORY(data);
                else
                  GET_INT( data, i );
              }
              *(int*)(ptr+ofs) = (int)i;
            }
            if( mode==MEM_STRUCT_UNPACK )
            {
              i = *(int*)(ptr+ofs);
              append( new_integer(i), &result, &result_end );
            }
            ofs += type_size/8;
            goto to_continue;
          }
        case C_TYPE_ATOM:
          {
            atom_t i = 0;
            if( mode==MEM_STRUCT_PACK )
            {
              break;
            }
            if( mode==MEM_STRUCT_UNPACK )
            {
              i = *(atom_t*)(ptr+ofs);
              append( USE(i), &result, &result_end );
            }
            ofs += type_size/8;
            goto to_continue;
          }
        case C_TYPE_FLOAT:
          {
            float64_t i = 0;
            if( mode==MEM_STRUCT_PACK )
            {
              if( !IS_EMPTY( data ) ) GET_FLOAT( data, i );
              switch( type_size ) 
              {                   
                case 32: *(float32_t*)(ptr+ofs) = i; break;
                case 64: *(float64_t*)(ptr+ofs) = i; break;
                default: goto subtype_test;
              }
            }
            if( mode==MEM_STRUCT_UNPACK )
            {
              switch( type_size )
              {                   
                case 32: i = *(float32_t*)(ptr+ofs); break;
                case 64: i = *(float64_t*)(ptr+ofs); break;
                default: goto subtype_test;
              }
              append( new_float(i), &result, &result_end );
            }
            ofs += type_size/8;
            goto to_continue;
          }

        case C_TYPE_SIGNED:
          {
              int64_t i = 0;
              if( mode==MEM_STRUCT_PACK )
              {
                if( !IS_EMPTY( data ) ) GET_INT( data, i );
                switch( type_size ) 
                {                   
                  case  8: *(int8_t*) (ptr+ofs) = i; break;
                  case 16: *(int16_t*)(ptr+ofs) = i; break;
                  case 32: *(int32_t*)(ptr+ofs) = i; break;
                  case 64: *(int64_t*)(ptr+ofs) = i; break;
                  default: goto subtype_test;
                }
              }
              if( mode==MEM_STRUCT_UNPACK )
              {
                switch( type_size ) 
                {                   
                  case  8: i = *(int8_t*) (ptr+ofs); break;
                  case 16: i = *(int16_t*)(ptr+ofs); break;
                  case 32: i = *(int32_t*)(ptr+ofs); break;
                  case 64: i = *(int64_t*)(ptr+ofs); break;
                  default: goto subtype_test;
                }
                append( new_integer(i), &result, &result_end );
              }
              ofs += type_size/8;
              goto to_continue;
            }
        case C_TYPE_UNSIGNED:
            {
              int64_t i = 0;
              if( mode==MEM_STRUCT_PACK )
              {
                if( !IS_EMPTY( data ) ) GET_INT( data, i );\
                switch( type_size ) 
                {                   
                  case  8: *(uint8_t*) (ptr+ofs) = i; break;
                  case 16: *(uint16_t*)(ptr+ofs) = i; break;
                  case 32: *(uint32_t*)(ptr+ofs) = i; break;
                  case 64: *(uint64_t*)(ptr+ofs) = i; break;
                  default: goto subtype_test;
                }
              }
              if( mode==MEM_STRUCT_UNPACK )
              {
                switch( type_size ) 
                {                   
                  case  8: i = *(uint8_t*) (ptr+ofs); break;
                  case 16: i = *(uint16_t*)(ptr+ofs); break;
                  case 32: i = *(uint32_t*)(ptr+ofs); break;
                  case 64: i = *(uint64_t*)(ptr+ofs); break;
                  default: goto subtype_test;
                }
                append( new_integer(i), &result, &result_end );
              }
              ofs += type_size/8;
              goto to_continue;
            }
      }

   subtype_test:
      new_type = type_value( static_link, parent, type );
      if( IS_UNBOUND(new_type) )
      {
   its_a_number:
        if( atom_to_integer( type, &count ) )
        {
          GET_NEXT_TYPE;
          continue;
        }
        return USE(new_error( ERROR_NOT_A_TYPE_NAME, type ));
      }
      type = new_type;
      
      goto try_again;
      
   to_continue:
      count--;
      if( !count )
      {
        count = 1;
        GET_NEXT_TYPE;
      }
      GET_NEXT_DATA;
    } //for

    return result ;
  }

  atom_t res = traverse( prototype, protodata );
  if( IS_ERROR(res) ) return res;
  
  // if there is no target pointer, then just return the size  
  if( mode==MEM_STRUCT_SIZE ) return new_integer( ofs );

  return res;
}

Variable Documentation

typeid_t c_types[]

Data Structures

Defines

Typedefs

Functions

Variables

Define Documentation

Typedef Documentation

Function Documentation

Variable Documentation