mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-13 10:18: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
|
|
@ -71,19 +71,19 @@ module State =
|
|||
(* Builtins *)
|
||||
module Builtin =
|
||||
struct
|
||||
|
||||
|
||||
let eval (st, i, o, _) args = function
|
||||
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
|
||||
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
|
||||
| "$elem" -> let [b; j] = args in
|
||||
| ".elem" -> let [b; j] = args in
|
||||
(st, i, o, let i = Value.to_int j in
|
||||
Some (match b with
|
||||
| Value.String s -> Value.of_int @@ Char.code s.[i]
|
||||
| Value.Array a -> List.nth a i
|
||||
)
|
||||
)
|
||||
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| "$array" -> (st, i, o, Some (Value.of_array args))
|
||||
| ".length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| ".array" -> (st, i, o, Some (Value.of_array args))
|
||||
| "isArray" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.Array _ -> 1 | _ -> 0))
|
||||
| "isString" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.String _ -> 1 | _ -> 0))
|
||||
|
||||
|
|
@ -158,7 +158,7 @@ module Expr =
|
|||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Array xs ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
env#definition env "$array" vs (st, i, o, None)
|
||||
env#definition env ".array" vs (st, i, o, None)
|
||||
| Sexp (t, xs) ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
(st, i, o, Some (Value.Sexp (t, vs)))
|
||||
|
|
@ -168,10 +168,10 @@ module Expr =
|
|||
(st, i, o, Some (Value.of_int @@ to_func op (Value.to_int x) (Value.to_int y)))
|
||||
| Elem (b, i) ->
|
||||
let (st, i, o, args) = eval_list env conf [b; i] in
|
||||
env#definition env "$elem" args (st, i, o, None)
|
||||
env#definition env ".elem" args (st, i, o, None)
|
||||
| Length e ->
|
||||
let (st, i, o, Some v) = eval env conf e in
|
||||
env#definition env "$length" [v] (st, i, o, None)
|
||||
env#definition env ".length" [v] (st, i, o, None)
|
||||
| Call (f, args) ->
|
||||
let (st, i, o, args) = eval_list env conf args in
|
||||
env#definition env f args (st, i, o, None)
|
||||
|
|
@ -244,7 +244,6 @@ module Stmt =
|
|||
Takes an environment, a configuration and a statement, and returns another configuration. The
|
||||
environment is the same as for expressions
|
||||
*)
|
||||
|
||||
let update st x v is =
|
||||
let rec update a v = function
|
||||
| [] -> v
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
|||
Takes a program, an input stream, and returns an output stream this program calculates
|
||||
*)
|
||||
let run p i =
|
||||
(* print_prg p; *)
|
||||
(*print_prg p; *)
|
||||
let module M = Map.Make (String) in
|
||||
let rec make_map m = function
|
||||
| [] -> m
|
||||
|
|
@ -119,9 +119,9 @@ let compile (defs, p) =
|
|||
| Expr.String s -> [STRING s]
|
||||
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
|
||||
| Expr.Call (f, args) -> call f args false
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL ("$array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr a @ expr i @ [CALL ("$elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL ("$length", 1, false)]
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL (".array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr a @ expr i @ [CALL (".elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL (".length", 1, false)]
|
||||
in
|
||||
let rec compile_stmt l env = function
|
||||
| Stmt.Assign (x, [], e) -> env, false, expr e @ [ST x]
|
||||
|
|
|
|||
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