source: Deliverables/D2.2/8051/src/clight/clightToCminor.ml @ 740

Last change on this file since 740 was 740, checked in by ayache, 9 years ago

New memory model and bug fixes in 8051 branch. Added primitive operations in interpreters from Clight to LIN.

File size: 21.1 KB
Line 
1open AST
2open Cminor
3open Clight
4
5
6let error_prefix = "Cminor to RTLabs"
7let error = Error.global_error error_prefix
8let error_float () = error "float not supported."
9
10
11(*For internal use*)
12type var_type = 
13  | Global
14  | Stack of int (*Note: this is a constraint on the size of the stack.*) 
15  | Param
16  | Local
17
18(*Parametrisation by int and pointer size *)
19let int_size = Driver.CminorMemory.int_size
20let ptr_size = Driver.CminorMemory.ptr_size
21let alignment = Driver.CminorMemory.alignment
22
23let fresh_tmp variables = 
24  let rec ft i = 
25    let tmp = "tmp"^(string_of_int i) in
26      try (match Hashtbl.find variables tmp with _ -> ft (i+1))
27      with Not_found -> tmp
28  in ft 0
29
30let rec ctype_to_type_return t = match t with 
31  | Tvoid       -> Type_void
32  | Tfloat _    -> Type_ret Sig_float (*Not supported*)
33  | Tpointer _ | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_) -> Type_ret Sig_ptr
34  | _           -> Type_ret Sig_int
35
36let rec ctype_to_sig_type t = match t with
37  | Tfloat _    -> 
38      Sig_float (*Not supported but needed for external function from library*)
39  | Tvoid       -> assert false
40  | Tpointer _ | Tstruct (_,_) | Tunion (_,_) | Tarray(_,_) -> Sig_ptr
41  | _           -> Sig_int
42
43let rec size_of_ty = function
44  | Tvoid               -> assert false
45  | Tfloat _            -> assert false (*Not supported*)
46  | Tfunction (_,_)     -> assert false (*Not supported*) 
47  | Tint (I8,Signed)    -> 1
48  | Tint (I8,Unsigned)  -> 1
49  | Tint (I16,Signed)   -> 2
50  | Tint (I16,Unsigned) -> 2
51  (*FIXME MQ_int32 : signed or unsigned ? *)
52  | Tint (I32,Signed)   -> 4
53  | Tint (I32,Unsigned) -> 4
54  | Tpointer _ | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_)
55  | Tcomp_ptr _         -> ptr_size
56
57let size_of_intsize = function
58  | I8 -> 1
59  | I16 -> 2
60  | I32 -> 4
61
62let quantity_of_ty = function
63  | Tvoid               -> assert false (* do not use on this argument *)
64  | Tint (size,_)       -> Memory.QInt (size_of_intsize size)
65  | Tpointer _ | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_)
66  | Tfunction (_,_)
67  | Tcomp_ptr _         -> Memory.QPtr
68  | Tfloat _            -> error_float ()
69
70let init_to_data l = List.map (
71  function 
72    | Init_int8 i       -> Data_int8 i
73    | Init_int16 i      -> Data_int16 i
74    | Init_int32 i      -> Data_int32 i
75    | Init_float32 _ 
76    | Init_float64 _    -> assert false (*Not supported*)
77    | Init_space n      -> Data_reserve n
78    | Init_addrof (_,_) -> assert false (*TODO*)
79) l
80
81let rec size_of_ctype t = match t with
82  | Tvoid                       -> 0
83  | Tint (I8,_)                 -> 1
84  | Tint (I16,_)                -> 2
85  | Tint (I32,_)                -> 4
86  | Tpointer _                  -> ptr_size     
87  | Tarray (c,s)                -> s*(size_of_ctype c)
88  | Tstruct (_,lst)             -> 
89      List.fold_left
90        (fun n (_,ty) -> n+(size_of_ctype ty)) 0 lst
91  | Tunion (_,lst)              -> 
92      List.fold_left
93        (fun n (_,ty) -> 
94           let sz = (size_of_ctype ty) in (if n>sz then n else sz)
95        ) 0 lst
96  | Tfloat _ | Tfunction (_,_)  -> assert false (*Not supported*)
97  | Tcomp_ptr _                 -> ptr_size     
98
99let translate_global_vars ((id,lst),_) = (id,init_to_data lst)
100
101let translate_unop t = function
102  | Onotbool                    -> Op_notbool
103  | Onotint                     -> Op_notint
104  | Oneg -> (match t with 
105               | Tint (_,_)     -> Op_negint 
106               | Tfloat _       -> assert false  (*Not supported*)
107               | _              -> assert false  (*Type error*)
108    )
109
110let translate_cmp t1 t2 cmp =
111  match (t1,t2) with
112    | (Tint(_,Signed),Tint(_,Signed))           -> Op_cmp cmp
113    | (Tint(_,Unsigned),Tint(_,Unsigned))       -> Op_cmpu cmp
114    | (Tpointer _,Tpointer _)                   -> Op_cmpp cmp
115    | _                                         -> Op_cmp cmp 
116
117let translate_add e1 e2 = function
118  | (Tint(_,_),Tint(_,_))       -> Op2 (Op_add,e1,e2)
119  | (Tfloat _,Tfloat _)         -> assert false (*Not supported*)
120  | (Tpointer t,Tint(_,_))      -> 
121      Op2 (Op_addp,e1, Op2 (Op_mul,e2,Cst (Cst_int (size_of_ctype t))))
122  | (Tint(_,_),Tpointer t)      -> 
123      Op2 (Op_addp,e2,Op2 (Op_mul,e1,Cst (Cst_int (size_of_ctype t))))
124  | (Tarray (t,_),Tint(_,_))    -> 
125      Op2 (Op_addp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
126  | (Tint(_,_),Tarray(t,_))     -> 
127      Op2 (Op_addp,e2,Op2 (Op_mul,e1,(Cst (Cst_int (size_of_ctype t)))))
128  | _                           -> assert false (*Type error*)
129
130let translate_sub e1 e2 = function
131  | (Tint(_,_),Tint(_,_))       -> Op2 (Op_sub,e1,e2)
132  | (Tfloat _,Tfloat _)         -> assert false (*Not supported*)
133  | (Tpointer t,Tint(_,_))      -> 
134      Op2 (Op_subp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
135  | (Tarray (t,_),Tint(_,_))    -> 
136      Op2 (Op_subp,e1,Op2 (Op_mul,e2,(Cst (Cst_int (size_of_ctype t)))))
137  | _                           -> assert false (*Type error*)
138
139let translate_mul e1 e2 = function
140  | (Tint(_,_),Tint(_,_))       -> Op2 (Op_mul,e1,e2)
141  | (Tfloat _,Tfloat _)         -> assert false (*Not supported*)
142  | _                           -> assert false (*Type error*)
143
144let translate_div e1 e2 = function
145  | (Tint(_,Signed),Tint(_,Signed))     -> Op2 (Op_div,e1,e2)
146  | (Tint(_,Unsigned),Tint(_,Unsigned)) -> Op2 (Op_divu,e1,e2)
147  | (Tfloat _,Tfloat _)                 -> assert false (*Not supported*)
148  | _                                   -> assert false (*Type error*) 
149
150let translate_binop t1 e1 t2 e2 = function
151  | Oadd -> translate_add e1 e2 (t1,t2)
152  | Osub -> translate_sub e1 e2 (t1,t2)
153  | Omul -> translate_mul e1 e2 (t1,t2)
154  | Odiv -> translate_div e1 e2 (t1,t2)
155  | Omod -> Op2 (Op_mod,e1,e2)
156  | Oand -> Op2 (Op_and,e1,e2)
157  | Oor  -> Op2 (Op_or,e1,e2)
158  | Oxor -> Op2 (Op_xor,e1,e2)
159  | Oshl -> Op2 (Op_shl,e1,e2)
160  | Oshr -> Op2 (Op_shr,e1,e2)
161  | Oeq  -> Op2 (translate_cmp t1 t2 Cmp_eq,e1,e2)
162  | One  -> Op2 (translate_cmp t1 t2 Cmp_ne,e1,e2)
163  | Olt  -> Op2 (translate_cmp t1 t2 Cmp_lt,e1,e2)
164  | Ogt  -> Op2 (translate_cmp t1 t2 Cmp_gt,e1,e2)
165  | Ole  -> Op2 (translate_cmp t1 t2 Cmp_le,e1,e2)
166  | Oge  -> Op2 (translate_cmp t1 t2 Cmp_ge,e1,e2)
167
168let make_cast e = function 
169  | (Tint(I8,Signed),Tint(_,_))    -> Op1 (Op_cast8signed,e)
170  | (Tint(I8,Unsigned),Tint(_,_))  -> Op1 (Op_cast8unsigned,e)
171  | (Tint(I16,Signed),Tint(_,_))   -> Op1 (Op_cast16signed,e)
172  | (Tint(I16,Unsigned),Tint(_,_)) -> Op1 (Op_cast16unsigned,e)
173  | _ -> e
174
175let get_type (Expr (_,t)) = t
176
177let rec get_offset_struct e id = function
178  | [] -> assert false (*Wrong id*)
179  | (fi,_)::_ when fi=id -> e
180  | (_,ty)::ll -> get_offset_struct (e+(size_of_ctype ty)) id ll
181
182let is_struct = function
183  | Tarray(_,_) | Tstruct (_,_) | Tunion(_,_) -> true
184  | _ -> false
185
186let is_ptr_to_struct = function
187  | Tpointer t when is_struct t -> true
188  | _ -> false 
189
190let is_function = function
191  | Tfunction _ -> true
192  | _ -> false
193
194let rec translate_expr variables expr =
195  let Expr(d,c) = expr in match d with
196    | Econst_int i      -> Cst (Cst_int i)
197    | Econst_float f    -> assert false (*Not supported*)
198    | Evar id when is_function c -> Cst (Cst_addrsymbol id)
199    | Evar id           -> 
200        (try (match Hashtbl.find variables id with
201           | (Local,_)          -> Id id
202           | (Stack o,ty) when is_struct ty     -> Cst (Cst_stackoffset o)
203           | (Stack o,_)        ->
204             Mem (quantity_of_ty c,Cst (Cst_stackoffset o))
205           | (Param,_)          -> Id id
206           | (Global,ty) when is_struct ty -> Cst (Cst_addrsymbol id)
207           | (Global,_)         ->
208             Mem (quantity_of_ty c,Cst (Cst_addrsymbol id))
209        ) with Not_found -> assert false)
210    | Ederef e when is_ptr_to_struct (get_type e) ->
211        translate_expr variables e
212    | Ederef e          -> Mem (quantity_of_ty c,translate_expr variables e)
213    | Eaddrof se        ->  (
214        match se with
215          | Expr(Evar id,_) ->
216             (try  (match Hashtbl.find variables id with
217                 | (Local,_) -> assert false (*Impossible: see sort_variables*)
218                 | (Stack o,_) -> Cst (Cst_stackoffset o)
219                 | (Param,_) ->  Cst (Cst_addrsymbol id) 
220                 | (Global,_) -> Cst (Cst_addrsymbol id)
221              ) with Not_found -> assert false)
222          | Expr(Ederef ee,_)                              -> 
223              translate_expr variables ee
224          | Expr(Efield (str,fi),_)  -> 
225              (match str with 
226                 | Expr(_,Tstruct(_,b)) -> 
227                     Op2 (Op_add
228                          ,translate_expr variables str
229                          ,Cst (Cst_int (get_offset_struct 0 fi b)))
230                 | Expr(_,Tunion(_,_)) ->
231                     translate_expr variables str
232                 | _ -> assert false (*Type Error*)
233              )
234          | _ ->  assert false (*Must be a lvalue*)
235      )
236    | Eunop (op,e)      -> 
237        Op1 (translate_unop (get_type e) op ,translate_expr variables e)
238    | Ebinop (op,e1,e2) -> 
239        translate_binop
240          (get_type e1) (translate_expr variables e1) 
241          (get_type e2) (translate_expr variables e2) op
242    | Ecast (ty,e)     -> make_cast (translate_expr variables e) (get_type e,ty)
243    | Econdition (e1,e2,e3) ->
244        Cond (translate_expr variables e1,
245              translate_expr variables e2,
246              translate_expr variables e3)
247    | Eandbool (e1,e2) -> 
248        Cond ( 
249          translate_expr variables e1, 
250          Cond(translate_expr variables e2,Cst (Cst_int 1),Cst (Cst_int 0)),
251          Cst (Cst_int 0))
252    | Eorbool (e1,e2) -> 
253        Cond ( 
254          translate_expr variables e1, 
255          Cst (Cst_int 1),
256          Cond(translate_expr variables e2, Cst (Cst_int 1),Cst (Cst_int 0)) )
257    | Esizeof cc        -> Cst (Cst_int (size_of_ctype cc))
258    | Efield (e,id)     -> 
259        (match get_type e with
260           | Tstruct(_,lst) -> 
261               (try 
262                  Mem (quantity_of_ty (List.assoc id lst)
263                       ,Op2(Op_add
264                            ,translate_expr variables e
265                            , Cst (Cst_int (get_offset_struct 0 id lst))
266                       )
267                  )
268                with Not_found -> assert false (*field does not exists*)
269               )
270           | Tunion(_,lst) -> 
271               (try 
272                  Mem (quantity_of_ty (List.assoc id lst), translate_expr variables e)
273                with Not_found -> assert false (*field does not exists*)
274               )
275           | _ -> assert false (*Type error*)
276        )
277    | Ecost (lbl,e)     -> Exp_cost (lbl,translate_expr variables e) 
278    | Ecall _           -> assert false (* Only for annotations *)
279
280let translate_assign variables e = function
281  | Expr (Evar v,t) -> 
282      (try (match Hashtbl.find variables v with
283         | (Local,_)            -> St_assign (v,translate_expr variables e)
284         | (Stack o,_)          -> St_store (quantity_of_ty t
285                                             ,Cst (Cst_stackoffset o)
286                                             ,translate_expr variables e)
287         | (Param,_)            -> St_assign (v,translate_expr variables e)
288         | (Global,_)           -> St_store (quantity_of_ty t
289                                             ,Cst (Cst_addrsymbol v)
290                                             ,translate_expr variables e)
291      ) with Not_found -> assert false)
292  | Expr (Ederef ee,t)          -> St_store (quantity_of_ty t
293                                             ,translate_expr variables ee
294                                             ,translate_expr variables e)
295  | Expr (Efield (ee,id),t) -> 
296      (match ee with
297         | Expr (_,Tstruct(_,lst)) ->
298             St_store (quantity_of_ty t
299                       ,Op2(Op_add,translate_expr variables ee
300                            ,Cst(Cst_int (get_offset_struct 0 id lst )))
301                       ,translate_expr variables e)
302         | Expr (_,Tunion(_,_)) -> St_store (quantity_of_ty t
303                                             ,translate_expr variables ee
304                                             ,translate_expr variables e)
305         | _ -> assert false (*Type error*)
306      )
307  | _                           -> assert false (*lvalue error*)
308
309let translate_call_name variables = function
310  | Expr (Evar id,_)    -> Cst (Cst_addrsymbol id)
311  | _                   -> assert false (*Not supported*)
312
313let translate_call variables e1 e2 lst =
314  let st_call f_assign f_res =
315    St_call (f_assign
316             ,translate_expr variables e2
317             ,List.map (translate_expr variables) lst
318             ,{args=List.map (fun exp -> 
319                                let Expr(_,t) = exp in ctype_to_sig_type t
320             )lst;res=f_res} 
321        ) in
322    match e1 with
323      | Some (Expr (se,tt)) -> (
324          match se with
325            | Evar v ->
326                (try (match Hashtbl.find variables v with
327                   | (Local,_) | (Param,_) -> 
328                       st_call (Some v) (Type_ret (ctype_to_sig_type tt))
329                   | (Stack o,_) -> 
330                       let tmp = fresh_tmp variables in 
331                         St_seq (
332                           st_call (Some tmp) (Type_ret (ctype_to_sig_type tt))
333                           ,St_store (quantity_of_ty tt,Cst (Cst_stackoffset o),Id tmp)
334                         )
335                   | (Global,_) ->
336                       let tmp = fresh_tmp variables in 
337                         St_seq (
338                           st_call (Some tmp) (Type_ret (ctype_to_sig_type tt))
339                           ,St_store (quantity_of_ty tt,Cst (Cst_addrsymbol v),Id tmp)
340                         )
341                ) with Not_found -> assert false )
342            | Ederef ee         -> assert false (*Not supported*)
343            | Efield (ee,id)    -> assert false (*Not supported*)
344            | _ -> assert false (*Should be a lvalue*)
345        )
346      | None -> st_call None Type_void
347
348(*TODO rewrite this buggy function*)                 
349let translate_switch expr (cases,default) = 
350  let sz = List.length cases in
351  let sw = St_block (St_switch (
352    expr, MiscPottier.mapi (fun i (n,_) -> (n,i)) cases, sz)) in
353  let rec add_block n e = function 
354    | [] -> St_block (St_seq(e,default))
355    | (_,st)::l -> 
356        add_block (n-1) (St_block (St_seq(e,St_seq(st,St_exit n)))) l
357  in add_block sz sw cases
358
359let rec translate_stmt variables = function
360  | Sskip               -> St_skip
361  | Sassign (e1,e2)     -> translate_assign variables e2 e1
362  | Scall (e1,e2,lst)   -> translate_call variables e1 e2 lst
363  | Ssequence (s1,s2)   -> 
364      St_seq (translate_stmt variables s1,
365              translate_stmt variables s2)
366  | Sifthenelse (e,s1,s2) -> 
367      St_ifthenelse (translate_expr variables e,
368                     translate_stmt variables s1, 
369                     translate_stmt variables s2)
370  | Swhile (e,s)        -> 
371      St_block(St_loop(St_seq (
372        St_ifthenelse (
373          Op1 (Op_notbool,translate_expr variables e),
374          St_exit 0,St_skip),
375        St_block (translate_stmt variables s)
376      )))
377  | Sdowhile (e,s)      ->
378      St_block(St_loop(St_seq (
379        St_block (translate_stmt variables s),
380        St_ifthenelse (
381          Op1(Op_notbool, translate_expr variables e),
382          St_exit 0,St_skip)
383      )))
384  | Sfor (s1,e,s2,s3)   ->
385      let b = St_block (St_loop (St_seq (
386        St_ifthenelse (
387          Op1(Op_notbool,translate_expr variables e), 
388          St_exit 0,St_skip),
389        St_seq (St_block (translate_stmt variables s3),
390                translate_stmt variables s2
391        )))) in
392        (match (translate_stmt variables s1) with 
393           | St_skip -> b | ss -> St_seq (ss,b))
394  | Sbreak              -> St_exit(1)           
395  | Scontinue           -> St_exit(0)
396  | Sreturn (Some e)    -> St_return (Some(translate_expr variables e))
397  | Sreturn None        -> St_return None
398  | Sswitch (e,lbl)     -> 
399      translate_switch (translate_expr variables e) (compute_lbl variables lbl)
400  | Slabel (lbl,st)     ->
401      St_label(lbl,translate_stmt variables st)
402  | Sgoto lbl           -> St_goto lbl
403  | Scost (lbl,s)       -> St_cost(lbl,translate_stmt variables s)
404
405and compute_lbl variables = function
406  | LSdefault s -> ([],translate_stmt variables s)
407  | LScase (i,s,l) ->
408      let (ll,def) = (compute_lbl variables l) in
409        ((i,translate_stmt variables s)::ll,def)
410
411let rec get_stack_vars_expr (Expr (exp,_)) = match exp with
412  | Econst_int _  | Evar _ | Esizeof _ -> []
413  | Ederef e -> (get_stack_vars_expr e)
414  | Eaddrof Expr(e,_) -> (
415      match e with 
416        | Evar id                       -> [id] 
417        | Ederef ee | Efield (ee,_)     -> (get_stack_vars_expr ee)
418        | _                             -> assert false (*Should be a lvalue*)
419    ) 
420  | Eunop (_,e) -> (get_stack_vars_expr e)
421  | Ebinop (_,e1,e2) -> (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
422  | Ecast (_,e) -> (get_stack_vars_expr e)
423  | Econdition (e1,e2,e3) -> 
424      (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
425      @(get_stack_vars_expr e3)
426  | Eandbool (e1,e2) -> (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
427  | Eorbool (e1,e2) -> (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
428  | Ecost (_,e) -> (get_stack_vars_expr e)
429  | Efield (e,_) -> (get_stack_vars_expr e)
430  | Econst_float _ -> assert false (*Not supported*)
431  | Ecall _ -> assert false (* Should not happen *)
432
433let rec get_stack_vars_stmt = function
434  | Sskip | Sbreak | Scontinue | Sreturn None | Sgoto _ -> []
435  | Sassign (e1,e2) -> 
436      (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
437  | Scall (None,e,lst) -> 
438      (get_stack_vars_expr e)
439      @(List.fold_left (fun l e -> l@(get_stack_vars_expr e)) [] lst)
440  | Scall (Some e1,e2,lst) -> 
441      (get_stack_vars_expr e1)@(get_stack_vars_expr e2)
442      @(List.fold_left (fun l e -> l@(get_stack_vars_expr e)) [] lst)
443  | Ssequence (s1,s2) -> 
444      (get_stack_vars_stmt s1)@(get_stack_vars_stmt s2)
445  | Sifthenelse (e,s1,s2) -> 
446      (get_stack_vars_expr e)@(get_stack_vars_stmt s1)@(get_stack_vars_stmt s2)
447  | Swhile (e,s) ->
448      (get_stack_vars_expr e)@(get_stack_vars_stmt s)
449  | Sdowhile (e,s) -> 
450      (get_stack_vars_expr e)@(get_stack_vars_stmt s)
451  | Sfor (s1,e,s2,s3) -> 
452      (get_stack_vars_expr e)@(get_stack_vars_stmt s1)@(get_stack_vars_stmt s2)
453      @(get_stack_vars_stmt s3)
454  | Sreturn (Some e) -> 
455      (get_stack_vars_expr e)
456  | Sswitch (e,ls) -> 
457      (get_stack_vars_expr e)@(get_stack_vars_ls ls)
458  | Slabel (_,s) -> (get_stack_vars_stmt s)
459  | Scost (_,s) -> (get_stack_vars_stmt s)
460and get_stack_vars_ls = function
461  | LSdefault s -> get_stack_vars_stmt s
462  | LScase (_,s,ls) -> (get_stack_vars_stmt s)@(get_stack_vars_ls ls)
463
464let is_struct = function
465  | Tarray (_,_) | Tstruct (_,_) | Tunion (_,_) -> true
466  | _ -> false
467
468let sort_variables globals f = 
469  let variables = Hashtbl.create 47 and next_offset = ref 0 in
470    List.iter (fun (id,ty) -> Hashtbl.add variables id (Global,ty)) globals;
471    List.iter (fun (id,ty) -> Hashtbl.add variables id (Param,ty)) f.fn_params;
472    List.iter
473      (fun (id,ty) -> 
474         if is_struct ty then (
475           Hashtbl.add variables id (Stack !next_offset,ty); 
476           next_offset := !next_offset + (size_of_ctype ty)
477         ) else Hashtbl.add variables id (Local,ty)
478      ) f.fn_vars;
479    List.iter
480      (fun id -> match 
481         (try 
482            Hashtbl.find variables id
483          with 
484              Not_found -> ( 
485                 Printf.eprintf "Error: Cannot find variable %s\n" id;
486                 assert false)
487         ) with
488         | (Local,ty) -> 
489             Hashtbl.add variables id (Stack !next_offset,ty);
490             next_offset:=!next_offset + (size_of_ctype ty)
491         | (Global,_)           -> ()
492         | (Param,_)            -> () 
493         | (Stack _,_)          -> ()
494      ) (get_stack_vars_stmt f.fn_body);
495    variables
496
497let get_locals variables = 
498  Hashtbl.fold
499    (fun id (v,_) l -> match v with
500       | Local -> id::l
501       | _ -> l
502    ) variables []
503
504let get_stacksize variables = 
505  Hashtbl.fold
506    (fun _ (v,t) c1 -> let c2 = match v with 
507       | Stack o -> o+(size_of_ctype t)
508       | _ -> c1 in if c1 > c2 then c1 else c2
509    ) variables 0
510
511let translate_internal globals f =
512  let variables = sort_variables globals f in
513    { f_sig = 
514        { 
515          args = List.map (fun p -> ctype_to_sig_type (snd p)) f.fn_params ;
516          res = ctype_to_type_return f.fn_return
517        };
518      f_params = List.map fst f.fn_params ;
519      f_vars = (fresh_tmp variables)::(get_locals variables);
520      f_ptrs = [] (* will be filled in translate,
521                     when calling CminorPointers.fill *);
522      f_stacksize = get_stacksize variables ;
523      f_body = translate_stmt variables f.fn_body
524    }
525
526let translate_external id params return = 
527  { 
528    ef_tag = id ;
529    ef_sig = { 
530      args = List.map ctype_to_sig_type params ;
531      res = ctype_to_type_return return
532    }
533  }
534
535let translate_funct globals = function
536  | (id,Internal ff) -> (id,F_int (translate_internal globals ff))
537  | (id,External (i,p,r)) -> (id, F_ext (translate_external i p r))
538
539let translate p =
540  let p = Clight32ToClight8.translate p in
541  let globals = List.map (fun p -> (fst (fst p),snd p) ) p.prog_vars in 
542  let p =
543    {Cminor.vars   = List.map translate_global_vars p.prog_vars;
544     Cminor.functs = List.map (translate_funct globals ) p.prog_funct;
545     Cminor.main = p.prog_main } in
546  (* TODO: find a better solution to get the pointers in the result. *)
547  CminorPointers.fill p
Note: See TracBrowser for help on using the repository browser.