## lustrec / src / optimize_machine.ml @ ef34b4ae

History | View | Annotate | Download (9.72 KB)

1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|

2 | (* *) |
||

3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||

4 | (* Copyright 2012 - -- ONERA - CNRS - INPT *) |
||

5 | (* *) |
||

6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||

7 | (* under the terms of the GNU Lesser General Public License *) |
||

8 | (* version 2.1. *) |
||

9 | (* *) |
||

10 | (********************************************************************) |
||

11 | |||

12 | cf78a589 | ploc | open LustreSpec |

13 | open Corelang |
||

14 | b1655a21 | xthirioux | open Causality |

15 | cf78a589 | ploc | open Machine_code |

16 | |||

17 | let rec eliminate elim instr = |
||

18 | let e_expr = eliminate_expr elim in |
||

19 | match instr with |
||

20 | | MLocalAssign (i,v) -> MLocalAssign (i, e_expr v) |
||

21 | | MStateAssign (i,v) -> MStateAssign (i, e_expr v) |
||

22 | | MReset i -> instr |
||

23 | | MStep (il, i, vl) -> MStep(il, i, List.map e_expr vl) |
||

24 | | MBranch (g,hl) -> |
||

25 | MBranch |
||

26 | (e_expr g, |
||

27 | (List.map |
||

28 | (fun (l, il) -> l, List.map (eliminate elim) il) |
||

29 | hl |
||

30 | ) |
||

31 | ) |
||

32 | |||

33 | and eliminate_expr elim expr = |
||

34 | match expr with |
||

35 | | LocalVar v -> if List.mem_assoc v elim then List.assoc v elim else expr |
||

36 | | Fun (id, vl) -> Fun (id, List.map (eliminate_expr elim) vl) |
||

37 | | Array(vl) -> Array(List.map (eliminate_expr elim) vl) |
||

38 | | Access(v1, v2) -> Access(eliminate_expr elim v1, eliminate_expr elim v2) |
||

39 | | Power(v1, v2) -> Access(eliminate_expr elim v1, eliminate_expr elim v2) |
||

40 | | Cst _ | StateVar _ -> expr |
||

41 | |||

42 | (* see if elim has to take in account the provided instr: |
||

43 | if so, upodate elim and return the remove flag, |
||

44 | otherwise, the expression should be kept and elim is left untouched *) |
||

45 | 8df90dd3 | ploc | let update_elim outputs elim instr = |

46 | 429ab729 | ploc | (* Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*) |

47 | cf78a589 | ploc | |

48 | let apply elim v new_e = |
||

49 | (v, new_e)::List.map (fun (v, e) -> v, eliminate_expr [v, new_e] e) elim |
||

50 | in |
||

51 | match instr with |
||

52 | (* Simple cases*) |
||

53 | | MLocalAssign (v, (Cst _ as e)) |
||

54 | | MLocalAssign (v, (LocalVar _ as e)) |
||

55 | 8df90dd3 | ploc | | MLocalAssign (v, (StateVar _ as e)) -> |

56 | if not (List.mem v outputs) then true, apply elim v e else false, elim |
||

57 | cf78a589 | ploc | (* When optimization >= 3, we also inline any basic operator call. |

58 | All those are returning a single ouput *) |
||

59 | | MStep([v], id, vl) when |
||

60 | bb2ca5f4 | xthirioux | Basic_library.is_internal_fun id |

61 | cf78a589 | ploc | && !Options.optimization >= 3 |

62 | -> assert false |
||

63 | (* true, apply elim v (Fun(id, vl))*) |
||

64 | |||

65 | |||

66 | | MLocalAssign (v, ((Fun (id, il)) as e)) when |
||

67 | 8df90dd3 | ploc | not (List.mem v outputs) |

68 | bb2ca5f4 | xthirioux | && Basic_library.is_internal_fun id (* this will avoid inlining ite *) |

69 | cf78a589 | ploc | && !Options.optimization >= 3 |

70 | -> ( |
||

71 | 429ab729 | ploc | (* Format.eprintf "WE STORE THE EXPRESSION DEFINING %s TO ELIMINATE IT@." v.var_id; *) |

72 | cf78a589 | ploc | true, apply elim v e |

73 | ) |
||

74 | | _ -> |
||

75 | (* default case, we keep the instruction and do not modify elim *) |
||

76 | false, elim |
||

77 | |||

78 | |||

79 | (** We iterate in the order, recording simple local assigns in an accumulator |
||

80 | 1. each expression is rewritten according to the accumulator |
||

81 | 2. local assigns then rewrite occurrences of the lhs in the computed accumulator |
||

82 | *) |
||

