mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-24 23:58:47 +00:00
Merge branch 'hw15'
This commit is contained in:
Dmitry Boulytchev
commit
f14bbf8fcb
11 changed files with 2259 additions and 83 deletions
75
src/X86.ml
75
src/X86.ml
|
|
@ -19,6 +19,8 @@ let word_size = 4;;
|
|||
| L of int (* an immediate operand *)
|
||||
with show
|
||||
|
||||
let show_opnd = show(opnd)
|
||||
|
||||
(* For convenience we define the following synonyms for the registers: *)
|
||||
let ebx = R 0
|
||||
let ecx = R 1
|
||||
|
|
@ -52,6 +54,7 @@ type instr =
|
|||
(* arithmetic correction: or 0x0001 *) | Or1 of opnd
|
||||
(* arithmetic correction: shl 1 *) | Sal1 of opnd
|
||||
(* arithmetic correction: shr 1 *) | Sar1 of opnd
|
||||
| Repmovsl
|
||||
|
||||
(* Instruction printer *)
|
||||
let show instr =
|
||||
|
|
@ -91,6 +94,7 @@ let show instr =
|
|||
| Or1 s -> Printf.sprintf "\torl\t$0x0001,\t%s" (opnd s)
|
||||
| Sal1 s -> Printf.sprintf "\tsall\t%s" (opnd s)
|
||||
| Sar1 s -> Printf.sprintf "\tsarl\t%s" (opnd s)
|
||||
| Repmovsl -> Printf.sprintf "\trep movsl\t"
|
||||
|
||||
(* Opening stack machine to use instructions without fully qualified names *)
|
||||
open SM
|
||||
|
|
@ -164,7 +168,7 @@ let compile env code =
|
|||
(env, Mov (M ("$" ^ s), l) :: call)
|
||||
|
||||
| LD x ->
|
||||
let s, env' = (env#global x)#allocate in
|
||||
let s, env' = (env#variable x)#allocate in
|
||||
env',
|
||||
(match s with
|
||||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
|
|
@ -172,7 +176,7 @@ let compile env code =
|
|||
)
|
||||
|
||||
| STA (x, n) ->
|
||||
let s, env = (env#global x)#allocate in
|
||||
let s, env = (env#variable x)#allocate in
|
||||
let push =
|
||||
match s with
|
||||
| S _ | M _ -> [Mov (env#loc x, eax); Mov (eax, s)]
|
||||
|
|
@ -182,7 +186,7 @@ let compile env code =
|
|||
env, push @ code
|
||||
|
||||
| ST x ->
|
||||
let s, env' = (env#global x)#pop in
|
||||
let s, env' = (env#variable x)#pop in
|
||||
env',
|
||||
(match s with
|
||||
| S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
|
||||
|
|
@ -288,14 +292,20 @@ let compile env code =
|
|||
|
||||
| BEGIN (f, a, l) ->
|
||||
let env = env#enter f a l in
|
||||
env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp)]
|
||||
env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp);
|
||||
Mov (esp, edi);
|
||||
Mov (M "$filler", esi);
|
||||
Mov (M ("$" ^ (env#allocated_size)), ecx);
|
||||
Repmovsl
|
||||
]
|
||||
|
||||
| END ->
|
||||
env, [Label env#epilogue;
|
||||
env#endfunc, [Label env#epilogue;
|
||||
Mov (ebp, esp);
|
||||
Pop ebp;
|
||||
Ret;
|
||||
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#lsize (env#allocated * word_size))
|
||||
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#lsize (env#allocated * word_size));
|
||||
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#allocated_size env#allocated)
|
||||
]
|
||||
|
||||
| RET b ->
|
||||
|
|
@ -386,6 +396,14 @@ class env =
|
|||
val fname = "" (* function name *)
|
||||
val stackmap = M.empty (* labels to stack map *)
|
||||
val barrier = false (* barrier condition *)
|
||||
val max_locals_size = 0
|
||||
|
||||
method max_locals_size = max_locals_size
|
||||
|
||||
method endfunc =
|
||||
if stack_slots > max_locals_size
|
||||
then {< max_locals_size = stack_slots >}
|
||||
else self
|
||||
|
||||
method show_stack =
|
||||
GT.show(list) (GT.show(opnd)) stack
|
||||
|
|
@ -425,13 +443,13 @@ class env =
|
|||
(* allocates a fresh position on a symbolic stack *)
|
||||
method allocate =
|
||||
let x, n =
|
||||
let rec allocate' = function
|
||||
| [] -> ebx , 0
|
||||
| (S n)::_ -> S (n+1) , n+2
|
||||
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
|
||||
| _ -> S static_size, static_size+1
|
||||
in
|
||||
allocate' stack
|
||||
let rec allocate' = function
|
||||
| [] -> ebx , 0
|
||||
| (S n)::_ -> S (n+1) , n+2
|
||||
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
|
||||
| _ -> S static_size, static_size+1
|
||||
in
|
||||
allocate' stack
|
||||
in
|
||||
x, {< stack_slots = max n stack_slots; stack = x::stack >}
|
||||
|
||||
|
|
@ -458,8 +476,11 @@ class env =
|
|||
done;
|
||||
!h
|
||||
|
||||
(* registers a global variable in the environment *)
|
||||
method global x = {< globals = S.add ("global_" ^ x) globals >}
|
||||
(* registers a variable in the environment *)
|
||||
method variable x =
|
||||
match self#loc x with
|
||||
| M name -> {< globals = S.add name globals >}
|
||||
| _ -> self
|
||||
|
||||
(* registers a string constant *)
|
||||
method string x =
|
||||
|
|
@ -476,7 +497,9 @@ class env =
|
|||
method strings = M.bindings stringm
|
||||
|
||||
(* gets a number of stack positions allocated *)
|
||||
method allocated = stack_slots
|
||||
method allocated = stack_slots
|
||||
|
||||
method allocated_size = Printf.sprintf "LS%s_SIZE" fname
|
||||
|
||||
(* enters a function *)
|
||||
method enter f a l =
|
||||
|
|
@ -515,14 +538,26 @@ class env =
|
|||
the stack code, then generates x86 assember code, then prints the assembler file
|
||||
*)
|
||||
let genasm (ds, stmt) =
|
||||
let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0])))) in
|
||||
let stmt =
|
||||
Language.Stmt.Seq (
|
||||
Language.Stmt.Call ("__gc_init", []),
|
||||
Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0]))))
|
||||
)
|
||||
in
|
||||
let env, code =
|
||||
compile
|
||||
(new env)
|
||||
((LABEL "main") :: (BEGIN ("main", [], [])) :: SM.compile (ds, stmt))
|
||||
in
|
||||
let data = Meta "\t.data" :: (List.map (fun s -> Meta (Printf.sprintf "%s:\t.int\t0" s )) env#globals) @
|
||||
(List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings) in
|
||||
let gc_start, gc_end = "__gc_data_start", "__gc_data_end" in
|
||||
let data = [Meta "\t.data";
|
||||
Meta (Printf.sprintf "filler:\t.fill\t%d, 4, 1" env#max_locals_size);
|
||||
Meta (Printf.sprintf "\t.globl\t%s" gc_start); Meta (Printf.sprintf "\t.globl\t%s" gc_end)] @
|
||||
[Meta (Printf.sprintf "%s:" gc_start)] @
|
||||
(List.map (fun s -> Meta (Printf.sprintf "%s:\t.int\t1" s )) env#globals) @
|
||||
[Meta (Printf.sprintf "%s:" gc_end)] @
|
||||
(List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings)
|
||||
in
|
||||
let asm = Buffer.create 1024 in
|
||||
List.iter
|
||||
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
||||
|
|
@ -535,5 +570,5 @@ let build prog name =
|
|||
Printf.fprintf outf "%s" (genasm prog);
|
||||
close_out outf;
|
||||
let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
|
||||
Sys.command (Printf.sprintf "gcc -m32 -o %s %s/runtime.o %s.s" name inc name)
|
||||
Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s/gc_runtime.o %s/runtime.o %s.s" name inc inc name)
|
||||
|
||||
|
|
|
|||
22
src/testgc.expr
Normal file
22
src/testgc.expr
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
fun f () local b {
|
||||
b := 7;
|
||||
test ();
|
||||
b := y;
|
||||
test ();
|
||||
b := 9;
|
||||
test ();
|
||||
return 0
|
||||
}
|
||||
|
||||
--x := 0;
|
||||
--y := 0;
|
||||
--z := 0;
|
||||
--t := 0;
|
||||
--test ();
|
||||
y := "abc";
|
||||
test ();
|
||||
t := [];
|
||||
test ();
|
||||
t := 0;
|
||||
test ();
|
||||
f ()
|
||||
Loading…
Add table
Add a link
Reference in a new issue