Revision 90cc3b8e
Added by Lélio Brun over 3 years ago
| src/backends/C/c_backend_header.ml | ||
|---|---|---|
| 9 | 9 |
(* *) |
| 10 | 10 |
(********************************************************************) |
| 11 | 11 |
|
| 12 |
open Format
|
|
| 12 |
open Utils.Format
|
|
| 13 | 13 |
open Lustre_types |
| 14 | 14 |
open Corelang |
| 15 | 15 |
open Machine_code_types |
| ... | ... | |
| 21 | 21 |
(********************************************************************************************) |
| 22 | 22 |
|
| 23 | 23 |
|
| 24 |
module type MODIFIERS_HDR = |
|
| 25 |
sig |
|
| 24 |
module type MODIFIERS_HDR = sig |
|
| 26 | 25 |
val print_machine_decl_prefix: Format.formatter -> machine_t -> unit |
| 27 | 26 |
end |
| 28 | 27 |
|
| 29 |
module EmptyMod = |
|
| 30 |
struct |
|
| 28 |
module EmptyMod = struct |
|
| 31 | 29 |
let print_machine_decl_prefix = fun _ _ -> () |
| 32 | 30 |
end |
| 33 | 31 |
|
| 34 |
module Main = functor (Mod: MODIFIERS_HDR) -> |
|
| 35 |
struct |
|
| 32 |
module Main = functor (Mod: MODIFIERS_HDR) -> struct |
|
| 36 | 33 |
|
| 37 |
let print_import_standard fmt = |
|
| 38 |
begin |
|
| 34 |
let print_import_standard fmt () = |
|
| 39 | 35 |
(* if Machine_types.has_machine_type () then *) |
| 40 |
(* begin *) |
|
| 41 |
fprintf fmt "#include <stdint.h>@."; |
|
| 42 |
(* end; *) |
|
| 43 |
if !Options.mpfr then |
|
| 44 |
begin |
|
| 45 |
fprintf fmt "#include <mpfr.h>@." |
|
| 46 |
end; |
|
| 47 |
if !Options.cpp then |
|
| 48 |
fprintf fmt "#include \"%s/arrow.hpp\"@.@." (Arrow.arrow_top_decl ()).top_decl_owner |
|
| 49 |
else |
|
| 50 |
fprintf fmt "#include \"%s/arrow.h\"@.@." (Arrow.arrow_top_decl ()).top_decl_owner |
|
| 51 |
|
|
| 52 |
end |
|
| 53 |
|
|
| 54 |
let rec print_static_val pp_var fmt v = |
|
| 55 |
match v.value_desc with |
|
| 56 |
| Cst c -> pp_c_const fmt c |
|
| 57 |
| Var v -> pp_var fmt v |
|
| 58 |
| Fun (n, vl) -> pp_basic_lib_fun (Types.is_int_type v.value_type) n (print_static_val pp_var) fmt vl |
|
| 59 |
| _ -> (Format.eprintf "Internal error: C_backend_header.print_static_val"; assert false) |
|
| 60 |
|
|
| 61 |
let print_constant_decl (m, attr, inst) pp_var fmt v = |
|
| 62 |
Format.fprintf fmt "%s %a = %a" |
|
| 63 |
attr |
|
| 64 |
(pp_c_type (Format.sprintf "%s ## %s" inst v.var_id)) v.var_type |
|
| 65 |
(print_static_val pp_var) (get_const_assign m v) |
|
| 66 |
|
|
| 67 |
let print_static_constant_decl (m, attr, inst) fmt const_locals = |
|
| 68 |
let pp_var fmt v = |
|
| 69 |
if List.mem v const_locals |
|
| 70 |
then |
|
| 71 |
Format.fprintf fmt "%s ## %s" inst v.var_id |
|
| 72 |
else |
|
| 73 |
Format.fprintf fmt "%s" v.var_id in |
|
| 74 |
Format.fprintf fmt "%a%t" |
|
| 75 |
(Utils.fprintf_list ~sep:";\\@," (print_constant_decl (m, attr, inst) pp_var)) const_locals |
|
| 76 |
(Utils.pp_final_char_if_non_empty ";\\@," const_locals) |
|
| 77 |
|
|
| 78 |
let print_static_declare_instance (m, attr, inst) const_locals fmt (i, (n, static)) = |
|
| 79 |
let pp_var fmt v = |
|
| 80 |
if List.mem v const_locals |
|
| 81 |
then |
|
| 82 |
Format.fprintf fmt "%s ## %s" inst v.var_id |
|
| 83 |
else |
|
| 84 |
Format.fprintf fmt "%s" v.var_id in |
|
| 85 |
let values = List.map (value_of_dimension m) static in |
|
| 86 |
fprintf fmt "%a(%s, %a%t%s)" |
|
| 87 |
pp_machine_static_declare_name (node_name n) |
|
| 88 |
attr |
|
| 89 |
(Utils.fprintf_list ~sep:", " (print_static_val pp_var)) values |
|
| 90 |
(Utils.pp_final_char_if_non_empty ", " static) |
|
| 91 |
i |
|
| 92 |
|
|
| 93 |
let print_static_declare_macro fmt (m, attr, inst) = |
|
| 94 |
let const_locals = List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in |
|
| 95 |
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in |
|
| 96 |
fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%a%s %a %s;\\@,%a%t%a;@,@]" |
|
| 97 |
pp_machine_static_declare_name m.mname.node_id |
|
| 98 |
attr |
|
| 99 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
|
| 100 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
|
| 101 |
inst |
|
| 102 |
(* constants *) |
|
| 103 |
(print_static_constant_decl (m, attr, inst)) const_locals |
|
| 104 |
attr |
|
| 105 |
pp_machine_memtype_name m.mname.node_id |
|
| 106 |
inst |
|
| 107 |
(Utils.fprintf_list ~sep:";\\@," (pp_c_decl_local_var m)) array_mem |
|
| 108 |
(Utils.pp_final_char_if_non_empty ";\\@," array_mem) |
|
| 109 |
(Utils.fprintf_list ~sep:";\\@," |
|
| 110 |
(fun fmt (i',m') -> |
|
| 111 |
let path = sprintf "%s ## _%s" inst i' in |
|
| 112 |
fprintf fmt "%a" |
|
| 113 |
(print_static_declare_instance (m, attr, inst) const_locals) (path, m') |
|
| 114 |
)) m.minstances |
|
| 115 |
|
|
| 116 |
|
|
| 117 |
let print_static_link_instance fmt (i, (m, _)) = |
|
| 118 |
fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i |
|
| 119 |
|
|
| 120 |
(* Allocation of a node struct: |
|
| 121 |
- if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct) |
|
| 122 |
*) |
|
| 123 |
let print_static_link_macro fmt (m, _, inst) = |
|
| 124 |
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in |
|
| 125 |
fprintf fmt "@[<v>@[<v 2>#define %a(%s) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
|
|
| 126 |
pp_machine_static_link_name m.mname.node_id |
|
| 127 |
inst |
|
| 128 |
(Utils.fprintf_list ~sep:";\\@," |
|
| 129 |
(fun fmt v -> |
|
| 130 |
fprintf fmt "%s._reg.%s = (%a*) &%s" |
|
| 131 |
inst |
|
| 132 |
v.var_id |
|
| 133 |
(fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v |
|
| 134 |
v.var_id |
|
| 135 |
)) array_mem |
|
| 136 |
(Utils.pp_final_char_if_non_empty ";\\@," array_mem) |
|
| 137 |
(Utils.fprintf_list ~sep:";\\@," |
|
| 138 |
(fun fmt (i',m') -> |
|
| 139 |
let path = sprintf "%s ## _%s" inst i' in |
|
| 140 |
fprintf fmt "%a;\\@,%s.%s = &%s" |
|
| 141 |
print_static_link_instance (path,m') |
|
| 142 |
inst |
|
| 143 |
i' |
|
| 144 |
path |
|
| 145 |
)) m.minstances |
|
| 146 |
|
|
| 147 |
let print_static_alloc_macro fmt (m, attr, inst) = |
|
| 148 |
fprintf fmt "@[<v>@[<v 2>#define %a(%s, %a%t%s)\\@,%a(%s, %a%t%s);\\@,%a(%s);@]@,@]@." |
|
| 149 |
pp_machine_static_alloc_name m.mname.node_id |
|
| 150 |
attr |
|
| 151 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
|
| 152 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
|
| 153 |
inst |
|
| 154 |
pp_machine_static_declare_name m.mname.node_id |
|
| 155 |
attr |
|
| 156 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
|
| 157 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
|
| 158 |
inst |
|
| 159 |
pp_machine_static_link_name m.mname.node_id |
|
| 160 |
inst |
|
| 161 |
|
|
| 162 |
(* TODO: ACSL |
|
| 163 |
we do multiple things: |
|
| 164 |
- provide the semantics of the node as a predicate: function step and reset are associated to ACSL predicate |
|
| 165 |
- the node is associated to a refinement contract, wrt its ACSL sem |
|
| 166 |
- if the node is a regular node associated to a contract, print the contract as function contract. |
|
| 167 |
- do not print anything if this is a contract node |
|
| 168 |
*) |
|
| 169 |
let print_machine_alloc_decl fmt m = |
|
| 170 |
Mod.print_machine_decl_prefix fmt m; |
|
| 171 |
if fst (get_stateless_status m) then |
|
| 172 |
begin |
|
| 173 |
end |
|
| 174 |
else |
|
| 175 |
begin |
|
| 176 |
if !Options.static_mem |
|
| 177 |
then |
|
| 178 |
begin |
|
| 179 |
(* Static allocation *) |
|
| 180 |
let inst = mk_instance m in |
|
| 181 |
let attr = mk_attribute m in |
|
| 182 |
fprintf fmt "%a@.%a@.%a@." |
|
| 183 |
print_static_declare_macro (m, attr, inst) |
|
| 184 |
print_static_link_macro (m, attr, inst) |
|
| 185 |
print_static_alloc_macro (m, attr, inst) |
|
| 186 |
end |
|
| 36 |
fprintf fmt |
|
| 37 |
"#include <stdint.h>@,\ |
|
| 38 |
%a\ |
|
| 39 |
#include \"%s/arrow.h%s\"" |
|
| 40 |
(if !Options.mpfr then |
|
| 41 |
pp_print_endcut "#include <mpfr.h>" |
|
| 42 |
else pp_print_nothing) () |
|
| 43 |
(Arrow.arrow_top_decl ()).top_decl_owner |
|
| 44 |
(if !Options.cpp then "pp" else "") |
|
| 45 |
|
|
| 46 |
let rec print_static_val pp_var fmt v = |
|
| 47 |
match v.value_desc with |
|
| 48 |
| Cst c -> |
|
| 49 |
pp_c_const fmt c |
|
| 50 |
| Var v -> |
|
| 51 |
pp_var fmt v |
|
| 52 |
| Fun (n, vl) -> |
|
| 53 |
pp_basic_lib_fun (Types.is_int_type v.value_type) n |
|
| 54 |
(print_static_val pp_var) fmt vl |
|
| 55 |
| _ -> |
|
| 56 |
(* TODO: raise proper error *) |
|
| 57 |
eprintf "Internal error: C_backend_header.print_static_val"; |
|
| 58 |
assert false |
|
| 59 |
|
|
| 60 |
let print_constant_decl (m, attr, inst) pp_var fmt v = |
|
| 61 |
fprintf fmt "%s %a = %a" |
|
| 62 |
attr |
|
| 63 |
(pp_c_type (sprintf "%s ## %s" inst v.var_id)) v.var_type |
|
| 64 |
(print_static_val pp_var) (get_const_assign m v) |
|
| 65 |
|
|
| 66 |
let pp_var inst const_locals fmt v = |
|
| 67 |
if List.mem v const_locals then |
|
| 68 |
fprintf fmt "%s ## %s" inst v.var_id |
|
| 69 |
else fprintf fmt "%s" v.var_id |
|
| 70 |
|
|
| 71 |
let print_static_constant_decl (_, _, inst as macro) fmt const_locals = |
|
| 72 |
pp_print_list ~pp_open_box:pp_open_vbox0 |
|
| 73 |
~pp_sep:(pp_print_endcut ";\\") ~pp_eol:(pp_print_endcut ";\\") |
|
| 74 |
(print_constant_decl macro (pp_var inst const_locals)) |
|
| 75 |
fmt |
|
| 76 |
const_locals |
|
| 77 |
|
|
| 78 |
let print_static_declare_instance |
|
| 79 |
(m, attr, inst) const_locals fmt (i, (n, static)) = |
|
| 80 |
let values = List.map (value_of_dimension m) static in |
|
| 81 |
fprintf fmt "%a(%s, %a%s)" |
|
| 82 |
pp_machine_static_declare_name (node_name n) |
|
| 83 |
attr |
|
| 84 |
(pp_print_list ~pp_open_box:pp_open_hbox ~pp_sep:pp_print_comma |
|
| 85 |
~pp_eol:pp_print_comma (print_static_val (pp_var inst const_locals))) |
|
| 86 |
values |
|
| 87 |
i |
|
| 88 |
|
|
| 89 |
let print_static_declare_macro fmt (m, attr, inst as macro) = |
|
| 90 |
let const_locals = |
|
| 91 |
List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in |
|
| 92 |
let array_mem = |
|
| 93 |
List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in |
|
| 94 |
fprintf fmt |
|
| 95 |
"@[<v 2>\ |
|
| 96 |
#define %a(%s, %a%s)\\@,\ |
|
| 97 |
%a%s %a %s;\\@,\ |
|
| 98 |
%a%a;\ |
|
| 99 |
@]" |
|
| 100 |
pp_machine_static_declare_name m.mname.node_id |
|
| 101 |
attr |
|
| 102 |
(pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma |
|
| 103 |
(pp_c_var_read m)) m.mstatic |
|
| 104 |
inst |
|
| 105 |
(* constants *) |
|
| 106 |
(print_static_constant_decl macro) const_locals |
|
| 107 |
attr |
|
| 108 |
pp_machine_memtype_name m.mname.node_id |
|
| 109 |
inst |
|
| 110 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
|
| 111 |
~pp_sep:(pp_print_endcut ";\\") ~pp_eol:(pp_print_endcut ";\\") |
|
| 112 |
(pp_c_decl_local_var m)) array_mem |
|
| 113 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
|
| 114 |
~pp_sep:(pp_print_endcut ";\\") |
|
| 115 |
(fun fmt (i', m') -> |
|
| 116 |
let path = sprintf "%s ## _%s" inst i' in |
|
| 117 |
fprintf fmt "%a" |
|
| 118 |
(print_static_declare_instance macro const_locals) |
|
| 119 |
(path, m'))) m.minstances |
|
| 120 |
|
|
| 121 |
let print_static_link_instance fmt (i, (m, _)) = |
|
| 122 |
fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i |
|
| 123 |
|
|
| 124 |
(* Allocation of a node struct: |
|
| 125 |
- if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct) |
|
| 126 |
*) |
|
| 127 |
let print_static_link_macro fmt (m, _, inst) = |
|
| 128 |
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) |
|
| 129 |
m.mmemory in |
|
| 130 |
fprintf fmt |
|
| 131 |
"@[<v>@[<v 2>\ |
|
| 132 |
#define %a(%s) do {\\@,\
|
|
| 133 |
%a%a;\\@]@,\ |
|
| 134 |
} while (0)\ |
|
| 135 |
@]" |
|
| 136 |
pp_machine_static_link_name m.mname.node_id |
|
| 137 |
inst |
|
| 138 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
|
| 139 |
~pp_sep:(pp_print_endcut ";\\") ~pp_eol:(pp_print_endcut ";\\") |
|
| 140 |
(fun fmt v -> |
|
| 141 |
fprintf fmt "%s._reg.%s = (%a*) &%s" |
|
| 142 |
inst |
|
| 143 |
v.var_id |
|
| 144 |
(fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v |
|
| 145 |
v.var_id)) array_mem |
|
| 146 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
|
| 147 |
~pp_sep:(pp_print_endcut ";\\") |
|
| 148 |
(fun fmt (i',m') -> |
|
| 149 |
let path = sprintf "%s ## _%s" inst i' in |
|
| 150 |
fprintf fmt "%a;\\@,%s.%s = &%s" |
|
| 151 |
print_static_link_instance (path,m') |
|
| 152 |
inst |
|
| 153 |
i' |
|
| 154 |
path)) m.minstances |
|
| 155 |
|
|
| 156 |
let print_static_alloc_macro fmt (m, attr, inst) = |
|
| 157 |
fprintf fmt |
|
| 158 |
"@[<v>@[<v 2>\ |
|
| 159 |
#define %a(%s, %a%s)\\@,\ |
|
| 160 |
%a(%s, %a%s);\\@,\ |
|
| 161 |
%a(%s);\ |
|
| 162 |
@]@]" |
|
| 163 |
pp_machine_static_alloc_name m.mname.node_id |
|
| 164 |
attr |
|
| 165 |
(pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma |
|
| 166 |
(pp_c_var_read m)) m.mstatic |
|
| 167 |
inst |
|
| 168 |
pp_machine_static_declare_name m.mname.node_id |
|
| 169 |
attr |
|
| 170 |
(pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma |
|
| 171 |
(pp_c_var_read m)) m.mstatic |
|
| 172 |
inst |
|
| 173 |
pp_machine_static_link_name m.mname.node_id |
|
| 174 |
inst |
|
| 175 |
|
|
| 176 |
(* TODO: ACSL |
|
| 177 |
we do multiple things: |
|
| 178 |
- provide the semantics of the node as a predicate: function step and reset are associated to ACSL predicate |
|
| 179 |
- the node is associated to a refinement contract, wrt its ACSL sem |
|
| 180 |
- if the node is a regular node associated to a contract, print the contract as function contract. |
|
| 181 |
- do not print anything if this is a contract node |
|
| 182 |
*) |
|
| 183 |
let print_machine_alloc_decl fmt m = |
|
| 184 |
Mod.print_machine_decl_prefix fmt m; |
|
| 185 |
if not (fst (get_stateless_status m)) then |
|
| 186 |
if !Options.static_mem then |
|
| 187 |
(* Static allocation *) |
|
| 188 |
let macro = (m, mk_attribute m, mk_instance m) in |
|
| 189 |
fprintf fmt "%a@,%a@,%a" |
|
| 190 |
print_static_declare_macro macro |
|
| 191 |
print_static_link_macro macro |
|
| 192 |
print_static_alloc_macro macro |
|
| 187 | 193 |
else |
| 188 |
begin |
|
| 189 |
(* Dynamic allocation *) |
|
| 190 |
fprintf fmt "extern %a;@.@." |
|
| 191 |
print_alloc_prototype (m.mname.node_id, m.mstatic); |
|
| 192 |
|
|
| 193 |
fprintf fmt "extern %a;@.@." |
|
| 194 |
print_dealloc_prototype m.mname.node_id |
|
| 195 |
end |
|
| 196 |
end |
|
| 197 |
|
|
| 198 |
let print_machine_decl_from_header fmt inode = |
|
| 199 |
(*Mod.print_machine_decl_prefix fmt m;*) |
|
| 200 |
if inode.nodei_prototype = Some "C" then |
|
| 201 |
if inode.nodei_stateless then |
|
| 202 |
begin |
|
| 203 |
fprintf fmt "extern %a;@.@." |
|
| 204 |
print_stateless_C_prototype |
|
| 205 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
|
| 206 |
end |
|
| 207 |
else (Format.eprintf "internal error: print_machine_decl_from_header"; assert false) |
|
| 208 |
else |
|
| 209 |
if inode.nodei_stateless then |
|
| 210 |
begin |
|
| 211 |
fprintf fmt "extern %a;@.@." |
|
| 212 |
print_stateless_prototype |
|
| 213 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
|
| 214 |
end |
|
| 215 |
else |
|
| 216 |
begin |
|
| 217 |
let static_inputs = List.filter (fun v -> v.var_dec_const) inode.nodei_inputs in |
|
| 218 |
let used name = |
|
| 219 |
(List.exists (fun v -> v.var_id = name) inode.nodei_inputs) |
|
| 220 |
|| (List.exists (fun v -> v.var_id = name) inode.nodei_outputs) in |
|
| 221 |
let self = mk_new_name used "self" in |
|
| 222 |
fprintf fmt "extern %a;@.@." |
|
| 223 |
(print_reset_prototype self) (inode.nodei_id, static_inputs); |
|
| 224 |
|
|
| 225 |
fprintf fmt "extern %a;@.@." |
|
| 226 |
(print_init_prototype self) (inode.nodei_id, static_inputs); |
|
| 227 |
|
|
| 228 |
fprintf fmt "extern %a;@.@." |
|
| 229 |
(print_clear_prototype self) (inode.nodei_id, static_inputs); |
|
| 230 |
|
|
| 231 |
fprintf fmt "extern %a;@.@." |
|
| 232 |
(print_step_prototype self) |
|
| 233 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
|
| 194 |
(* Dynamic allocation *) |
|
| 195 |
fprintf fmt "extern %a;@,extern %a" |
|
| 196 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
| 197 |
print_dealloc_prototype m.mname.node_id |
|
| 198 |
|
|
| 199 |
let print_machine_struct_top_decl_from_header fmt tdecl = |
|
| 200 |
let inode = imported_node_of_top tdecl in |
|
| 201 |
if not inode.nodei_stateless then |
|
| 202 |
(* Declare struct *) |
|
| 203 |
fprintf fmt "%a;" |
|
| 204 |
pp_machine_memtype_name inode.nodei_id |
|
| 205 |
|
|
| 206 |
let print_stateless_C_prototype fmt (name, inputs, outputs) = |
|
| 207 |
let output = |
|
| 208 |
match outputs with |
|
| 209 |
| [hd] -> hd |
|
| 210 |
| _ -> assert false |
|
| 211 |
in |
|
| 212 |
fprintf fmt "%a %s %a" |
|
| 213 |
(pp_basic_c_type ~var_opt:None) output.var_type |
|
| 214 |
name |
|
| 215 |
(pp_print_parenthesized pp_c_decl_input_var) inputs |
|
| 216 |
|
|
| 217 |
let print_machine_decl_top_decl_from_header fmt tdecl = |
|
| 218 |
let inode = imported_node_of_top tdecl in |
|
| 219 |
(*Mod.print_machine_decl_prefix fmt m;*) |
|
| 220 |
let prototype = (inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) in |
|
| 221 |
if inode.nodei_prototype = Some "C" then |
|
| 222 |
if inode.nodei_stateless then |
|
| 223 |
fprintf fmt "extern %a;" print_stateless_C_prototype prototype |
|
| 224 |
else begin |
|
| 225 |
(* TODO: raise proper error *) |
|
| 226 |
Format.eprintf "internal error: print_machine_decl_top_decl_from_header"; |
|
| 227 |
assert false |
|
| 234 | 228 |
end |
| 229 |
else if inode.nodei_stateless then |
|
| 230 |
fprintf fmt "extern %a;" print_stateless_prototype prototype |
|
| 231 |
else |
|
| 232 |
let static_inputs = List.filter (fun v -> v.var_dec_const) |
|
| 233 |
inode.nodei_inputs in |
|
| 234 |
let used name = |
|
| 235 |
List.exists (fun v -> v.var_id = name) |
|
| 236 |
(inode.nodei_inputs @ inode.nodei_outputs) in |
|
| 237 |
let self = mk_new_name used "self" in |
|
| 238 |
let static_prototype = (inode.nodei_id, static_inputs) in |
|
| 239 |
fprintf fmt |
|
| 240 |
"extern %a;@,\ |
|
| 241 |
extern %a;@,\ |
|
| 242 |
extern %a;@,\ |
|
| 243 |
extern %a;" |
|
| 244 |
(print_reset_prototype self) static_prototype |
|
| 245 |
(print_init_prototype self) static_prototype |
|
| 246 |
(print_clear_prototype self) static_prototype |
|
| 247 |
(print_step_prototype self) prototype |
|
| 248 |
|
|
| 249 |
let print_const_top_decl fmt tdecl = |
|
| 250 |
let cdecl = const_of_top tdecl in |
|
| 251 |
fprintf fmt "extern %a;" |
|
| 252 |
(pp_c_type cdecl.const_id) |
|
| 253 |
(if !Options.mpfr && Types.(is_real_type (array_base_type cdecl.const_type)) |
|
| 254 |
then Types.dynamic_type cdecl.const_type |
|
| 255 |
else cdecl.const_type) |
|
| 235 | 256 |
|
| 236 |
let print_const_decl fmt cdecl = |
|
| 237 |
if !Options.mpfr && Types.is_real_type (Types.array_base_type cdecl.const_type) |
|
| 238 |
then |
|
| 239 |
fprintf fmt "extern %a;@." |
|
| 240 |
(pp_c_type cdecl.const_id) (Types.dynamic_type cdecl.const_type) |
|
| 241 |
else |
|
| 242 |
fprintf fmt "extern %a;@." |
|
| 243 |
(pp_c_type cdecl.const_id) cdecl.const_type |
|
| 244 |
|
|
| 245 |
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) = |
|
| 246 |
fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc |
|
| 247 |
and pp_c_type_decl filename cpt var fmt tdecl = |
|
| 248 |
match tdecl with |
|
| 249 |
| Tydec_any -> assert false |
|
| 250 |
| Tydec_int -> fprintf fmt "int %s" var |
|
| 251 |
| Tydec_real when !Options.mpfr |
|
| 252 |
-> fprintf fmt "%s %s" Mpfr.mpfr_t var |
|
| 253 |
| Tydec_real -> fprintf fmt "double %s" var |
|
| 254 |
(* | Tydec_float -> fprintf fmt "float %s" var *) |
|
| 255 |
| Tydec_bool -> fprintf fmt "_Bool %s" var |
|
| 256 |
| Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty |
|
| 257 |
| Tydec_const c -> fprintf fmt "%s %s" c var |
|
| 258 |
| Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d |
|
| 259 |
| Tydec_enum tl -> |
|
| 260 |
begin |
|
| 257 |
let rec pp_c_type_decl filename cpt var fmt tdecl = |
|
| 258 |
match tdecl with |
|
| 259 |
| Tydec_any -> |
|
| 260 |
assert false |
|
| 261 |
| Tydec_int -> |
|
| 262 |
fprintf fmt "int %s" var |
|
| 263 |
| Tydec_real when !Options.mpfr -> |
|
| 264 |
fprintf fmt "%s %s" Mpfr.mpfr_t var |
|
| 265 |
| Tydec_real -> |
|
| 266 |
fprintf fmt "double %s" var |
|
| 267 |
(* | Tydec_float -> fprintf fmt "float %s" var *) |
|
| 268 |
| Tydec_bool -> |
|
| 269 |
fprintf fmt "_Bool %s" var |
|
| 270 |
| Tydec_clock ty -> |
|
| 271 |
pp_c_type_decl filename cpt var fmt ty |
|
| 272 |
| Tydec_const c -> |
|
| 273 |
fprintf fmt "%s %s" c var |
|
| 274 |
| Tydec_array (d, ty) -> |
|
| 275 |
fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d |
|
| 276 |
| Tydec_enum tl -> |
|
| 261 | 277 |
incr cpt; |
| 262 |
fprintf fmt "enum _enum_%s_%d { %a } %s" (protect_filename filename) !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
|
|
| 263 |
end |
|
| 264 |
| Tydec_struct fl -> |
|
| 265 |
begin |
|
| 278 |
fprintf fmt "enum _enum_%s_%d %a %s" (protect_filename filename) !cpt |
|
| 279 |
(pp_print_braced pp_print_string) tl var |
|
| 280 |
| Tydec_struct fl -> |
|
| 266 | 281 |
incr cpt; |
| 267 |
fprintf fmt "struct _struct_%s_%d { %a } %s" (protect_filename filename) !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var
|
|
| 268 |
end |
|
| 269 |
|
|
| 270 |
let print_type_definitions fmt filename = |
|
| 271 |
let cpt_type = ref 0 in |
|
| 272 |
Hashtbl.iter (fun typ decl -> |
|
| 273 |
match typ with |
|
| 274 |
| Tydec_const var -> |
|
| 275 |
(match decl.top_decl_desc with |
|
| 276 |
| TypeDef tdef -> |
|
| 277 |
fprintf fmt "typedef %a;@.@." |
|
| 278 |
(pp_c_type_decl filename cpt_type var) tdef.tydef_desc |
|
| 279 |
| _ -> assert false) |
|
| 280 |
| _ -> ()) type_table |
|
| 281 |
|
|
| 282 |
let reset_type_definitions, print_type_definition_from_header = |
|
| 283 |
let cpt_type = ref 0 in |
|
| 284 |
(fun () -> cpt_type := 0), |
|
| 285 |
(fun fmt typ filename -> |
|
| 286 |
fprintf fmt "typedef %a;@.@." |
|
| 287 |
(pp_c_type_decl filename cpt_type typ.tydef_id) typ.tydef_desc) |
|
| 282 |
fprintf fmt "struct _struct_%s_%d %a %s" (protect_filename filename) !cpt |
|
| 283 |
(pp_print_braced ~pp_sep:pp_print_semicolon |
|
| 284 |
(fun fmt (label, tdesc) -> pp_c_type_decl filename cpt label fmt tdesc)) |
|
| 285 |
fl var |
|
| 288 | 286 |
|
| 289 |
(********************************************************************************************) |
|
| 290 |
(* MAIN Header Printing functions *) |
|
| 291 |
(********************************************************************************************) |
|
| 292 |
(* Seems not used |
|
| 293 |
|
|
| 294 |
let print_header header_fmt basename prog machines dependencies = |
|
| 295 |
(* Include once: start *) |
|
| 296 |
let baseNAME = file_to_module_name basename in |
|
| 297 |
begin |
|
| 298 |
(* Print the version number and the supported C standard (C90 or C99) *) |
|
| 299 |
print_version header_fmt; |
|
| 300 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
|
| 301 |
pp_print_newline header_fmt (); |
|
| 302 |
fprintf header_fmt "/* Imports standard library */@."; |
|
| 303 |
(* imports standard library definitions (arrow) *) |
|
| 304 |
print_import_standard header_fmt; |
|
| 305 |
pp_print_newline header_fmt (); |
|
| 306 |
(* imports dependencies *) |
|
| 307 |
fprintf header_fmt "/* Import dependencies */@."; |
|
| 308 |
fprintf header_fmt "@[<v>"; |
|
| 309 |
List.iter (print_import_prototype header_fmt) dependencies; |
|
| 310 |
fprintf header_fmt "@]@."; |
|
| 311 |
fprintf header_fmt "/* Types definitions */@."; |
|
| 312 |
(* Print the type definitions from the type table *) |
|
| 313 |
print_type_definitions header_fmt basename; |
|
| 314 |
pp_print_newline header_fmt (); |
|
| 315 |
(* Print the global constant declarations. *) |
|
| 316 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
|
| 317 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) (get_consts prog); |
|
| 318 |
pp_print_newline header_fmt (); |
|
| 319 |
if !Options.mpfr then |
|
| 320 |
begin |
|
| 321 |
fprintf header_fmt "/* Global initialization declaration */@."; |
|
| 322 |
fprintf header_fmt "extern %a;@.@." |
|
| 323 |
print_global_init_prototype baseNAME; |
|
| 324 |
|
|
| 325 |
fprintf header_fmt "/* Global clear declaration */@."; |
|
| 326 |
fprintf header_fmt "extern %a;@.@." |
|
| 327 |
print_global_clear_prototype baseNAME; |
|
| 328 |
end; |
|
| 329 |
(* Print the struct declarations of all machines. *) |
|
| 330 |
fprintf header_fmt "/* Structs declarations */@."; |
|
| 331 |
List.iter (print_machine_struct machines header_fmt) machines; |
|
| 332 |
pp_print_newline header_fmt (); |
|
| 333 |
(* Print the prototypes of all machines *) |
|
| 334 |
fprintf header_fmt "/* Nodes declarations */@."; |
|
| 335 |
List.iter (print_machine_decl header_fmt) machines; |
|
| 336 |
pp_print_newline header_fmt (); |
|
| 337 |
(* Include once: end *) |
|
| 338 |
fprintf header_fmt "#endif@."; |
|
| 339 |
pp_print_newline header_fmt () |
|
| 340 |
end |
|
| 341 |
*) |
|
| 342 |
let print_alloc_header header_fmt basename _prog machines dependencies spec = |
|
| 343 |
(* Include once: start *) |
|
| 344 |
let baseNAME = file_to_module_name basename in |
|
| 345 |
begin |
|
| 346 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
|
| 347 |
print_version header_fmt; |
|
| 348 |
fprintf header_fmt "#ifndef _%s_alloc@.#define _%s_alloc@." baseNAME baseNAME; |
|
| 349 |
pp_print_newline header_fmt (); |
|
| 350 |
(* Import the header *) |
|
| 351 |
fprintf header_fmt "/* Import header from %s */@." basename; |
|
| 352 |
fprintf header_fmt "@[<v>"; |
|
| 353 |
print_import_prototype header_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is staful *);
|
|
| 354 |
fprintf header_fmt "@]@."; |
|
| 355 |
fprintf header_fmt "/* Import dependencies */@."; |
|
| 356 |
fprintf header_fmt "@[<v>"; |
|
| 357 |
List.iter (print_import_alloc_prototype header_fmt) dependencies; |
|
| 358 |
fprintf header_fmt "@]@."; |
|
| 359 |
(* Print the struct definitions of all machines. *) |
|
| 360 |
fprintf header_fmt "/* Struct definitions */@."; |
|
| 361 |
List.iter (print_machine_struct header_fmt) machines; |
|
| 362 |
pp_print_newline header_fmt (); |
|
| 363 |
fprintf header_fmt "/* Specification */@.%a@." C_backend_spec.pp_acsl_preamble spec; |
|
| 364 |
(* Print the prototypes of all machines *) |
|
| 365 |
fprintf header_fmt "/* Node allocation function/macro prototypes */@."; |
|
| 366 |
List.iter (print_machine_alloc_decl header_fmt) machines; |
|
| 367 |
pp_print_newline header_fmt (); |
|
| 368 |
(* Include once: end *) |
|
| 369 |
fprintf header_fmt "#endif@."; |
|
| 370 |
pp_print_newline header_fmt () |
|
| 371 |
end |
|
| 372 |
|
|
| 373 |
(* Function called when compiling a lusi file and generating the associated C |
|
| 374 |
header. *) |
|
| 375 |
let print_header_from_header header_fmt basename header = |
|
| 376 |
(* Include once: start *) |
|
| 377 |
let baseNAME = file_to_module_name basename in |
|
| 378 |
let types = get_typedefs header in |
|
| 379 |
let consts = get_consts header in |
|
| 380 |
let nodes = get_imported_nodes header in |
|
| 381 |
let dependencies = get_dependencies header in |
|
| 382 |
begin |
|
| 383 |
(* Print the version number and the supported C standard (C90 or C99) *) |
|
| 384 |
print_version header_fmt; |
|
| 385 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
|
| 386 |
pp_print_newline header_fmt (); |
|
| 387 |
fprintf header_fmt "/* Imports standard library */@."; |
|
| 388 |
(* imports standard library definitions (arrow) *) |
|
| 389 |
print_import_standard header_fmt; |
|
| 390 |
pp_print_newline header_fmt (); |
|
| 391 |
(* imports dependencies *) |
|
| 392 |
fprintf header_fmt "/* Import dependencies */@."; |
|
| 393 |
fprintf header_fmt "@[<v>"; |
|
| 394 |
List.iter |
|
| 395 |
(fun dep -> |
|
| 396 |
let (local, s) = dependency_of_top dep in |
|
| 397 |
print_import_prototype header_fmt {local=local; name=s; content=[]; is_stateful=true} (* assuming it is stateful *))
|
|
| 398 |
dependencies; |
|
| 399 |
fprintf header_fmt "@]@."; |
|
| 400 |
fprintf header_fmt "/* Types definitions */@."; |
|
| 401 |
(* Print the type definitions from the type table *) |
|
| 287 |
(* let print_type_definitions fmt filename = |
|
| 288 |
* let cpt_type = ref 0 in |
|
| 289 |
* Hashtbl.iter (fun typ decl -> |
|
| 290 |
* match typ with |
|
| 291 |
* | Tydec_const var -> |
|
| 292 |
* begin match decl.top_decl_desc with |
|
| 293 |
* | TypeDef tdef -> |
|
| 294 |
* fprintf fmt "typedef %a;@.@." |
|
| 295 |
* (pp_c_type_decl filename cpt_type var) tdef.tydef_desc |
|
| 296 |
* | _ -> assert false |
|
| 297 |
* end |
|
| 298 |
* | _ -> ()) type_table *) |
|
| 299 |
|
|
| 300 |
let reset_type_definitions, print_type_definition_top_decl_from_header = |
|
| 301 |
let cpt_type = ref 0 in |
|
| 302 |
(fun () -> cpt_type := 0), |
|
| 303 |
(fun filename fmt tdecl -> |
|
| 304 |
let typ = typedef_of_top tdecl in |
|
| 305 |
fprintf fmt "typedef %a;" |
|
| 306 |
(pp_c_type_decl filename cpt_type typ.tydef_id) typ.tydef_desc) |
|
| 307 |
|
|
| 308 |
(********************************************************************************************) |
|
| 309 |
(* MAIN Header Printing functions *) |
|
| 310 |
(********************************************************************************************) |
|
| 311 |
|
|
| 312 |
let print_alloc_header header_fmt basename _prog machines dependencies spec = |
|
| 313 |
(* Include once: start *) |
|
| 314 |
let baseNAME = file_to_module_name basename in |
|
| 315 |
fprintf header_fmt |
|
| 316 |
"@[<v>\ |
|
| 317 |
%a@,\ |
|
| 318 |
#ifndef _%s_alloc@,\ |
|
| 319 |
#define _%s_alloc@,\ |
|
| 320 |
@,\ |
|
| 321 |
/* Import header from %s */@,\ |
|
| 322 |
%a@,\ |
|
| 323 |
@,\ |
|
| 324 |
%a\ |
|
| 325 |
%a\ |
|
| 326 |
%a\ |
|
| 327 |
%a\ |
|
| 328 |
#endif\ |
|
| 329 |
@]" |
|
| 330 |
|
|
| 331 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
|
| 332 |
pp_print_version () |
|
| 333 |
|
|
| 334 |
baseNAME baseNAME |
|
| 335 |
|
|
| 336 |
(* Import the header *) |
|
| 337 |
basename |
|
| 338 |
print_import_prototype |
|
| 339 |
{
|
|
| 340 |
local = true; |
|
| 341 |
name = basename; |
|
| 342 |
content = []; |
|
| 343 |
is_stateful = true (* assuming it is staful *); |
|
| 344 |
} |
|
| 345 |
|
|
| 346 |
(* Print dependencies *) |
|
| 347 |
(pp_print_list |
|
| 348 |
~pp_open_box:pp_open_vbox0 |
|
| 349 |
~pp_prologue:(pp_print_endcut "/* Import dependencies */") |
|
| 350 |
print_import_alloc_prototype |
|
| 351 |
~pp_epilogue:pp_print_cutcut) dependencies |
|
| 352 |
|
|
| 353 |
(* Print the struct definitions of all machines. *) |
|
| 354 |
(pp_print_list |
|
| 355 |
~pp_open_box:pp_open_vbox0 |
|
| 356 |
~pp_prologue:(pp_print_endcut "/* Struct definitions */") |
|
| 357 |
~pp_sep:pp_print_cutcut |
|
| 358 |
print_machine_struct |
|
| 359 |
~pp_epilogue:pp_print_cutcut) machines |
|
| 360 |
|
|
| 361 |
(* Print specification *) |
|
| 362 |
C_backend_spec.pp_acsl_preamble spec |
|
| 363 |
|
|
| 364 |
(* Print the prototypes of all machines *) |
|
| 365 |
(pp_print_list |
|
| 366 |
~pp_open_box:pp_open_vbox0 |
|
| 367 |
~pp_prologue:(pp_print_endcut |
|
| 368 |
"/* Node allocation function/macro prototypes */") |
|
| 369 |
~pp_sep:pp_print_cutcut |
|
| 370 |
print_machine_alloc_decl |
|
| 371 |
~pp_epilogue:pp_print_cutcut) machines |
|
| 372 |
(* Include once: end *) |
|
| 373 |
|
|
| 374 |
(* Function called when compiling a lusi file and generating the associated C |
|
| 375 |
header. *) |
|
| 376 |
let print_header_from_header header_fmt basename header = |
|
| 377 |
(* Include once: start *) |
|
| 378 |
let baseNAME = file_to_module_name basename in |
|
| 379 |
let types = get_typedefs header in |
|
| 380 |
let consts = get_consts header in |
|
| 381 |
let nodes = get_imported_nodes header in |
|
| 382 |
let dependencies = get_dependencies header in |
|
| 402 | 383 |
reset_type_definitions (); |
| 403 |
List.iter (fun typ -> print_type_definition_from_header header_fmt (typedef_of_top typ) basename) types; |
|
| 404 |
pp_print_newline header_fmt (); |
|
| 405 |
(* Print the global constant declarations. *) |
|
| 406 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
|
| 407 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) consts; |
|
| 408 |
pp_print_newline header_fmt (); |
|
| 409 |
if !Options.mpfr then |
|
| 410 |
begin |
|
| 411 |
fprintf header_fmt "/* Global initialization declaration */@."; |
|
| 412 |
fprintf header_fmt "extern %a;@.@." |
|
| 413 |
print_global_init_prototype baseNAME; |
|
| 414 |
|
|
| 415 |
fprintf header_fmt "/* Global clear declaration */@."; |
|
| 416 |
fprintf header_fmt "extern %a;@.@." |
|
| 417 |
print_global_clear_prototype baseNAME; |
|
| 418 |
end; |
|
| 419 |
(* Print the struct declarations of all machines. *) |
|
| 420 |
fprintf header_fmt "/* Structs declarations */@."; |
|
| 421 |
List.iter (fun node -> print_machine_struct_from_header header_fmt (imported_node_of_top node)) nodes; |
|
| 422 |
pp_print_newline header_fmt (); |
|
| 423 |
(* Print the prototypes of all machines *) |
|
| 424 |
fprintf header_fmt "/* Nodes declarations */@."; |
|
| 425 |
List.iter (fun node -> print_machine_decl_from_header header_fmt (imported_node_of_top node)) nodes; |
|
| 426 |
pp_print_newline header_fmt (); |
|
| 427 |
(* Include once: end *) |
|
| 428 |
fprintf header_fmt "#endif@."; |
|
| 429 |
pp_print_newline header_fmt () |
|
| 430 |
end |
|
| 384 |
fprintf header_fmt |
|
| 385 |
"@[<v>\ |
|
| 386 |
%a@,\ |
|
| 387 |
#ifndef _%s@,\ |
|
| 388 |
#define _%s@,\ |
|
| 389 |
@,\ |
|
| 390 |
/* Import standard library */@,\ |
|
| 391 |
%a@,\ |
|
| 392 |
@,\ |
|
| 393 |
%a\ |
|
| 394 |
%a\ |
|
| 395 |
%a\ |
|
| 396 |
%a\ |
|
| 397 |
%a\ |
|
| 398 |
%a\ |
|
| 399 |
#endif\ |
|
| 400 |
@]@." |
|
| 401 |
|
|
| 402 |
(* Print the version number and the supported C standard (C90 or C99) *) |
|
| 403 |
pp_print_version () |
|
| 404 |
|
|
| 405 |
baseNAME baseNAME |
|
| 406 |
|
|
| 407 |
(* imports standard library definitions (arrow) *) |
|
| 408 |
print_import_standard () |
|
| 409 |
|
|
| 410 |
(* imports dependencies *) |
|
| 411 |
(pp_print_list |
|
| 412 |
~pp_open_box:pp_open_vbox0 |
|
| 413 |
~pp_prologue:(pp_print_endcut "/* Import dependencies */") |
|
| 414 |
(fun fmt dep -> |
|
| 415 |
let local, name = dependency_of_top dep in |
|
| 416 |
print_import_prototype fmt |
|
| 417 |
{
|
|
| 418 |
local; |
|
| 419 |
name; |
|
| 420 |
content = []; |
|
| 421 |
is_stateful = true (* assuming it is stateful *) |
|
| 422 |
}) |
|
| 423 |
~pp_epilogue:pp_print_cutcut) |
|
| 424 |
dependencies |
|
| 425 |
|
|
| 426 |
(* Print the type definitions from the type table *) |
|
| 427 |
(pp_print_list |
|
| 428 |
~pp_open_box:pp_open_vbox0 |
|
| 429 |
~pp_prologue:(pp_print_endcut "/* Types definitions */") |
|
| 430 |
(print_type_definition_top_decl_from_header basename) |
|
| 431 |
~pp_epilogue:pp_print_cutcut) |
|
| 432 |
types |
|
| 433 |
|
|
| 434 |
(* Print the global constant declarations. *) |
|
| 435 |
(pp_print_list |
|
| 436 |
~pp_open_box:pp_open_vbox0 |
|
| 437 |
~pp_prologue: |
|
| 438 |
(pp_print_endcut |
|
| 439 |
"/* Global constants (declarations, definitions are in C file) */") |
|
| 440 |
print_const_top_decl |
|
| 441 |
~pp_epilogue:pp_print_cutcut) |
|
| 442 |
consts |
|
| 443 |
|
|
| 444 |
(* MPFR *) |
|
| 445 |
(if !Options.mpfr then |
|
| 446 |
fun fmt () -> fprintf fmt |
|
| 447 |
"/* Global initialization declaration */@,\ |
|
| 448 |
extern %a;@,@,\ |
|
| 449 |
/* Global clear declaration */@,\ |
|
| 450 |
extern %a;@,@," |
|
| 451 |
print_global_init_prototype baseNAME |
|
| 452 |
print_global_clear_prototype baseNAME |
|
| 453 |
else pp_print_nothing) () |
|
| 454 |
|
|
| 455 |
(* Print the struct declarations of all machines. *) |
|
| 456 |
(pp_print_list |
|
| 457 |
~pp_open_box:pp_open_vbox0 |
|
| 458 |
~pp_prologue:(pp_print_endcut "/* Struct declarations */") |
|
| 459 |
print_machine_struct_top_decl_from_header |
|
| 460 |
~pp_epilogue:pp_print_cutcut) |
|
| 461 |
nodes |
|
| 462 |
|
|
| 463 |
(* Print the prototypes of all machines *) |
|
| 464 |
(pp_print_list |
|
| 465 |
~pp_open_box:pp_open_vbox0 |
|
| 466 |
~pp_prologue:(pp_print_endcut "/* Nodes declarations */") |
|
| 467 |
~pp_sep:pp_print_cutcut |
|
| 468 |
print_machine_decl_top_decl_from_header |
|
| 469 |
~pp_epilogue:pp_print_cutcut) |
|
| 470 |
nodes |
|
| 431 | 471 |
|
| 432 | 472 |
end |
| 433 | 473 |
(* Local Variables: *) |
Also available in: Unified diff
some rewriting in C backend pretty-printer