83 | 8df90dd3 | ploc | let optimize_minstrs outputs instrs = |

84 | cf78a589 | ploc | let rev_instrs, eliminate = |

85 | List.fold_left (fun (rinstrs, elim) instr -> |
||

86 | (* each subexpression in instr that could be rewritten by the elim set is |
||

87 | rewritten *) |
||

88 | let instr = eliminate elim instr in |
||

89 | (* if instr is a simple local assign, then (a) elim is simplified with it (b) it |
||

90 | is stored as the elim set *) |
||

91 | 8df90dd3 | ploc | let remove, elim = update_elim outputs elim instr in |

92 | cf78a589 | ploc | (if remove then rinstrs else instr::rinstrs), elim |

93 | ) ([],[]) instrs |
||

94 | in |
||

95 | let eliminated_vars = List.map fst eliminate in |
||

96 | eliminated_vars, List.rev rev_instrs |
||

97 | |||

98 | (** Perform optimization on machine code: |
||

99 | - iterate through step instructions and remove simple local assigns |
||

100 | |||

101 | *) |
||

102 | let optimize_machine machine = |
||

103 | 8df90dd3 | ploc | let eliminated_vars, new_instrs = optimize_minstrs machine.mstep.step_outputs machine.mstep.step_instrs in |

104 | cf78a589 | ploc | let new_locals = |

105 | List.filter (fun v -> not (List.mem v eliminated_vars)) machine.mstep.step_locals |
||

106 | in |
||

107 | { |
||

108 | machine with |
||

109 | mstep = { |
||

110 | machine.mstep with |
||

111 | step_locals = new_locals; |
||

112 | step_instrs = new_instrs |
||

113 | } |
||

114 | } |
||

115 | |||

116 | |||

117 | |||

118 | let optimize_machines machines = |
||

119 | List.map optimize_machine machines |
||

120 | |||

121 | 45c13277 | xthirioux | (* variable substitution for optimizing purposes *) |

122 | |||

123 | (* checks whether an [instr] is skip and can be removed from program *) |
||

124 | let rec instr_is_skip instr = |
||

125 | match instr with |
||

126 | | MLocalAssign (i, LocalVar v) when i = v -> true |
||

127 | | MStateAssign (i, StateVar v) when i = v -> true |
||

128 | | MBranch (g, hl) -> List.for_all (fun (_, il) -> instrs_are_skip il) hl |
||

129 | | _ -> false |
||

130 | and instrs_are_skip instrs = |
||

131 | List.for_all instr_is_skip instrs |
||

132 | |||

133 | let instr_cons instr cont = |
||

134 | if instr_is_skip instr then cont else instr::cont |
||

135 | |||

136 | let rec instr_remove_skip instr cont = |
||

137 | match instr with |
||

138 | | MLocalAssign (i, LocalVar v) when i = v -> cont |
||

139 | | MStateAssign (i, StateVar v) when i = v -> cont |
||

140 | | MBranch (g, hl) -> MBranch (g, List.map (fun (h, il) -> (h, instrs_remove_skip il [])) hl) :: cont |
||

141 | | _ -> instr::cont |
||

142 | |||

143 | and instrs_remove_skip instrs cont = |
||

144 | List.fold_right instr_remove_skip instrs cont |
||

145 | |||

146 | let rec value_replace_var fvar value = |
||

147 | match value with |
||

148 | | Cst c -> value |
||

149 | | LocalVar v -> LocalVar (fvar v) |
||

150 | | StateVar v -> value |
||

151 | | Fun (id, args) -> Fun (id, List.map (value_replace_var fvar) args) |
||

152 | | Array vl -> Array (List.map (value_replace_var fvar) vl) |
||

153 | | Access (t, i) -> Access(value_replace_var fvar t, i) |
||

154 | | Power (v, n) -> Power(value_replace_var fvar v, n) |
||

155 | |||

156 | let rec instr_replace_var fvar instr cont = |
||

157 | match instr with |
||

158 | | MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont |
||

159 | | MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont |
||

160 | | MReset i -> instr_cons instr cont |
||

161 | | MStep (il, i, vl) -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont |
||

162 | | MBranch (g, hl) -> instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il [])) hl)) cont |
||

163 | |||

164 | and instrs_replace_var fvar instrs cont = |
||

165 | List.fold_right (instr_replace_var fvar) instrs cont |
||

166 | |||

167 | let step_replace_var fvar step = |
||

168 | (* Some outputs may have been replaced by locals. |
||

169 | We then need to rename those outputs |
||

170 | without changing their clocks, etc *) |
||

