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

Initialization of separate units; fixed runtime

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-01-26 06:06:14 +03:00
parent 811c24d5a6
commit c09a3b36b6
13 changed files with 116 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/Driver.ml
View file

@ -104,7 +104,11 @@ class options args =
| Some name -> name
method get_help = !help
method get_include_paths = !paths
method basename = Filename.chop_suffix self#get_infile ".expr"
method basename = Filename.chop_suffix (Filename.basename self#get_infile) ".expr"
method topname =
match !mode with
| `Compile -> "init" ^ self#basename
| _ -> "main"
method dump_file ext contents =
let name = self#basename in
let outf = open_out (Printf.sprintf "%s.%s" name ext) in

6
src/Language.ml
View file

@ -372,7 +372,7 @@ module Expr =
(* return statement *) | Return of t option
(* ignore a value *) | Ignore of t
(* unit value *) | Unit
(* entering the scope *) | Scope of (string * decl) list * t
(* entering the scope *) | Scope of (string * decl) list * t
(* lambda expression *) | Lambda of string list * t
(* leave a scope *) | Leave
(* intrinsic (for evaluation) *) | Intrinsic of (t config, t config) arrow
@ -1075,11 +1075,11 @@ ostap (
is, infix
};
(* Workaround until Ostap starts to memoize properly *)
constparse[cmd]: <(is, infix)> : imports[cmd] d:!(Definition.constdef) {(is, []), Expr.Scope (d, Expr.Skip)};
constparse[cmd]: <(is, infix)> : imports[cmd] d:!(Definition.constdef) {(is, []), Expr.Scope (d, Expr.materialize Expr.Weak Expr.Skip)};
(* end of the workaround *)
parse[cmd]:
<(is, infix)> : imports[cmd] <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Weak)? {
(is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
(is, Infix.extract_exports infix'), Expr.Scope (d, match expr with None -> Expr.materialize Expr.Weak Expr.Skip | Some e -> e)
};
definitions[infix]:
<(def, infix')> : !(Definition.parse infix (fun def infix atr -> Expr.scope def infix atr (Expr.parse def))

6
src/SM.ml
View file

@ -878,9 +878,9 @@ let compile cmd ((imports, infixes), p) =
let lend, env = env#get_label in
let env, flag, code = compile_expr lend env p in
let code = if flag then code @ [LABEL lend] else code in
let has_main = List.length code > 0 in
let env, prg = compile_fundefs [if has_main then [LABEL "main"; BEGIN ("main", 0, env#nlocals, [])] @ code @ [END] else []] env in
let prg = (if has_main then [PUBLIC "main"] else []) @ env#get_decls @ List.flatten prg in
let topname = cmd#topname in
let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, 0, env#nlocals, [])] @ code @ [END]] env in
let prg = [PUBLIC topname] @ env#get_decls @ List.flatten prg in
(*Printf.eprintf "Before propagating closures:\n";
Printf.eprintf "%s\n%!" env#show_funinfo;
*)

45
src/X86.ml
View file

@ -64,14 +64,15 @@ type instr =
(* Instruction printer *)
let show instr =
let binop = function
| "+" -> "addl"
| "-" -> "subl"
| "*" -> "imull"
| "&&" -> "andl"
| "!!" -> "orl"
| "^" -> "xorl"
| "cmp" -> "cmpl"
| _ -> failwith "unknown binary operator"
| "+" -> "addl"
| "-" -> "subl"
| "*" -> "imull"
| "&&" -> "andl"
| "!!" -> "orl"
| "^" -> "xorl"
| "cmp" -> "cmpl"
| "test" -> "test"
| _ -> failwith "unknown binary operator"
in
let rec opnd = function
| R i -> regs.(i)
@ -116,7 +117,7 @@ open SM
Take an environment, a stack machine program, and returns a pair --- the updated environment and the list
of x86 instructions
*)
let compile cmd env code =
let compile cmd env imports code =
(* SM.print_prg code; *)
flush stdout;
let suffix = function
@ -356,6 +357,17 @@ let compile cmd env code =
let has_closure = closure <> [] in
let env = env#enter f nlocals has_closure in
env, (if has_closure then [Push edx] else []) @
(if f = cmd#topname
then
[Mov (M "_init", eax);
Binop ("test", eax, eax);
CJmp ("z", "_continue");
Ret;
Label "_continue";
Mov (L 1, M "_init");
]
else []
) @
[Push ebp;
Mov (esp, ebp);
Binop ("-", M ("$" ^ env#lsize), esp);
@ -364,7 +376,14 @@ let compile cmd env code =
Mov (M ("$" ^ (env#allocated_size)), ecx);
Repmovsl
] @
(if f = "main" then [Call "L__gc_init"] else [])
(if f = "main"
then [Call "L__gc_init"]
else []
) @
(if f = cmd#topname
then List.map (fun i -> Call ("init" ^ i)) (List.filter (fun i -> i <> "Std") imports)
else []
)
| END ->
let x, env = env#pop in
@ -646,11 +665,13 @@ class env prg =
*)
let genasm cmd prog =
let sm = SM.compile cmd prog in
let env, code = compile cmd (new env sm) sm in
let env, code = compile cmd (new env sm) (fst (fst prog)) sm in
let globals =
List.map (fun s -> Meta (Printf.sprintf "\t.globl\t%s" s)) env#publics
in
let data = [Meta "\t.section custom_data,\"aw\",@progbits";
let data = [Meta "\t.data";
Meta "_init:\t.int 0";
Meta "\t.section custom_data,\"aw\",@progbits";
Meta (Printf.sprintf "filler:\t.fill\t%d, 4, 1" env#max_locals_size)] @
(List.map (fun s -> Meta (Printf.sprintf "%s:\t.int\t1" s)) env#globals) @
(List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings)