Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
int
Rust
提交
025b1e41
R
Rust
项目概览
int
/
Rust
大约 1 年 前同步成功
通知
1
Star
0
Fork
0
代码
文件
提交
分支
Tags
贡献者
分支图
Diff
Issue
0
列表
看板
标记
里程碑
合并请求
0
DevOps
流水线
流水线任务
计划
Wiki
0
Wiki
分析
仓库
DevOps
项目成员
Pages
R
Rust
项目概览
项目概览
详情
发布
仓库
仓库
文件
提交
分支
标签
贡献者
分支图
比较
Issue
0
Issue
0
列表
看板
标记
里程碑
合并请求
0
合并请求
0
Pages
DevOps
DevOps
流水线
流水线任务
计划
分析
分析
仓库分析
DevOps
Wiki
0
Wiki
成员
成员
收起侧边栏
关闭侧边栏
动态
分支图
创建新Issue
流水线任务
提交
Issue看板
体验新版 GitCode,发现更多精彩内容 >>
提交
025b1e41
编写于
7月 26, 2010
作者:
G
Graydon Hoare
浏览文件
操作
浏览文件
下载
电子邮件补丁
差异文件
Do some more iflog-guarding.
上级
085cd2ee
变更
2
隐藏空白更改
内联
并排
Showing
2 changed file
with
94 addition
and
84 deletion
+94
-84
src/boot/be/ra.ml
src/boot/be/ra.ml
+43
-61
src/boot/me/type.ml
src/boot/me/type.ml
+51
-23
未找到文件。
src/boot/be/ra.ml
浏览文件 @
025b1e41
...
...
@@ -184,7 +184,7 @@ let calculate_live_bitvectors
(
cx
:
ctxt
)
:
((
Bits
.
t
array
)
*
(
Bits
.
t
array
))
=
log
cx
"calculating live bitvectors"
;
iflog
cx
(
fun
_
->
log
cx
"calculating live bitvectors"
)
;
let
quads
=
cx
.
ctxt_quads
in
let
n_quads
=
Array
.
length
quads
in
...
...
@@ -198,10 +198,9 @@ let calculate_live_bitvectors
let
(
quad_uncond_jmp
:
bool
array
)
=
Array
.
make
n_quads
false
in
let
(
quad_jmp_targs
:
(
Il
.
label
list
)
array
)
=
Array
.
make
n_quads
[]
in
let
outer_changed
=
ref
true
in
(* Working bit-vector. *)
let
scratch
=
new_bitv
()
in
let
changed
=
ref
true
in
(* bit-vector helpers. *)
(* Setup pass. *)
...
...
@@ -217,62 +216,39 @@ let calculate_live_bitvectors
(
quad_defined_vregs
q
)
done
;
while
!
outer_changed
do
iflog
cx
(
fun
_
->
log
cx
"iterating outer bitvector calculation"
);
outer_changed
:=
false
;
for
i
=
0
to
n_quads
-
1
do
Bits
.
clear
live_in_vregs
.
(
i
);
Bits
.
clear
live_out_vregs
.
(
i
)
while
!
changed
do
changed
:=
false
;
iflog
cx
(
fun
_
->
log
cx
"iterating inner bitvector calculation over %d quads"
n_quads
);
for
i
=
n_quads
-
1
downto
0
do
let
note_change
b
=
if
b
then
changed
:=
true
in
let
live_in
=
live_in_vregs
.
(
i
)
in
let
live_out
=
live_out_vregs
.
(
i
)
in
let
used
=
quad_used_vrs
.
(
i
)
in
let
defined
=
quad_defined_vrs
.
(
i
)
in
(* Union in the vregs we use. *)
note_change
(
Bits
.
union
live_in
used
);
(* Union in all our jump targets. *)
List
.
iter
(
fun
i
->
note_change
(
Bits
.
union
live_out
live_in_vregs
.
(
i
)))
(
quad_jmp_targs
.
(
i
));
(* Union in our block successor if we have one *)
if
i
<
(
n_quads
-
1
)
&&
(
not
(
quad_uncond_jmp
.
(
i
)))
then
note_change
(
Bits
.
union
live_out
live_in_vregs
.
(
i
+
1
));
(* Propagate live-out to live-in on anything we don't define. *)
ignore
(
Bits
.
copy
scratch
defined
);
Bits
.
invert
scratch
;
ignore
(
Bits
.
intersect
scratch
live_out
);
note_change
(
Bits
.
union
live_in
scratch
);
done
;
let
inner_changed
=
ref
true
in
while
!
inner_changed
do
inner_changed
:=
false
;
iflog
cx
(
fun
_
->
log
cx
"iterating inner bitvector calculation over %d quads"
n_quads
);
for
i
=
n_quads
-
1
downto
0
do
let
note_change
b
=
if
b
then
inner_changed
:=
true
in
let
live_in
=
live_in_vregs
.
(
i
)
in
let
live_out
=
live_out_vregs
.
(
i
)
in
let
used
=
quad_used_vrs
.
(
i
)
in
let
defined
=
quad_defined_vrs
.
(
i
)
in
(* Union in the vregs we use. *)
note_change
(
Bits
.
union
live_in
used
);
(* Union in all our jump targets. *)
List
.
iter
(
fun
i
->
note_change
(
Bits
.
union
live_out
live_in_vregs
.
(
i
)))
(
quad_jmp_targs
.
(
i
));
(* Union in our block successor if we have one *)
if
i
<
(
n_quads
-
1
)
&&
(
not
(
quad_uncond_jmp
.
(
i
)))
then
note_change
(
Bits
.
union
live_out
live_in_vregs
.
(
i
+
1
));
(* Propagate live-out to live-in on anything we don't define. *)
ignore
(
Bits
.
copy
scratch
defined
);
Bits
.
invert
scratch
;
ignore
(
Bits
.
intersect
scratch
live_out
);
note_change
(
Bits
.
union
live_in
scratch
);
done
done
;
let
kill_mov_to_dead_target
i
q
=
match
q
.
Il
.
quad_body
with
Il
.
Unary
{
Il
.
unary_op
=
uop
;
Il
.
unary_dst
=
Il
.
Reg
(
Il
.
Vreg
v
,
_
)
}
when
((
Il
.
is_mov
uop
)
&&
not
(
Bits
.
get
live_out_vregs
.
(
i
)
v
))
->
begin
kill_quad
i
cx
;
outer_changed
:=
true
;
end
|
_
->
()
in
Array
.
iteri
kill_mov_to_dead_target
quads
done
;
iflog
cx
begin
...
...
@@ -340,7 +316,10 @@ let dump_quads cx =
None
->
""
|
Some
f
->
f
.
fixup_name
^
":"
in
log
cx
"[%s] %s %s"
(
padded_num
i
len
)
(
padded_str
lab
(
!
maxlablen
))
qs
iflog
cx
(
fun
_
->
log
cx
"[%s] %s %s"
(
padded_num
i
len
)
(
padded_str
lab
(
!
maxlablen
))
qs
)
done
;;
...
...
@@ -449,8 +428,11 @@ let reg_alloc
in
let
spill_mem
=
spill_slot
spill_idx
in
let
spill_cell
=
Il
.
Mem
(
spill_mem
,
Il
.
ScalarTy
word_ty
)
in
log
cx
"spilling <%d> from %s to %s"
vreg
(
hr_str
hreg
)
(
string_of_mem
hr_str
spill_mem
);
iflog
cx
(
fun
_
->
log
cx
"spilling <%d> from %s to %s"
vreg
(
hr_str
hreg
)
(
string_of_mem
hr_str
spill_mem
));
prepend
(
Il
.
mk_quad
(
Il
.
umov
spill_cell
(
Il
.
Cell
(
hr
hreg
))));
else
()
...
...
src/boot/me/type.ml
浏览文件 @
025b1e41
...
...
@@ -25,6 +25,12 @@ let log cx =
cx
.
Semant
.
ctxt_sess
.
Session
.
sess_log_type
cx
.
Semant
.
ctxt_sess
.
Session
.
sess_log_out
let
iflog
cx
thunk
=
if
cx
.
Semant
.
ctxt_sess
.
Session
.
sess_log_type
then
thunk
()
else
()
;;
let
type_error
expected
actual
=
raise
(
Type_error
(
expected
,
actual
))
(* We explicitly curry [cx] like this to avoid threading it through all the
...
...
@@ -65,7 +71,10 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
let
res
=
if
mutability
=
Ast
.
MUT_mutable
then
Ast
.
TY_mutable
ty
else
ty
in
log
cx
"maybe_mutable: %a -> %a"
Ast
.
sprintf_ty
ty
Ast
.
sprintf_ty
res
;
iflog
cx
(
fun
_
->
log
cx
"maybe_mutable: %a -> %a"
Ast
.
sprintf_ty
ty
Ast
.
sprintf_ty
res
);
res
in
...
...
@@ -238,11 +247,13 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
demand
expected
actual
;
actual
|
Some
inferred
,
None
->
log
cx
"setting auto slot #%d = %a to type %a"
(
Common
.
int_of_node
defn_id
)
Ast
.
sprintf_slot_key
(
Hashtbl
.
find
cx
.
Semant
.
ctxt_slot_keys
defn_id
)
Ast
.
sprintf_ty
inferred
;
iflog
cx
(
fun
_
->
log
cx
"setting auto slot #%d = %a to type %a"
(
Common
.
int_of_node
defn_id
)
Ast
.
sprintf_slot_key
(
Hashtbl
.
find
cx
.
Semant
.
ctxt_slot_keys
defn_id
)
Ast
.
sprintf_ty
inferred
);
let
new_slot
=
{
slot
with
Ast
.
slot_ty
=
Some
inferred
}
in
Hashtbl
.
replace
cx
.
Semant
.
ctxt_all_defns
defn_id
(
Semant
.
DEFN_slot
new_slot
);
...
...
@@ -305,8 +316,11 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
|
`Module
items
->
Ast
.
sprintf_mod_items
chan
items
in
let
_
=
log
cx
"base lval %a, base type %a"
Ast
.
sprintf_lval
base
sprintf_itype
()
let
_
=
iflog
cx
(
fun
_
->
log
cx
"base lval %a, base type %a"
Ast
.
sprintf_lval
base
sprintf_itype
()
)
in
let
rec
typecheck
base_ity
=
...
...
@@ -495,20 +509,26 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
* Get the real one. *)
let
lval_id
=
Semant
.
lval_base_id
lval
in
let
lval
=
Hashtbl
.
find
cx
.
Semant
.
ctxt_all_lvals
lval_id
in
let
_
=
log
cx
"generic_check_lval %a mut=%s deref=%s infer=%s"
Ast
.
sprintf_lval
lval
(
if
mut
=
Ast
.
MUT_mutable
then
"mutable"
else
"immutable"
)
(
if
deref
then
"true"
else
"false"
)
(
match
infer
with
None
->
"<none>"
|
Some
t
->
Fmt
.
fmt_to_str
Ast
.
fmt_ty
t
)
let
_
=
iflog
cx
(
fun
_
->
log
cx
"generic_check_lval %a mut=%s deref=%s infer=%s"
Ast
.
sprintf_lval
lval
(
if
mut
=
Ast
.
MUT_mutable
then
"mutable"
else
"immutable"
)
(
if
deref
then
"true"
else
"false"
)
(
match
infer
with
None
->
"<none>"
|
Some
t
->
Fmt
.
fmt_to_str
Ast
.
fmt_ty
t
))
in
let
(
lval_ty
,
n_boxes
)
=
internal_check_outer_lval
~
mut
:
mut
~
deref
:
deref
infer
lval
in
let
_
=
log
cx
"checked lval %a with type %a"
Ast
.
sprintf_lval
lval
Ast
.
sprintf_ty
lval_ty
let
_
=
iflog
cx
(
fun
_
->
log
cx
"checked lval %a with type %a"
Ast
.
sprintf_lval
lval
Ast
.
sprintf_ty
lval_ty
)
in
if
Hashtbl
.
mem
cx
.
Semant
.
ctxt_all_lval_types
lval_id
then
...
...
@@ -887,7 +907,7 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
(* Verify that, if main is present, it has the right form. *)
let
verify_main
(
item_id
:
Common
.
node_id
)
:
unit
=
let
path_name
=
Semant
.
string_of_name
(
Semant
.
path_to_name
path
)
in
let
path_name
=
Hashtbl
.
find
cx
.
Semant
.
ctxt_all_item_names
item_id
in
if
cx
.
Semant
.
ctxt_main_name
=
Some
path_name
then
try
match
Hashtbl
.
find
cx
.
Semant
.
ctxt_all_item_types
item_id
with
...
...
@@ -972,11 +992,19 @@ let process_crate (cx:Semant.ctxt) (crate:Ast.crate) : unit =
* return void *)
let
visit_stmt_pre
(
stmt
:
Ast
.
stmt
)
:
unit
=
try
log
cx
""
;
log
cx
"typechecking stmt: %a"
Ast
.
sprintf_stmt
stmt
;
log
cx
""
;
iflog
cx
begin
fun
_
->
log
cx
""
;
log
cx
"typechecking stmt: %a"
Ast
.
sprintf_stmt
stmt
;
log
cx
""
;
end
;
check_stmt
cx
(
Stack
.
top
fn_ctx_stack
)
stmt
;
log
cx
"finished typechecking stmt: %a"
Ast
.
sprintf_stmt
stmt
;
iflog
cx
begin
fun
_
->
log
cx
"finished typechecking stmt: %a"
Ast
.
sprintf_stmt
stmt
;
end
;
with
Common
.
Semant_err
(
None
,
msg
)
->
raise
(
Common
.
Semant_err
((
Some
stmt
.
Common
.
id
)
,
msg
))
in
...
...
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录