mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-05 22:38:44 +00:00
Functions in X86
This commit is contained in:
Dmitry Boulytchev
parent
8907ab2119
commit
b19bea4d58
13 changed files with 126 additions and 67 deletions
|
|
@ -7,7 +7,7 @@ RC=../src/rc.opt
|
|||
check: $(TESTS)
|
||||
|
||||
$(TESTS): %: %.expr
|
||||
# @$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ RC = ../../src/rc.opt
|
|||
check: $(TESTS)
|
||||
|
||||
$(TESTS): %: %.expr
|
||||
# @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ RC = ../../src/rc.opt
|
|||
check: $(TESTS)
|
||||
|
||||
$(TESTS): %: %.expr
|
||||
# @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
|
||||
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,8 @@ fun test2 (b) {
|
|||
a := b
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
test1 ();
|
||||
write (a);
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,8 @@ fun print () {
|
|||
write (c)
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
a := 100;
|
||||
b := 200;
|
||||
c := 300;
|
||||
|
|
|
|||
|
|
@ -19,6 +19,8 @@ fun print () {
|
|||
write (c)
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
a := 100;
|
||||
b := 200;
|
||||
c := 300;
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
0
|
||||
0
|
||||
|
|
|
|||
|
|
@ -21,6 +21,8 @@ fun test2 (b) {
|
|||
print ()
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
a := 100;
|
||||
b := 200;
|
||||
c := 300;
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@ fun ack (m, n) {
|
|||
fi
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
for m := 0, m <= 3, m := m+1 do
|
||||
for n := 0, n <= 8, n := n+1 do
|
||||
write (ack (m, n))
|
||||
|
|
|
|||
|
|
@ -8,5 +8,7 @@ fun test (n, m) local i, s {
|
|||
return s
|
||||
}
|
||||
|
||||
read (x);
|
||||
|
||||
write (test (10, 100));
|
||||
write (test (100, 10))
|
||||
|
|
@ -25,11 +25,9 @@ let main =
|
|||
match parse infile with
|
||||
| `Ok prog ->
|
||||
if to_compile
|
||||
then failwith "Not implemented yet"
|
||||
(*
|
||||
then
|
||||
let basename = Filename.chop_suffix infile ".expr" in
|
||||
ignore @@ X86.build prog basename
|
||||
*)
|
||||
ignore @@ X86.build prog basename
|
||||
else
|
||||
let rec read acc =
|
||||
try
|
||||
|
|
|
|||
33
src/SM.ml
33
src/SM.ml
|
|
@ -10,11 +10,12 @@ open Language
|
|||
(* load a variable to the stack *) | LD of string
|
||||
(* store a variable from the stack *) | ST of string
|
||||
(* a label *) | LABEL of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* unconditional jump *) | JMP of string
|
||||
(* conditional jump *) | CJMP of string * string
|
||||
(* begins procedure definition *) | BEGIN of string list * string list
|
||||
(* begins procedure definition *) | BEGIN of string * string list * string list
|
||||
(* end procedure definition *) | END
|
||||
(* calls a procedure *) | CALL of string with show
|
||||
(* calls a function/procedure *) | CALL of string * int * bool
|
||||
(* returns from a function *) | RET of bool with show
|
||||
|
||||
(* The type for the stack machine program *)
|
||||
type prg = insn list
|
||||
|
|
@ -46,18 +47,18 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
|||
| LABEL _ -> eval env conf prg'
|
||||
| JMP l -> eval env conf (env#labeled l)
|
||||
| CJMP (c, l) -> let x::stack' = stack in eval env (cstack, stack', (st, i, o)) (if (c = "z" && x = 0) || (c = "nz" && x <> 0) then env#labeled l else prg')
|
||||
| CALL f -> eval env ((prg', st)::cstack, stack, c) (env#labeled f)
|
||||
| BEGIN (args, locals) -> let rec combine acc args stack =
|
||||
| CALL (f, _, _) -> eval env ((prg', st)::cstack, stack, c) (env#labeled f)
|
||||
| BEGIN (_, args, locals) -> let rec combine acc args stack =
|
||||
match args, stack with
|
||||
| [], _ -> List.rev acc, stack
|
||||
| a::args', s::stack' -> combine ((a, s)::acc) args' stack'
|
||||
in
|
||||
let state', stack' = combine [] args stack in
|
||||
eval env (cstack, stack', (List.fold_left (fun s (x, v) -> State.update x v s) (State.enter st (args @ locals)) state', i, o)) prg'
|
||||
| END -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
| END | RET _ -> (match cstack with
|
||||
| (prg', st')::cstack' -> eval env (cstack', stack, (State.leave st st', i, o)) prg'
|
||||
| [] -> conf
|
||||
)
|
||||
)
|
||||
|
||||
(* Top-level evaluation
|
||||
|
|
@ -86,14 +87,14 @@ let run p i =
|
|||
*)
|
||||
let compile (defs, p) =
|
||||
let label s = "L" ^ s in
|
||||
let rec call f args =
|
||||
let rec call f args p =
|
||||
let args_code = List.concat @@ List.map expr (List.rev args) in
|
||||
args_code @ [CALL (label f)]
|
||||
args_code @ [CALL (label f, List.length args, p)]
|
||||
and expr = function
|
||||
| Expr.Var x -> [LD x]
|
||||
| Expr.Const n -> [CONST n]
|
||||
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
|
||||
| Expr.Call (f, args) -> call f args
|
||||
| Expr.Call (f, args) -> call f args false
|
||||
in
|
||||
let rec compile_stmt l env = function
|
||||
| Stmt.Read x -> env, false, [READ; ST x]
|
||||
|
|
@ -121,15 +122,15 @@ let compile (defs, p) =
|
|||
let env , flag, body = compile_stmt check env s in
|
||||
env, false, [LABEL loop] @ body @ (if flag then [LABEL check] else []) @ (expr c) @ [CJMP ("z", loop)]
|
||||
|
||||
| Stmt.Call (f, args) -> env, false, call f args
|
||||
| Stmt.Call (f, args) -> env, false, call f args true
|
||||
|
||||
| Stmt.Return e -> env, false, (match e with Some e -> expr e | None -> []) @ [END]
|
||||
| Stmt.Return e -> env, false, (match e with Some e -> expr e | None -> []) @ [RET (e <> None)]
|
||||
in
|
||||
let compile_def env (name, (args, locals, stmt)) =
|
||||
let lend, env = env#get_label in
|
||||
let env, flag, code = compile_stmt lend env stmt in
|
||||
env,
|
||||
[LABEL name; BEGIN (args, locals)] @
|
||||
[LABEL name; BEGIN (name, args, locals)] @
|
||||
code @
|
||||
(if flag then [LABEL lend] else []) @
|
||||
[END]
|
||||
|
|
@ -148,5 +149,5 @@ let compile (defs, p) =
|
|||
in
|
||||
let lend, env = env#get_label in
|
||||
let _, flag, code = compile_stmt lend env p in
|
||||
(LABEL "main" :: if flag then code @ [LABEL lend] else code) @ [END] @ (List.concat def_code)
|
||||
(if flag then code @ [LABEL lend] else code) @ [END] @ (List.concat def_code)
|
||||
|
||||
|
|
|
|||
134
src/X86.ml
134
src/X86.ml
|
|
@ -43,7 +43,8 @@ type instr =
|
|||
(* a label in the code *) | Label of string
|
||||
(* a conditional jump *) | CJmp of string * string
|
||||
(* a non-conditional jump *) | Jmp of string
|
||||
|
||||
(* directive *) | Meta of string
|
||||
|
||||
(* Instruction printer *)
|
||||
let show instr =
|
||||
let binop = function
|
||||
|
|
@ -58,7 +59,9 @@ let show instr =
|
|||
in
|
||||
let opnd = function
|
||||
| R i -> regs.(i)
|
||||
| S i -> Printf.sprintf "-%d(%%ebp)" ((i+1) * word_size)
|
||||
| S i -> if i >= 0
|
||||
then Printf.sprintf "-%d(%%ebp)" ((i+1) * word_size)
|
||||
else Printf.sprintf "%d(%%ebp)" (8+(-i-1) * word_size)
|
||||
| M x -> x
|
||||
| L i -> Printf.sprintf "$%d" i
|
||||
in
|
||||
|
|
@ -75,6 +78,7 @@ let show instr =
|
|||
| Label l -> Printf.sprintf "%s:\n" l
|
||||
| Jmp l -> Printf.sprintf "\tjmp\t%s" l
|
||||
| CJmp (s , l) -> Printf.sprintf "\tj%s\t%s" s l
|
||||
| Meta s -> Printf.sprintf "%s\n" s
|
||||
|
||||
(* Opening stack machine to use instructions without fully qualified names *)
|
||||
open SM
|
||||
|
|
@ -96,7 +100,7 @@ let compile env code =
|
|||
| ">" -> "g"
|
||||
| _ -> failwith "unknown operator"
|
||||
in
|
||||
let rec compile' env scode =
|
||||
let rec compile' env scode =
|
||||
let on_stack = function S _ -> true | _ -> false in
|
||||
match scode with
|
||||
| [] -> env, []
|
||||
|
|
@ -116,15 +120,15 @@ let compile env code =
|
|||
let s, env' = (env#global x)#allocate in
|
||||
env',
|
||||
(match s with
|
||||
| S _ | M _ -> [Mov (M (env'#loc x), eax); Mov (eax, s)]
|
||||
| _ -> [Mov (M (env'#loc x), s)]
|
||||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env'#loc x, s)]
|
||||
)
|
||||
| ST x ->
|
||||
let s, env' = (env#global x)#pop in
|
||||
env',
|
||||
(match s with
|
||||
| S _ | M _ -> [Mov (s, eax); Mov (eax, M (env'#loc x))]
|
||||
| _ -> [Mov (s, M (env'#loc x))]
|
||||
| S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
|
||||
| _ -> [Mov (s, env'#loc x)]
|
||||
)
|
||||
| BINOP op ->
|
||||
let x, y, env' = env#pop2 in
|
||||
|
|
@ -189,6 +193,41 @@ let compile env code =
|
|||
| CJMP (s, l) ->
|
||||
let x, env = env#pop in
|
||||
env, [Binop ("cmp", L 0, x); CJmp (s, l)]
|
||||
|
||||
| BEGIN (f, a, l) ->
|
||||
let env = env#enter f a l in
|
||||
env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp)]
|
||||
|
||||
| END ->
|
||||
env, [Label env#epilogue;
|
||||
Mov (ebp, esp);
|
||||
Pop ebp;
|
||||
Ret;
|
||||
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#lsize (env#allocated * word_size))
|
||||
]
|
||||
|
||||
| RET b ->
|
||||
if b
|
||||
then let x, env = env#pop in env, [Mov (x, eax); Jmp env#epilogue]
|
||||
else env, [Jmp env#epilogue]
|
||||
|
||||
| CALL (f, n, p) ->
|
||||
let pushr, popr =
|
||||
List.split @@ List.map (fun r -> (Push r, Pop r)) env#live_registers
|
||||
in
|
||||
let env, code =
|
||||
if n = 0
|
||||
then env, pushr @ [Call f] @ (List.rev popr)
|
||||
else
|
||||
let rec push_args env acc = function
|
||||
| 0 -> env, acc
|
||||
| n -> let x, env = env#pop in
|
||||
push_args env ((Push x)::acc) (n-1)
|
||||
in
|
||||
let env, pushs = push_args env [] n in
|
||||
env, pushr @ pushs @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
|
||||
in
|
||||
(if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)])
|
||||
in
|
||||
let env'', code'' = compile' env' scode' in
|
||||
env'', code' @ code''
|
||||
|
|
@ -199,15 +238,23 @@ let compile env code =
|
|||
module S = Set.Make (String)
|
||||
|
||||
(* Environment implementation *)
|
||||
let make_assoc l = List.combine l (List.init (List.length l) (fun x -> x))
|
||||
|
||||
class env =
|
||||
object (self)
|
||||
val stack_slots = 0 (* maximal number of stack positions *)
|
||||
val globals = S.empty (* a set of global variables *)
|
||||
val stack = [] (* symbolic stack *)
|
||||
|
||||
val globals = S.empty (* a set of global variables *)
|
||||
val stack_slots = 0 (* maximal number of stack positions *)
|
||||
val stack = [] (* symbolic stack *)
|
||||
val args = [] (* function arguments *)
|
||||
val locals = [] (* function local variables *)
|
||||
val fname = "" (* function name *)
|
||||
|
||||
(* gets a name for a global variable *)
|
||||
method loc x = "global_" ^ x
|
||||
|
||||
method loc x =
|
||||
try S (- (List.assoc x args) - 1)
|
||||
with Not_found ->
|
||||
try S (List.assoc x locals) with Not_found -> M ("global_" ^ x)
|
||||
|
||||
(* allocates a fresh position on a symbolic stack *)
|
||||
method allocate =
|
||||
let x, n =
|
||||
|
|
@ -226,7 +273,7 @@ class env =
|
|||
method push y = {< stack = y::stack >}
|
||||
|
||||
(* pops one operand from the symbolic stack *)
|
||||
method pop = let x::stack' = stack in x, {< stack = stack' >}
|
||||
method pop = let x::stack' = stack in x, {< stack = stack' >}
|
||||
|
||||
(* pops two operands from the symbolic stack *)
|
||||
method pop2 = let x::y::stack' = stack in x, y, {< stack = stack' >}
|
||||
|
|
@ -234,48 +281,49 @@ class env =
|
|||
(* registers a global variable in the environment *)
|
||||
method global x = {< globals = S.add ("global_" ^ x) globals >}
|
||||
|
||||
(* gets the number of allocated stack slots *)
|
||||
method allocated = stack_slots
|
||||
|
||||
(* gets all global variables *)
|
||||
method globals = S.elements globals
|
||||
|
||||
(* gets a number of stack positions allocated *)
|
||||
method allocated = stack_slots
|
||||
|
||||
(* enters a function *)
|
||||
method enter f a l =
|
||||
{< stack_slots = List.length l; stack = []; locals = make_assoc l; args = make_assoc a; fname = f >}
|
||||
|
||||
(* returns a label for the epilogue *)
|
||||
method epilogue = Printf.sprintf "L%s_epilogue" fname
|
||||
|
||||
(* returns a name for local size meta-symbol *)
|
||||
method lsize = Printf.sprintf "L%s_SIZE" fname
|
||||
|
||||
(* returns a list of live registers *)
|
||||
method live_registers =
|
||||
List.filter (function R _ -> true | _ -> false) stack
|
||||
|
||||
end
|
||||
|
||||
(* Compiles a unit: generates x86 machine code for the stack program and surrounds it
|
||||
with function prologue/epilogue
|
||||
*)
|
||||
let compile_unit env scode =
|
||||
let env, code = compile env scode in
|
||||
env,
|
||||
([Push ebp; Mov (esp, ebp); Binop ("-", L (word_size*env#allocated), esp)] @
|
||||
code @
|
||||
[Mov (ebp, esp); Pop ebp; Binop ("^", eax, eax); Ret]
|
||||
)
|
||||
|
||||
|
||||
(* Generates an assembler text for a program: first compiles the program into
|
||||
the stack code, then generates x86 assember code, then prints the assembler file
|
||||
*)
|
||||
let genasm prog =
|
||||
let env, code = compile_unit (new env) (SM.compile prog) in
|
||||
let genasm (ds, stmt) =
|
||||
let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (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 (s ^ ":\t.int\t0")) env#globals) in
|
||||
let asm = Buffer.create 1024 in
|
||||
Buffer.add_string asm "\t.data\n";
|
||||
List.iter
|
||||
(fun s ->
|
||||
Buffer.add_string asm (Printf.sprintf "%s:\t.int\t0\n" s)
|
||||
)
|
||||
env#globals;
|
||||
Buffer.add_string asm "\t.text\n";
|
||||
Buffer.add_string asm "\t.globl\tmain\n";
|
||||
Buffer.add_string asm "main:\n";
|
||||
List.iter
|
||||
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
||||
code;
|
||||
(data @ [Meta "\t.text"; Meta "\t.globl\tmain"] @ code);
|
||||
Buffer.contents asm
|
||||
|
||||
(* Builds a program: generates the assembler file and compiles it with the gcc toolchain *)
|
||||
let build stmt name =
|
||||
let build prog name =
|
||||
let outf = open_out (Printf.sprintf "%s.s" name) in
|
||||
Printf.fprintf outf "%s" (genasm stmt);
|
||||
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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue