source: Deliverables/D2.2/8051/src/ERTL/ERTLGraph.ml @ 1585

Last change on this file since 1585 was 1585, checked in by tranquil, 8 years ago

fighting with a bug of the translation from RTL to ERTL

File size: 2.7 KB
Line 
1type node = Label.t
2
3type statement = ERTL.statement
4
5module NodeMap = Label.Map
6module NodeSet = Label.Set
7
8type t = ERTL.graph
9
10open ERTL
11
12(** Successors of a statement *)
13let successors (stmt : statement) =
14  match stmt with
15  | St_return _  ->
16    []
17  | St_skip l
18  | St_newframe l
19  | St_delframe l
20  | St_clear_carry l
21  | St_set_carry l
22  | St_framesize (_, l)
23  | St_pop (_, l)
24  | St_push (_, l)
25  | St_comment (_, l)
26  | St_addrH (_, _, l)
27  | St_addrL (_, _, l)
28  | St_cost (_, l)
29  | St_ind_0 (_, l)
30  | St_ind_inc (_, l)
31  | St_get_hdw (_, _, l)
32  | St_set_hdw (_, _, l)
33  | St_hdw_to_hdw (_, _, l)
34  | St_move (_, _, l)
35  | St_opaccsA (_, _, _, _, l)
36  | St_opaccsB (_, _, _, _, l)
37  | St_op1 (_, _, _, l)
38  | St_op2 (_, _, _, _, l)
39  | St_load (_, _, _, l)
40  | St_store (_, _, _, l)
41  | St_call_ptr (_, _, _, l)
42  | St_call_id (_, _, l) ->
43    [l]
44  | St_cond (_, l1, l2) ->
45    [l1 ; l2]
46
47let skip lbl = St_skip lbl
48
49let fill_succs stmt succs = match stmt, succs with
50  | St_skip _, [lbl] -> St_skip lbl
51  | St_comment (s, _), [lbl] -> St_comment (s, lbl)
52  | St_cost (cost_lbl, _), [lbl] -> St_cost (cost_lbl, lbl)
53  | St_ind_0 (i, _), [lbl] -> St_ind_0 (i, lbl)
54  | St_ind_inc (i, _), [lbl] -> St_ind_inc (i, lbl)
55  | St_get_hdw (r1, r2, _), [lbl] -> St_get_hdw (r1, r2, lbl)
56  | St_set_hdw (r1, r2, _), [lbl] -> St_set_hdw (r1, r2, lbl)
57  | St_hdw_to_hdw (r1, r2, _), [lbl] -> St_hdw_to_hdw (r1, r2, lbl)
58  | St_newframe _, [lbl] -> St_newframe lbl
59  | St_delframe _, [lbl] -> St_delframe lbl
60  | St_framesize (r, _), [lbl] -> St_framesize (r, lbl)
61  | St_pop (r, _), [lbl] -> St_pop (r, lbl)
62  | St_push (r, _), [lbl] -> St_push (r, lbl)
63  | St_addrH (r, id, _), [lbl] -> St_addrH (r, id, lbl)
64  | St_addrL (r, id, _), [lbl] -> St_addrL (r, id, lbl)
65  | St_move (r1, a, _), [lbl] -> St_move (r1, a, lbl)
66  | St_opaccsA (opaccs, dstr, srcr1, srcr2, _), [lbl] ->
67    St_opaccsA (opaccs, dstr, srcr1, srcr2, lbl)
68  | St_opaccsB (opaccs, dstr, srcr1, srcr2, _), [lbl] ->
69    St_opaccsB (opaccs, dstr, srcr1, srcr2, lbl)
70  | St_op1 (op1, dstr, srcr, _), [lbl] -> St_op1 (op1, dstr, srcr, lbl)
71  | St_op2 (op2, dstr, srcr1, srcr2, _), [lbl] ->
72    St_op2 (op2, dstr, srcr1, srcr2, lbl)
73  | St_clear_carry _, [lbl] -> St_clear_carry lbl
74  | St_set_carry _, [lbl] -> St_set_carry lbl
75  | St_load (dstrs, addr1, addr2, _), [lbl] ->
76    St_load (dstrs, addr1, addr2, lbl)
77  | St_store (addr1, addr2, srcrs, _), [lbl] ->
78    St_store (addr1, addr2, srcrs, lbl)
79  | St_call_id (f, nb_args, _), [lbl] -> St_call_id (f, nb_args, lbl)
80  | St_call_ptr (f1, f2, nb_args, _), [lbl] ->
81    St_call_ptr (f1, f2, nb_args, lbl)
82  | St_cond (r, _, _), [lbl1; lbl2] -> St_cond (r, lbl1, lbl2)
83  | St_return _ as inst, [] -> inst
84  | _ -> invalid_arg "ERTL fill_succs: successors do not match"
Note: See TracBrowser for help on using the repository browser.