← Back to branch summary

~ubuntu-branches/debian/sid/frama-c/sid

« back to all changes in this revision

Viewing changes to cil/src/ext/deadcodeelim.ml

  • Committer: Bazaar Package Importer
  • Author(s): Mehdi Dogguy
  • Date: 2009-06-03 08:19:25 UTC
  • Revision ID: james.westby@ubuntu.com-20090603081925-kihvxvt0wy3zc4ar
Tags: upstream-20081201.dfsg
Import upstream version 20081201.dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
cil/src/ext/deadcodeelim.ml
 
1
(**************************************************************************)
 
2
(*                                                                        *)
 
3
(*  Copyright (C) 2001-2003,                                              *)
 
4
(*   George C. Necula    <necula@cs.berkeley.edu>                         *)
 
5
(*   Scott McPeak        <smcpeak@cs.berkeley.edu>                        *)
 
6
(*   Wes Weimer          <weimer@cs.berkeley.edu>                         *)
 
7
(*   Ben Liblit          <liblit@cs.berkeley.edu>                         *)
 
8
(*  All rights reserved.                                                  *)
 
9
(*                                                                        *)
 
10
(*  Redistribution and use in source and binary forms, with or without    *)
 
11
(*  modification, are permitted provided that the following conditions    *)
 
12
(*  are met:                                                              *)
 
13
(*                                                                        *)
 
14
(*  1. Redistributions of source code must retain the above copyright     *)
 
15
(*  notice, this list of conditions and the following disclaimer.         *)
 
16
(*                                                                        *)
 
17
(*  2. Redistributions in binary form must reproduce the above copyright  *)
 
18
(*  notice, this list of conditions and the following disclaimer in the   *)
 
19
(*  documentation and/or other materials provided with the distribution.  *)
 
20
(*                                                                        *)
 
21
(*  3. The names of the contributors may not be used to endorse or        *)
 
22
(*  promote products derived from this software without specific prior    *)
 
23
(*  written permission.                                                   *)
 
24
(*                                                                        *)
 
25
(*  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS   *)
 
26
(*  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT     *)
 
27
(*  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS     *)
 
28
(*  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE        *)
 
29
(*  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,   *)
 
30
(*  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,  *)
 
31
(*  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;      *)
 
32
(*  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER      *)
 
33
(*  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT    *)
 
34
(*  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN     *)
 
35
(*  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE       *)
 
36
(*  POSSIBILITY OF SUCH DAMAGE.                                           *)
 
37
(*                                                                        *)
 
