flambda-backend: Check that stack frames are not too large (#10085) (oxcaml#561)

gretay-js · xavierleroy · web-flow · commit 20fc614bffc3 · 2022-04-14T08:56:35.000+01:00
The frame table uses 16-bit unsigned integers to store the size of a
stack frame as well as the number and offsets of roots.

This commit adds a compile-time error if these 16-bit fields overflow.

Closes: #10072

Co-authored-by: Xavier Leroy &lt;xavierleroy@users.noreply.github.com&gt;
diff --git a/.depend b/.depend
@@ -2149,6 +2149,7 @@ asmcomp/asmgen.cmo : \
     asmcomp/linscan.cmi \
     asmcomp/linearize.cmi \
     file_formats/linear_format.cmi \
+    asmcomp/linear.cmi \
     lambda/lambda.cmi \
     asmcomp/interval.cmi \
     asmcomp/interf.cmi \
@@ -2191,6 +2192,7 @@ asmcomp/asmgen.cmx : \
     asmcomp/linscan.cmx \
     asmcomp/linearize.cmx \
     file_formats/linear_format.cmx \
+    asmcomp/linear.cmx \
     lambda/lambda.cmx \
     asmcomp/interval.cmx \
     asmcomp/interf.cmx \
@@ -2214,6 +2216,7 @@ asmcomp/asmgen.cmx : \
     asmcomp/asmgen.cmi
 asmcomp/asmgen.cmi : \
     lambda/lambda.cmi \
+    asmcomp/emitaux.cmi \
     asmcomp/cmm.cmi \
     middle_end/clambda.cmi \
     middle_end/backend_intf.cmi
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
@@ -26,6 +26,7 @@ open Cmm
 type error =
   | Assembler_error of string
   | Mismatched_for_pack of string option
+  | Asm_generation of string * Emitaux.error
 
 exception Error of error
 
@@ -96,9 +97,13 @@ let if_emit_do f x = if should_emit () then f x else ()
 let emit_begin_assembly = if_emit_do Emit.begin_assembly
 let emit_end_assembly = if_emit_do Emit.end_assembly
 let emit_data = if_emit_do Emit.data
-let emit_fundecl =
-  if_emit_do
-    (Profile.record ~accumulate:true "emit" Emit.fundecl)
+let emit_fundecl fd =
+  if should_emit() then begin
+    try
+      Profile.record ~accumulate:true "emit" Emit.fundecl fd
+    with Emitaux.Error e ->
+      raise (Error (Asm_generation(fd.Linear.fun_name, e)))
+  end
 
 let rec regalloc ~ppf_dump round fd =
   if round > 50 then
@@ -290,6 +295,10 @@ let report_error ppf = function
      fprintf ppf
        "This input file cannot be compiled %s: it was generated %s."
        (msg !Clflags.for_package) (msg saved)
+  | Asm_generation(fn, err) ->
+     fprintf ppf
+       "Error producing assembly code for function %s: %a"
+       fn Emitaux.report_error err
 
 let () =
   Location.register_error_of_exn
diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli
@@ -44,6 +44,7 @@ val compile_phrase :
 type error =
   | Assembler_error of string
   | Mismatched_for_pack of string option
+  | Asm_generation of string * Emitaux.error
 
 exception Error of error
 val report_error: Format.formatter -> error -> unit
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
@@ -15,6 +15,11 @@
 
 (* Common functions for emitting assembly code *)
 
+type error =
+  | Stack_frame_too_large of int
+
+exception Error of error
+
 let output_channel = ref stdout
 
 let emit_string s = output_string !output_channel s
@@ -178,6 +183,12 @@ let emit_frames a =
       Label_table.add debuginfos key lbl;
       lbl
   in
+  let efa_16_checked n =
+    assert (n >= 0);
+    if n < 0x1_0000
+    then a.efa_16 n
+    else raise (Error(Stack_frame_too_large n))
+  in
   let emit_frame fd =
     assert (fd.fd_frame_size land 3 = 0);
     let flags =
@@ -191,9 +202,9 @@ let emit_frames a =
         then 3 else 2
     in
     a.efa_code_label fd.fd_lbl;
-    a.efa_16 (fd.fd_frame_size + flags);
-    a.efa_16 (List.length fd.fd_live_offset);
-    List.iter a.efa_16 fd.fd_live_offset;
+    efa_16_checked (fd.fd_frame_size + flags);
+    efa_16_checked (List.length fd.fd_live_offset);
+    List.iter efa_16_checked fd.fd_live_offset;
     begin match fd.fd_debuginfo with
     | _ when flags = 0 ->
       ()
@@ -370,3 +381,7 @@ let reset () =
 
 let binary_backend_available = ref false
 let create_asm_file = ref true
+
+let report_error ppf = function
+  | Stack_frame_too_large n ->
+      Format.fprintf ppf "stack frame too large (%d bytes)" n
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
@@ -71,11 +71,16 @@ val cfi_endproc : unit -> unit
 val cfi_adjust_cfa_offset : int -> unit
 val cfi_offset : reg:int -> offset:int -> unit
 
-
 val binary_backend_available: bool ref
     (** Is a binary backend available.  If yes, we don't need
         to generate the textual assembly file (unless the user
         request it with -S). *)
 
 val create_asm_file: bool ref
     (** Are we actually generating the textual assembly file? *)
+
+type error =
+  | Stack_frame_too_large of int
+
+exception Error of error
+val report_error: Format.formatter -> error -> unit
