1

(********************************************************************)

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

open Utils

13

open LustreSpec

14

open Corelang

15

open Causality

16

open Machine_code

17


18

let pp_elim fmt elim =

19

begin

20

Format.fprintf fmt "{ /* elim table: */@.";

21

IMap.iter (fun v expr > Format.fprintf fmt "%s > %a@." v pp_val expr) elim;

22

Format.fprintf fmt "}@.";

23

end

24


25

let rec eliminate elim instr =

26

let e_expr = eliminate_expr elim in

27

match instr with

28

 MLocalAssign (i,v) > MLocalAssign (i, e_expr v)

29

 MStateAssign (i,v) > MStateAssign (i, e_expr v)

30

 MReset i > instr

31

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

32

 MBranch (g,hl) >

33

MBranch

34

(e_expr g,

35

(List.map

36

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

37

hl

38

)

39

)

40


41

and eliminate_expr elim expr =

42

match expr with

43

 LocalVar v > (try IMap.find v.var_id elim with Not_found > expr)

44

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

45

 Array(vl) > Array(List.map (eliminate_expr elim) vl)

46

 Access(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2)

47

 Power(v1, v2) > Power(eliminate_expr elim v1, eliminate_expr elim v2)

48

 Cst _  StateVar _ > expr

49


50

let is_scalar_const c =

51

match c with

52

 Const_int _

53

 Const_real _

54

 Const_float _

55

 Const_tag _ > true

56

 _ > false

57


58

let unfoldable_assign fanin v expr =

59

try

60

let d = Hashtbl.find fanin v.var_id

61

in match expr with

62

 Cst c when is_scalar_const c > true

63

 Cst c when d < 2 > true

64

 LocalVar _

65

 StateVar _ > true

66

 Fun (id, _) when d < 2 && Basic_library.is_internal_fun id > true

67

 _ > false

68

with Not_found > false

69


70

let merge_elim elim1 elim2 =

71

let merge k e1 e2 =

72

match e1, e2 with

73

 Some e1, Some e2 > if e1 = e2 then Some e1 else None

74

 _ , Some e2 > Some e2

75

 Some e1, _ > Some e1

76

 _ > None

77

in IMap.merge merge elim1 elim2

78


79

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

80

if so, update elim and return the remove flag,

81

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

82

let rec instrs_unfold fanin elim instrs =

83

let elim, rev_instrs =

84

List.fold_left (fun (elim, instrs) instr >

85

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

86

rewritten *)

87

let instr = eliminate elim instr in

88

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

89

is stored as the elim set *)

90

instr_unfold fanin instrs elim instr

91

) (elim, []) instrs

92

in elim, List.rev rev_instrs

93


94

and instr_unfold fanin instrs elim instr =

95

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

96

match instr with

97

(* Simple cases*)

98

 MStep([v], id, vl) when Basic_library.is_internal_fun id

99

> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl)))

100

 MLocalAssign(v, expr) when unfoldable_assign fanin v expr

101

> (IMap.add v.var_id expr elim, instrs)

102

 MBranch(g, hl) when false

103

> let elim_branches = List.map (fun (h, l) > (h, instrs_unfold fanin elim l)) hl in

104

let (elim, branches) =

105

List.fold_right

106

(fun (h, (e, l)) (elim, branches) > (merge_elim elim e, (h, l)::branches))

107

elim_branches (elim, [])

108

in elim, (MBranch (g, branches) :: instrs)

109

 _

110

> (elim, instr :: instrs)

111

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

112


113


114

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

115

1. each expression is rewritten according to the accumulator

116

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

117

*)

118


119

(** Perform optimization on machine code:

120

 iterate through step instructions and remove simple local assigns

121


122

*)

123

let machine_unfold fanin elim machine =

124

(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)

125

let eliminated_vars, new_instrs = instrs_unfold fanin elim machine.mstep.step_instrs in

126

let new_locals = List.filter (fun v > not (IMap.mem v.var_id eliminated_vars)) machine.mstep.step_locals

127

in

128

{

129

machine with

130

mstep = {

131

machine.mstep with

132

step_locals = new_locals;

133

step_instrs = new_instrs

134

}

135

}

136


137

let instr_of_const top_const =

138

let const = const_of_top top_const in

139

let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true) in

140

let vdecl = { vdecl with var_type = const.const_type }

141

in MLocalAssign (vdecl, Cst const.const_value)

142


143

let machines_unfold consts node_schs machines =

144

List.map

145

(fun m >

146

let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in

147

let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts)

148

in machine_unfold fanin elim_consts m)

149

machines

150


151

(* variable substitution for optimizing purposes *)

152


153

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

154

let rec instr_is_skip instr =

155

match instr with

156

 MLocalAssign (i, LocalVar v) when i = v > true

157

 MStateAssign (i, StateVar v) when i = v > true

158

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

159

 _ > false

160

and instrs_are_skip instrs =

161

List.for_all instr_is_skip instrs

162


163

let instr_cons instr cont =

164

if instr_is_skip instr then cont else instr::cont

165


166

let rec instr_remove_skip instr cont =

167

match instr with

168

 MLocalAssign (i, LocalVar v) when i = v > cont

169

 MStateAssign (i, StateVar v) when i = v > cont

170

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

171

 _ > instr::cont

172


173

and instrs_remove_skip instrs cont =

174

List.fold_right instr_remove_skip instrs cont

175


176

let rec value_replace_var fvar value =

177

match value with

178

 Cst c > value

179

 LocalVar v > LocalVar (fvar v)

180

 StateVar v > value

181

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

182

 Array vl > Array (List.map (value_replace_var fvar) vl)

183

 Access (t, i) > Access(value_replace_var fvar t, i)

184

 Power (v, n) > Power(value_replace_var fvar v, n)

185


186

let rec instr_replace_var fvar instr cont =

187

match instr with

188

 MLocalAssign (i, v) > instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont

189

 MStateAssign (i, v) > instr_cons (MStateAssign (i, value_replace_var fvar v)) cont

190

 MReset i > instr_cons instr cont

191

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

192

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

193


194

and instrs_replace_var fvar instrs cont =

195

List.fold_right (instr_replace_var fvar) instrs cont

196


197

let step_replace_var fvar step =

198

(* Some outputs may have been replaced by locals.

199

We then need to rename those outputs

200

without changing their clocks, etc *)

201

let outputs' =

202

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

203

let locals' =

204

List.fold_left (fun res l >

205

let l' = fvar l in

206

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

207

then res

208

else Utils.add_cons l' res)

209

[] step.step_locals in

210

{ step with

211

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

212

step_outputs = outputs';

213

step_locals = locals';

214

step_instrs = instrs_replace_var fvar step.step_instrs [];

215

}

216


217

let rec machine_replace_variables fvar m =

218

{ m with

219

mstep = step_replace_var fvar m.mstep

220

}

221


222

let machine_reuse_variables m reuse =

223

let fvar v =

224

try

225

Hashtbl.find reuse v.var_id

226

with Not_found > v in

227

machine_replace_variables fvar m

228


229

let machines_reuse_variables prog node_schs =

230

List.map

231

(fun m >

232

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

233

) prog

234


235

let rec instr_assign res instr =

236

match instr with

237

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

238

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

239

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

240

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

241

 _ > res

242


243

and instrs_assign res instrs =

244

List.fold_left instr_assign res instrs

245


246

let rec instr_constant_assign var instr =

247

match instr with

248

 MLocalAssign (i, Cst (Const_tag _))

249

 MStateAssign (i, Cst (Const_tag _)) > i = var

250

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

251

 _ > false

252


253

and instrs_constant_assign var instrs =

254

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

255


256

let rec instr_reduce branches instr1 cont =

257

match instr1 with

258

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

259

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

260

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

261

 _ > instr1 :: cont

262


263

and instrs_reduce branches instrs cont =

264

match instrs with

265

 [] > cont

266

 [i] > instr_reduce branches i cont

267

 i1::i2::q > i1 :: instrs_reduce branches (i2::q) cont

268


269

let rec instrs_fusion instrs =

270

match instrs with

271

 []

272

 [_] >

273

instrs

274

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

275

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

276

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

277

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

278

 i1::i2::q >

279

i1 :: instrs_fusion (i2::q)

280


281

let step_fusion step =

282

{ step with

283

step_instrs = instrs_fusion step.step_instrs;

284

}

285


286

let rec machine_fusion m =

287

{ m with

288

mstep = step_fusion m.mstep

289

}

290


291

let machines_fusion prog =

292

List.map machine_fusion prog

293


294

(* Local Variables: *)

295

(* compilecommand:"make C .." *)

296

(* End: *)
