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

Go to the source code of this file.

Macros

#define EXTERNAPI   __attribute__((used,noinline,regparm(0),stdcall))
 
#define C_TYPES   17
 
#define GET_NEXT_TYPE   prototype = CDR( prototype )
 
#define GET_NEXT_DATA   protodata = CDR( protodata )
 

Functions

atom_t EXTERNAPI i1_to_atom (signed char data)
 
atom_t EXTERNAPI i2_to_atom (signed short data)
 
atom_t EXTERNAPI i4_to_atom (signed int data)
 
atom_t EXTERNAPI i8_to_atom (int64_t data)
 
atom_t EXTERNAPI u1_to_atom (unsigned char data)
 
atom_t EXTERNAPI u2_to_atom (unsigned short data)
 
atom_t EXTERNAPI u4_to_atom (unsigned int data)
 
atom_t EXTERNAPI u8_to_atom (int64_t data)
 
atom_t EXTERNAPI f4_to_atom (float data)
 
atom_t EXTERNAPI f8_to_atom (float64_t data)
 
atom_t EXTERNAPI v0_to_atom (void)
 
atom_t EXTERNAPI p4_to_atom (void *data)
 
atom_t EXTERNAPI a4_to_atom (atom_t data)
 
atom_t EXTERNAPI s2_to_atom (chars_t data)
 
atom_t EXTERNAPI s1_to_atom (char *data)
 
signed char EXTERNAPI atom_to_i1 (atom_t data)
 
signed short EXTERNAPI atom_to_i2 (atom_t data)
 
signed int EXTERNAPI atom_to_i4 (atom_t data)
 
int64_t EXTERNAPI atom_to_i8 (atom_t data)
 
unsigned char EXTERNAPI atom_to_u1 (atom_t data)
 
unsigned short EXTERNAPI atom_to_u2 (atom_t data)
 
unsigned int EXTERNAPI atom_to_u4 (atom_t data)
 
int64_t EXTERNAPI atom_to_u8 (atom_t data)
 
float EXTERNAPI atom_to_f4 (atom_t data)
 
float64_t EXTERNAPI atom_to_f8 (atom_t data)
 
void EXTERNAPI atom_to_v0 (atom_t data)
 
atom_t EXTERNAPI atom_to_a4 (atom_t data)
 
void *EXTERNAPI atom_to_p4 (atom_t data)
 
atom_t unique_word (atom_t data)
 
chars_t EXTERNAPI atom_to_s2 (atom_t data)
 
char *EXTERNAPI atom_to_s1 (atom_t data)
 
int type_info (atom_t type)
 gets C-type info More...
 
atom_t type_value (int static_link, atom_t parent, atom_t type)
 gets the value of a type variable More...
 
int get_c_type (int static_link, atom_t parent, atom_t type)
 gets the C-type of a type More...
 
atom_t traverse_pack (int static_link, atom_t parent, atom_t prototype, atom_t protodata, char *ptr, int mode)
 traverses packed data More...
 

Variables

typeid_t c_types [C_TYPES]
 

Macro Definition Documentation

#define EXTERNAPI   __attribute__((used,noinline,regparm(0),stdcall))

Definition at line 61 of file external.c.

#define C_TYPES   17

Definition at line 176 of file external.c.

#define GET_NEXT_TYPE   prototype = CDR( prototype )
#define GET_NEXT_DATA   protodata = CDR( protodata )

Function Documentation

atom_t EXTERNAPI i1_to_atom ( signed char  data)

Definition at line 66 of file external.c.

66 { RETURN(new_integer( data )); }
atom_t EXTERNAPI i2_to_atom ( signed short  data)

Definition at line 67 of file external.c.

67 { RETURN(new_integer( data )); }
atom_t EXTERNAPI i4_to_atom ( signed int  data)

Definition at line 68 of file external.c.

68 { RETURN(new_integer( data )); }
atom_t EXTERNAPI i8_to_atom ( int64_t  data)

Definition at line 69 of file external.c.

69 { RETURN(new_integer( data )); }
atom_t EXTERNAPI u1_to_atom ( unsigned char  data)

Definition at line 71 of file external.c.

71 { RETURN(new_integer( data )); }
atom_t EXTERNAPI u2_to_atom ( unsigned short  data)

Definition at line 72 of file external.c.

72 { RETURN(new_integer( data )); }
atom_t EXTERNAPI u4_to_atom ( unsigned int  data)

Definition at line 73 of file external.c.

73 { RETURN(new_integer( data )); }
atom_t EXTERNAPI u8_to_atom ( int64_t  data)

