Commit | Line | Data |
---|---|---|
34e49164 C |
1 | module TH = Token_helpers |
2 | ||
3 | let names = ref ([] : (string * int ref) list) | |
4 | ||
5 | (* ----------------------------------------------------------------------- *) | |
6 | (* drop tokens representing the function header and the final close brace *) | |
7 | ||
8 | let drop_header_toks toks_e = | |
9 | let remove t = | |
10 | if not (TH.is_comment_or_space t) | |
11 | then | |
12 | (TH.info_of_tok t).Ast_c.cocci_tag := | |
13 | (Ast_cocci.MINUS(Ast_cocci.DontCarePos,[]),[]) in | |
14 | let rec drop_up_to_brace = function | |
15 | [] -> () | |
16 | | ((Parser_c.TOBrace _) as t) :: _ -> remove t | |
17 | | x :: rest -> remove x; drop_up_to_brace rest in | |
18 | let drop_final_brace toks = | |
19 | match List.rev toks with | |
20 | ((Parser_c.TCBrace _) as t) :: _ -> remove t | |
21 | | _ -> failwith "unexpected end of function" in | |
22 | drop_up_to_brace toks_e; | |
23 | drop_final_brace toks_e | |
24 | ||
25 | (* ----------------------------------------------------------------------- *) | |
26 | (* remove coments from tokens *) | |
27 | ||
28 | let strip_comments toks = | |
29 | let toks = List.filter (function x -> not (TH.is_just_comment x)) toks in | |
30 | List.iter | |
31 | (function t -> | |
32 | (TH.info_of_tok t).Ast_c.comments_tag := | |
33 | {Ast_c.mbefore = []; Ast_c.mafter = [];}) | |
34 | toks; | |
35 | toks | |
36 | ||
37 | (* ----------------------------------------------------------------------- *) | |
38 | (* Create rule to check for header include *) | |
39 | ||
40 | let print_header_rule pr srcfile = | |
41 | match Str.split (Str.regexp "/") srcfile with | |
42 | [x] -> | |
43 | pr "@header@\n@@\n\n#include \""; pr x; pr "\"\n\n"; true | |
44 | | l -> | |
45 | let rec loop = function | |
46 | [] -> false | |
47 | | [x] -> | |
48 | pr "@header@\n@@\n\n#include \""; pr x; pr "\"\n\n"; true | |
49 | | "include"::(x::xs) -> | |
50 | pr "@header@\n@@\n\n#include <"; | |
51 | let x = | |
52 | if Str.string_match (Str.regexp "asm-") x 0 then "asm" else x in | |
53 | pr (String.concat "/" (x::xs)); | |
54 | pr ">\n\n"; true | |
55 | | x::xs -> loop xs in | |
56 | loop l | |
57 | ||
58 | (* ----------------------------------------------------------------------- *) | |
59 | (* Print metavariable declarations *) | |
60 | ||
61 | let rec print_typedef typedefs pr = function | |
62 | (Ast_c.TypeName(s,_),_) -> | |
63 | if not (List.mem s !typedefs) | |
64 | then (typedefs := s::!typedefs; pr "typedef "; pr s; pr ";\n") | |
65 | | (Ast_c.Pointer(_,ty),_) -> print_typedef typedefs pr ty | |
66 | | _ -> () | |
67 | ||
68 | let print_metavar pr typedefs = function | |
69 | ((_,Some param,(_,(Ast_c.Pointer(_,(Ast_c.BaseType(Ast_c.Void),_)),_))),_) | |
70 | -> | |
71 | pr "expression "; pr param | |
72 | | (((_,Some param,(_,ty)),il) : Ast_c.parameterType) -> | |
73 | print_typedef typedefs pr ty; | |
74 | Pretty_print_c.pp_param_gen | |
75 | (function x -> | |
76 | let str = Ast_c.str_of_info x in | |
77 | if not (List.mem str ["const";"volatile"]) | |
78 | then (pr str; pr " ")) | |
79 | (function _ -> pr " ") | |
80 | ((false,Some param, | |
81 | (({Ast_c.const = false; Ast_c.volatile = false},[]),ty)), | |
82 | il) | |
83 | | _ -> failwith "function must have named parameters" | |
84 | ||
485bce71 C |
85 | let print_metavariables pr defn header_req = |
86 | let {Ast_c.f_name = s; f_type = (_, (paramst, (b, iib))); } = defn in | |
34e49164 C |
87 | (if header_req |
88 | then pr "@depends on header@\n" | |
89 | else pr "@@\n"); | |
90 | (if b then failwith "not handling variable argument functions"); | |
91 | let typedefs = ref ([] : string list) in | |
92 | (match paramst with | |
93 | [] | [(((_,_,(_,(Ast_c.BaseType(Ast_c.Void),_))),_),_)] -> () | |
94 | | (first,_)::rest -> | |
95 | print_metavar pr typedefs first; pr ";\n"; | |
96 | List.iter (function (x,_) -> print_metavar pr typedefs x; pr ";\n") | |
97 | rest); | |
98 | pr "@@\n\n" | |
99 | ||
100 | (* ----------------------------------------------------------------------- *) | |
101 | (* copy a file, adding - at the beginning of every line *) | |
102 | ||
103 | let minus_file pr file = | |
104 | Common.with_open_infile file (function chan -> | |
105 | let rec loop _ = | |
106 | let l = input_line chan in | |
107 | pr "- "; pr l; pr "\n"; | |
108 | loop() in | |
109 | try loop() with End_of_file -> ()) | |
110 | ||
111 | (* ----------------------------------------------------------------------- *) | |
112 | (* Print call to the defined function *) | |
113 | ||
114 | let print_param_name pr = function | |
115 | ((_,Some param,_),_) -> pr param | |
116 | | _ -> failwith "function must have named parameters" | |
117 | ||
485bce71 C |
118 | let pp_def_gen pr defn isexp = |
119 | let {Ast_c.f_name = s; f_type = (_, (paramst, (b, iib))); } = defn in | |
34e49164 C |
120 | pr s; pr "("; |
121 | (if b then failwith "not handling variable argument functions"); | |
122 | (match paramst with | |
123 | [] | [(((_,_,(_,(Ast_c.BaseType(Ast_c.Void),_))),_),_)] -> () | |
124 | | (first,_)::rest -> | |
125 | print_param_name pr first; | |
126 | List.iter (function (x,_) -> pr ", "; print_param_name pr x) rest); | |
127 | pr ")"; if not isexp then pr ";" | |
128 | ||
129 | (* ----------------------------------------------------------------------- *) | |
130 | (* Entry point *) | |
131 | ||
132 | let pp_program (e,(str, toks_e)) outdir srcfile isexp = | |
133 | match e with | |
485bce71 | 134 | Ast_c.Definition(({Ast_c.f_name = name;} as defn),_) -> |
34e49164 C |
135 | (* generate the - code *) |
136 | drop_header_toks toks_e; | |
137 | let toks_e = strip_comments toks_e in | |
138 | let tmp_file = Common.new_temp_file "cocci_small_output" ".c" in | |
485bce71 | 139 | Unparse_c.pp_program [((e,(str, toks_e)), Unparse_c.PPnormal)] |
34e49164 C |
140 | tmp_file; |
141 | let outfile = outdir ^ "/" ^ name in | |
142 | let outfile = | |
143 | try | |
144 | let cell = List.assoc outfile !names in | |
145 | let ct = !cell in | |
146 | cell := ct + 1; | |
147 | outfile ^ (string_of_int ct) | |
148 | with Not_found -> | |
149 | let cell = ref 1 in names := (outfile,cell) :: !names; outfile in | |
150 | let outfile = outfile ^ ".cocci" in | |
151 | Common.with_open_outfile outfile (fun (pr,chan) -> | |
152 | let header_req = print_header_rule pr srcfile in | |
153 | print_metavariables pr defn header_req; | |
154 | minus_file pr tmp_file; | |
155 | pr "+ "; | |
156 | pp_def_gen pr defn isexp; | |
157 | pr "\n") | |
158 | | _ -> Common.pr2_once "warning: function expected"; () |