1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Insert load/stores for pseudoregs that got assigned to stack locations. *)
open Misc
open Reg
open Mach
let access_stack r =
try
for i = 0 to Array.length r - 1 do
match r.(i).loc with Stack _ -> raise Exit | _ -> ()
done;
false
with Exit ->
true
let insert_move src dst next =
if src.loc = dst.loc
then next
else instr_cons (Iop Imove) [|src|] [|dst|] next
let insert_moves src dst next =
let rec insmoves i =
if i >= Array.length src
then next
else insert_move src.(i) dst.(i) (insmoves (i+1))
in insmoves 0
class reload_generic = object (self)
val mutable redo_regalloc = false
method makereg r =
match r.loc with
Unknown -> fatal_error "Reload.makereg"
| Reg _ -> r
| Stack _ ->
redo_regalloc <- true;
let newr = Reg.clone r in
(* Strongly discourage spilling this register *)
newr.spill_cost <- 100000;
newr
method private makeregs rv =
let n = Array.length rv in
let newv = Array.create n Reg.dummy in
for i = 0 to n-1 do newv.(i) <- self#makereg rv.(i) done;
newv
method private makereg1 rv =
let newv = Array.copy rv in
newv.(0) <- self#makereg rv.(0);
newv
method reload_operation op arg res =
(* By default, assume that arguments and results must reside
in hardware registers. For moves, allow one arg or one
res to be stack-allocated, but do something for
stack-to-stack moves *)
match op with
Imove | Ireload | Ispill ->
begin match arg.(0), res.(0) with
{loc = Stack s1}, {loc = Stack s2} when s1 <> s2 ->
([| self#makereg arg.(0) |], res)
| _ ->
(arg, res)
end
| _ ->
(self#makeregs arg, self#makeregs res)
method reload_test tst args =
self#makeregs args
method private reload i =
match i.desc with
(* For function calls, returns, etc: the arguments and results are
already at the correct position (e.g. on stack for some arguments).
However, something needs to be done for the function pointer in
indirect calls. *)
Iend | Ireturn | Iop(Itailcall_imm _) | Iraise -> i
| Iop(Itailcall_ind) ->
let newarg = self#makereg1 i.arg in
insert_moves i.arg newarg
(instr_cons_live i.desc newarg i.res i.live i.next)
| Iop(Icall_imm _ | Iextcall(_, _)) ->
instr_cons_live i.desc i.arg i.res i.live (self#reload i.next)
| Iop(Icall_ind) ->
let newarg = self#makereg1 i.arg in
insert_moves i.arg newarg
(instr_cons_live i.desc newarg i.res i.live (self#reload i.next))
| Iop op ->
let (newarg, newres) = self#reload_operation op i.arg i.res in
insert_moves i.arg newarg
(instr_cons_live i.desc newarg newres i.live
(insert_moves newres i.res
(self#reload i.next)))
| Iifthenelse(tst, ifso, ifnot) ->
let newarg = self#reload_test tst i.arg in
insert_moves i.arg newarg
(instr_cons
(Iifthenelse(tst, self#reload ifso, self#reload ifnot)) newarg [||]
(self#reload i.next))
| Iswitch(index, cases) ->
let newarg = self#makeregs i.arg in
insert_moves i.arg newarg
(instr_cons (Iswitch(index, Array.map (self#reload) cases)) newarg [||]
(self#reload i.next))
| Iloop body ->
instr_cons (Iloop(self#reload body)) [||] [||] (self#reload i.next)
| Icatch(nfail, body, handler) ->
instr_cons
(Icatch(nfail, self#reload body, self#reload handler)) [||] [||]
(self#reload i.next)
| Iexit i ->
instr_cons (Iexit i) [||] [||] dummy_instr
| Itrywith(body, handler) ->
instr_cons (Itrywith(self#reload body, self#reload handler)) [||] [||]
(self#reload i.next)
method fundecl f =
redo_regalloc <- false;
let new_body = self#reload f.fun_body in
({fun_name = f.fun_name; fun_args = f.fun_args;
fun_body = new_body; fun_fast = f.fun_fast},
redo_regalloc)
end
|