38
(*  File modified by CEA (Commissariat � l'�nergie Atomique).             *)
 
39
(**************************************************************************)
 
40
 
 
41
(* Eliminate assignment instructions whose results are not
 
42
   used *)
 
43
 
 
44
open Cil_types
 
45
open Cil
 
46
open Pretty
 
47
 
 
48
module E = Errormsg
 
49
module RD = Reachingdefs
 
50
module UD = Usedef
 
51
module IH = Inthash
 
52
module S = (*Stats*) struct
 
53
  let time _ f c = f c
 
54
end
 
55
 
 
56
 
 
57
module IS = Set.Make(
 
58
  struct
 
59
    type t = int
 
60
    let compare = compare
 
61
  end)
 
62
 
 
63
let debug = RD.debug
 
64
 
 
65
let doTime = ref false
 
66
 
 
67
let time s f a =
 
68
  if !doTime then
 
69
    S.time s f a
 
70
  else f a
 
71
 
 
72
(* This function should be set by the client if it
 
73
 * knows of functions returning a result that have
 
74
 * no side effects. If the result is not used, then
 
75
 * the call will be eliminated. *)
 
76
let callHasNoSideEffects : (instr -> bool) ref =
 
77
  ref (fun _ -> false)
 
78
 
 
79
 
 
80
(* the set of used definition ids *)
 
81
let usedDefsSet = ref IS.empty
 
82
 
 
83
(* a mapping d -> {u_1,...,u_n} where d is a
 
84
 * definition id, and the u's are definition
 
85
 * ids corresponding to definitions in which
 
86
 * d was used *)
 
87
let defUseSetHash = IH.create 100
 
88
 
 
89
(* a mapping d -> {sid_1,...,sid_n} where d is
 
90
 * a definition id and the sids are statement ids
 
91
 * corresponding to non-Instr statements where d
 
92
 * was used *)
 
93
let sidUseSetHash = IH.create 100
 
94
 
 
95
(* put used def ids into usedDefsSet *)
 
96
(* assumes reaching definitions have already been computed *)
 
97
class usedDefsCollectorClass = object(self)
 
98
    inherit RD.rdVisitorClass as super
 
99
 
 
100
  method add_defids iosh e u =
 
101
    UD.VS.iter (fun vi ->
 
102
      if IH.mem iosh vi.vid then
 
103
        let ios = IH.find iosh vi.vid in
 
104
        if !debug then ignore(E.log "DCE: IOS size for vname=%s at stmt=%d: %d\n"
 
105
                                vi.vname
 
106
                                sid (RD.IOS.cardinal ios));
 
107
        RD.IOS.iter (function
 
108
            Some(i) ->
 
109
              if !debug then log "DCE: def %d used: %a\n" i d_plainexp e;
 
110
              usedDefsSet := IS.add i (!usedDefsSet)
 
111
          | None -> ()) ios
 
112
      else if !debug then log "DCE: vid %d:%s not in stm:%d iosh at %a\n"
 
113
                                   vi.vid vi.vname
 
114
                                   sid d_plainexp e) u
 
115
 
 
116
  method vexpr e =
 
117
    let u = UD.computeUseExp e in
 
118
    match self#get_cur_iosh() with
 
119
      Some(iosh) -> self#add_defids iosh e u; DoChildren
 
120
    | None ->
 
121
        if !debug then log "DCE: use but no rd data: %a\n" d_plainexp e;
 
122
        DoChildren
 
123
 
 
124
  method vstmt s =
 
125
    ignore(super#vstmt s);
 
126
    match s.skind with
 
127
    | Instr _ -> DoChildren
 
128
    | _ -> begin
 
129
        let u,_d = UD.computeUseDefStmtKind s.skind in
 
130
        match self#get_cur_iosh() with
 
131
        | Some iosh ->
 
132
            UD.VS.iter (fun vi ->
 
133
              if IH.mem iosh vi.vid then
 
134
                let ios = IH.find iosh vi.vid in
 
135
                RD.IOS.iter (function
 
136
                  | Some i -> begin (* add s.sid to set for i *)
 
137
                      try
 
138
                        let set = IH.find sidUseSetHash i in
 
139
                        IH.replace sidUseSetHash i (IS.add s.sid set)
 
140
                      with Not_found ->
 
141
                        IH.add sidUseSetHash i (IS.singleton s.sid)
 
142
                  end
 
143
                  | None -> ()) ios) u;
 
144
            DoChildren
 
145
        | None -> DoChildren
 
146
    end
 
147
 
 
148
  method vinst i =
 
149
    let handle_inst iosh i = match i with
 
150
    | Asm(_,_,slvl,_,_,_) -> List.iter (fun (_,s,lv) ->
 
151
        match lv with (Var v, off) ->
 
152
          if s.[0] = '+' then
 
153
            self#add_defids iosh (Lval(Var v, off)) (UD.VS.singleton v)
 
154
        | _ -> ()) slvl
 
155
    | Call(_,ce,el,_) when not (!callHasNoSideEffects i) ->
 
156
        List.iter (fun e ->
 
157
          let u = UD.computeUseExp e in
 
158
          UD.VS.iter (fun vi ->
 
159
            if IH.mem iosh vi.vid then
 
160
              let ios = IH.find iosh vi.vid in
 
161
              RD.IOS.iter (function
 
162
                | Some i -> begin (* add sid to set for i *)
 
163
                    try
 
164
                      let set = IH.find sidUseSetHash i in
 
165
                      IH.replace sidUseSetHash i (IS.add sid set)
 
166
                    with Not_found ->
 
167
                      IH.add sidUseSetHash i (IS.singleton sid)
 
168
                end
 
169
                | None -> ()) ios) u) (ce::el)
 
170
    | Set((Mem _,_) as lh, rhs,_l) ->
 
171
        List.iter (fun e ->
 
172
          let u = UD.computeUseExp e in
 
173
          UD.VS.iter (fun vi ->
 
174
            if IH.mem iosh vi.vid then
 
175
              let ios = IH.find iosh vi.vid in
 
176
              RD.IOS.iter (function
 
177
                | Some i -> begin (* add sid to set for i *)
 
178
                    try
 
179
                      let set = IH.find sidUseSetHash i in
 
180
                      IH.replace sidUseSetHash i (IS.add sid set)
 
181
                    with Not_found ->
 
182
                      IH.add sidUseSetHash i (IS.singleton sid)
 
183
                end
 
184
                | None -> ()) ios) u) ([Lval(lh);rhs])
 
185
    | _ -> ()
 
186
    in
 
187
    ignore(super#vinst i);
 
188
    match cur_rd_dat with
 
189
    | None -> begin
 
190
        if !debug then ignore(E.log "DCE: instr with no cur_rd_dat\n");
 
191
        (* handle_inst *)
 
192
        DoChildren
 
193
    end
 
194
    | Some(_,s,iosh) -> begin
 
195
        let u,d = UD.computeUseDefInstr i in
 
196
        (* add things in d to the U sets for things in u *)
 
197
        let rec loop n =
 
198
          if n < 0 then () else begin
 
199
            UD.VS.iter (fun vi ->
 
200
              if IH.mem iosh vi.vid then
 
201
                let ios = IH.find iosh vi.vid in
 
202
                RD.IOS.iter (function
 
203
                  | Some i -> begin (* add n + s to set for i *)
 
204
                      try
 
205
                        let set = IH.find defUseSetHash i in
 
206
                        IH.replace defUseSetHash i (IS.add (n+s) set)
 
207
                      with Not_found ->
 
208
                        IH.add defUseSetHash i (IS.singleton (n+s))
 
209
                  end
 
210
                  | None -> ()) ios
 
211
              else ()) u;
 
212
            loop (n-1)
 
213
          end
 
214
        in
 
215
        loop (UD.VS.cardinal d - 1);
 
216
        handle_inst iosh i;
 
217
        DoChildren
 
218
    end
 
219
 
 
220
end
 
221
 
 
222
(***************************************************
 
223
 * Also need to find reads from volatiles
 
224
 * uses two functions I've put in ciltools which
 
225
 * are basically what Zach wrote, except one is for
 
226
 * types and one is for vars. Another difference is
 
227
 * they filter out pointers to volatiles. This
 
228
 * handles DMA
 
229
 ***************************************************)
 
230
class hasVolatile flag = object
 
231
  inherit nopCilVisitor
 
232
  method vlval l =
 
233
    let tp = typeOfLval l in
 
234
    if (Ciltools.is_volatile_tp tp) then flag := true;
 
235
    DoChildren
 
236
  method vexpr _e =
 
237
    DoChildren
 
238
end
 
239
 
 
240
let exp_has_volatile e =
 
241
  let flag = ref false in
 
242
  ignore (visitCilExpr (new hasVolatile flag) e);
 
243
  !flag
 
244
 
 
245
let el_has_volatile =
 
246
  List.fold_left (fun b e ->
 
247
    b || (exp_has_volatile e)) false
 
248
 (***************************************************)
 
249
 
 
250
let rec compareExp (e1: exp) (e2: exp) : bool =
 
251
(*   log "CompareExp %a and %a.\n" d_plainexp e1 d_plainexp e2; *)
 
252
  e1 == e2 ||
 
253
  match e1, e2 with
 
254
  | Lval lv1, Lval lv2
 
255
  | StartOf lv1, StartOf lv2
 
256
  | AddrOf lv1, AddrOf lv2 -> compareLval lv1 lv2
 
257
  | BinOp(bop1, l1, r1, _), BinOp(bop2, l2, r2, _) ->
 
258
      bop1 = bop2 && compareExp l1 l2 && compareExp r1 r2
 
259
  | _ -> begin
 
260
      match isInteger (constFold true e1), isInteger (constFold true e2) with
 
261
        Some i1, Some i2 -> i1 = i2
 
262
      | _ -> false
 
263
    end
 
264
 
 
265
and compareLval (lv1: lval) (lv2: lval) : bool =
 
266
  let rec compareOffset (off1: offset) (off2: offset) : bool =
 
267
    match off1, off2 with
 
268
    | Field (fld1, off1'), Field (fld2, off2') ->
 
269
        fld1 == fld2 && compareOffset off1' off2'
 
270
    | Index (e1, off1'), Index (e2, off2') ->
 
271
        compareExp e1 e2 && compareOffset off1' off2'
 
272
    | NoOffset, NoOffset -> true
 
273
    | _ -> false
 
274
  in
 
275
  lv1 == lv2 ||
 
276
  match lv1, lv2 with
 
277
  | (Var vi1, off1), (Var vi2, off2) ->
 
278
      vi1 == vi2 && compareOffset off1 off2
 
279
  | (Mem e1, off1), (Mem e2, off2) ->
 
280
      compareExp e1 e2 && compareOffset off1 off2
 
281
  | _ -> false
 
282
 
 
283
let rec stripNopCasts (e:exp): exp =
 
284
  match e with
 
285
    CastE(t, e') -> begin
 
286
      match unrollType (typeOf e'), unrollType t  with
 
287
        TPtr _, TPtr _ -> (* okay to strip *)
 
288
          stripNopCasts e'
 
289
      (* strip casts from pointers to unsigned int/long*)
 
290
      | (TPtr _ as t1), (TInt(ik,_) as t2)
 
291
          when bitsSizeOf t1 = bitsSizeOf t2
 
292
            && not (isSigned ik) ->
 
293
          stripNopCasts e'
 
294
      | (TInt _ as t1), (TInt _ as t2)
 
295
          when bitsSizeOf t1 = bitsSizeOf t2 -> (* Okay to strip.*)
 
296
          stripNopCasts e'
 
297
      |  _ -> e
 
298
    end
 
299
  | _ -> e
 
300
 
 
301
let compareExpStripCasts (e1: exp) (e2: exp) : bool =
 
302
  compareExp (stripNopCasts e1) (stripNopCasts e2)
 
303
 
 
304
let removedCount = ref 0
 
305
(* Filter out instructions whose definition ids are not
 
306
   in usedDefsSet *)
 
307
class uselessInstrElim : cilVisitor = object
 
308
  inherit nopCilVisitor
 
309
 
 
310
  method vstmt stm =
 
311
 
 
312
    (* give a set of varinfos and an iosh and get
 
313
     * the set of definition ids definining the vars *)
 
314
    let viSetToDefIdSet iosh vis =
 
315
      UD.VS.fold (fun vi s ->
 
316
        if IH.mem iosh vi.vid then
 
317
          let ios = IH.find iosh vi.vid in
 
318
          RD.IOS.fold (fun io s ->
 
319
            match io with None -> s
 
320
            | Some i -> IS.add i s) ios s
 
321
        else s) vis IS.empty
 
322
    in
 
323
 
 
324
    (* false when U(defid)\subeq instruses and SU(d) = empty *)
 
325
    let check_defid i instruses iosh defid =
 
326
      IS.mem defid (!usedDefsSet) &&
 
327
      try
 
328
        let defuses = IH.find defUseSetHash defid in
 
329
        (*let siduses = IH.find sidUseSetHash defid in*)
 
330
        if IH.mem sidUseSetHash defid then begin
 
331
          if !debug then log "siduses not empty: %a\n" d_instr i;
 
332
          true
 
333
        end else begin
 
334
          (* true if there is something in defuses not in instruses or when
 
335
           * something from defuses is in instruses and is also used somewhere else *)
 
336
          let instruses = viSetToDefIdSet iosh instruses in
 
337
          IS.fold (fun i' b ->
 
338
            if not(IS.mem i' instruses) then begin
 
339
              if !debug then log "i not in instruses: %a\n" d_instr i;
 
340
              true
 
341
            end else
 
342
              (* can only use the definition i' at the definition defid *)
 
343
              let i'_uses = IH.find defUseSetHash i' in
 
344
              IH.mem sidUseSetHash i' ||
 
345
              if not(IS.equal i'_uses (IS.singleton defid)) then begin
 
346
                IS.iter (fun iu -> match RD.getSimpRhs iu with
 
347
                | Some(RD.RDExp e) ->
 
348
                    if !debug then log "i' had other than one use: %d: %a\n"
 
349
                      (IS.cardinal i'_uses) d_exp e
 
350
                | Some(RD.RDCall i) ->
 
351
                    if !debug then log "i' had other than one use: %d: %a\n"
 
352
                             (IS.cardinal i'_uses) d_instr i
 
353
                | None -> ()) i'_uses;
 
354
                true
 
355
              end else b) defuses false
 
356
        end
 
357
      with Not_found -> true
 
358
    in
 
359
 
 
360
    let test (i,(_,s,iosh)) =
 
361
      match i with
 
362
      | Call(Some(Var vi,NoOffset),Lval(Var _vf,NoOffset),el,_l) ->
 
363
          if not(!callHasNoSideEffects i) then begin
 
364
            if !debug then log "found call w/ side effects: %a\n" d_instr i;
 
365
            true
 
366
          end else begin
 
367
            if !debug then log "found call w/o side effects: %a\n" d_instr i;
 
368
            (vi.vglob || (Ciltools.is_volatile_vi vi) || (el_has_volatile el) ||
 
369
            let uses, defd = UD.computeUseDefInstr i in
 
370
            let rec loop n =
 
371
              n >= 0 &&
 
372
              (check_defid i uses iosh (n+s) || loop (n-1))
 
373
            in
 
374
            loop (UD.VS.cardinal defd - 1) || (incr removedCount; false))
 
375
          end
 
376
      | Call _ -> true
 
377
      | Set(lh,e,_) when compareExpStripCasts (Lval lh) e -> false (* filter x = x *)
 
378
      | Set((Var vi,NoOffset),e,_) ->
 
379
          vi.vglob || (Ciltools.is_volatile_vi vi) || (exp_has_volatile e) ||
 
380
          let uses, defd = UD.computeUseDefInstr i in
 
381
          let rec loop n =
 
382
            n >= 0 &&
 
383
            (check_defid i uses iosh (n+s) || loop (n-1))
 
384
          in
 
385
          loop (UD.VS.cardinal defd - 1) || (incr removedCount; false)
 
386
      | _ -> true
 
387
    in
 
388
 
 
389
    let filter il stmdat =
 
390
      match
 
391
        let rd_dat_lst = RD.instrRDs il stm.sid stmdat false in
 
392
        let ildatlst = List.combine [il] rd_dat_lst in
 
393
        let ildatlst' = List.filter test ildatlst in
 
394
        let (newil,_) = List.split ildatlst' in
 
395
        newil
 
396
      with [] -> Skip Cilutil.locUnknown | [x] -> x | _ -> assert false
 
397
    in
 
398
 
 
399
    match RD.getRDs stm.sid with
 
400
      None -> DoChildren
 
401
    | Some(_,s,iosh) ->
 
402
        match stm.skind with
 
403
          Instr il ->
 
404
            stm.skind <- Instr(filter il ((),s,iosh));
 
405
            SkipChildren
 
406
        | _ -> DoChildren
 
407
 
 
408
end
 
409
 
 
410
(* until fixed point is reached *)
 
411
let elim_dead_code_fp (fd : fundec) :  fundec =
 
412
  (* fundec -> fundec *)
 
413
  let rec loop fd =
 
414
    usedDefsSet := IS.empty;
 
415
    IH.clear defUseSetHash;
 
416
    IH.clear sidUseSetHash;
 
417
    removedCount := 0;
 
418
    time "reaching definitions" RD.computeRDs fd;
 
419
    ignore(time "ud-collector"
 
420
             (visitCilFunction (new usedDefsCollectorClass :> cilVisitor)) fd);
 
421
    let fd' = time "useless-elim" (visitCilFunction (new uselessInstrElim)) fd in
 
422
    if !removedCount = 0 then fd' else loop fd'
 
423
  in
 
424
  loop fd
 
425
 
 
426
(* just once *)
 
427
let elim_dead_code (fd : fundec) :  fundec =
 
428
  (* fundec -> fundec *)
 
429
  usedDefsSet := IS.empty;
 
430
  IH.clear defUseSetHash;
 
431
  IH.clear sidUseSetHash;
 
432
  removedCount := 0;
 
433
  time "reaching definitions" RD.computeRDs fd;
 
434
  if !debug then ignore(E.log "DCE: collecting used definitions\n");
 
435
  ignore(time "ud-collector"
 
436
           (visitCilFunction (new usedDefsCollectorClass :> cilVisitor)) fd);
 
437
  if !debug then ignore(E.log "DCE: eliminating useless instructions\n");
 
438
  let fd' = time "useless-elim" (visitCilFunction (new uselessInstrElim)) fd in
 
439
  fd'
 
440
 
 
441
class deadCodeElimClass : cilVisitor = object
 
442
    inherit nopCilVisitor
 
443
 
 
444
  method vfunc fd =
 
445
    let fd' = elim_dead_code(*_fp*) fd in
 
446
    ChangeTo(fd')
 
447
 
 
448
end
 
449
 
 
450
let dce f =
 
451
  if !debug then ignore(E.log "DCE: starting dead code elimination\n");
 
452
  visitCilFile (new deadCodeElimClass) f