Source file soc2cExtern.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
open Soc2cIdent
let (is_extern_type: Lic.type_ -> bool) =
function
| Lic.External_type_eff _ -> true
| _ -> false
let (_is_extern_const: Lic.const -> bool) =
function
| Lic.Extern_const_eff _ -> true
| _ -> false
let (type_decl : LicPrg.t -> string) =
fun prg ->
let type_to_string k t acc =
if is_extern_type t then
Printf.sprintf "%s\ntypedef FAKE_TYPE_DEF_2FIX %s;" acc (long2s k)
else acc
in
let preambule = "\n/* XXX FIXME: The following types must be defined/fixed */" ^
"\n#define FAKE_TYPE_DEF_2FIX char*\n"
in
let str = LicPrg.fold_types type_to_string prg "" in
if str = "" then "" else (preambule^""^str^"\n")
let (const_def : LicPrg.t -> string) =
fun prg ->
let const_to_string k c acc =
match c with
| Lic.Extern_const_eff(_,t) ->
let t = Soc2cUtil.lic_type_to_c t (long2s k) in
Printf.sprintf "%s\n%s=FAKE_CONST_DEF_2FIX;" acc t
| _ -> acc
in
let preambule = "\n/* XXX FIXME: The following const def must be defined/fixed */" ^
"\n#define FAKE_CONST_DEF_2FIX 1" in
let str = LicPrg.fold_consts const_to_string prg "" in
if str = "" then "" else (preambule^str^"\n")
let (const_declaration : LicPrg.t -> string) =
fun prg ->
let const_to_string k c acc =
match c with
| Lic.Extern_const_eff(_,t) ->
let t = Soc2cUtil.lic_type_to_c t (long2s k) in
Printf.sprintf "%s\nextern %s;" acc t
| _ -> acc
in
let preambule = "/* */\n" in
let str = LicPrg.fold_consts const_to_string prg "" in
if str = "" then "" else (preambule^str^"\n")
let (gen_getters : string -> LicPrg.t -> Soc.t -> string) =
fun fn prg soc ->
let ctx = get_ctx_name soc.key in
let type_to_string k t acc =
if is_extern_type t then (
Printf.eprintf "W: please check the def of _get_%s in %s.\n%!" (long2s k) fn;
Printf.sprintf "%s
%s _get_%s(%schar* n) {
%s r;
// XXX the code below is just a guess: you should check it is ok
r = _get_string(%sn);
return r;
}" acc (long2s k) (long2s k)
(if SocUtils.is_memory_less soc then "" else
(Printf.sprintf "%s_type * ctx, " ctx))
(long2s k)
(if SocUtils.is_memory_less soc then "" else "ctx, ")
)
else acc
in
let preambule = "\n/* XXX FIXME: The getters may need to be fixed too */" in
let str = LicPrg.fold_types type_to_string prg "" in
if str = "" then "" else (preambule^""^str^"\n")
open Soc
let (gen_files : Soc.t -> Soc.tbl -> LicPrg.t -> string -> string -> string ->
bool * bool) =
fun _msoc stbl licprg ext_cfile ext_hfile hfile ->
let extern_steps = SocMap.fold
(fun _sk soc acc ->
List.fold_left (fun acc sm -> if sm.impl=Extern then (sm,soc)::acc else acc)
acc soc.step
)
stbl []
in
let extern_types = LicPrg.fold_types
(fun _ t acc -> match t with Lic.External_type_eff et -> et::acc | _ -> acc)
licprg []
in
let extern_consts = LicPrg.fold_consts
(fun _ c acc -> match c with Lic.Extern_const_eff(ec,_) -> ec::acc | _ -> acc)
licprg []
in
let needs_cfile = extern_steps <> [] || extern_consts <> [] in
let needs_hfile = needs_cfile || extern_types<>[] || extern_consts<>[] in
if not (Sys.file_exists ext_hfile) && needs_hfile then (
let ext_och = open_out ext_hfile in
Printf.eprintf "W: please check the def of FAKE_TYPE_DEF_2FIX in %s.\n%!"
ext_hfile;
output_string ext_och (type_decl licprg);
List.iter (fun (sm,soc) ->
let proto_decl,_,_ = Soc2cDep.get_step_prototype sm soc in
output_string ext_och proto_decl;
) extern_steps;
close_out ext_och;
Printf.eprintf "W: %s has been generated.\n%!" ext_hfile;
);
let hfile0 = Filename.basename hfile in
if not (Sys.file_exists ext_cfile) && needs_cfile then (
let ext_occ = open_out ext_cfile in
if needs_hfile then
output_string ext_occ (Printf.sprintf "#include \"%s\"\n" hfile0);
Printf.eprintf "W: please check the def of FAKE_CONST_DEF_2FIX in %s.\n%!"
ext_cfile;
output_string ext_occ (const_def licprg);
List.iter (fun (sm,soc) ->
let _,proto_begin,_ = Soc2cDep.get_step_prototype sm soc in
output_string ext_occ proto_begin;
output_string ext_occ (Printf.sprintf " /* finish me! */\n}\n")
) extern_steps;
close_out ext_occ;
Printf.eprintf "W: %s has been generated.\n" ext_cfile;
);
needs_cfile, needs_hfile