171 | let outputs' = |
||

172 | List.map (fun o -> { o with var_id = (fvar o).var_id }) step.step_outputs in |
||

173 | let locals' = |
||

174 | List.fold_left (fun res l -> |
||

175 | let l' = fvar l in |
||

176 | if List.exists (fun o -> o.var_id = l'.var_id) outputs' |
||

177 | then res |
||

178 | else Utils.add_cons l' res) |
||

179 | [] step.step_locals in |
||

180 | { step with |
||

181 | step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks; |
||

182 | step_outputs = outputs'; |
||

183 | step_locals = locals'; |
||

184 | step_instrs = instrs_replace_var fvar step.step_instrs []; |
||

185 | } |
||

186 | |||

187 | let rec machine_replace_variables fvar m = |
||

188 | { m with |
||

189 | mstep = step_replace_var fvar m.mstep |
||

190 | } |
||

191 | |||

192 | let machine_reuse_variables m reuse = |
||

193 | let fvar v = |
||

194 | try |
||

195 | Hashtbl.find reuse v.var_id |
||

196 | with Not_found -> v in |
||

197 | machine_replace_variables fvar m |
||

198 | |||

199 | let machines_reuse_variables prog node_schs = |
||

200 | List.map |
||

201 | (fun m -> |
||

202 | machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table |
||

203 | ) prog |
||

204 | |||

205 | b1655a21 | xthirioux | let rec instr_assign res instr = |

206 | match instr with |
||

207 | | MLocalAssign (i, _) -> Disjunction.CISet.add i res |
||

208 | | MStateAssign (i, _) -> Disjunction.CISet.add i res |
||

209 | | MBranch (g, hl) -> List.fold_left (fun res (h, b) -> instrs_assign res b) res hl |
||

210 | | MStep (il, _, _) -> List.fold_right Disjunction.CISet.add il res |
||

211 | | _ -> res |
||

212 | |||

213 | and instrs_assign res instrs = |
||

214 | List.fold_left instr_assign res instrs |
||

215 | |||

216 | let rec instr_constant_assign var instr = |
||

217 | match instr with |
||

218 | | MLocalAssign (i, Cst (Const_tag _)) |
||

219 | | MStateAssign (i, Cst (Const_tag _)) -> i = var |
||

220 | | MBranch (g, hl) -> List.for_all (fun (h, b) -> instrs_constant_assign var b) hl |
||

221 | | _ -> false |
||

222 | |||

223 | and instrs_constant_assign var instrs = |
||

224 | List.fold_left (fun res i -> if Disjunction.CISet.mem var (instr_assign Disjunction.CISet.empty i) then instr_constant_assign var i else res) false instrs |
||

225 | |||

226 | let rec instr_reduce branches instr1 cont = |
||

227 | match instr1 with |
||

228 | | MLocalAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont) |
||

229 | | MStateAssign (_, Cst (Const_tag c)) -> instr1 :: (List.assoc c branches @ cont) |
||

230 | | MBranch (g, hl) -> MBranch (g, List.map (fun (h, b) -> (h, instrs_reduce branches b [])) hl) :: cont |
||

231 | | _ -> instr1 :: cont |
||

232 | |||

233 | and instrs_reduce branches instrs cont = |
||

234 | match instrs with |
||

235 | | [] -> cont |
||

236 | | [i] -> instr_reduce branches i cont |
||

237 | | i1::i2::q -> i1 :: instrs_reduce branches (i2::q) cont |
||

238 | |||

239 | let rec instrs_fusion instrs = |
||

240 | match instrs with |
||

241 | | [] |
||

242 | | [_] -> |
||

243 | instrs |
||

244 | | i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 -> |
||

245 | instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q) |
||

246 | | i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 -> |
||

247 | instr_reduce (List.map (fun (h, b) -> h, instrs_fusion b) hl) i1 (instrs_fusion q) |
||

248 | | i1::i2::q -> |
||

249 | i1 :: instrs_fusion (i2::q) |
||

250 | |||

251 | let step_fusion step = |
||

252 | { step with |
||

253 | step_instrs = instrs_fusion step.step_instrs; |
||

254 | } |
||

255 | |||

256 | let rec machine_fusion m = |
||

257 | { m with |
||

258 | mstep = step_fusion m.mstep |
||

259 | } |
||

260 | |||

261 | let machines_fusion prog = |
||

262 | List.map machine_fusion prog |
||

263 | cf78a589 | ploc | |

264 | (* Local Variables: *) |
||

265 | (* compile-command:"make -C .." *) |
||

266 | (* End: *) |