From d000cf2f133a0ab24cc1ad89f0577710321f06aa Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Fri, 4 Sep 2020 00:25:07 +0300 Subject: [PATCH] Debugging support (weak for now) --- src/Driver.ml | 4 ++++ src/Makefile | 1 + src/SM.ml | 24 +++++++++++++++++++----- src/X86.ml | 16 +++++++--------- src/version.ml | 2 +- 5 files changed, 32 insertions(+), 15 deletions(-) diff --git a/src/Driver.ml b/src/Driver.ml index fc9eb5225..e1d1dc1ee 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -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") diff --git a/src/Makefile b/src/Makefile index d44eb43b1..b29eb0647 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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) diff --git a/src/SM.ml b/src/SM.ml index 90e7f70f4..01de524f6 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -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 diff --git a/src/X86.ml b/src/X86.ml index 4310b420a..43ab2c8fe 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -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 () = diff --git a/src/version.ml b/src/version.ml index dc311332b..63058b42f 100644 --- a/src/version.ml +++ b/src/version.ml @@ -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"