~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to asmcomp/amd64/emit_nt.mlp

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
10
10
(*                                                                     *)
11
11
(***********************************************************************)
12
12
 
13
 
(* $Id: emit_nt.mlp 8768 2008-01-11 16:13:18Z doligez $ *)
 
13
(* $Id: emit_nt.mlp 10460 2010-05-24 15:26:23Z xleroy $ *)
14
14
 
15
15
(* Emission of x86-64 (AMD 64) assembly code, MASM syntax *)
16
16
 
39
39
 
40
40
let frame_size () =                     (* includes return address *)
41
41
  if frame_required() then begin
42
 
    let sz = 
 
42
    let sz =
43
43
      (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8)
44
44
    in Misc.align sz 16
45
 
  end else 
 
45
  end else
46
46
    !stack_offset + 8
47
47
 
48
48
let slot_offset loc cl =
63
63
let emit_symbol s =
64
64
  Emitaux.emit_symbol '$' s
65
65
 
66
 
(* Record symbols used and defined - at the end generate extern for those 
 
66
(* Record symbols used and defined - at the end generate extern for those
67
67
   used but not defined *)
68
68
 
69
69
let symbols_defined = ref StringSet.empty
84
84
 
85
85
let emit_align n =
86
86
  `     ALIGN   {emit_int n}\n`
87
 
  
 
87
 
88
88
let emit_Llabel fallthrough lbl =
89
89
  if not fallthrough && !fastcode_flag then emit_align 4;
90
90
  emit_label lbl
91
 
  
 
91
 
92
92
(* Output a pseudo-register *)
93
93
 
94
94
let emit_reg = function
106
106
(* Output a reference to the lower 8, 16 or 32 bits of a register *)
107
107
 
108
108
let reg_low_8_name =
109
 
  [| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b"; 
 
109
  [| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
110
110
     "r10b"; "r11b"; "bpl"; "r12b"; "r13b" |]
111
111
let reg_low_16_name =
112
 
  [| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w"; 
 
112
  [| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
113
113
     "r10w"; "r11w"; "bp"; "r12w"; "r13w" |]
114
114
let reg_low_32_name =
115
 
  [| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d"; 
 
115
  [| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
116
116
     "r10d"; "r11d"; "ebp"; "r12d"; "r13d" |]
117
117
 
118
118
let emit_subreg tbl pref r =
253
253
  | Iunsigned Ceq -> "e"   | Iunsigned Cne -> "ne"
254
254
  | Iunsigned Cle -> "be"  | Iunsigned Cgt -> "a"
255
255
  | Iunsigned Clt -> "b"  | Iunsigned Cge -> "ae"
256
 
    
 
256
 
257
257
(* Output an = 0 or <> 0 test. *)
258
258
 
259
259
let output_test_zero arg =
264
264
(* Output a floating-point compare and branch *)
265
265
 
266
266
let emit_float_test cmp neg arg lbl =
267
 
  begin match cmp with
268
 
  | Ceq | Cne -> `      ucomisd `
269
 
  | _         -> `      comisd  `
270
 
  end;
271
 
  `{emit_reg arg.(0)}, {emit_reg arg.(1)}\n`;
272
 
  let (branch_opcode, need_jp) =
273
 
    match (cmp, neg) with
274
 
      (Ceq, false) -> ("je", true)
275
 
    | (Ceq, true)  -> ("jne", true)
276
 
    | (Cne, false) -> ("jne", true)
277
 
    | (Cne, true)  -> ("je", true)
278
 
    | (Clt, false) -> ("jb", true)
279
 
    | (Clt, true)  -> ("jae", true)
280
 
    | (Cle, false) -> ("jbe", true)
281
 
    | (Cle, true)  -> ("ja", true)
282
 
    | (Cgt, false) -> ("ja", false)
283
 
    | (Cgt, true)  -> ("jbe", false)
284
 
    | (Cge, false) -> ("jae", true)
285
 
    | (Cge, true)  -> ("jb", false) in
286
 
  let branch_if_not_comparable =
287
 
    if cmp = Cne then not neg else neg in
288
 
  if need_jp then
289
 
    if branch_if_not_comparable then begin
290
 
      ` jp      {emit_label lbl}\n`;
291
 
      ` {emit_string branch_opcode}     {emit_label lbl}\n`
292
 
    end else begin
 
267
  (* Effect of comisd on flags and conditional branches:
 
268
                     ZF PF CF  cond. branches taken
 
269
        unordered     1  1  1  je, jb, jbe, jp
 
270
        >             0  0  0  jne, jae, ja
 
271
        <             0  0  1  jne, jbe, jb
 
272
        =             1  0  0  je, jae, jbe.
 
273
     If FP traps are on (they are off by default),
 
274
     comisd traps on QNaN and SNaN but ucomisd traps on SNaN only.
 
275
  *)
 
276
  match (cmp, neg) with
 
277
  | (Ceq, false) | (Cne, true) ->
293
278
      let next = new_label() in
294
 
      ` jp      {emit_label next}\n`;
295
 
      ` {emit_string branch_opcode}     {emit_label lbl}\n`;
 
279
      ` ucomisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`;
 
280
      ` jp      {emit_label next}\n`;    (* skip if unordered *)
 
281
      ` je      {emit_label lbl}\n`;     (* branch taken if x=y *)
296
282
      `{emit_label next}:\n`
297
 
    end
298
 
  else begin
299
 
    `   {emit_string branch_opcode}     {emit_label lbl}\n`
300
 
  end
 
283
  | (Cne, false) | (Ceq, true) ->
 
284
      ` ucomisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`;
 
285
      ` jp      {emit_label lbl}\n`;     (* branch taken if unordered *)
 
286
      ` jne     {emit_label lbl}\n`      (* branch taken if x<y or x>y *)
 
287
  | (Clt, _) ->
 
288
      ` comisd  {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`;  (* swap compare *)
 
289
      if not neg then
 
290
      ` ja      {emit_label lbl}\n`     (* branch taken if y>x i.e. x<y *)
 
291
      else
 
292
      ` jbe     {emit_label lbl}\n` (* taken if unordered or y<=x i.e. !(x<y) *)
 
293
  | (Cle, _) ->
 
294
      ` comisd  {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`;  (* swap compare *)
 
295
      if not neg then
 
296
      ` jae     {emit_label lbl}\n`     (* branch taken if y>=x i.e. x<=y *)
 
297
      else
 
298
      ` jb      {emit_label lbl}\n` (* taken if unordered or y<x i.e. !(x<=y) *)
 
299
  | (Cgt, _) ->
 
300
      ` comisd  {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`;
 
301
      if not neg then
 
302
      ` ja      {emit_label lbl}\n`     (* branch taken if x>y *)
 
303
      else
 
304
      ` jbe     {emit_label lbl}\n` (* taken if unordered or x<=y i.e. !(x>y) *)
 
305
  | (Cge, _) ->
 
306
      ` comisd  {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`;  (* swap compare *)
 
307
      if not neg then
 
308
      ` jae     {emit_label lbl}\n`     (* branch taken if x>=y *)
 
309
      else
 
310
      ` jb      {emit_label lbl}\n` (* taken if unordered or x<y i.e. !(x>=y) *)
301
311
 
302
312
(* Deallocate the stack frame before a return or tail call *)
303
313
 
544
554
            `   cmp     {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
545
555
            let b = name_for_cond_branch cmp in
546
556
            `   j{emit_string b}        {emit_label lbl}\n`
547
 
        | Iinttest_imm((Isigned Ceq | Isigned Cne | 
 
557
        | Iinttest_imm((Isigned Ceq | Isigned Cne |
548
558
                        Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
549
559
            output_test_zero i.arg.(0);
550
560
            let b = name_for_cond_branch cmp in