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

Debugging support (weak for now)

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-09-04 00:25:07 +03:00
parent 6ed1b44439
commit d000cf2f13
5 changed files with 32 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/Driver.ml
View file

@ -65,6 +65,7 @@ class options args =
val outfile = ref (None : string option)
val paths = ref [X86.get_std_path ()]
val mode = ref (`Default : [`Default | `Eval | `SM | `Compile ])
val curdir = Unix.getcwd ()
(* Workaround until Ostap starts to memoize properly *)
val const = ref false
(* end of the workaround *)
@ -127,6 +128,9 @@ class options args =
match !outfile with
| None -> Printf.sprintf "-o %s" self#basename
| Some name -> Printf.sprintf "-o %s" name
method get_absolute_infile =
let f = self#get_infile in
if Filename.is_relative f then Filename.concat curdir f else f
method get_infile =
match !infile with
| None -> raise (Commandline_error "Input file not specified")

1
src/Makefile
View file

@ -7,6 +7,7 @@ CAMLP5 = -syntax camlp5o -package ostap.syntax,GT.syntax.all
PXFLAGS = $(CAMLP5)
BFLAGS = -rectypes -g
OFLAGS = $(BFLAGS)
LIBS = unix.cma
all: metagen .depend $(TOPFILE)

24
src/SM.ml
View file

@ -36,6 +36,7 @@ open Language
(* match failure (location, leave a value *) | FAIL of Loc.t * bool
(* external definition *) | EXTERN of string
(* public definition *) | PUBLIC of string
(* line info *) | LINE of int
with show
(* The type for the stack machine program *)
@ -102,8 +103,9 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio
Printf.eprintf " stack=%s\n" (show(list) (show(value)) stack);
Printf.eprintf "end\n";
*)
(match insn with
| PUBLIC _ | EXTERN _ -> eval env conf prg'
(match insn with
| PUBLIC _ | EXTERN _ | LINE _ -> eval env conf prg'
| BINOP "==" -> let y::x::stack' = stack in
let z =
match x, y with
@ -426,6 +428,7 @@ object (self : 'self)
val fundefs = Top []
val decls = []
val funinfo = new funinfo
val line = None
method show_funinfo = funinfo#show_funinfo
@ -630,7 +633,15 @@ object (self : 'self)
| fds, Some fd -> Some ({< fundefs = fds >}, from_fundef fd)
method closure = List.rev scope.closure
method gen_line name =
match Loc.get name with
| None -> self, []
| Some (l, _) ->
match line with
| None -> {< line = Some l >}, [LINE l]
| Some l' when l' <> l -> {< line = Some l >}, [LINE l]
| _ -> self, []
end
let compile cmd ((imports, infixes), p) =
@ -740,8 +751,11 @@ let compile cmd ((imports, infixes), p) =
add_code (compile_expr tail ls env s) ls false [DROP]
| Expr.ElemRef (x, i) -> compile_list tail l env [x; i]
| Expr.Var x -> let env, acc = env#lookup x in (match acc with Value.Fun name -> env#register_call name, false, [PROTO (name, env#current_function)] | _ -> env, false, [LD acc])
| Expr.Ref x -> let env, acc = env#lookup x in env, false, [LDA acc]
| Expr.Var x -> let env, line = env#gen_line x in
let env, acc = env#lookup x in
(match acc with Value.Fun name -> env#register_call name, false, line @ [PROTO (name, env#current_function)] | _ -> env, false, line @ [LD acc])
| Expr.Ref x -> let env, line = env#gen_line x in
let env, acc = env#lookup x in env, false, line @ [LDA acc]
| Expr.Const n -> env, false, [CONST n]
| Expr.String s -> env, false, [STRING s]
| Expr.Binop (op, x, y) -> let lop, env = env#get_label in

16
src/X86.ml
View file

@ -395,7 +395,8 @@ let compile cmd env imports code =
env#assert_empty_stack;
let has_closure = closure <> [] in
let env = env#enter f nargs nlocals has_closure in
env, (if has_closure then [Push edx] else []) @
env, [Meta "\t.cfi_startproc\n"] @
(if has_closure then [Push edx] else []) @
(if f = cmd#topname
then
[Mov (M "_init", eax);
@ -437,6 +438,7 @@ let compile cmd env imports code =
env#rest_closure @
(if name = "main" then [Binop ("^", eax, eax)] else []) @
[Ret;
Meta "\t.cfi_endproc\n";
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#lsize (env#allocated * word_size));
Meta (Printf.sprintf "\t.set\t%s,\t%d" env#allocated_size env#allocated)
]
@ -489,7 +491,9 @@ let compile cmd env imports code =
| Sexp -> ".sexp_tag_patt"
| Closure -> ".closure_tag_patt"
) 1 false
| LINE (line) ->
env, [Meta (Printf.sprintf "\t.loc\t1 %d" line)]
| FAIL ((line, col), value) ->
let v, env = if value then env#peek, env else env#pop in
let s, env = env#string cmd#get_infile in
@ -719,17 +723,11 @@ let genasm cmd prog =
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)
(* 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) *)
in
let asm = Buffer.create 1024 in
List.iter
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
(globals @ data @ [Meta "\t.text"] @ code);
([Meta (Printf.sprintf "\t.file\t1 \"%s\"" cmd#get_absolute_infile)] @ globals @ data @ [Meta "\t.text"] @ code);
Buffer.contents asm
let get_std_path () =

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.00, f16f695ed, Tue Sep 1 17:23:36 2020 +0300"
let version = "Version 1.00, 6ed1b4443, Tue Sep 1 20:31:34 2020 +0300"