source: Deliverables/D2.3/8051-memoryspaces-branch/src/clight/clightToCminor.ml @ 460

Last change on this file since 460 was 460, checked in by campbell, 9 years ago

Port memory spaces changes to latest prototype compiler.

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