1 /*
2 * Part of Scheme 48 1.9. See file COPYING for notices and license.
3 *
4 * Authors: Mike Sperber, Harald Glab-Phlak
5 */
6
7 /*
8 * Access to various Scheme-side libraries via the FFI
9 */
10
11 #include <stdlib.h>
12 #include "scheme48.h"
13
14 /*
15 * Enum sets
16 */
17
18 static s48_ref_t enum_set_type_binding = NULL;
19
20 /*
21 * This needs to be in synch with the layout of :ENUM-SET in enum-set.scm
22 */
23
24 static void
check_enum_set(s48_value sch_thing)25 check_enum_set(s48_value sch_thing)
26 {
27 s48_check_record_type(sch_thing, s48_deref(enum_set_type_binding));
28 }
29
30 static void
check_enum_set_2(s48_call_t call,s48_ref_t sch_thing)31 check_enum_set_2(s48_call_t call, s48_ref_t sch_thing)
32 {
33 s48_check_record_type_2(call, sch_thing, enum_set_type_binding);
34 }
35
36 void
s48_check_enum_set_type(s48_value sch_thing,s48_value sch_enum_set_type_binding)37 s48_check_enum_set_type(s48_value sch_thing, s48_value sch_enum_set_type_binding)
38 {
39 check_enum_set(sch_thing);
40 {
41 s48_value actual_type = S48_UNSAFE_RECORD_REF(sch_thing, 0);
42 s48_value binding_val = S48_SHARED_BINDING_REF(sch_enum_set_type_binding);
43 s48_value unspecific = S48_UNSPECIFIC;
44
45
46 if (!S48_EQ_P(S48_UNSAFE_RECORD_REF(sch_thing, 0),
47 S48_SHARED_BINDING_REF(sch_enum_set_type_binding)))
48 s48_assertion_violation("s48_check_enum_set_type", "invalid enum-set type", 2,
49 sch_thing, binding_val);
50 }
51 }
52
53 void
s48_check_enum_set_type_2(s48_call_t call,s48_ref_t sch_thing,s48_ref_t sch_enum_set_type_binding)54 s48_check_enum_set_type_2(s48_call_t call, s48_ref_t sch_thing, s48_ref_t sch_enum_set_type_binding)
55 {
56 check_enum_set_2(call, sch_thing);
57 {
58 s48_ref_t actual_type = s48_unsafe_record_ref_2(call, sch_thing, 0);
59 s48_ref_t binding_val = s48_shared_binding_ref_2(call, sch_enum_set_type_binding);
60
61 if (!s48_eq_p_2(call, actual_type, binding_val))
62 s48_assertion_violation_2(call, "s48_check_enum_set_type_2",
63 "invalid enum-set type", 2,
64 sch_thing, binding_val);
65 }
66 }
67
68 long
s48_enum_set2integer(s48_value sch_enum_set)69 s48_enum_set2integer(s48_value sch_enum_set)
70 {
71 check_enum_set(sch_enum_set);
72 return s48_extract_fixnum(S48_UNSAFE_RECORD_REF(sch_enum_set, 1));
73 }
74
75 long
s48_enum_set2integer_2(s48_call_t call,s48_ref_t sch_enum_set)76 s48_enum_set2integer_2(s48_call_t call, s48_ref_t sch_enum_set)
77 {
78 check_enum_set_2(call, sch_enum_set);
79 return s48_extract_long_2(call, s48_unsafe_record_ref_2(call, sch_enum_set, 1));
80 }
81
82 s48_value
s48_integer2enum_set(s48_value sch_enum_set_type_binding,long mask)83 s48_integer2enum_set(s48_value sch_enum_set_type_binding, long mask)
84 {
85 s48_value sch_enum_set = s48_make_record(s48_deref(enum_set_type_binding));
86 S48_UNSAFE_RECORD_SET(sch_enum_set, 0, S48_SHARED_BINDING_REF(sch_enum_set_type_binding));
87 S48_UNSAFE_RECORD_SET(sch_enum_set, 1, s48_enter_fixnum(mask));
88 return sch_enum_set;
89 }
90
91 s48_ref_t
s48_integer2enum_set_2(s48_call_t call,s48_ref_t sch_enum_set_type_binding,long mask)92 s48_integer2enum_set_2(s48_call_t call, s48_ref_t sch_enum_set_type_binding, long mask)
93 {
94 s48_ref_t sch_enum_set = s48_make_record_2(call, enum_set_type_binding);
95 s48_unsafe_record_set_2(call, sch_enum_set, 0,
96 s48_shared_binding_ref_2(call, sch_enum_set_type_binding));
97 s48_unsafe_record_set_2(call, sch_enum_set, 1,
98 s48_enter_long_as_fixnum_2(call, mask));
99 return sch_enum_set;
100 }
101
102 void
s48_init_external_libs(void)103 s48_init_external_libs(void)
104 {
105 enum_set_type_binding = s48_get_imported_binding_2("enum-set-type");
106 }
107