From e2e6d479961a232192b6cecb745fea86cc2cf58a Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Sun, 6 Sep 2020 21:39:58 +0300 Subject: [PATCH] Better debugging support. No local variables yet. --- src/SM.ml | 17 ++++++++------- src/X86.ml | 58 +++++++++++++++++++++++++++++++++++++++----------- src/version.ml | 2 +- 3 files changed, 56 insertions(+), 21 deletions(-) diff --git a/src/SM.ml b/src/SM.ml index 62034dcac..482937a82 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -18,7 +18,7 @@ open Language (* a label *) | LABEL of string (* unconditional jump *) | JMP of string (* conditional jump *) | CJMP of string * string -(* begins procedure definition *) | BEGIN of string * int * int * Value.designation list +(* begins procedure definition *) | BEGIN of string * string list * int * int * Value.designation list (* end procedure definition *) | END (* create a closure *) | CLOSURE of string * Value.designation list (* proto closure *) | PROTO of string * string @@ -171,7 +171,7 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio | _ -> invalid_arg "not a closure (or a builtin) in CALL: %s\n" @@ show(value) f ) - | BEGIN (_, _, locals, _) -> eval env (cstack, stack, glob, {loc with locals = Array.init locals (fun _ -> Value.Empty)}, i, o) prg' + | BEGIN (_, _, _, locals, _) -> eval env (cstack, stack, glob, {loc with locals = Array.init locals (fun _ -> Value.Empty)}, i, o) prg' | END -> (match cstack with | (prg', loc')::cstack' -> eval env (cstack', (*Value.Empty ::*) stack, glob, loc', i, o) prg' @@ -765,12 +765,13 @@ let compile cmd ((imports, infixes), p) = | Expr.Call (f, args) -> let lcall, env = env#get_label in (match f with | Expr.Var name -> - let env, acc = env#lookup name in + let env, line = env#gen_line name in + let env, acc = env#lookup name in (match acc with | Value.Fun name -> let env = env#register_call name in let env, f, code = add_code (compile_list false lcall env args) lcall false [PCALLC (List.length args, tail)] in - env, f, PPROTO (name, env#current_function) :: code + env, f, line @ (PPROTO (name, env#current_function) :: code) | _ -> add_code (compile_list false lcall env (f :: args)) lcall false [CALLC (List.length args, tail)] ) @@ -867,7 +868,7 @@ let compile cmd ((imports, infixes), p) = (*Printf.eprintf "Function: %s, closure: %s\n%!" name (show(list) (show(Value.designation)) env#closure);*) let env = env#register_closure name in let code = - ([LABEL name; BEGIN (name, env#nargs, env#nlocals, env#closure)] @ + ([LABEL name; BEGIN (name, args, env#nargs, env#nlocals, env#closure)] @ code @ (if flag then [LABEL lend] else []) @ [END]) :: funcode @@ -883,8 +884,8 @@ let compile cmd ((imports, infixes), p) = let fix_closures env prg = let rec inner state = function | [] -> [] - | BEGIN (f, a, l, c) :: tl -> BEGIN (f, a, l, try env#get_fun_closure f with Not_found -> c) :: inner state tl - | PROTO (f, c) :: tl -> CLOSURE (f, env#get_closure (f, c)) :: inner state tl + | BEGIN (f, a, na, l, c) :: tl -> BEGIN (f, a, na, l, try env#get_fun_closure f with Not_found -> c) :: inner state tl + | PROTO (f, c) :: tl -> CLOSURE (f, env#get_closure (f, c)) :: inner state tl | PPROTO (f, c) :: tl -> (match env#get_closure (f, c) with | [] -> inner (Some f :: state) tl @@ -904,7 +905,7 @@ let compile cmd ((imports, infixes), p) = let env, flag, code = compile_expr false lend env p in let code = if flag then code @ [LABEL lend] else code in let topname = cmd#topname in - let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, (if topname = "main" then 2 else 0), env#nlocals, [])] @ code @ [END]] env in + let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, [], (if topname = "main" then 2 else 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; diff --git a/src/X86.ml b/src/X86.ml index 0e80fcea1..6027fe4ae 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -391,11 +391,22 @@ let compile cmd env imports code = let x, env = env#pop in env#set_stack l, [Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l)] - | BEGIN (f, nargs, nlocals, closure) -> + | BEGIN (f, args, nargs, nlocals, closure) -> + let name = + if f.[0] = 'L' then String.sub f 1 (String.length f - 1) else f + in env#assert_empty_stack; let has_closure = closure <> [] in - let env = env#enter f nargs nlocals has_closure in - env, [Meta "\t.cfi_startproc"] @ + let env = env#enter f nargs nlocals has_closure in + env, [Meta (Printf.sprintf "\t.type %s, @function" name)] @ + (if f = "main" + then [] + else + [Meta (Printf.sprintf "\t.stabs \"%s:F1\",36,0,0,%s" name f)] @ + (List.mapi (fun i a -> Meta (Printf.sprintf "\t.stabs \"%s:p1\",160,0,0,%d" a ((i*4) + match closure with [] -> 8 | _ -> 12))) args) + ) + @ + [Meta "\t.cfi_startproc"] @ (if has_closure then [Push edx; Meta "\t.cfi_adjust_cfa_offset\t8"] else []) @ (if f = cmd#topname then @@ -444,7 +455,8 @@ let compile cmd env imports code = Ret; Meta "\t.cfi_endproc"; 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) + Meta (Printf.sprintf "\t.set\t%s,\t%d" env#allocated_size env#allocated); + Meta (Printf.sprintf "\t.size %s, .-%s" name name); ] | RET -> @@ -496,7 +508,7 @@ let compile cmd env imports code = | Closure -> ".closure_tag_patt" ) 1 false | LINE (line) -> - env, [Meta (Printf.sprintf "\t.loc\t1 %d" line)] + env#gen_line line | FAIL ((line, col), value) -> let v, env = if value then env#peek, env else env#pop in @@ -532,7 +544,6 @@ class env prg = val static_size = 0 (* static data size *) val stack = [] (* symbolic stack *) val nargs = 0 (* number of function arguments *) - (* val args = [] (* function arguments *) *) val locals = [] (* function local variables *) val fname = "" (* function name *) val stackmap = M.empty (* labels to stack map *) @@ -541,7 +552,9 @@ class env prg = val has_closure = false val publics = S.empty val externs = S.empty - + val nlabels = 0 + val first_line = true + method publics = S.elements publics method register_public name = {< publics = S.add name publics >} @@ -693,7 +706,7 @@ class env prg = (* enters a function *) method enter f nargs nlocals has_closure = - {< nargs = nargs; static_size = nlocals; stack_slots = nlocals; stack = []; fname = f; has_closure = has_closure >} + {< nargs = nargs; static_size = nlocals; stack_slots = nlocals; stack = []; fname = f; has_closure = has_closure; first_line = true >} (* returns a label for the epilogue *) method epilogue = Printf.sprintf "L%s_epilogue" fname @@ -710,6 +723,17 @@ class env prg = in inner 0 [] stack + (* generate a line number information for current function *) + method gen_line line = + let lab = Printf.sprintf ".L%d" nlabels in + {< nlabels = nlabels + 1; first_line = false >}, + if fname = "main" + then + [Meta (Printf.sprintf "\t.stabn 68,0,%d,%s" line lab); Label lab] + else + (if first_line then [Meta (Printf.sprintf "\t.stabn 68,0,%d,0" line)] else []) @ + [Meta (Printf.sprintf "\t.stabn 68,0,%d,%s-%s" line lab fname); Label lab] + end (* Generates an assembler text for a program: first compiles the program into @@ -726,12 +750,22 @@ let genasm cmd prog = [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.concat @@ + List.map + (fun s -> [Meta (Printf.sprintf "\t.stabs \"%s:S1\",40,0,0,%s" (String.sub s (String.length "global_") (String.length s - String.length "global_")) s); + Meta (Printf.sprintf "%s:\t.int\t1" s)]) + env#globals + ) in let asm = Buffer.create 1024 in List.iter (fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i)) - ([Meta (Printf.sprintf "\t.file\t1 \"%s\"" cmd#get_absolute_infile)] @ globals @ data @ [Meta "\t.text"] @ code); + ([Meta (Printf.sprintf "\t.file \"%s\"" cmd#get_absolute_infile); + Meta (Printf.sprintf "\t.stabs \"%s\",100,0,0,.Ltext" cmd#get_absolute_infile)] @ + globals @ + data @ + [Meta "\t.text"; Label ".Ltext"; Meta "\t.stabs \"data:t1=r1;0;4294967295;\",128,0,0,0"] @ + code); Buffer.contents asm let get_std_path () = @@ -767,8 +801,8 @@ let build cmd prog = let objs = find_objects (fst @@ fst prog) cmd#get_include_paths in let buf = Buffer.create 255 in List.iter (fun o -> Buffer.add_string buf o; Buffer.add_string buf " ") objs; - let gcc_cmdline = Printf.sprintf "gcc -g -m32 %s %s.s %s %s/runtime.a" cmd#get_output_option cmd#basename (Buffer.contents buf) inc in + let gcc_cmdline = Printf.sprintf "gcc -m32 %s %s.s %s %s/runtime.a" cmd#get_output_option cmd#basename (Buffer.contents buf) inc in Sys.command gcc_cmdline | `Compile -> - Sys.command (Printf.sprintf "gcc -g -m32 -c %s.s" cmd#basename) + Sys.command (Printf.sprintf "gcc -m32 -c %s.s" cmd#basename) | _ -> invalid_arg "must not happen" diff --git a/src/version.ml b/src/version.ml index 65eae3c89..43dcb82f3 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1 +1 @@ -let version = "Version 1.00, d000cf2f1, Fri Sep 4 00:25:07 2020 +0300" +let version = "Version 1.00, 81c060d21, Fri Sep 4 23:45:57 2020 +0300"