Skip to content

Commit dd85f4f

Browse files
spiessimonspiessimon
committed
review
1 parent c73e03b commit dd85f4f

File tree

3 files changed

+47
-43
lines changed

3 files changed

+47
-43
lines changed

‎backend/asm_targets/asm_directives_new.ml

Lines changed: 41 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -86,38 +86,41 @@ module Directive = struct
8686
| Add of t * t
8787
| Sub of t * t
8888

89-
(* The [force_digits] option is for supporting .sleb128 directives. See the
89+
(* The [force_decimal] option is for supporting .sleb128 directives. See the
9090
comment in [print] below. *)
91-
let rec print ~force_digits buf t =
91+
let rec print_aux ~force_decimal buf t =
9292
match t with
9393
| (Named_thing _ | Signed_int _ | Unsigned_int _ | This) as c ->
94-
print_subterm ~force_digits buf c
94+
print_aux_subterm ~force_decimal buf c
9595
| Add (c1, c2) ->
9696
bprintf buf "%a + %a"
97-
(print_subterm ~force_digits)
97+
(print_aux_subterm ~force_decimal)
9898
c1
99-
(print_subterm ~force_digits)
99+
(print_aux_subterm ~force_decimal)
100100
c2
101101
| Sub (c1, c2) ->
102102
bprintf buf "%a - %a"
103-
(print_subterm ~force_digits)
103+
(print_aux_subterm ~force_decimal)
104104
c1
105-
(print_subterm ~force_digits)
105+
(print_aux_subterm ~force_decimal)
106106
c2
107107

108-
and print_subterm ~force_digits buf t =
108+
and print_aux_subterm ~force_decimal buf t =
109109
match t with
110110
| This -> (
111111
match TS.assembler () with
112112
| MacOS | GAS_like -> Buffer.add_string buf "."
113113
| MASM -> Buffer.add_string buf "THIS BYTE")
114114
| Named_thing name -> Buffer.add_string buf name
115115
| Signed_int n -> (
116-
match TS.assembler (), force_digits with
116+
match TS.assembler (), force_decimal with
117117
| _, true -> Buffer.add_string buf (Int64.to_string n)
118118
| MASM, _ ->
119119
if Int64.compare n 0x7FFF_FFFFL <= 0
120120
&& Int64.compare n (-0x8000_0000L) >= 0
121+
(* This constant was changed from 0x8000_0000L (in the original
122+
code for these directives) to -0x8000_0000L, matching what we do
123+
for GAS below. See #3948. *)
121124
then Buffer.add_string buf (Int64.to_string n)
122125
else bprintf buf "0%LxH" n
123126
| _, false ->
@@ -128,19 +131,23 @@ module Directive = struct
128131
| Unsigned_int n ->
129132
(* We can use the printer for [Signed_int] since we always print as an
130133
unsigned hex representation. *)
131-
print_subterm ~force_digits buf (Signed_int (Uint64.to_int64 n))
134+
print_aux_subterm ~force_decimal buf (Signed_int (Uint64.to_int64 n))
132135
| Add (c1, c2) ->
133136
bprintf buf "(%a + %a)"
134-
(print_subterm ~force_digits)
137+
(print_aux_subterm ~force_decimal)
135138
c1
136-
(print_subterm ~force_digits)
139+
(print_aux_subterm ~force_decimal)
137140
c2
138141
| Sub (c1, c2) ->
139142
bprintf buf "(%a - %a)"
140-
(print_subterm ~force_digits)
143+
(print_aux_subterm ~force_decimal)
141144
c1
142-
(print_subterm ~force_digits)
145+
(print_aux_subterm ~force_decimal)
143146
c2
147+
148+
let print = print_aux ~force_decimal:false
149+
150+
let print_using_decimals = print_aux ~force_decimal:true
144151
end
145152

146153
module Constant_with_width = struct
@@ -251,6 +258,14 @@ module Directive = struct
251258
let between x low high =
252259
Char.compare x low >= 0 && Char.compare x high <= 0
253260
in
261+
if k + n > String.length s
262+
then
263+
Misc.fatal_errorf
264+
"Attempting to extract a substring that is too long: range %d..<%d \
265+
goes beyond the string %S of length %d."
266+
k (k + n) s (String.length s);
267+
if n < 0 || k < 0
268+
then Misc.fatal_errorf "Negative substring length %d or start index %d" n k;
254269
let b = Buffer.create (n + 2) in
255270
let last_was_escape = ref false in
256271
for i = k to k + n - 1 do
@@ -349,19 +364,18 @@ module Directive = struct
349364
| Sixty_four -> "8byte"
350365
in
351366
let comment = gas_comment_opt comment in
352-
bprintf buf "\t.%s\t%a%s" directive
353-
(Constant.print ~force_digits:false)
367+
bprintf buf "\t.%s\t%a%s" directive Constant.print
354368
(Constant_with_width.constant constant)
355369
comment
356370
| Bytes { str; comment } ->
357371
(match TS.system (), TS.architecture () with
358372
| Solaris, _ | _, POWER ->
359373
buf_bytes_directive buf ~directive:".byte" str
360-
(* Very long lines can cause gas to be extremely slow so split up large
374+
(* Very long lines can cause gas to be extremely slow, so split up large
361375
string literals. It turns out that gas reads files in 32kb chunks so
362376
splitting the string into blocks of 25k characters should be close to
363377
the sweet spot even with a lot of escapes. *)
364-
| _, X86_64 -> print_ascii_string_gas ~chunk_size:25000 buf str
378+
| _, X86_64 -> print_ascii_string_gas ~chunk_size:25_000 buf str
365379
| _, AArch64 -> print_ascii_string_gas ~chunk_size:80 buf str
366380
| _, _ -> print_ascii_string_gas ~chunk_size:80 buf str);
367381
bprintf buf "%s" (gas_comment_opt comment)
@@ -412,16 +426,15 @@ module Directive = struct
412426
print_discriminator discriminator
413427
| Private_extern s -> bprintf buf "\t.private_extern %s" s
414428
| Size (s, c) ->
415-
bprintf buf "\t.size %s,%a" s (Constant.print ~force_digits:false) c
429+
bprintf buf "\t.size %s,%a" s Constant.print c
416430
(* We use %Ld and not %Lx on Unix-like platforms to ensure that ".sleb128"
417431
directives do not end up with hex arguments (since this denotes a
418432
variable-length encoding it would not be clear where the sign bit
419433
is). *)
420434
| Sleb128 { constant; comment } ->
421435
let comment = gas_comment_opt comment in
422-
bprintf buf "\t.sleb128\t%a%s"
423-
(Constant.print ~force_digits:true)
424-
constant comment
436+
bprintf buf "\t.sleb128\t%a%s" Constant.print_using_decimals constant
437+
comment
425438
| Type (s, typ) ->
426439
let typ = symbol_type_to_string typ in
427440
(* CR sspies: Technically, ",STT_OBJECT" violates the assembler syntax
@@ -431,15 +444,11 @@ module Directive = struct
431444
bprintf buf "\t.type %s,%s" s typ
432445
| Uleb128 { constant; comment } ->
433446
let comment = gas_comment_opt comment in
434-
bprintf buf "\t.uleb128\t%a%s"
435-
(Constant.print ~force_digits:true)
436-
constant comment
447+
bprintf buf "\t.uleb128\t%a%s" Constant.print_using_decimals constant
448+
comment
437449
| Direct_assignment (var, const) -> (
438450
match TS.assembler () with
439-
| MacOS ->
440-
bprintf buf "\t.set %s, %a" var
441-
(Constant.print ~force_digits:false)
442-
const
451+
| MacOS -> bprintf buf "\t.set %s, %a" var Constant.print const
443452
| _ ->
444453
Misc.fatal_error
445454
"Cannot emit [Direct_assignment] except on macOS-like assemblers")
@@ -449,12 +458,9 @@ module Directive = struct
449458
(* masm only *)
450459
| External _ -> assert false
451460
| Reloc { offset; name; expr } ->
452-
bprintf buf "\t.reloc\t%a, %s, %a"
453-
(Constant.print ~force_digits:false)
454-
offset
461+
bprintf buf "\t.reloc\t%a, %s, %a" Constant.print offset
455462
(reloc_type_to_string name)
456-
(Constant.print ~force_digits:false)
457-
expr
463+
Constant.print expr
458464

459465
let print_masm buf t =
460466
let unsupported name =
@@ -486,8 +492,7 @@ module Directive = struct
486492
| Sixty_four -> "QWORD"
487493
in
488494
let comment = masm_comment_opt comment in
489-
bprintf buf "\t%s\t%a%s" directive
490-
(Constant.print ~force_digits:false)
495+
bprintf buf "\t%s\t%a%s" directive Constant.print
491496
(Constant_with_width.constant constant)
492497
comment
493498
| Global s -> bprintf buf "\tPUBLIC\t%s" s

‎backend/x86_binary_emitter.ml

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1645,7 +1645,7 @@ let assemble_instr b loc = function
16451645
| SIMD (instr, args) -> emit_simd b instr args
16461646

16471647

1648-
let constant b cst (width: D.Constant_with_width.width_in_bytes) =
1648+
let[@warning "+4"] constant b cst (width: D.Constant_with_width.width_in_bytes) =
16491649
let open D.Constant_with_width in
16501650
match cst, width with
16511651
| C.Signed_int n, Eight -> buf_int8L b n
@@ -1656,16 +1656,16 @@ let constant b cst (width: D.Constant_with_width.width_in_bytes) =
16561656
| C.Unsigned_int n, Sixteen -> buf_int16L b (Numbers.Uint64.to_int64 n)
16571657
| C.Unsigned_int n, Thirty_two -> buf_int32L b (Numbers.Uint64.to_int64 n)
16581658
| C.Unsigned_int n, Sixty_four -> buf_int64L b (Numbers.Uint64.to_int64 n)
1659-
| _, Eight ->
1659+
| (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Eight ->
16601660
record_local_reloc b (RelocConstant (cst, B8));
16611661
buf_int8L b 0L
1662-
| _, Sixteen ->
1662+
| (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Sixteen ->
16631663
record_local_reloc b (RelocConstant (cst, B16));
16641664
buf_int16L b 0L
1665-
| _, Thirty_two ->
1665+
| (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Thirty_two ->
16661666
record_local_reloc b (RelocConstant (cst, B32));
16671667
buf_int32L b 0L
1668-
| _, Sixty_four ->
1668+
| (C.This | C.Named_thing _ | C.Add _ | C.Sub _), Sixty_four ->
16691669
record_local_reloc b (RelocConstant (cst, B64));
16701670
buf_int64L b 0L
16711671

@@ -1742,7 +1742,6 @@ let assemble_line b loc ins =
17421742
buf_int8 b 0
17431743
done
17441744
| Directive (D.Hidden _) | Directive D.New_line -> ()
1745-
(* CR sspies: This requires some testing. *)
17461745
| Directive (D.Reloc { name = D.R_X86_64_PLT32;
17471746
expr = C.Sub (C.Named_thing wrap_label, C.Signed_int 4L);
17481747
offset = C.Sub (C.This, C.Signed_int 4L);

‎backend/x86_gas.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -238,7 +238,7 @@ let print_instr b = function
238238
instr.mnemonic (Array.length args))
239239

240240
let print_line b i =
241-
match[@warning "-4"] i with
241+
match i with
242242
| Ins i -> print_instr b i
243243
| Directive d -> Asm_targets.Asm_directives_new.Directive.print b d
244244

0 commit comments

Comments
 (0)