Definition at line 74 of file external.c.

74 { RETURN(new_integer( data )); }
atom_t EXTERNAPI f4_to_atom ( float  data)

Definition at line 76 of file external.c.

76 { RETURN(new_float( data )); }
atom_t EXTERNAPI f8_to_atom ( float64_t  data)

Definition at line 77 of file external.c.

77 { RETURN(new_float( data )); }
atom_t EXTERNAPI v0_to_atom ( void  )

Definition at line 79 of file external.c.

79 { RETURN(unbound); }
atom_t EXTERNAPI p4_to_atom ( void data)

Definition at line 80 of file external.c.

80 { RETURN(new_integer( (int)data )); }
atom_t EXTERNAPI a4_to_atom ( atom_t  data)

Definition at line 81 of file external.c.

81 { /*printf("@<:%d::",(int)data); dump_atom(data,1); printf(":>@\n");*/ RETURN(data);}
atom_t EXTERNAPI s2_to_atom ( chars_t  data)

Definition at line 85 of file external.c.

86 {
87  int len = STRLEN( data );
88  chars_t w = ALLOC((len+1)*CHAR_SIZE);
89  memcpy( w, data, (len+1)*CHAR_SIZE);
90  RETURN(new_word( w, len ));
91 }
atom_t EXTERNAPI s1_to_atom ( char *  data)

Definition at line 92 of file external.c.

93 {
94  RETURN(new_word(ASCII_to_UTF16 (data), -1));
95 }
signed char EXTERNAPI atom_to_i1 ( atom_t  data)

Definition at line 108 of file external.c.

108 { int64_t i; atom_to_int( data, &i ); return i; }
signed short EXTERNAPI atom_to_i2 ( atom_t  data)

Definition at line 109 of file external.c.

109 { int64_t i; atom_to_int( data, &i ); return i; }
signed int EXTERNAPI atom_to_i4 ( atom_t  data)

Definition at line 110 of file external.c.

110 { int64_t i; atom_to_int( data, &i ); return i; }
int64_t EXTERNAPI atom_to_i8 ( atom_t  data)

Definition at line 111 of file external.c.

111 { int64_t i; atom_to_int( data, &i ); return i; }
unsigned char EXTERNAPI atom_to_u1 ( atom_t  data)

Definition at line 113 of file external.c.

113 { int64_t i; atom_to_int( data, &i ); return i; }
unsigned short EXTERNAPI atom_to_u2 ( atom_t  data)

Definition at line 114 of file external.c.

114 { int64_t i; atom_to_int( data, &i ); return i; }
unsigned int EXTERNAPI atom_to_u4 ( atom_t  data)

Definition at line 115 of file external.c.

115 { int64_t i; atom_to_int( data, &i ); return i; }
int64_t EXTERNAPI atom_to_u8 ( atom_t  data)

Definition at line 116 of file external.c.

116 { int64_t i; atom_to_int( data, &i ); return i; }
float EXTERNAPI atom_to_f4 ( atom_t  data)

Definition at line 118 of file external.c.

118 { float64_t i; atom_to_float( data, &i ); return i; }
float64_t EXTERNAPI atom_to_f8 ( atom_t  data)

Definition at line 119 of file external.c.

119 { float64_t i; atom_to_float( data, &i ); return i; }
void EXTERNAPI atom_to_v0 ( atom_t  data)

Definition at line 121 of file external.c.

121 { return; }
atom_t EXTERNAPI atom_to_a4 ( atom_t  data)

Definition at line 123 of file external.c.

123 {/*printf("&[[;;%d;;]]\n",(int)data);*/ return data;}
void* EXTERNAPI atom_to_p4 ( atom_t  data)

Definition at line 125 of file external.c.

125  {
126  if( IS_MEM(data) )
127  {
128  return MEMORY(data);
129  };
130  int64_t i;
131  atom_to_int( data, &i );
132  return (void*)((int)i);
133  }
atom_t unique_word ( atom_t  data)

Definition at line 136 of file external.c.

137 {
138  if( IS_SUBWORD(data) ) return new_word( STRING(data), LENGTH(data) );
139  if( !IS_WORD(data) ) return atom_to_word( data );
140  if( !IS_WORD(data) ) return new_word( TEXT(""), -1 );
141  return USE(data);
142 }
chars_t EXTERNAPI atom_to_s2 ( atom_t  data)

Definition at line 145 of file external.c.

146 {
147  data = unique_word( data );
149  return STRING(data);
150 }
char* EXTERNAPI atom_to_s1 ( atom_t  data)

Definition at line 151 of file external.c.

152 {
153  data = unique_word( data );
154 
155  char* c = UTF16_to_ASCII( STRING(data) );
156  DEUSE( data );
157 
158  data = new_mem( 0 );
159  DEALLOC( MEMORY(data) );
160  MEMORY(data) = c;
161 
163 
164  return c;
165 }
int type_info ( atom_t  type)
Parameters
typeword containing type name
Returns
C-type of the data

Examines the value of type which must be a 2-character word. Returns an index of the type which can be used with array c c_types[] to get more details.

Definition at line 221 of file external.c.

222 {
223  if( IS_LIST(type) ) return C_TYPE_STRUCT;
224 
225 #ifdef SAFE_MODE
226  assert( IS_ANY_WORD(type) );
227 #endif
228 
229  // check whether the word is: i1 i2 i4 i8 u1 u2 u4 u8 f4 f8 v0 p4 a4 s1 s2
230  if( LENGTH(type)==2 )
231  {
232  char_t ch1 = TOUPPER(*(STRING(type)));
233  char_t ch2 = *(STRING(type)+1);
234  int i;
235  for( i=2; i<C_TYPES; i++ ) // skip 0-th and 1-st elements
236  {
237  //printf("compare index=%d %C %C\n",i,*c_types[i].name,*(c_types[i].name+1));
238  if( ch1==*c_types[i].name && ch2==*(c_types[i].name+1) )
239  {
240  //printf("type_info("); dump(type); printf(")=%d\n",i);
241  return i;
242  }
243  }
244  }
245 
246  //printf("type_info("); dump(type); printf(")=0\n");
247  return C_TYPE_UNKNOWN;
248 }
atom_t type_value ( int  static_link,
atom_t  parent,
atom_t  type 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
typeword containing type name
Returns
value or unbound

Assumes that type is a name of a type variable and returns its value. If it is not a variable or has no value then return unbound atom.

Definition at line 264 of file external.c.

265 {
266  atom_t var = find_runtime_var( type, static_link );
267 
268  // not found or not a var then exit
269  if( !var || !IS_VARIABLE( var ) ) return unbound;
270 
271  // get the value and try again to calculate type size
272  if( IS_RUNTIME( var ) )
273  return VALUE( var );
274  else
275  return rt_var_value( static_link, parent, var );
276 }
int get_c_type ( int  static_link,
atom_t  parent,
atom_t  type 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
typeword 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.

Definition at line 296 of file external.c.

297 {
298  int c_type;
299 
300 try_again:
301  c_type = type_info( type );
302  if( c_type==C_TYPE_UNKNOWN )
303  {
304  type = type_value( static_link, parent, type );
305  if( IS_UNBOUND(type) ) return C_TYPE_UNKNOWN;
306  goto try_again;
307  }
308  return c_type;
309 }
atom_t traverse_pack ( int  static_link,
atom_t  parent,
atom_t  prototype,
atom_t  protodata,
char *  ptr,
int  mode 
)
Parameters
static_linkstatic link from the current frame
parentcurrent parent
prototypelist describing the c-type in the pack
protodatalist containing the Logo data
ptrpointer to memory with C data
modemode 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.

Definition at line 347 of file external.c.

348 {
349  int ofs = 0;
350  atom_t new_type;
351 
352  atom_t traverse( atom_t prototype, atom_t protodata )
353  {
354  atom_t result = unbound;
355  atom_t result_end;
356 
357  // check prototype list
358  if (IS_ERROR( prototype )) return prototype;
359  if (!IS_LIST( prototype )) return new_error( ERROR_NOT_A_LIST, prototype );
360 
361  // check data list
362  if (IS_ERROR( protodata )) return protodata;
363  if (!IS_LIST( protodata )) return new_error( ERROR_NOT_A_LIST, protodata );
364 
365  if( mode==MEM_STRUCT_UNPACK )
366  {
367  result = empty_list;
368  result_end = empty_list;
369  }
370 
371  int count = 1;
372 
373 #define GET_NEXT_TYPE prototype = CDR( prototype )
374 #define GET_NEXT_DATA protodata = CDR( protodata )
375 
376  // scan all elements of the prototype
377  for (; IS_NOT_EMPTY( prototype ); )
378  {
379  atom_t type = CAR( prototype );
380  atom_t data = CAR( protodata );
381 
382 try_again:
383 
384  // list prototypes are processed recursively
385  if( IS_LIST(type) )
386  {
387  atom_t res = traverse( type, data );
388  if( IS_ERROR(res) ) return res;
389  if( mode==MEM_STRUCT_UNPACK ) append( res, &result, &result_end );
390  goto to_continue;
391  }
392 
393  // other non-word prototypes are not accepted
394  if( IS_INTEGER(type) || IS_FLOAT(type) ) goto its_a_number;
395  if( !IS_ANY_WORD(type) ) return new_error(ERROR_NOT_A_TYPE_NAME,type);
396 
397  int type_id = type_info( type );
398  int type_size = c_types[type_id].size;
399 
400  switch( c_types[type_id].class )
401  {
402  case C_TYPE_POINTER:
403  {
404  int64_t i = 0;
405  if( mode==MEM_STRUCT_PACK )
406  {
407  if( !IS_EMPTY( data ) )
408  {
409  if( IS_MEM(data) )
410  i = (int)MEMORY(data);
411  else
412  GET_INT( data, i );
413  }
414  *(int*)(ptr+ofs) = (int)i;
415  }
416  if( mode==MEM_STRUCT_UNPACK )
417  {
418  i = *(int*)(ptr+ofs);
419  append( new_integer(i), &result, &result_end );
420  }
421  ofs += type_size/8;
422  goto to_continue;
423  }
424  case C_TYPE_ATOM:
425  {
426  atom_t i = 0;
427  if( mode==MEM_STRUCT_PACK )
428  {
429  //*(atom_t*)(ptr+ofs) = data;
430  break;
431  }
432  if( mode==MEM_STRUCT_UNPACK )
433  {
434  i = *(atom_t*)(ptr+ofs);
435  append( USE(i), &result, &result_end );
436  }
437  ofs += type_size/8;
438  goto to_continue;
439  }
440  case C_TYPE_FLOAT:
441  {
442  float64_t i = 0;
443  if( mode==MEM_STRUCT_PACK )
444  {
445  if( !IS_EMPTY( data ) ) GET_FLOAT( data, i );
446  switch( type_size )
447  {
448  case 32: *(float32_t*)(ptr+ofs) = i; break;
449  case 64: *(float64_t*)(ptr+ofs) = i; break;
450  default: goto subtype_test;
451  }
452  }
453  if( mode==MEM_STRUCT_UNPACK )
454  {
455  switch( type_size )
456  {
457  case 32: i = *(float32_t*)(ptr+ofs); break;
458  case 64: i = *(float64_t*)(ptr+ofs); break;
459  default: goto subtype_test;
460  }
461  append( new_float(i), &result, &result_end );
462  }
463  ofs += type_size/8;
464  goto to_continue;
465  }
466 
467  case C_TYPE_SIGNED:
468  {
469  int64_t i = 0;
470  if( mode==MEM_STRUCT_PACK )
471  {
472  if( !IS_EMPTY( data ) ) GET_INT( data, i );
473  switch( type_size )
474  {
475  case 8: *(int8_t*) (ptr+ofs) = i; break;
476  case 16: *(int16_t*)(ptr+ofs) = i; break;
477  case 32: *(int32_t*)(ptr+ofs) = i; break;
478  case 64: *(int64_t*)(ptr+ofs) = i; break;
479  default: goto subtype_test;
480  }
481  }
482  if( mode==MEM_STRUCT_UNPACK )
483  {
484  switch( type_size )
485  {
486  case 8: i = *(int8_t*) (ptr+ofs); break;
487  case 16: i = *(int16_t*)(ptr+ofs); break;
488  case 32: i = *(int32_t*)(ptr+ofs); break;
489  case 64: i = *(int64_t*)(ptr+ofs); break;
490  default: goto subtype_test;
491  }
492  append( new_integer(i), &result, &result_end );
493  }
494  ofs += type_size/8;
495  goto to_continue;
496  }
497  case C_TYPE_UNSIGNED:
498  {
499  int64_t i = 0;
500  if( mode==MEM_STRUCT_PACK )
501  {
502  if( !IS_EMPTY( data ) ) GET_INT( data, i );\
503  switch( type_size )
504  {
505  case 8: *(uint8_t*) (ptr+ofs) = i; break;
506  case 16: *(uint16_t*)(ptr+ofs) = i; break;
507  case 32: *(uint32_t*)(ptr+ofs) = i; break;
508  case 64: *(uint64_t*)(ptr+ofs) = i; break;
509  default: goto subtype_test;
510  }
511  }
512  if( mode==MEM_STRUCT_UNPACK )
513  {
514  switch( type_size )
515  {
516  case 8: i = *(uint8_t*) (ptr+ofs); break;
517  case 16: i = *(uint16_t*)(ptr+ofs); break;
518  case 32: i = *(uint32_t*)(ptr+ofs); break;
519  case 64: i = *(uint64_t*)(ptr+ofs); break;
520  default: goto subtype_test;
521  }
522  append( new_integer(i), &result, &result_end );
523  }
524  ofs += type_size/8;
525  goto to_continue;
526  }
527  }
528 
529  subtype_test:
530  new_type = type_value( static_link, parent, type );
531  if( IS_UNBOUND(new_type) )
532  {
533  its_a_number:
534  if( atom_to_integer( type, &count ) )
535  {
537  continue;
538  }
539  return USE(new_error( ERROR_NOT_A_TYPE_NAME, type ));
540  }
541  type = new_type;
542 
543  goto try_again;
544 
545  to_continue:
546  count--;
547  if( !count )
548  {
549  count = 1;
551  }
553  } //for
554 
555  return result ;
556  }
557 
558  atom_t res = traverse( prototype, protodata );
559  if( IS_ERROR(res) ) return res;
560 
561  // if there is no target pointer, then just return the size
562  if( mode==MEM_STRUCT_SIZE ) return new_integer( ofs );
563 
564  return res;
565 }

Variable Documentation

typeid_t c_types[C_TYPES]
Initial value:
=
{
{ TEXT(""), 0, C_TYPE_UNKNOWN, 0, 0, TEXT(""), TEXT("") },
{ TEXT(""), 0, C_TYPE_STRUCT, 0, 0, TEXT(""), TEXT("") },
{ TEXT("I1"), 8, C_TYPE_SIGNED, (fn)i1_to_atom, (fn)atom_to_i1, TEXT("i1_to_atom"), TEXT("atom_to_i1") },
{ TEXT("I2"), 16, C_TYPE_SIGNED, (fn)i2_to_atom, (fn)atom_to_i2, TEXT("i2_to_atom"), TEXT("atom_to_i2") },
{ TEXT("I4"), 32, C_TYPE_SIGNED, (fn)i4_to_atom, (fn)atom_to_i4, TEXT("i4_to_atom"), TEXT("atom_to_i4") },
{ TEXT("I8"), 64, C_TYPE_SIGNED, (fn)i8_to_atom, (fn)atom_to_i8, TEXT("i8_to_atom"), TEXT("atom_to_i8") },
{ TEXT("U1"), 8, C_TYPE_UNSIGNED, (fn)u1_to_atom, (fn)atom_to_u1, TEXT("u1_to_atom"), TEXT("atom_to_u1") },
{ TEXT("U2"), 16, C_TYPE_UNSIGNED, (fn)u2_to_atom, (fn)atom_to_u2, TEXT("u2_to_atom"), TEXT("atom_to_u2") },
{ TEXT("U4"), 32, C_TYPE_UNSIGNED, (fn)u4_to_atom, (fn)atom_to_u4, TEXT("u4_to_atom"), TEXT("atom_to_u4") },
{ TEXT("U8"), 64, C_TYPE_UNSIGNED, (fn)u8_to_atom, (fn)atom_to_u8, TEXT("u8_to_atom"), TEXT("atom_to_u8") },
{ TEXT("F4"), 32, C_TYPE_FLOAT, (fn)f4_to_atom, (fn)atom_to_f4, TEXT("f4_to_atom"), TEXT("atom_to_f4") },
{ TEXT("F8"), 64, C_TYPE_FLOAT, (fn)f8_to_atom, (fn)atom_to_f8, TEXT("f8_to_atom"), TEXT("atom_to_f8") },
{ TEXT("V0"), 0, C_TYPE_VOID, (fn)v0_to_atom, (fn)atom_to_v0, TEXT("v0_to_atom"), TEXT("atom_to_v0") },
{ TEXT("P4"), 32, C_TYPE_POINTER, (fn)p4_to_atom, (fn)atom_to_p4, TEXT("p4_to_atom"), TEXT("atom_to_p4") },
{ TEXT("A4"), 32, C_TYPE_ATOM, (fn)a4_to_atom, (fn)atom_to_a4, TEXT("a4_to_atom"), TEXT("atom_to_a4") },
{ TEXT("S1"), 32, C_TYPE_STRING, (fn)s1_to_atom, (fn)atom_to_s1, TEXT("s1_to_atom"), TEXT("atom_to_s1") },
{ TEXT("S2"), 32, C_TYPE_STRING, (fn)s2_to_atom, (fn)atom_to_s2, TEXT("s2_to_atom"), TEXT("atom_to_s2") },
}

Definition at line 181 of file external.c.


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