st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-05 22:38:44 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Functions in X86

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-04-11 00:47:46 +03:00
parent 8907ab2119
commit b19bea4d58
13 changed files with 126 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/Makefile
View file

@ -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

2
regression/deep-expressions/Makefile
View file

@ -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

2
regression/expressions/Makefile
View file

@ -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

2
regression/test024.expr
View file

@ -6,6 +6,8 @@ fun test2 (b) {
a := b
}
read (x);
test1 ();
write (a);

2
regression/test025.expr
View file

@ -16,6 +16,8 @@ fun print () {
write (c)
}
read (x);
a := 100;
b := 200;
c := 300;

2
regression/test026.expr
View file

@ -19,6 +19,8 @@ fun print () {
write (c)
}
read (x);
a := 100;
b := 200;
c := 300;

2
regression/test027.expr
View file

@ -21,6 +21,8 @@ fun test2 (b) {
print ()
}
read (x);
a := 100;
b := 200;
c := 300;

2
regression/test032.expr
View file

@ -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))

2
regression/test033.expr
View file

@ -8,5 +8,7 @@ fun test (n, m) local i, s {
return s
}
read (x);
write (test (10, 100));
write (test (100, 10))

4
src/Driver.ml
View file

@ -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
*)
else
let rec read acc =
try

31
src/SM.ml
View file

@ -12,9 +12,10 @@ open Language
(* a label *) | LABEL 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)

124
src/X86.ml
View file

@ -43,6 +43,7 @@ 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 =
@ -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
@ -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,14 +238,22 @@ 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 =
@ -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
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]
)
(* 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
(* 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)