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

Last change on this file since 486 was 486, checked in by ayache, 8 years ago

Deliverable D2.2

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