mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-24 15:48:47 +00:00
Arrays/strings in x86
This commit is contained in:
Dmitry Boulytchev
parent
39508a0195
commit
7314f109b4
5 changed files with 385 additions and 34 deletions
92
src/X86.ml
92
src/X86.ml
|
|
@ -102,6 +102,35 @@ let compile env code =
|
|||
in
|
||||
let rec compile' env scode =
|
||||
let on_stack = function S _ -> true | _ -> false in
|
||||
let call env f n p =
|
||||
let f =
|
||||
match f.[0] with '.' -> "B" ^ String.sub f 1 (String.length f - 1) | _ -> f
|
||||
in
|
||||
let pushr, popr =
|
||||
List.split @@ List.map (fun r -> (Push r, Pop r)) (env#live_registers n)
|
||||
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
|
||||
let pushs =
|
||||
match f with
|
||||
| "Barray" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Bsta" ->
|
||||
let x::v::is = List.rev pushs in
|
||||
is @ [x; v] @ [Push (L (n-2))]
|
||||
| _ -> List.rev pushs
|
||||
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
|
||||
match scode with
|
||||
| [] -> env, []
|
||||
| instr :: scode' ->
|
||||
|
|
@ -110,6 +139,13 @@ let compile env code =
|
|||
| CONST n ->
|
||||
let s, env' = env#allocate in
|
||||
(env', [Mov (L n, s)])
|
||||
|
||||
| STRING s ->
|
||||
let s, env = env#string s in
|
||||
let l, env = env#allocate in
|
||||
let env, call = call env ".string" 1 false in
|
||||
(env, Mov (M ("$" ^ s), l) :: call)
|
||||
|
||||
| LD x ->
|
||||
let s, env' = (env#global x)#allocate in
|
||||
env',
|
||||
|
|
@ -117,7 +153,15 @@ let compile env code =
|
|||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env'#loc x, s)]
|
||||
)
|
||||
| STA (x, n) -> failwith ""
|
||||
| STA (x, n) ->
|
||||
let s, env = (env#global x)#allocate in
|
||||
let push =
|
||||
match s with
|
||||
| S _ | M _ -> [Mov (env#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env#loc x, s)]
|
||||
in
|
||||
let env, code = call env ".sta" (n+2) true in
|
||||
env, push @ code
|
||||
| ST x ->
|
||||
let s, env' = (env#global x)#pop in
|
||||
env',
|
||||
|
|
@ -206,23 +250,7 @@ let compile env code =
|
|||
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 @ (List.rev 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)])
|
||||
| CALL (f, n, p) -> call env f n p
|
||||
in
|
||||
let env'', code'' = compile' env' scode' in
|
||||
env'', code' @ code''
|
||||
|
|
@ -232,12 +260,17 @@ let compile env code =
|
|||
(* A set of strings *)
|
||||
module S = Set.Make (String)
|
||||
|
||||
(* A map indexed by strings *)
|
||||
module M = Map.Make (String)
|
||||
|
||||
(* Environment implementation *)
|
||||
let make_assoc l = List.combine l (List.init (List.length l) (fun x -> x))
|
||||
|
||||
class env =
|
||||
object (self)
|
||||
val globals = S.empty (* a set of global variables *)
|
||||
val stringm = M.empty (* a string map *)
|
||||
val scount = 0 (* string count *)
|
||||
val stack_slots = 0 (* maximal number of stack positions *)
|
||||
val stack = [] (* symbolic stack *)
|
||||
val args = [] (* function arguments *)
|
||||
|
|
@ -276,9 +309,20 @@ class env =
|
|||
(* registers a global variable in the environment *)
|
||||
method global x = {< globals = S.add ("global_" ^ x) globals >}
|
||||
|
||||
(* registers a string constant *)
|
||||
method string x =
|
||||
try M.find x stringm, self
|
||||
with Not_found ->
|
||||
let y = Printf.sprintf "string_%d" scount in
|
||||
let m = M.add x y stringm in
|
||||
y, {< scount = scount + 1; stringm = m>}
|
||||
|
||||
(* gets all global variables *)
|
||||
method globals = S.elements globals
|
||||
|
||||
(* gets all string definitions *)
|
||||
method strings = M.bindings stringm
|
||||
|
||||
(* gets a number of stack positions allocated *)
|
||||
method allocated = stack_slots
|
||||
|
||||
|
|
@ -293,8 +337,13 @@ class env =
|
|||
method lsize = Printf.sprintf "L%s_SIZE" fname
|
||||
|
||||
(* returns a list of live registers *)
|
||||
method live_registers =
|
||||
List.filter (function R _ -> true | _ -> false) stack
|
||||
method live_registers depth =
|
||||
let rec inner d acc = function
|
||||
| [] -> acc
|
||||
| (R _ as r)::tl -> inner (d+1) (if d >= depth then (r::acc) else acc) tl
|
||||
| _::tl -> inner (d+1) acc tl
|
||||
in
|
||||
inner 0 [] stack
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -308,7 +357,8 @@ let genasm (ds, stmt) =
|
|||
(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 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 asm = Buffer.create 1024 in
|
||||
List.iter
|
||||
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue