source: project/release/4/s11n/trunk/s11n-c.c @ 15282

Last change on this file since 15282 was 15282, checked in by felix winkelmann, 12 years ago

imported r4 version

File size: 1.9 KB
Line 
1/* s11n-c.c */
2
3
4static C_word fixnum_to_bytes(C_word c, C_word self, C_word k, C_word x)
5{
6  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(C_word)));
7  C_kontinue(k, C_string(&a, sizeof(C_word), (C_char *)&x));
8}
9
10static C_word word_to_bytes(C_word c, C_word self, C_word k, C_word x)
11{
12  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(unsigned long)));
13  unsigned long n = C_num_to_unsigned_long(x);
14  C_kontinue(k, C_string(&a, sizeof(unsigned long), (C_char *)&n));
15}
16
17static C_word header_to_bytes(C_word c, C_word self, C_word k, C_word x)
18{
19  C_word *a = C_alloc(C_SIZEOF_STRING(sizeof(C_header)));
20  C_kontinue(k, C_string(&a, sizeof(C_header), (C_char *)x));
21}
22
23static void bytes_to_block(C_word c, C_word self, C_word k, C_word str)
24{
25  C_header h = *((C_header *)C_data_pointer(str)); 
26  int size = h & C_HEADER_SIZE_MASK;
27
28  C_allocate_vector(6, C_SCHEME_UNDEFINED, k, C_fix(size), C_mk_bool((h & C_BYTEBLOCK_BIT) != 0),
29                       C_SCHEME_UNDEFINED, C_mk_bool((h & C_8ALIGN_BIT) != 0));
30}
31
32static ___scheme_value bytes_to_size(C_word str)
33{
34  C_header h = *((C_header *)C_data_pointer(str)); 
35
36  return C_fix(h & C_HEADER_SIZE_MASK);
37}
38
39static ___scheme_value bytes_to_word(___scheme_value str)
40{
41  return C_fix(*((unsigned long *)C_data_pointer(str)));
42}
43
44static ___scheme_value insert_bytes(___scheme_value x, ___scheme_value str)
45{
46  C_memcpy(C_data_pointer(x), C_data_pointer(str), C_header_size(str));
47  return C_SCHEME_UNDEFINED;
48}
49
50static ___scheme_value set_procedure_ptr(___scheme_value x, ___scheme_value pid)
51{
52  void *ptr = C_lookup_procedure_ptr(C_c_string(pid));
53
54  if(ptr != NULL) {
55    C_block_item(x, 0) = (C_word)ptr;
56    return C_SCHEME_TRUE;
57  }
58  else return C_SCHEME_FALSE;
59}
60
61static ___scheme_value bytes_to_fixnum(___scheme_value str)
62{
63  return *((C_word *)C_data_pointer(str));
64}
65
66static ___scheme_value set_header(___scheme_value x, ___scheme_value str)
67{
68  C_block_header(x) = *((C_header *)C_data_pointer(str));
69  return x;
70}
Note: See TracBrowser for help on using the repository browser.