1
(**************************************************************************)
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. *)
10
(* Redistribution and use in source and binary forms, with or without *)
11
(* modification, are permitted provided that the following conditions *)
14
(* 1. Redistributions of source code must retain the above copyright *)
15
(* notice, this list of conditions and the following disclaimer. *)
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. *)
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. *)
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. *)
38
(* File modified by CEA (Commissariat � l'�nergie Atomique). *)
39
(**************************************************************************)
43
* Copyright (c) 2001-2002,
44
* George C. Necula <necula@cs.berkeley.edu>
45
* Scott McPeak <smcpeak@cs.berkeley.edu>
46
* Wes Weimer <weimer@cs.berkeley.edu>
47
* Sumit Gulwani <gulwani@cs.berkeley.edu>
48
* All rights reserved.
50
* Redistribution and use in source and binary forms, with or without
51
* modification, are permitted provided that the following conditions are
54
* 1. Redistributions of source code must retain the above copyright
55
* notice, this list of conditions and the following disclaimer.
57
* 2. Redistributions in binary form must reproduce the above copyright
58
* notice, this list of conditions and the following disclaimer in the
59
* documentation and/or other materials provided with the distribution.
61
* 3. The names of the contributors may not be used to endorse or promote
62
* products derived from this software without specific prior written
65
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
66
* IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
67
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
68
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
69
* OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
70
* EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
71
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
72
* PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
73
* LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
74
* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
75
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
79
(* This module simplifies the expressions in a program in the following ways:
81
1. All expressions are either
85
Addrof(Var v, NoOffset)
86
StartOf(Var v, NoOffset)
87
Lval(Var v, off), where v is a variable whose address is not taken
88
and off contains only "basic"
92
Lval(Mem basic, NoOffset)
93
BinOp(bop, basic, basic)
99
Var v, off, where v is a variable whose address is not taken and off
100
contains only "basic"
102
- all sizeof and alignof are turned into constants
103
- accesses to variables whose address is taken is turned into "Mem" accesses
104
- same for accesses to arrays
105
- all field and index computations are turned into address arithmetic,
117
type taExp = exp (* Three address expression *)
118
type bExp = exp (* Basic expression *)
122
(* Whether to split structs *)
123
let splitStructs = ref true
125
let onlyVariableBasics = ref false
126
let noStringConstantsBasics = ref false
128
exception BitfieldAccess
130
(* Turn an expression into a three address expression (and queue some
131
* instructions in the process) *)
132
let rec makeThreeAddress
133
(setTemp: taExp -> bExp) (* Given an expression save it into a temp and
134
* return that temp *)
137
SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
140
| AddrOf (Var _, NoOffset) -> e
141
| Lval lv -> Lval (simplifyLval setTemp lv)
142
| BinOp(bo, e1, e2, tres) ->
143
BinOp(bo, makeBasic setTemp e1, makeBasic setTemp e2, tres)
144
| UnOp(uo, e1, tres) ->
145
UnOp(uo, makeBasic setTemp e1, tres)
147
CastE(t, makeBasic setTemp e)
149
match simplifyLval setTemp lv with
151
| _ -> (* This is impossible, because we are taking the address
152
* of v and simplifyLval should turn it into a Mem, except if the
153
* sizeof has failed. *)
154
E.s (bug "Simplify: makeThreeAddress for AddrOf(LV=%a, LVT=%a)"
155
d_lval lv d_type (typeOfLval lv))
158
makeThreeAddress setTemp (AddrOf (addOffsetLval (Index(zero, NoOffset))
161
(* Make a basic expression *)
162
and makeBasic (setTemp: taExp -> bExp) (e: exp) : bExp =
163
let dump = false (* !currentLoc.line = 395 *) in
165
ignore (E.log "makeBasic %a\n" d_plainexp e);
166
(* Make it a three address expression first *)
167
let e' = makeThreeAddress setTemp e in
169
ignore (E.log " e'= %a\n" d_plainexp e);
170
(* See if it is a basic one *)
172
| Lval (Var _, _) -> e'
173
| Const _ | AddrOf (Var _, NoOffset) | StartOf (Var _, NoOffset) ->
174
if !onlyVariableBasics then setTemp e' else e'
175
| SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
176
E.s (bug "Simplify: makeBasic found SizeOf: %a" d_exp e')
178
(* We cannot make a function to be Basic, unless it actually is a variable
179
* already. If this is a function pointer the best we can do is to make
180
* the address of the function basic *)
181
| Lval (Mem a, NoOffset) when isFunctionType (typeOf e') ->
183
ignore (E.log " a function type\n");
184
let a' = makeBasic setTemp a in
185
Lval (Mem a', NoOffset)
187
| _ -> setTemp e' (* Put it into a temporary otherwise *)
191
(setTemp: taExp -> bExp)
193
(* Add, watching for a zero *)
194
let add (e1: exp) (e2: exp) =
195
if isZero e2 then e1 else BinOp(PlusA, e1, e2, !upointType)
197
(* Convert an offset to an integer, and possibly a residual bitfield offset*)
199
(t: typ) (* The type of the host *)
200
(off: offset) : exp * offset =
202
NoOffset -> zero, NoOffset
203
| Field(fi, off') -> begin
206
let start, _ = bitsOffset t (Field(fi, NoOffset)) in
208
with SizeOfError (whystr, t') ->
209
E.s (E.bug "%a: Cannot compute sizeof: %s: %a"
210
d_loc !currentLoc whystr d_type t');
211
1 (* Make sure it is not a multiple of 8 bits *)
213
if start land 7 <> 0 then begin
214
(* We have a bitfield *)
215
assert (off' = NoOffset);
216
zero, Field(fi, off')
218
let next, restoff = offsetToInt fi.ftype off' in
219
add (integer (start / 8)) next, restoff
222
| Index(ei, off') -> begin
223
let telem = match unrollType t with
224
TArray(telem, _, _) -> telem
225
| _ -> E.s (bug "Simplify: simplifyLval: index on a non-array")
227
let next, restoff = offsetToInt telem off' in
229
(BinOp(Mult, ei, SizeOf telem, !upointType))
234
let tres = TPtr(typeOfLval lv, []) in
235
let typeForCast restOff: typ =
236
(* in (e+i)-> restoff, what should we cast e+i to? *)
238
Index _ -> E.s (bug "index in restOff")
240
| Field(fi, NoOffset) -> (* bitfield *)
241
TPtr(TComp(fi.fcomp, []), [])
242
| Field(fi, _) -> E.s (bug "bug in offsetToInt")
246
let offidx, restoff = offsetToInt (typeOfLval (Mem a, NoOffset)) off in
248
if offidx <> zero then
249
add (mkCast a !upointType) offidx
253
let a' = makeBasic setTemp a' in
254
Mem (mkCast a' (typeForCast restoff)), restoff
256
| Var v, off when v.vaddrof -> (* We are taking this variable's address *)
257
let offidx, restoff = offsetToInt v.vtype off in
258
(* We cannot call makeBasic recursively here, so we must do it
260
let a = mkAddrOrStartOf (Var v, NoOffset) in
262
if offidx = zero then a else
263
add (mkCast a !upointType) (makeBasic setTemp offidx)
265
let a' = setTemp a' in
266
Mem (mkCast a' (typeForCast restoff)), restoff
269
(Var v, simplifyOffset setTemp off)
272
(* Simplify an offset and make sure it has only three address expressions in
274
and simplifyOffset (setTemp: taExp -> bExp) = function
276
| Field(fi, off) -> Field(fi, simplifyOffset setTemp off)
278
let ei' = makeBasic setTemp ei in
279
Index(ei', simplifyOffset setTemp off)
284
(** This is a visitor that will turn all expressions into three address code *)
285
class threeAddressVisitor (fi: fundec) = object (self)
286
inherit nopCilVisitor
288
method private makeTemp (e1: exp) : exp =
289
let t = makeTempVar fi (typeOf e1) in
290
(* Add this instruction before the current statement *)
291
self#queueInstr [Set(var t, e1, !currentLoc)];
294
(* We'll ensure that this gets called only for top-level expressions
295
* inside functions. We must turn them into three address code. *)
296
method vexpr (e: exp) =
297
let e' = makeThreeAddress self#makeTemp e in
301
(** We want the argument in calls to be simple variables *)
302
method vinst (i: instr) =
304
Call (someo, f, args, loc) ->
307
Some lv -> Some (simplifyLval self#makeTemp lv)
310
let f' = makeBasic self#makeTemp f in
311
let args' = List.map (makeBasic self#makeTemp) args in
312
ChangeTo [ Call (someo', f', args', loc) ]
315
(* This method will be called only on top-level "lvals" (those on the
316
* left of assignments and function calls) *)
317
method vlval (lv: lval) =
318
ChangeTo (simplifyLval self#makeTemp lv)
321
(********************
322
Next is an old version of the code that was splitting structs into
323
* variables. It was not working on variables that are arguments or returns
325
(** This is a visitor that splits structured variables into separate
327
let isStructType (t: typ): bool =
328
match unrollType t with
329
TComp (ci, _) -> ci.cstruct
332
(* Keep track of how we change the variables. For each variable id we keep a
333
* hash table that maps an offset (a sequence of fieldinfo) into a
334
* replacement variable. We also keep track of the splittable vars: those
335
* with structure type but whose address is not take and which do not appear
336
* as the argument to a Return *)
337
let splittableVars: (int, unit) H.t = H.create 13
338
let replacementVars: (int * offset, varinfo) H.t = H.create 13
340
let findReplacement (fi: fundec) (v: varinfo) (off: offset) : varinfo =
342
H.find replacementVars (v.vid, off)
343
with Not_found -> begin
344
let t = typeOfLval (Var v, off) in
345
(* make a name for this variable *)
346
let rec mkName = function
347
| Field(fi, off) -> "_" ^ fi.fname ^ mkName off
350
let v' = makeTempVar fi ~name:(v.vname ^ mkName off ^ "_") t in
351
H.add replacementVars (v.vid, off) v';
353
ignore (E.log "Simplify: %s (%a) replace %a with %s\n"
361
(* Now separate the offset into a sequence of field accesses and the
362
* rest of the offset *)
363
let rec separateOffset (off: offset): offset * offset =
365
NoOffset -> NoOffset, NoOffset
366
| Field(fi, off') when fi.fcomp.cstruct ->
367
let off1, off2 = separateOffset off' in
368
Field(fi, off1), off2
372
class splitStructVisitor (fi: fundec) = object (self)
373
inherit nopCilVisitor
375
method vlval (lv: lval) =
377
Var v, off when H.mem splittableVars v.vid ->
378
(* The type of this lval better not be a struct *)
379
if isStructType (typeOfLval lv) then
380
E.s (unimp "Simplify: found lval of struct type %a : %a\n"
381
d_lval lv d_type (typeOfLval lv));
382
let off1, restoff = separateOffset off in
384
if off1 <> NoOffset then begin
385
(* This is a splittable variable and we have an offset that makes
386
* it a scalar. Find the replacement variable for this *)
387
let v' = findReplacement fi v off1 in
388
if restoff = NoOffset then
390
else (* We have some more stuff. Use Mem *)
391
Mem (mkAddrOrStartOf (Var v', NoOffset)), restoff
392
end else begin (* off1 = NoOffset *)
393
if restoff = NoOffset then
394
E.s (bug "Simplify: splitStructVisitor:lval")
398
let t = makeTempVar fi (typeOf e1) in
399
(* Add this instruction before the current statement *)
400
self#queueInstr [Set(var t, e1, !currentLoc)];
402
(Mem (mkAddrOrStartOf (Var v, NoOffset)), restoff)
409
method vinst (i: instr) =
410
(* Accumulate to the list of instructions a number of assignments of
411
* non-splittable lvalues *)
412
let rec accAssignment (ci: compinfo) (dest: lval) (what: lval)
413
(acc: instr list) : instr list =
416
let dest' = addOffsetLval (Field(f, NoOffset)) dest in
417
let what' = addOffsetLval (Field(f, NoOffset)) what in
418
match unrollType f.ftype with
419
TComp(ci, _) when ci.cstruct ->
420
accAssignment ci dest' what' acc
421
| TArray _ -> (* We must copy the array *)
422
(Set((Mem (AddrOf dest'), NoOffset),
423
Lval (Mem (AddrOf what'), NoOffset), !currentLoc)) :: acc
424
| _ -> (* If the type of f is not a struct then leave this alone *)
425
(Set(dest', Lval what', !currentLoc)) :: acc)
429
let doAssignment (ci: compinfo) (dest: lval) (what: lval) : instr list =
430
let il' = accAssignment ci dest what [] in
431
List.concat (List.map (visitCilInstr (self :> cilVisitor)) il')
434
Set(((Var v, off) as lv), what, _) when H.mem splittableVars v.vid ->
435
let off1, restoff = separateOffset off in
436
if restoff <> NoOffset then (* This means that we are only assigning
437
* part of a replacement variable. Leave
438
* this alone because the vlval will take
442
(* The type of the replacement has to be a structure *)
443
match unrollType (typeOfLval lv) with
444
TComp (ci, _) when ci.cstruct ->
445
(* The assigned thing better be an lvalue *)
449
| _ -> E.s (unimp "Simplify: assigned struct is not lval")
451
ChangeTo (doAssignment ci (Var v, off) whatlv)
453
| _ -> (* vlval will take care of it *)
457
| Set(dest, Lval (Var v, off), _) when H.mem splittableVars v.vid ->
458
let off1, restoff = separateOffset off in
459
if restoff <> NoOffset then (* vlval will do this *)
462
(* The type of the replacement has to be a structure *)
463
match unrollType (typeOfLval dest) with
464
TComp (ci, _) when ci.cstruct ->
465
ChangeTo (doAssignment ci dest (Var v, off))
467
| _ -> (* vlval will take care of it *)
476
(* Whether to split the arguments of functions *)
477
let splitArguments = true
479
(* Whether we try to do the splitting all in one pass. The advantage is that
480
* it is faster and it generates nicer names *)
483
(* Go over the code and split some temporary variables of stucture type into
484
* several separate variables. The hope is that the compiler will have an
485
* easier time to do standard optimizations with the resulting scalars *)
486
(* Unfortunately, implementing this turns out to be more complicated than I
489
(** Iterate over the fields of a structured type. Returns the empty list if
490
* no splits. The offsets are in order in which they appear in the structure
491
* type. Along with the offset we pass a string that identifies the
492
* meta-component, and the type of that component. *)
493
let rec foldRightStructFields
494
(doit: offset -> string -> typ -> 'a) (* Invoked on non-struct fields *)
496
(post: 'a list) (** A suffix to what you compute *)
497
(fields: fieldinfo list) : 'a list =
500
let off' = addOffset (Field(f, NoOffset)) off in
501
match unrollType f.ftype with
502
TComp (comp, _) when comp.cstruct -> (* struct type: recurse *)
503
foldRightStructFields doit off' post comp.cfields
505
(doit off' f.fname f.ftype) :: post)
510
let rec foldStructFields
512
(doit: offset -> string -> typ -> 'a)
514
match unrollType t with
515
TComp (comp, _) when comp.cstruct ->
516
foldRightStructFields doit NoOffset [] comp.cfields
520
(* Map a variable name to a list of component variables, along with the
521
* accessor offset. The fields are in the order in which they appear in the
523
let newvars : (string, (offset * varinfo) list) H.t = H.create 13
525
(* Split a variable and return the replacements, in the proper order. If this
526
* variable is not split, then return just the variable. *)
527
let splitOneVar (v: varinfo)
528
(mknewvar: string -> typ -> varinfo) : varinfo list =
530
(* See if we have already split it *)
531
List.map snd (H.find newvars v.vname)
532
with Not_found -> begin
533
let vars: (offset * varinfo) list =
534
foldStructFields v.vtype
535
(fun off n t -> (* make a new one *)
536
let newname = v.vname ^ "_" ^ n in
537
let v'= mknewvar newname t in
543
(* Now remember the newly created vars *)
544
H.add newvars v.vname vars;
545
List.map snd vars (* Return just the vars *)
550
(* A visitor that finds all locals that appear in a call or have their
552
let dontSplitLocals : (string, bool) H.t = H.create 111
553
class findVarsCantSplitClass : cilVisitor = object (self)
554
inherit nopCilVisitor
556
(* expressions, to see the address being taken *)
557
method vexpr (e: exp) : exp visitAction =
559
AddrOf (Var v, NoOffset) ->
560
H.add dontSplitLocals v.vname true; SkipChildren
561
(* See if we take the address of the "_ms" field in a variable *)
565
(* variables involved in call instructions *)
566
method vinst (i: instr) : instr list visitAction =
568
Call (res, f, args, _) ->
570
Some (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
572
if not splitArguments then
575
Lval (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
577
(* Now continue the visit *)
582
(* Variables used in return should not be split *)
583
method vstmt (s: stmt) : stmt visitAction =
585
Return (Some (Lval (Var v, NoOffset)), _) ->
586
H.add dontSplitLocals v.vname true; DoChildren
587
| Return (Some e, _) ->
591
method vtype t = SkipChildren
594
let findVarsCantSplit = new findVarsCantSplitClass
598
(Var v, NoOffset) -> true
602
class splitVarVisitorClass(func:fundec option) : cilVisitor = object (self)
603
inherit nopCilVisitor
605
method private makeTemp (e1: exp) : exp =
606
let fi:fundec = match func with
609
E.s (bug "You can't create a temporary if you're not in a function.")
611
let t = makeTempVar fi (typeOf e1) in
612
(* Add this instruction before the current statement *)
613
self#queueInstr [Set(var t, e1, !currentLoc)];
617
(* We must process the function types *)
619
(* We invoke the visitor first and then we fix it *)
620
let postProcessFunType (t: typ) : typ =
622
TFun(rt, Some params, isva, a) ->
623
let rec loopParams = function
625
| ((pn, pt, pa) :: rest) as params ->
626
let rest' = loopParams rest in
627
let res: (string * typ * attributes) list =
630
(* Careful with no-name parameters, or we end up with
631
* many parameters named _p ! *)
632
((if pn <> "" then pn ^ n else ""), t, pa))
634
if res = [] then (* Not a fat *)
635
if rest' == rest then
636
params (* No change at all. Try not to reallocate so that
637
* the visitor does not allocate. *)
639
(pn, pt, pa) :: rest'
640
else (* Some change *)
643
let params' = loopParams params in
644
if params == params' then
647
TFun(rt, Some params', isva, a)
651
if splitArguments then
652
ChangeDoChildrenPost(t, postProcessFunType)
656
(* Whenever we see a variable with a field access we try to replace it
657
* by its components *)
658
method vlval ((b, off) : lval) : lval visitAction =
661
Var v, (Field _ as off) ->
662
(* See if this variable has some splits.Might throw Not_found *)
663
let splits = H.find newvars v.vname in
664
(* Now find among the splits one that matches this offset. And
665
* return the remaining offset *)
666
let rec find = function
668
E.s (E.bug "Cannot find component %a of %s\n"
669
(d_offset nil) off (!Cil.output_ident v.vname))
670
| (splitoff, splitvar) :: restsplits ->
671
let rec matches = function
672
Field(f1, rest1), Field(f2, rest2)
673
when f1.fname = f2.fname ->
674
matches (rest1, rest2)
676
(* We found a match *)
678
| NoOffset, restoff ->
679
ignore (warn "Found aggregate lval %a\n"
683
| _, _ -> (* We did not match this one; go on *)
686
matches (off, splitoff)
688
ChangeTo (find splits)
690
with Not_found -> DoChildren
692
(* Sometimes we pass the variable as a whole to a function or we
693
* assign it to something *)
694
method vinst (i: instr) : instr list visitAction =
696
(* Split into several instructions and then do children inside
697
* the rhs. Howver, v might appear in the rhs and if we
698
* duplicate the instruction we might get bad
699
* results. (e.g. test/small1/simplify_Structs2.c). So first copy
700
* the rhs to temp variables, then to v.
702
* Optimization: if the rhs is a variable, skip the temporary vars.
703
* Either the rhs = lhs, in which case this is all a nop, or it's not,
704
* in which case the rhs and lhs don't overlap.*)
706
Set ((Var v, NoOffset), Lval lv, l) when H.mem newvars v.vname -> begin
707
let needTemps = not (isVar lv) in
708
let vars4v = H.find newvars v.vname in
709
if vars4v = [] then E.s (errorLoc l "No fields in split struct");
714
visitCilLval (self :> cilVisitor)
715
(addOffsetLval off lv) in
716
(* makeTemp creates a temp var and puts (Lval lv') in it,
717
before any instructions in this ChangeTo list are handled.*)
718
let lv_tmp = if needTemps then
719
self#makeTemp (Lval lv')
723
Set((Var newv, NoOffset), lv_tmp, l))
727
| Set (lv, Lval (Var v, NoOffset), l) when H.mem newvars v.vname -> begin
728
(* Split->NonSplit assignment. no overlap between lhs and rhs
730
let vars4v = H.find newvars v.vname in
731
if vars4v = [] then E.s (errorLoc l "No fields in split struct");
736
visitCilLval (self :> cilVisitor)
737
(addOffsetLval off lv) in
738
Set(lv', Lval (Var newv, NoOffset), l))
742
(* Split all function arguments in calls *)
743
| Call (ret, f, args, l) when splitArguments ->
744
(* Visit the children first and then see if we must change the
746
let finishArgs = function
747
[Call (ret', f', args', l')] as i' ->
748
let mustChange = ref false in
750
(* Look for opportunities to split arguments. If we can
751
* split, we must split the original argument (in args).
752
* Otherwise, we use the result of processing children
757
Lval (Var v, NoOffset) when H.mem newvars v.vname ->
762
Lval (Var newv, NoOffset))
763
(H.find newvars v.vname))
768
foldStructFields (typeOfLval lv)
770
let lv' = addOffsetLval off lv in
773
a' :: acc (* not a split var *)
779
| _ -> (* only lvals are split, right? *)
785
[Call (ret', f', newargs, l')]
788
| _ -> E.s (E.bug "splitVarVisitorClass: expecting call")
790
ChangeDoChildrenPost ([i], finishArgs)
795
method vfunc (func: fundec) : fundec visitAction =
797
H.clear dontSplitLocals;
798
(* Visit the type of the function itself *)
799
if splitArguments then
800
func.svar.vtype <- visitCilType (self :> cilVisitor) func.svar.vtype;
802
(* Go over the block and find the candidates *)
803
ignore (visitCilBlock findVarsCantSplit func.sbody);
805
(* Now go over the formals and create the splits *)
806
if splitArguments then begin
807
(* Split all formals because we will split all arguments in function
812
(* Process the type first *)
814
visitCilType (self : #cilVisitor :> cilVisitor) form.vtype;
817
(fun s t -> makeLocalVar func ~insert:false s t)
819
(* Now it is a good time to check if we actually can split this
821
if List.length form' > 1 &&
822
H.mem dontSplitLocals form.vname then
823
ignore (warn "boxsplit: can't split formal \"%s\" in %s. Make sure you never take the address of a formal.\n"
824
(!Cil.output_ident form.vname)
825
(!Cil.output_ident func.svar.vname));
829
(* Now make sure we fix the type. *)
830
setFormals func newformals
832
(* Now go over the locals and create the splits *)
835
(* Process the type of the local *)
836
l.vtype <- visitCilType (self :> cilVisitor) l.vtype;
837
(* Now see if we must split it *)
838
if not (H.mem dontSplitLocals l.vname) then begin
839
ignore (splitOneVar l (fun s t -> makeTempVar func ~name:s t))
842
(* Now visit the body and change references to these variables *)
843
ignore (visitCilBlock (self :> cilVisitor) func.sbody);
845
H.clear dontSplitLocals;
846
SkipChildren (* We are done with this function *)
848
(* Try to catch the occurrences of the variable in a sizeof expression *)
849
method vexpr (e: exp) =
851
| SizeOfE (Lval(Var v, NoOffset)) -> begin
853
let splits = H.find newvars v.vname in
854
(* We cound here on no padding between the elements ! *)
857
(fun acc (_, thisv) ->
858
BinOp(PlusA, SizeOfE(Lval(Var thisv, NoOffset)),
862
with Not_found -> DoChildren
867
let doGlobal = function
869
(* Visit the body and change all expressions into three address code *)
870
let v = new threeAddressVisitor fi in
871
fi.sbody <- visitCilBlock v fi.sbody;
872
if !splitStructs then begin
873
H.clear dontSplitLocals;
874
let splitVarVisitor = new splitVarVisitorClass (Some fi) in
875
ignore (visitCilFunction splitVarVisitor fi);
877
| GVarDecl(vi, _) when isFunctionType vi.vtype ->
878
(* we might need to split the args/return value in the function type. *)
879
if !splitStructs then begin
880
H.clear dontSplitLocals;
881
let splitVarVisitor = new splitVarVisitorClass None in
882
ignore (visitCilVarDecl splitVarVisitor vi);
886
let feature : featureDescr =
887
{ fd_name = "simplify";
888
fd_enabled = ref false;
889
fd_description = "compiles CIL to 3-address code";
891
("--no-split-structs", Arg.Unit (fun _ -> splitStructs := false),
892
"do not split structured variables");
894
fd_doit = (function f -> iterGlobals f doGlobal);
895
fd_post_check = true;
added
removed
cil/src/ext/simplify.ml
