Added built-in labels parametrization

This commit is contained in:
Roman Venediktov 2024-02-15 10:49:20 +01:00
parent de2c516935
commit c4ffeb2fbf
2 changed files with 11 additions and 10 deletions

View file

@ -15,6 +15,7 @@ type scope = {
[@@deriving gt ~options:{ show }] [@@deriving gt ~options:{ show }]
let label s = "L" ^ s let label s = "L" ^ s
let builtin_label s = "B" ^ s
let scope_label i s = label s ^ "_" ^ string_of_int i let scope_label i s = label s ^ "_" ^ string_of_int i
let show_scope = show scope let show_scope = show scope

View file

@ -388,12 +388,12 @@ let safepoint_functions =
label "s__Infix_58"; label "s__Infix_58";
label "substring"; label "substring";
label "clone"; label "clone";
"Bstring"; builtin_label "string";
label "stringcat"; label "stringcat";
label "string"; label "string";
"Bclosure"; builtin_label "closure";
"Barray"; builtin_label "array";
"Bsexp"; builtin_label "sexp";
label "i__Infix_4343" label "i__Infix_4343"
(* "makeArray"; not required as do not have ptr arguments *) (* "makeArray"; not required as do not have ptr arguments *)
(* "makeString"; 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 Option.map
(fun fname -> (fun fname ->
match fname.[0] with 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)
fname fname
in in
@ -530,11 +530,11 @@ let compile_call env ?fname nargs tail =
setup_args_code @ [ Lea (I (word_size, rsp), rdi) ] setup_args_code @ [ Lea (I (word_size, rsp), rdi) ]
in in
let setup_args_code = let setup_args_code =
match fname with if fname = builtin_label "closure" then
| "Barray" | "Bsexp" -> setup_args_code @ [ Mov (L (box (nargs - 2)), rsi) ]
setup_args_code @ [ Mov (L (box (nargs - 1)), rsi) ] else if fname = builtin_label "sexp" || fname = builtin_label "array"
| "Bclosure" -> setup_args_code @ [ Mov (L (box (nargs - 2)), rsi) ] then setup_args_code @ [ Mov (L (box (nargs - 1)), rsi) ]
| _ -> setup_args_code else setup_args_code
in in
(nargs, env, setup_args_code) (nargs, env, setup_args_code)
in in