mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-05 22:38:44 +00:00
Made compiler working on Linux too
This commit is contained in:
Roman Venediktov
parent
468caac0f2
commit
85b838ea2b
10 changed files with 188 additions and 128 deletions
|
|
@ -17,6 +17,7 @@ depends: [
|
|||
"camlp5" { >= "8.00.05" }
|
||||
"ostap" { >= "0.5"}
|
||||
"GT" { >= "0.5.1" }
|
||||
"posix-uname" { = "2.0.2" }
|
||||
]
|
||||
|
||||
build: [
|
||||
|
|
|
|||
|
|
@ -3,6 +3,13 @@ TESTS=$(sort $(filter-out test111, $(basename $(wildcard test*.lama))))
|
|||
|
||||
LAMAC=../src/lamac
|
||||
|
||||
UNAME_S := $(shell uname -s)
|
||||
|
||||
ifeq ($(UNAME_S),Linux)
|
||||
else ifeq ($(UNAME_S),Darwin)
|
||||
ARCH = arch -x86_64
|
||||
endif
|
||||
|
||||
.PHONY: check $(TESTS)
|
||||
|
||||
|
||||
|
|
@ -12,11 +19,11 @@ $(TESTS): %: %.lama
|
|||
@echo "regression/$@"
|
||||
# @cat $@.input | LAMA=../runtime $(LAMAC) -i $< > $@.log && diff $@.log orig/$@.log
|
||||
# @cat $@.input | LAMA=../runtime $(LAMAC) -ds -s $< > $@.log && diff $@.log orig/$@.log
|
||||
@LAMA=../runtime $(LAMAC) $< && cat $@.input | arch -x86_64 ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@LAMA=../runtime $(LAMAC) $< && cat $@.input | $(ARCH) ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
ctest111:
|
||||
@echo "regression/test111"
|
||||
@LAMA=../runtime $(LAMAC) test111.lama && cat test111.input | arch -x86_64 ./test111 > test111.log && diff test111.log orig/test111.log
|
||||
@LAMA=../runtime $(LAMAC) test111.lama && cat test111.input | $(ARCH) ./test111 > test111.log && diff test111.log orig/test111.log
|
||||
|
||||
clean:
|
||||
$(RM) test*.log *.s *.sm *~ $(TESTS) *.i $(DEBUG_FILES) test111
|
||||
|
|
|
|||
|
|
@ -51,8 +51,8 @@ runtime.o: runtime.c runtime.h
|
|||
runtime64.o: runtime.c runtime.h
|
||||
$(CC) $(PROD_FLAGS) -c runtime.c -o runtime64.o
|
||||
|
||||
printf.o: printf.s
|
||||
$(CC) $(PROD_FLAGS) -c -g printf.s -o printf.o
|
||||
printf.o: printf.S
|
||||
$(CC) $(PROD_FLAGS) -x assembler-with-cpp -c -g printf.S -o printf.o
|
||||
|
||||
clean:
|
||||
$(RM) *.a *.o *~ negative_scenarios/*.err
|
||||
|
|
|
|||
|
|
@ -26,9 +26,13 @@ static extra_roots_pool extra_roots;
|
|||
|
||||
size_t __gc_stack_top = 0, __gc_stack_bottom = 0;
|
||||
#ifdef LAMA_ENV
|
||||
#ifdef __linux__
|
||||
extern const size_t __start_custom_data, __stop_custom_data;
|
||||
#elif defined(__APPLE__)
|
||||
extern const size_t __start_custom_data __asm("section$start$__DATA$custom_data");
|
||||
extern const size_t __stop_custom_data __asm("section$end$__DATA$custom_data");
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef DEBUG_VERSION
|
||||
memory_chunk heap;
|
||||
|
|
|
|||
|
|
@ -1,22 +1,27 @@
|
|||
#ifdef __linux__
|
||||
#define PREFIXED(name) name
|
||||
#elif defined(__APPLE__)
|
||||
#define PREFIXED(name) _##name
|
||||
#endif
|
||||
.data
|
||||
|
||||
.global _Lprintf
|
||||
.extern _Bprintf
|
||||
.global PREFIXED(Lprintf)
|
||||
.extern PREFIXED(Bprintf)
|
||||
|
||||
.global _Lfprintf
|
||||
.extern _Bfprintf
|
||||
.global PREFIXED(Lfprintf)
|
||||
.extern PREFIXED(Bfprintf)
|
||||
|
||||
.global _Lsprintf
|
||||
.extern _Bsprintf
|
||||
.global PREFIXED(Lsprintf)
|
||||
.extern PREFIXED(Bsprintf)
|
||||
|
||||
.global _Lfailure
|
||||
.extern _failure
|
||||
.global PREFIXED(Lfailure)
|
||||
.extern PREFIXED(failure)
|
||||
|
||||
.extern cnt_percentage_sign
|
||||
|
||||
.text
|
||||
|
||||
_Lprintf:
|
||||
PREFIXED(Lprintf):
|
||||
# save return address
|
||||
popq %r14
|
||||
|
||||
|
|
@ -28,22 +33,22 @@ _Lprintf:
|
|||
movq %rsp, %rax
|
||||
# rdi --- format string
|
||||
# r11 --- number of arguments except format string
|
||||
_Lprintf_loop:
|
||||
PREFIXED(Lprintf_loop):
|
||||
movq $0, %r12
|
||||
cmpq %r11, %r12
|
||||
jz _Lprintf_continue
|
||||
jz PREFIXED(Lprintf_continue)
|
||||
|
||||
decq %r11
|
||||
movq (%rax), %r10
|
||||
testq $1, %r10
|
||||
jz _Lprintf_loop_end
|
||||
jz PREFIXED(Lprintf_loop_end)
|
||||
# unbox value
|
||||
sarq %r10
|
||||
movq %r10, (%rax)
|
||||
_Lprintf_loop_end:
|
||||
PREFIXED(Lprintf_loop_end):
|
||||
addq $8, %rax
|
||||
jmp _Lprintf_loop
|
||||
_Lprintf_continue:
|
||||
jmp PREFIXED(Lprintf_loop)
|
||||
PREFIXED(Lprintf_continue):
|
||||
popq %rsi
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
|
|
@ -51,9 +56,9 @@ _Lprintf_continue:
|
|||
popq %r9
|
||||
# restore return address
|
||||
pushq %r14
|
||||
jmp _Bprintf
|
||||
jmp PREFIXED(Bprintf)
|
||||
|
||||
_Lfprintf:
|
||||
PREFIXED(Lfprintf):
|
||||
# save return address
|
||||
popq %r14
|
||||
|
||||
|
|
@ -65,31 +70,31 @@ _Lfprintf:
|
|||
# rdi --- FILE*
|
||||
# rsi --- format string
|
||||
# r11 --- number of arguments except format string
|
||||
_Lfprintf_loop:
|
||||
PREFIXED(Lfprintf_loop):
|
||||
movq $0, %r12
|
||||
cmpq %r11, %r12
|
||||
jz _Lfprintf_continue
|
||||
jz PREFIXED(Lfprintf_continue)
|
||||
|
||||
decq %r11
|
||||
movq (%rax), %r10
|
||||
testq $1, %r10
|
||||
jz _Lfprintf_loop_end
|
||||
jz PREFIXED(Lfprintf_loop_end)
|
||||
# unbox value
|
||||
sarq %r10
|
||||
movq %r10, (%rax)
|
||||
_Lfprintf_loop_end:
|
||||
PREFIXED(Lfprintf_loop_end):
|
||||
addq $8, %rax
|
||||
jmp _Lfprintf_loop
|
||||
_Lfprintf_continue:
|
||||
jmp PREFIXED(Lfprintf_loop)
|
||||
PREFIXED(Lfprintf_continue):
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
popq %r8
|
||||
popq %r9
|
||||
# restore return address
|
||||
pushq %r14
|
||||
jmp _Bfprintf
|
||||
jmp PREFIXED(Bfprintf)
|
||||
|
||||
_Lsprintf:
|
||||
PREFIXED(Lsprintf):
|
||||
# save return address
|
||||
popq %r14
|
||||
|
||||
|
|
@ -101,22 +106,22 @@ _Lsprintf:
|
|||
movq %rsp, %rax
|
||||
# rdi --- format string
|
||||
# r11 --- number of arguments except format string
|
||||
_Lsprintf_loop:
|
||||
PREFIXED(Lsprintf_loop):
|
||||
movq $0, %r12
|
||||
cmpq %r11, %r12
|
||||
jz _Lsprintf_continue
|
||||
jz PREFIXED(Lsprintf_continue)
|
||||
|
||||
decq %r11
|
||||
movq (%rax), %r10
|
||||
testq $1, %r10
|
||||
jz _Lsprintf_loop_end
|
||||
jz PREFIXED(Lsprintf_loop_end)
|
||||
# unbox value
|
||||
sarq %r10
|
||||
movq %r10, (%rax)
|
||||
_Lsprintf_loop_end:
|
||||
PREFIXED(Lsprintf_loop_end):
|
||||
addq $8, %rax
|
||||
jmp _Lsprintf_loop
|
||||
_Lsprintf_continue:
|
||||
jmp PREFIXED(Lsprintf_loop)
|
||||
PREFIXED(Lsprintf_continue):
|
||||
popq %rsi
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
|
|
@ -124,9 +129,9 @@ _Lsprintf_continue:
|
|||
popq %r9
|
||||
# restore return address
|
||||
pushq %r14
|
||||
jmp _Bsprintf
|
||||
jmp PREFIXED(Bsprintf)
|
||||
|
||||
_Lfailure:
|
||||
PREFIXED(Lfailure):
|
||||
# save return address
|
||||
popq %r14
|
||||
|
||||
|
|
@ -138,22 +143,22 @@ _Lfailure:
|
|||
movq %rsp, %rax
|
||||
# rdi --- format string
|
||||
# r11 --- number of arguments except format string
|
||||
_Lfailure_loop:
|
||||
PREFIXED(Lfailure_loop):
|
||||
movq $0, %r12
|
||||
cmpq %r11, %r12
|
||||
jz _Lfailure_continue
|
||||
jz PREFIXED(Lfailure_continue)
|
||||
|
||||
decq %r11
|
||||
movq (%rax), %r10
|
||||
testq $1, %r10
|
||||
jz _Lfailure_loop_end
|
||||
jz PREFIXED(Lfailure_loop_end)
|
||||
# unbox value
|
||||
sarq %r10
|
||||
movq %r10, (%rax)
|
||||
_Lfailure_loop_end:
|
||||
PREFIXED(Lfailure_loop_end):
|
||||
addq $8, %rax
|
||||
jmp _Lfailure_loop
|
||||
_Lfailure_continue:
|
||||
jmp PREFIXED(Lfailure_loop)
|
||||
PREFIXED(Lfailure_continue):
|
||||
popq %rsi
|
||||
popq %rdx
|
||||
popq %rcx
|
||||
|
|
@ -161,4 +166,4 @@ _Lfailure_continue:
|
|||
popq %r9
|
||||
# restore return address
|
||||
pushq %r14
|
||||
jmp _failure
|
||||
jmp PREFIXED(failure)
|
||||
|
|
@ -143,7 +143,7 @@ class options args =
|
|||
Filename.chop_suffix (Filename.basename self#get_infile) ".lama"
|
||||
|
||||
method topname =
|
||||
match !mode with `Compile -> "init" ^ self#basename | _ -> "_main"
|
||||
match !mode with `Compile -> "init" ^ self#basename | _ -> "main"
|
||||
|
||||
method dump_file ext contents =
|
||||
let name = self#basename in
|
||||
|
|
|
|||
37
src/SM.ml
37
src/SM.ml
|
|
@ -14,11 +14,13 @@ type scope = {
|
|||
}
|
||||
[@@deriving gt ~options:{ show }]
|
||||
|
||||
let normal_prefix = "_L"
|
||||
let builtin_prefix = "_B"
|
||||
let label s = normal_prefix ^ s
|
||||
let builtin_label s = builtin_prefix ^ s
|
||||
let scope_label i s = label s ^ "_" ^ string_of_int i
|
||||
let normal_label = "L"
|
||||
let builtin_label = "B"
|
||||
let global_label = "global_"
|
||||
let labeled s = normal_label ^ s
|
||||
let labeled_builtin s = builtin_label ^ s
|
||||
let labeled_global s = global_label ^ s
|
||||
let labeled_scoped i s = labeled s ^ "_" ^ string_of_int i
|
||||
let show_scope = show scope
|
||||
|
||||
(* The type for the stack machine instructions *)
|
||||
|
|
@ -270,13 +272,13 @@ module ByteCode = struct
|
|||
add_fixup s;
|
||||
add_ints [ 0 ]
|
||||
(* 0x70 *)
|
||||
| CALL (f, _, _) when f = label "read" -> add_bytes [ (7 * 16) + 0 ]
|
||||
| CALL (f, _, _) when f = labeled "read" -> add_bytes [ (7 * 16) + 0 ]
|
||||
(* 0x71 *)
|
||||
| CALL (f, _, _) when f = label "write" -> add_bytes [ (7 * 16) + 1 ]
|
||||
| CALL (f, _, _) when f = labeled "write" -> add_bytes [ (7 * 16) + 1 ]
|
||||
(* 0x72 *)
|
||||
| CALL (f, _, _) when f = label "length" -> add_bytes [ (7 * 16) + 2 ]
|
||||
| CALL (f, _, _) when f = labeled "length" -> add_bytes [ (7 * 16) + 2 ]
|
||||
(* 0x73 *)
|
||||
| CALL (f, _, _) when f = label "string" -> add_bytes [ (7 * 16) + 3 ]
|
||||
| CALL (f, _, _) when f = labeled "string" -> add_bytes [ (7 * 16) + 3 ]
|
||||
(* 0x74 *)
|
||||
| CALL (".array", n, _) ->
|
||||
add_bytes [ (7 * 16) + 4 ];
|
||||
|
|
@ -1016,7 +1018,7 @@ class env cmd imports =
|
|||
{<funinfo = funinfo#register_closure f self#closure>}
|
||||
|
||||
method current_function =
|
||||
match fundefs with Top _ -> "_main" | Item (fd, _, _) -> fd.name
|
||||
match fundefs with Top _ -> "main" | Item (fd, _, _) -> fd.name
|
||||
|
||||
method private import_imports =
|
||||
let paths = cmd#get_include_paths in
|
||||
|
|
@ -1037,10 +1039,10 @@ class env cmd imports =
|
|||
method global_scope = scope_index = 0
|
||||
|
||||
method get_label =
|
||||
(label @@ string_of_int label_index, {<label_index = label_index + 1>})
|
||||
(labeled @@ string_of_int label_index, {<label_index = label_index + 1>})
|
||||
|
||||
method get_end_label =
|
||||
let lab = label @@ string_of_int label_index in
|
||||
let lab = labeled @@ string_of_int label_index in
|
||||
(lab, {<end_label = lab; label_index = label_index + 1>})
|
||||
|
||||
method end_label = end_label
|
||||
|
|
@ -1048,7 +1050,10 @@ class env cmd imports =
|
|||
method nlocals = scope.nlocals
|
||||
|
||||
method get_decls =
|
||||
let opt_label = function true -> label | _ -> fun x -> "_global_" ^ x in
|
||||
let opt_label = function
|
||||
| true -> labeled
|
||||
| _ -> labeled_global
|
||||
in
|
||||
List.flatten
|
||||
@@ List.map (function
|
||||
| name, `Extern, f -> [ EXTERN (opt_label f name) ]
|
||||
|
|
@ -1196,7 +1201,9 @@ class env cmd imports =
|
|||
}>}
|
||||
|
||||
method fun_internal_name (name : string) =
|
||||
(match scope.st with State.G _ -> label | _ -> scope_label scope_index)
|
||||
(match scope.st with
|
||||
| State.G _ -> labeled
|
||||
| _ -> labeled_scoped scope_index)
|
||||
name
|
||||
|
||||
method add_fun_name (name : string)
|
||||
|
|
@ -1651,7 +1658,7 @@ let compile cmd ((imports, _), p) =
|
|||
LABEL topname;
|
||||
BEGIN
|
||||
( topname,
|
||||
(if topname = "_main" then 2 else 0),
|
||||
(if topname = "main" then 2 else 0),
|
||||
env#nlocals,
|
||||
[],
|
||||
[],
|
||||
|
|
|
|||
149
src/X86.ml
149
src/X86.ml
|
|
@ -4,6 +4,18 @@ open SM
|
|||
|
||||
(* X86 codegeneration interface *)
|
||||
|
||||
type os_t = Linux | Darwin
|
||||
|
||||
let os =
|
||||
let uname = Posix_uname.uname () in
|
||||
match uname.sysname with
|
||||
| "Darwin" -> Darwin
|
||||
| "Linux" -> Linux
|
||||
| _ -> failwith "Unsupported OS"
|
||||
|
||||
let prefix = match os with Linux -> "" | Darwin -> "_"
|
||||
let prefixed name = prefix ^ name
|
||||
|
||||
module Register : sig
|
||||
type t
|
||||
|
||||
|
|
@ -203,10 +215,10 @@ let show instr =
|
|||
| S i ->
|
||||
if i >= 0 then Printf.sprintf "-%d(%%rbp)" (stack_offset i)
|
||||
else Printf.sprintf "%d(%%rbp)" (stack_offset i)
|
||||
| M (_, I, _, s) -> Printf.sprintf "%s(%%rip)" s
|
||||
| M (F, E, _, s) -> Printf.sprintf "%s(%%rip)" s
|
||||
| M (D, E, _, s) -> Printf.sprintf "%s@GOTPCREL(%%rip)" s
|
||||
| C s -> Printf.sprintf "$%s" s
|
||||
| M (_, I, _, s) -> Printf.sprintf "%s(%%rip)" (prefixed s)
|
||||
| M (F, E, _, s) -> Printf.sprintf "%s(%%rip)" (prefixed s)
|
||||
| M (D, E, _, s) -> Printf.sprintf "%s@GOTPCREL(%%rip)" (prefixed s)
|
||||
| C s -> Printf.sprintf "$%s" (prefixed s)
|
||||
| L i -> Printf.sprintf "$%d" i
|
||||
| I (0, x) -> Printf.sprintf "(%s)" (opnd x)
|
||||
| I (n, x) -> Printf.sprintf "%d(%s)" n (opnd x)
|
||||
|
|
@ -237,12 +249,12 @@ let show instr =
|
|||
| Push s -> Printf.sprintf "\tpushq\t%s" (opnd s)
|
||||
| Pop s -> Printf.sprintf "\tpopq\t%s" (opnd s)
|
||||
| Ret -> "\tret"
|
||||
| Call p -> Printf.sprintf "\tcall\t%s" p
|
||||
| Call p -> Printf.sprintf "\tcall\t%s" (prefixed p)
|
||||
| CallI o -> Printf.sprintf "\tcall\t*(%s)" (opnd o)
|
||||
| Label l -> Printf.sprintf "%s:\n" l
|
||||
| Jmp l -> Printf.sprintf "\tjmp\t%s" l
|
||||
| Label l -> Printf.sprintf "%s:\n" (prefixed l)
|
||||
| Jmp l -> Printf.sprintf "\tjmp\t%s" (prefixed l)
|
||||
| JmpI o -> Printf.sprintf "\tjmp\t*(%s)" (opnd o)
|
||||
| CJmp (s, l) -> Printf.sprintf "\tj%s\t%s" s l
|
||||
| CJmp (s, l) -> Printf.sprintf "\tj%s\t%s" s (prefixed l)
|
||||
| Meta s -> Printf.sprintf "%s\n" s
|
||||
| Dec s -> Printf.sprintf "\tdecq\t%s" (opnd s)
|
||||
| Or1 s -> Printf.sprintf "\torq\t$0x0001,\t%s" (opnd s)
|
||||
|
|
@ -407,29 +419,29 @@ let compile_binop env op =
|
|||
|
||||
let safepoint_functions =
|
||||
[
|
||||
label "s__Infix_58";
|
||||
label "substring";
|
||||
label "clone";
|
||||
builtin_label "string";
|
||||
label "stringcat";
|
||||
label "string";
|
||||
builtin_label "closure";
|
||||
builtin_label "array";
|
||||
builtin_label "sexp";
|
||||
label "i__Infix_4343"
|
||||
labeled "s__Infix_58";
|
||||
labeled "substring";
|
||||
labeled "clone";
|
||||
labeled_builtin "string";
|
||||
labeled "stringcat";
|
||||
labeled "string";
|
||||
labeled_builtin "closure";
|
||||
labeled_builtin "array";
|
||||
labeled_builtin "sexp";
|
||||
labeled "i__Infix_4343"
|
||||
(* "makeArray"; not required as do not have ptr arguments *)
|
||||
(* "makeString"; not required as do not have ptr arguments *)
|
||||
(* "getEnv", not required as do not have ptr arguments *)
|
||||
(* "set_args", not required as do not have ptr arguments *);
|
||||
(* Lsprintf, or Bsprintf is an extra dirty hack that works? *)
|
||||
(* Lsprintf, or Bsprintf is an extra dirty hack that probably works *)
|
||||
]
|
||||
|
||||
let vararg_functions =
|
||||
[
|
||||
(label "printf", 1);
|
||||
(label "fprintf", 2);
|
||||
(label "sprintf", 1);
|
||||
(label "failure", 1);
|
||||
(labeled "printf", 1);
|
||||
(labeled "fprintf", 2);
|
||||
(labeled "sprintf", 1);
|
||||
(labeled "failure", 1);
|
||||
]
|
||||
|
||||
let compile_call env ?fname nargs tail =
|
||||
|
|
@ -437,7 +449,7 @@ let compile_call env ?fname nargs tail =
|
|||
Option.map
|
||||
(fun fname ->
|
||||
match fname.[0] with
|
||||
| '.' -> builtin_label (String.sub fname 1 (String.length fname - 1))
|
||||
| '.' -> labeled_builtin (String.sub fname 1 (String.length fname - 1))
|
||||
| _ -> fname)
|
||||
fname
|
||||
in
|
||||
|
|
@ -557,9 +569,10 @@ let compile_call env ?fname nargs tail =
|
|||
let setup_args_code = List.map (fun arg -> Push arg) @@ List.rev args in
|
||||
let setup_args_code = setup_args_code @ [ Mov (rsp, rdi) ] in
|
||||
let setup_args_code =
|
||||
if fname = builtin_label "closure" then
|
||||
if fname = labeled_builtin "closure" then
|
||||
setup_args_code @ [ Mov (L (box (nargs - 1)), rsi) ]
|
||||
else if fname = builtin_label "sexp" || fname = builtin_label "array"
|
||||
else if
|
||||
fname = labeled_builtin "sexp" || fname = labeled_builtin "array"
|
||||
then setup_args_code @ [ Mov (L (box nargs), rsi) ]
|
||||
else setup_args_code
|
||||
in
|
||||
|
|
@ -715,18 +728,18 @@ let compile cmd env imports code =
|
|||
[ Meta "\t.cfi_startproc" ]
|
||||
@ (if f = cmd#topname then
|
||||
[
|
||||
Mov (M (D, I, V, "_init"), rax);
|
||||
Mov (M (D, I, V, "init"), rax);
|
||||
Binop ("test", rax, rax);
|
||||
CJmp ("z", "_continue");
|
||||
CJmp ("z", "continue");
|
||||
Ret;
|
||||
Label "_ERROR";
|
||||
Call (label "binoperror");
|
||||
Call (labeled "binoperror");
|
||||
Ret;
|
||||
Label "_ERROR2";
|
||||
Call (label "binoperror2");
|
||||
Call (labeled "binoperror2");
|
||||
Ret;
|
||||
Label "_continue";
|
||||
Mov (L 1, M (D, I, V, "_init"));
|
||||
Label "continue";
|
||||
Mov (L 1, M (D, I, V, "init"));
|
||||
]
|
||||
else [])
|
||||
@ [
|
||||
|
|
@ -747,21 +760,21 @@ let compile cmd env imports code =
|
|||
Mov (r13, rsi);
|
||||
Mov (r14, rcx);
|
||||
]
|
||||
@ (if f = "_main" then
|
||||
@ (if f = "main" then
|
||||
[
|
||||
(* Align stack as main function is the only function that could be called without alignment. TODO *)
|
||||
Mov (L 0xF, rax);
|
||||
Binop ("test", rsp, rax);
|
||||
CJmp ("z", "_ALIGNED");
|
||||
CJmp ("z", "ALIGNED");
|
||||
Push filler;
|
||||
Label "_ALIGNED";
|
||||
Label "ALIGNED";
|
||||
(* Initialize gc and arguments *)
|
||||
Push (R Registers.rdi);
|
||||
Push (R Registers.rsi);
|
||||
Call "___gc_init";
|
||||
Call "__gc_init";
|
||||
Pop (R Registers.rsi);
|
||||
Pop (R Registers.rdi);
|
||||
Call "_set_args";
|
||||
Call "set_args";
|
||||
]
|
||||
else [])
|
||||
@
|
||||
|
|
@ -782,7 +795,7 @@ let compile cmd env imports code =
|
|||
Mov (rbp, rsp);
|
||||
Pop rbp;
|
||||
]
|
||||
@ (if name = "_main" then [ Binop ("^", rax, rax) ] else [])
|
||||
@ (if name = "main" then [ Binop ("^", rax, rax) ] else [])
|
||||
@ [
|
||||
Meta "\t.cfi_restore\t5";
|
||||
Meta "\t.cfi_def_cfa\t4, 4";
|
||||
|
|
@ -791,12 +804,13 @@ let compile cmd env imports code =
|
|||
Meta
|
||||
(* Allocate space for the symbolic stack
|
||||
Add extra word if needed to preserve alignment *)
|
||||
(Printf.sprintf "\t.set\t%s,\t%d" env#lsize
|
||||
(Printf.sprintf "\t.set\t%s,\t%d" (prefixed env#lsize)
|
||||
(if env#allocated mod 2 == 0 then
|
||||
env#allocated * word_size
|
||||
else (env#allocated + 1) * word_size));
|
||||
Meta
|
||||
(Printf.sprintf "\t.set\t%s,\t%d" env#allocated_size
|
||||
(Printf.sprintf "\t.set\t%s,\t%d"
|
||||
(prefixed env#allocated_size)
|
||||
env#allocated);
|
||||
] )
|
||||
| RET ->
|
||||
|
|
@ -1092,7 +1106,7 @@ class env prg =
|
|||
method loc x =
|
||||
match x with
|
||||
| Value.Global name ->
|
||||
let loc_name = "_global_" ^ name in
|
||||
let loc_name = labeled_global name in
|
||||
let ext = if self#is_external name then E else I in
|
||||
M (D, ext, V, loc_name)
|
||||
| Value.Fun name ->
|
||||
|
|
@ -1146,7 +1160,7 @@ class env prg =
|
|||
(* registers a variable in the environment *)
|
||||
method variable x =
|
||||
match x with
|
||||
| Value.Global name -> {<globals = S.add ("_global_" ^ name) globals>}
|
||||
| Value.Global name -> {<globals = S.add (labeled_global name) globals>}
|
||||
| _ -> self
|
||||
|
||||
(* registers a string constant *)
|
||||
|
|
@ -1157,7 +1171,9 @@ class env prg =
|
|||
let rec iterate i =
|
||||
if i < n then (
|
||||
(match x.[i] with
|
||||
| '"' -> (Buffer.add_char buf '\\'; Buffer.add_char buf '"')
|
||||
| '"' ->
|
||||
Buffer.add_char buf '\\';
|
||||
Buffer.add_char buf '"'
|
||||
| c -> Buffer.add_char buf c);
|
||||
iterate (i + 1))
|
||||
in
|
||||
|
|
@ -1184,7 +1200,7 @@ class env prg =
|
|||
|
||||
(* gets a number of stack positions allocated *)
|
||||
method allocated = stack_slots
|
||||
method allocated_size = label (Printf.sprintf "S%s_SIZE" fname)
|
||||
method allocated_size = labeled (Printf.sprintf "S%s_SIZE" fname)
|
||||
|
||||
(* enters a function *)
|
||||
method enter f nargs nlocals has_closure =
|
||||
|
|
@ -1197,10 +1213,10 @@ class env prg =
|
|||
; first_line = true>}
|
||||
|
||||
(* returns a label for the epilogue *)
|
||||
method epilogue = label (Printf.sprintf "%s_epilogue" fname)
|
||||
method epilogue = labeled (Printf.sprintf "%s_epilogue" fname)
|
||||
|
||||
(* returns a name for local size meta-symbol *)
|
||||
method lsize = label (Printf.sprintf "%s_SIZE" fname)
|
||||
method lsize = labeled (Printf.sprintf "%s_SIZE" fname)
|
||||
|
||||
(* returns a list of live registers *)
|
||||
method live_registers =
|
||||
|
|
@ -1213,8 +1229,11 @@ class env prg =
|
|||
method gen_line =
|
||||
let lab = Printf.sprintf ".L%d" nlabels in
|
||||
( {<nlabels = nlabels + 1; first_line = false>},
|
||||
if fname = "_main" then
|
||||
[ (* Meta (Printf.sprintf "\t.stabn 68,0,%d,%s" line lab); *) Label lab ]
|
||||
if fname = "main" then
|
||||
[
|
||||
(* Meta (Printf.sprintf "\t.stabn 68,0,%d,%s" line lab); *)
|
||||
Label lab;
|
||||
]
|
||||
else
|
||||
(if first_line then
|
||||
[ (* Meta (Printf.sprintf "\t.stabn 68,0,%d,0" line) *) ]
|
||||
|
|
@ -1232,17 +1251,25 @@ let genasm cmd prog =
|
|||
let sm = SM.compile cmd prog in
|
||||
let env, code = compile cmd (new env sm) (fst (fst prog)) sm in
|
||||
let globals =
|
||||
List.map (fun s -> Meta (Printf.sprintf "\t.globl\t%s" s)) env#publics
|
||||
List.map
|
||||
(fun s -> Meta (Printf.sprintf "\t.globl\t%s" (prefixed s)))
|
||||
env#publics
|
||||
in
|
||||
let data =
|
||||
[ Meta "\t.data" ]
|
||||
@ List.map
|
||||
(fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s))
|
||||
(fun (s, v) ->
|
||||
Meta (Printf.sprintf "%s:\t.string\t\"%s\"" (prefixed v) s))
|
||||
env#strings
|
||||
@ [
|
||||
Meta "_init:\t.quad 0";
|
||||
Meta "\t.section __DATA, custom_data, regular, no_dead_strip";
|
||||
Meta (Printf.sprintf "filler:\t.fill\t%d, 8, 1" env#max_locals_size);
|
||||
Meta (prefixed "init" ^ ":\t.quad 0");
|
||||
(match os with
|
||||
| Darwin ->
|
||||
Meta "\t.section __DATA, custom_data, regular, no_dead_strip"
|
||||
| Linux -> Meta "\t.section custom_data,\"aw\",@progbits");
|
||||
Meta
|
||||
(Printf.sprintf "%s:\t.fill\t%d, 8, 1" (prefixed "filler")
|
||||
env#max_locals_size);
|
||||
]
|
||||
@ List.concat
|
||||
@@ List.map
|
||||
|
|
@ -1253,7 +1280,7 @@ let genasm cmd prog =
|
|||
(String.sub s (String.length "global_")
|
||||
(String.length s - String.length "global_"))
|
||||
s); *)
|
||||
Meta (Printf.sprintf "%s:\t.quad\t1" s);
|
||||
Meta (Printf.sprintf "%s:\t.quad\t1" (prefixed s));
|
||||
])
|
||||
env#globals
|
||||
in
|
||||
|
|
@ -1303,7 +1330,9 @@ let build cmd prog =
|
|||
cmd#dump_file "i" (Interface.gen prog);
|
||||
let inc = get_std_path () in
|
||||
let compiler = "clang" in
|
||||
let flags = "-arch x86_64" in
|
||||
let compiler_flags, linker_flags =
|
||||
match os with Darwin -> ("-arch x86_64", "-ld_classic") | Linux -> ("", "")
|
||||
in
|
||||
match cmd#get_mode with
|
||||
| `Default ->
|
||||
let objs = find_objects (fst @@ fst prog) cmd#get_include_paths in
|
||||
|
|
@ -1314,13 +1343,13 @@ let build cmd prog =
|
|||
Buffer.add_string buf " ")
|
||||
objs;
|
||||
let gcc_cmdline =
|
||||
Printf.sprintf "%s -ld_classic %s %s %s %s.s %s %s/runtime.a" compiler flags
|
||||
cmd#get_debug cmd#get_output_option cmd#basename (Buffer.contents buf)
|
||||
inc
|
||||
Printf.sprintf "%s %s %s %s %s %s.s %s %s/runtime.a" compiler
|
||||
compiler_flags linker_flags cmd#get_debug cmd#get_output_option
|
||||
cmd#basename (Buffer.contents buf) inc
|
||||
in
|
||||
Sys.command gcc_cmdline
|
||||
| `Compile ->
|
||||
Sys.command
|
||||
(Printf.sprintf "%s %s %s -c -g %s.s" compiler flags cmd#get_debug
|
||||
cmd#basename)
|
||||
(Printf.sprintf "%s %s %s -c -g %s.s" compiler compiler_flags
|
||||
cmd#get_debug cmd#basename)
|
||||
| _ -> invalid_arg "must not happen"
|
||||
|
|
|
|||
2
src/dune
2
src/dune
|
|
@ -46,7 +46,7 @@
|
|||
(library
|
||||
(name liba)
|
||||
(modules Language Pprinter stdpath version X86 SM)
|
||||
(libraries GT ostap)
|
||||
(libraries GT ostap posix-uname)
|
||||
(flags
|
||||
(:standard
|
||||
-rectypes
|
||||
|
|
|
|||
|
|
@ -2,13 +2,20 @@ TESTS=$(sort $(filter-out test02 test30, $(basename $(wildcard test*.lama))))
|
|||
|
||||
LAMAC=../../src/lamac
|
||||
|
||||
UNAME_S := $(shell uname -s)
|
||||
|
||||
ifeq ($(UNAME_S),Linux)
|
||||
else ifeq ($(UNAME_S),Darwin)
|
||||
ARCH = arch -x86_64
|
||||
endif
|
||||
|
||||
.PHONY: check $(TESTS)
|
||||
|
||||
check: $(TESTS)
|
||||
|
||||
$(TESTS): %: %.lama
|
||||
@echo "stdlib/regression/$@"
|
||||
@LAMA=../../runtime $(LAMAC) -I .. -ds -dp $< && arch -X86_64 ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@LAMA=../../runtime $(LAMAC) -I .. -ds -dp $< && $(ARCH) ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
clean:
|
||||
$(RM) test*.log *.s *~ $(TESTS) *.i
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue