Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Code cleanups in asmcomp/s390x #908

Merged
merged 3 commits into from Dec 30, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
3 changes: 3 additions & 0 deletions Changes
Expand Up @@ -185,6 +185,9 @@ Next version (4.05.0):
include(struct ... end : sig ... end)
(Alain Frisch, report by Hongbo Zhang, review by Jacques Garrigue)

- GPR#908: refactor PIC-handling in the s390x backend
(Gabriel Scherer)

### Bug fixes

- PR#7216, GPR#949: don't require double parens in Functor((val x))
Expand Down
86 changes: 43 additions & 43 deletions asmcomp/s390x/emit.mlp
Expand Up @@ -53,10 +53,10 @@ let emit_symbol s = Emitaux.emit_symbol '.' s
(* Output function call *)

let emit_call s =
if !pic_code then
`brasl %r14, {emit_symbol s}@PLT`
else
`brasl %r14, {emit_symbol s}`
if !pic_code then
` brasl %r14, {emit_symbol s}@PLT\n`
else
` brasl %r14, {emit_symbol s}\n`

(* Output a label *)

Expand All @@ -83,7 +83,13 @@ let emit_reg r =

(* Special registers *)

let reg_f15 = phys_reg 115
let check_phys_reg reg_idx name =
let reg = phys_reg reg_idx in
assert (register_name reg_idx = name);
reg

let reg_f15 = check_phys_reg 115 "%f15"
let reg_r7 = check_phys_reg 5 "%r7"

(* Output a stack reference *)

Expand All @@ -94,6 +100,14 @@ let emit_stack r =
| _ -> fatal_error "Emit.emit_stack"


(* Output a load of the address of a global symbol *)

let emit_load_symbol_addr reg s =
if !pic_code then
` lgrl {emit_reg reg}, {emit_symbol s}@GOTENT\n`
else
` larl {emit_reg reg}, {emit_symbol s}\n`

(* Output a load or store operation *)

let emit_load_store instr addressing_mode addr n arg =
Expand Down Expand Up @@ -148,7 +162,7 @@ let emit_set_comp cmp res =

(* Record live pointers at call points *)

let record_frame ?label live raise_ dbg =
let record_frame_label ?label live raise_ dbg =
let lbl =
match label with
| None -> new_label()
Expand All @@ -169,6 +183,10 @@ let record_frame ?label live raise_ dbg =
~live_offset:!live_offset ~raise_frame:raise_ dbg;
lbl

let record_frame ?label live raise_ dbg =
let lbl = record_frame_label ?label live raise_ dbg in
`{emit_label lbl}:`

(* Record calls to caml_call_gc, emitted out of line. *)

type gc_call =
Expand All @@ -179,7 +197,7 @@ type gc_call =
let call_gc_sites = ref ([] : gc_call list)

let emit_call_gc gc =
`{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`;
`{emit_label gc.gc_lbl}:`; emit_call "caml_call_gc";
`{emit_label gc.gc_frame_lbl}: brcl 15, {emit_label gc.gc_return_lbl}\n`

(* Record calls to caml_ml_array_bound_error, emitted out of line. *)
Expand All @@ -194,7 +212,7 @@ let bound_error_call = ref 0
let bound_error_label ?label dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
let lbl_frame = record_frame ?label Reg.Set.empty false dbg in
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
bound_error_sites :=
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
lbl_bound_error
Expand All @@ -204,13 +222,14 @@ let bound_error_label ?label dbg =
end

let emit_call_bound_error bd =
`{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`;
`{emit_label bd.bd_lbl}:`; emit_call "caml_ml_array_bound_error";
`{emit_label bd.bd_frame}:\n`

let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
`{emit_label !bound_error_call}: {emit_call "caml_ml_array_bound_error"}\n`
if !bound_error_call > 0 then begin
`{emit_label !bound_error_call}:`; emit_call "caml_ml_array_bound_error";
end

(* Record floating-point and large integer literals *)

Expand Down Expand Up @@ -315,22 +334,14 @@ let emit_instr i =
` larl %r1, {emit_label lbl}\n`;
` ld {emit_reg i.res.(0)}, 0(%r1)\n`
| Lop(Iconst_symbol s) ->
if !pic_code then
` lgrl {emit_reg i.res.(0)}, {emit_symbol s}@GOTENT\n`
else
` larl {emit_reg i.res.(0)}, {emit_symbol s}\n`;
emit_load_symbol_addr i.res.(0) s
| Lop(Icall_ind { label_after; }) ->
` basr %r14, {emit_reg i.arg.(0)}\n`;
let lbl = record_frame i.live false i.dbg ~label:label_after in
`{emit_label lbl}:\n`
`{record_frame i.live false i.dbg ~label:label_after}\n`

| Lop(Icall_imm { func; label_after; }) ->
if !pic_code then
` brasl %r14, {emit_symbol func}@PLT\n`
else
` brasl %r14, {emit_symbol func}\n`;
let lbl = record_frame i.live false i.dbg ~label:label_after in
`{emit_label lbl}:\n`;
emit_call func;
`{record_frame i.live false i.dbg ~label:label_after}\n`
| Lop(Itailcall_ind { label_after = _; }) ->
let n = frame_size() in
if !contains_calls then
Expand All @@ -352,22 +363,12 @@ let emit_instr i =
end

| Lop(Iextcall { func; alloc; label_after; }) ->
if alloc then begin
if !pic_code then begin
` lgrl %r7, {emit_symbol func}@GOTENT\n`;
` brasl %r14, {emit_symbol "caml_c_call"}@PLT\n`
end else begin
` larl %r7, {emit_symbol func}\n`;
` brasl %r14, {emit_symbol "caml_c_call"}\n`
end;
let lbl = record_frame i.live false i.dbg ~label:label_after in
`{emit_label lbl}:\n`;
end else begin
if !pic_code then
` brasl %r14, {emit_symbol func}@PLT\n`
else
` brasl %r14, {emit_symbol func}\n`
end
if not alloc then emit_call func
else begin
emit_load_symbol_addr reg_r7 func;
emit_call "caml_c_call";
`{record_frame i.live false i.dbg ~label:label_after}\n`
end

| Lop(Istackoffset n) ->
emit_stack_adjust n;
Expand Down Expand Up @@ -407,7 +408,7 @@ let emit_instr i =
let lbl_redo = new_label() in
let lbl_call_gc = new_label() in
let lbl_frame =
record_frame i.live false i.dbg ?label:label_after_call_gc
record_frame_label i.live false i.dbg ?label:label_after_call_gc
in
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
Expand Down Expand Up @@ -607,9 +608,8 @@ let emit_instr i =
| Lraise k ->
begin match k with
| Cmm.Raise_withtrace ->
` {emit_call "caml_raise_exn"}\n`;
let lbl = record_frame Reg.Set.empty true i.dbg in
`{emit_label lbl}:\n`
emit_call "caml_raise_exn";
`{record_frame Reg.Set.empty true i.dbg}\n`
| Cmm.Raise_notrace ->
` lg %r1, 0(%r13)\n`;
` lgr %r15, %r13\n`;
Expand Down