From c4ffeb2fbf55c7178959405028f307729b9da044 Mon Sep 17 00:00:00 2001
From: Roman Venediktov <e2e4b6b7@gmail.com>
Date: Thu, 15 Feb 2024 10:49:20 +0100
Subject: [PATCH] Added built-in labels parametrization

---
 src/SM.ml  |  1 +
 src/X86.ml | 20 ++++++++++----------
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/SM.ml b/src/SM.ml
index f42ee33b8..67a26b0c0 100644
--- a/src/SM.ml
+++ b/src/SM.ml
@@ -15,6 +15,7 @@ type scope = {
 [@@deriving gt ~options:{ show }]
 
 let label s = "L" ^ s
+let builtin_label s = "B" ^ s
 let scope_label i s = label s ^ "_" ^ string_of_int i
 let show_scope = show scope
 
diff --git a/src/X86.ml b/src/X86.ml
index 1f893d905..bae0f250c 100644
--- a/src/X86.ml
+++ b/src/X86.ml
@@ -388,12 +388,12 @@ let safepoint_functions =
     label "s__Infix_58";
     label "substring";
     label "clone";
-    "Bstring";
+    builtin_label "string";
     label "stringcat";
     label "string";
-    "Bclosure";
-    "Barray";
-    "Bsexp";
+    builtin_label "closure";
+    builtin_label "array";
+    builtin_label "sexp";
     label "i__Infix_4343"
     (* "makeArray"; not required as do not have ptr arguments *)
     (* "makeString"; not required as do not have ptr arguments *)
@@ -415,7 +415,7 @@ let compile_call env ?fname nargs tail =
     Option.map
       (fun fname ->
         match fname.[0] with
-        | '.' -> "B" ^ String.sub fname 1 (String.length fname - 1)
+        | '.' -> builtin_label (String.sub fname 1 (String.length fname - 1))
         | _ -> fname)
       fname
   in
@@ -530,11 +530,11 @@ let compile_call env ?fname nargs tail =
         setup_args_code @ [ Lea (I (word_size, rsp), rdi) ]
       in
       let setup_args_code =
-        match fname with
-        | "Barray" | "Bsexp" ->
-            setup_args_code @ [ Mov (L (box (nargs - 1)), rsi) ]
-        | "Bclosure" -> setup_args_code @ [ Mov (L (box (nargs - 2)), rsi) ]
-        | _ -> setup_args_code
+        if fname = builtin_label "closure" then
+          setup_args_code @ [ Mov (L (box (nargs - 2)), rsi) ]
+        else if fname = builtin_label "sexp" || fname = builtin_label "array"
+        then setup_args_code @ [ Mov (L (box (nargs - 1)), rsi) ]
+        else setup_args_code
       in
       (nargs, env, setup_args_code)
     in