mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 14:58:50 +00:00
Return stabs for linux
This commit is contained in:
Roman Venediktov
parent
0fa417ca9b
commit
ba5c35b6d5
1 changed files with 97 additions and 30 deletions
119
src/X86_64.ml
119
src/X86_64.ml
|
|
@ -210,11 +210,11 @@ type instr =
|
||||||
| Sar1 of opnd
|
| Sar1 of opnd
|
||||||
| Repmovsl
|
| Repmovsl
|
||||||
|
|
||||||
(* Instruction printer *)
|
|
||||||
let show instr =
|
|
||||||
let stack_offset i =
|
let stack_offset i =
|
||||||
if i >= 0 then (i + 1) * word_size else (-i + 1) * word_size
|
if i >= 0 then (i + 1) * word_size else (-i + 1) * word_size
|
||||||
in
|
|
||||||
|
(* Instruction printer *)
|
||||||
|
let show instr =
|
||||||
let rec opnd = function
|
let rec opnd = function
|
||||||
| R r -> Register.show r
|
| R r -> Register.show r
|
||||||
| S i ->
|
| S i ->
|
||||||
|
|
@ -724,7 +724,7 @@ let compile cmd env imports code =
|
||||||
let x, env = env#pop in
|
let x, env = env#pop in
|
||||||
( env#set_stack l,
|
( env#set_stack l,
|
||||||
[ Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l) ] )
|
[ Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l) ] )
|
||||||
| BEGIN (f, nargs, nlocals, closure, _args, _scopes) ->
|
| BEGIN (f, nargs, nlocals, closure, _args, scopes) ->
|
||||||
let _ =
|
let _ =
|
||||||
let is_safepoint = List.mem f safepoint_functions in
|
let is_safepoint = List.mem f safepoint_functions in
|
||||||
let is_vararg =
|
let is_vararg =
|
||||||
|
|
@ -736,11 +736,64 @@ let compile cmd env imports code =
|
||||||
(Printf.sprintf
|
(Printf.sprintf
|
||||||
"Function name %s is reserved for built-in" f))
|
"Function name %s is reserved for built-in" f))
|
||||||
in
|
in
|
||||||
|
let rec stabs_scope scope =
|
||||||
|
let names =
|
||||||
|
List.map
|
||||||
|
(fun (name, index) ->
|
||||||
|
Meta
|
||||||
|
(Printf.sprintf "\t.stabs \"%s:1\",128,0,0,-%d" name
|
||||||
|
(stack_offset index)))
|
||||||
|
scope.names
|
||||||
|
in
|
||||||
|
let sub_stabs =
|
||||||
|
List.flatten @@ List.map stabs_scope scope.subs
|
||||||
|
in
|
||||||
|
if names = [] then sub_stabs
|
||||||
|
else
|
||||||
|
names
|
||||||
|
@ [
|
||||||
|
Meta
|
||||||
|
(Printf.sprintf "\t.stabn 192,0,0,%s-%s" scope.blab f);
|
||||||
|
]
|
||||||
|
@ sub_stabs
|
||||||
|
@ [
|
||||||
|
Meta
|
||||||
|
(Printf.sprintf "\t.stabn 224,0,0,%s-%s" scope.elab f);
|
||||||
|
]
|
||||||
|
in
|
||||||
|
let name =
|
||||||
|
if f.[0] = 'L' then String.sub f 1 (String.length f - 1)
|
||||||
|
else f
|
||||||
|
in
|
||||||
|
let stabs =
|
||||||
|
match os with
|
||||||
|
| Darwin -> []
|
||||||
|
| Linux ->
|
||||||
|
if f = "main" then
|
||||||
|
[ Meta (Printf.sprintf "\t.type main, @function") ]
|
||||||
|
else
|
||||||
|
let func =
|
||||||
|
[
|
||||||
|
Meta (Printf.sprintf "\t.type %s, @function" name);
|
||||||
|
Meta
|
||||||
|
(Printf.sprintf "\t.stabs \"%s:F1\",36,0,0,%s"
|
||||||
|
name f);
|
||||||
|
]
|
||||||
|
in
|
||||||
|
let arguments =
|
||||||
|
[] (* TODO: stabs for function arguments *)
|
||||||
|
in
|
||||||
|
let variables =
|
||||||
|
List.flatten @@ List.map stabs_scope scopes
|
||||||
|
in
|
||||||
|
func @ arguments @ variables
|
||||||
|
in
|
||||||
env#assert_empty_stack;
|
env#assert_empty_stack;
|
||||||
let has_closure = closure <> [] in
|
let has_closure = closure <> [] in
|
||||||
let env = env#enter f nargs nlocals has_closure in
|
let env = env#enter f nargs nlocals has_closure in
|
||||||
( env,
|
( env,
|
||||||
[ Meta "\t.cfi_startproc" ]
|
stabs
|
||||||
|
@ [ Meta "\t.cfi_startproc" ]
|
||||||
@ (if f = cmd#topname then
|
@ (if f = cmd#topname then
|
||||||
[
|
[
|
||||||
Mov (M (D, I, V, "init"), rax);
|
Mov (M (D, I, V, "init"), rax);
|
||||||
|
|
@ -802,6 +855,12 @@ let compile cmd env imports code =
|
||||||
let x, env = env#pop in
|
let x, env = env#pop in
|
||||||
env#assert_empty_stack;
|
env#assert_empty_stack;
|
||||||
let name = env#fname in
|
let name = env#fname in
|
||||||
|
let stabs =
|
||||||
|
match os with
|
||||||
|
| Darwin -> []
|
||||||
|
| Linux ->
|
||||||
|
[ Meta (Printf.sprintf "\t.size %s, .-%s" name name) ]
|
||||||
|
in
|
||||||
( env#leave,
|
( env#leave,
|
||||||
[
|
[
|
||||||
Mov (x, rax);
|
Mov (x, rax);
|
||||||
|
|
@ -827,7 +886,8 @@ let compile cmd env imports code =
|
||||||
(Printf.sprintf "\t.set\t%s,\t%d"
|
(Printf.sprintf "\t.set\t%s,\t%d"
|
||||||
(prefixed env#allocated_size)
|
(prefixed env#allocated_size)
|
||||||
env#allocated);
|
env#allocated);
|
||||||
] )
|
]
|
||||||
|
@ stabs )
|
||||||
| RET ->
|
| RET ->
|
||||||
let x = env#peek in
|
let x = env#peek in
|
||||||
(env, [ Mov (x, rax); Jmp env#epilogue ])
|
(env, [ Mov (x, rax); Jmp env#epilogue ])
|
||||||
|
|
@ -1269,10 +1329,10 @@ let genasm cmd prog =
|
||||||
env#strings
|
env#strings
|
||||||
@ [
|
@ [
|
||||||
Meta (prefixed "init" ^ ":\t.quad 0");
|
Meta (prefixed "init" ^ ":\t.quad 0");
|
||||||
|
Meta
|
||||||
(match os with
|
(match os with
|
||||||
| Darwin ->
|
| Darwin -> "\t.section __DATA, custom_data, regular, no_dead_strip"
|
||||||
Meta "\t.section __DATA, custom_data, regular, no_dead_strip"
|
| Linux -> "\t.section custom_data,\"aw\",@progbits");
|
||||||
| Linux -> Meta "\t.section custom_data,\"aw\",@progbits");
|
|
||||||
Meta
|
Meta
|
||||||
(Printf.sprintf "%s:\t.fill\t%d, 8, 1" (prefixed "filler")
|
(Printf.sprintf "%s:\t.fill\t%d, 8, 1" (prefixed "filler")
|
||||||
env#max_locals_size);
|
env#max_locals_size);
|
||||||
|
|
@ -1280,31 +1340,38 @@ let genasm cmd prog =
|
||||||
@ List.concat
|
@ List.concat
|
||||||
@@ List.map
|
@@ List.map
|
||||||
(fun s ->
|
(fun s ->
|
||||||
|
let unlabled_s =
|
||||||
|
String.sub s
|
||||||
|
(String.length global_label)
|
||||||
|
(String.length s - String.length global_label)
|
||||||
|
in
|
||||||
|
(match os with
|
||||||
|
| Darwin -> []
|
||||||
|
| Linux ->
|
||||||
[
|
[
|
||||||
(* For mach-o STABS format is not supported: Meta
|
Meta
|
||||||
( Printf.sprintf "\t.stabs \"%s:S1\",40,0,0,%s"
|
(Printf.sprintf "\t.stabs \"%s:S1\",40,0,0,%s" unlabled_s s);
|
||||||
(String.sub s (String.length "global_")
|
|
||||||
(String.length s - String.length "global_"))
|
|
||||||
s); *)
|
|
||||||
Meta (Printf.sprintf "%s:\t.quad\t1" (prefixed s));
|
|
||||||
])
|
])
|
||||||
|
@ [ Meta (Printf.sprintf "%s:\t.quad\t1" (prefixed s)) ])
|
||||||
env#globals
|
env#globals
|
||||||
in
|
in
|
||||||
let asm = Buffer.create 1024 in
|
let asm = Buffer.create 1024 in
|
||||||
List.iter
|
List.iter
|
||||||
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
||||||
([
|
([ Meta (Printf.sprintf "\t.file \"%s\"" cmd#get_absolute_infile) ]
|
||||||
Meta (Printf.sprintf "\t.file \"%s\"" cmd#get_absolute_infile);
|
@ (match os with
|
||||||
(* For mach-o STABS format is not supported: Meta
|
| Darwin -> []
|
||||||
|
| Linux ->
|
||||||
|
[
|
||||||
|
Meta
|
||||||
(Printf.sprintf "\t.stabs \"%s\",100,0,0,.Ltext"
|
(Printf.sprintf "\t.stabs \"%s\",100,0,0,.Ltext"
|
||||||
cmd#get_absolute_infile); *)
|
cmd#get_absolute_infile);
|
||||||
]
|
])
|
||||||
@ globals @ data
|
@ globals @ data
|
||||||
@ [
|
@ [ Meta "\t.text"; Label ".Ltext" ]
|
||||||
Meta "\t.text";
|
@ (match os with
|
||||||
Label ".Ltext";
|
| Darwin -> []
|
||||||
(* For mach-o STABS format is not supported: Meta "\t.stabs \"data:t1=r1;0;4294967295;\",128,0,0,0"; *)
|
| Linux -> [ Meta "\t.stabs \"data:t1=r1;0;4294967295;\",128,0,0,0" ])
|
||||||
]
|
|
||||||
@ code);
|
@ code);
|
||||||
Buffer.contents asm
|
Buffer.contents asm
|
||||||
|
|
||||||
|
|
@ -1331,7 +1398,7 @@ let build cmd prog =
|
||||||
in
|
in
|
||||||
cmd#dump_file "s" (genasm cmd prog);
|
cmd#dump_file "s" (genasm cmd prog);
|
||||||
cmd#dump_file "i" (Interface.gen prog);
|
cmd#dump_file "i" (Interface.gen prog);
|
||||||
let compiler = "clang" in
|
let compiler = match os with Darwin -> "clang" | Linux -> "gcc" in
|
||||||
let compiler_flags, linker_flags =
|
let compiler_flags, linker_flags =
|
||||||
match os with Darwin -> ("-arch x86_64", "-ld_classic") | Linux -> ("", "")
|
match os with Darwin -> ("-arch x86_64", "-ld_classic") | Linux -> ("", "")
|
||||||
in
|
in
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue