From 455a52999956fd4b47e4bce9762e458cd480aabb Mon Sep 17 00:00:00 2001 From: Dmitry Boulytchev Date: Thu, 12 Dec 2019 17:42:45 +0300 Subject: [PATCH] Dumps implemented --- src/Driver.ml | 32 +++++++++++++++++++++++++++----- src/Language.ml | 2 +- src/SM.ml | 6 +++++- src/X86.ml | 10 +++++++--- 4 files changed, 40 insertions(+), 10 deletions(-) diff --git a/src/Driver.ml b/src/Driver.ml index a5863929a..7586d7150 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -37,22 +37,27 @@ exception Commandline_error of string class options args = let n = Array.length args in let rec fix f = f (fix f) in + let dump_ast = 1 in + let dump_sm = 2 in object (self) val i = ref 1 val infile = ref (None : string option) val paths = ref [try Sys.getenv "RC_RUNTIME" with _ -> "../runtime"] val mode = ref (`Default : [`Default | `Eval | `SM | `Compile ]) + val dump = ref 0 val help = ref false initializer let rec loop () = match self#peek with | Some opt -> (match opt with - | "-c" -> self#set_mode `Compile - | "-I" -> (match self#peek with None -> raise (Commandline_error "path expected after '-I' specifier") | Some path -> self#add_include_path path) - | "-s" -> self#set_mode `SM - | "-i" -> self#set_mode `Eval - | "-h" -> self#set_help + | "-c" -> self#set_mode `Compile + | "-I" -> (match self#peek with None -> raise (Commandline_error "path expected after '-I' specifier") | Some path -> self#add_include_path path) + | "-s" -> self#set_mode `SM + | "-i" -> self#set_mode `Eval + | "-ds" -> self#set_dump dump_sm + | "-dp" -> self#set_dump dump_ast + | "-h" -> self#set_help | _ -> if opt.[0] = '-' then raise (Commandline_error (Printf.sprintf "invalid command line specifier ('%s')" opt)) @@ -61,6 +66,8 @@ class options args = loop () | None -> () in loop () + method private set_dump mask = + dump := !dump lor mask method private set_infile name = match !infile with | None -> infile := Some name @@ -84,6 +91,20 @@ 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 dump_file ext contents = + let name = self#basename in + let outf = open_out (Printf.sprintf "%s.%s" name ext) in + Printf.fprintf outf "%s" contents; + close_out outf + method dump_AST ast = + if (!dump land dump_ast) > 0 + then self#dump_file "ast" (GT.show(Language.Expr.t) ast) + else () + method dump_SM sm = + if (!dump land dump_sm) > 0 + then self#dump_file "sm" (SM.show_prg sm) + else () end let main = @@ -91,6 +112,7 @@ let main = let cmd = new options Sys.argv in match (try parse cmd with Language.Semantic_error msg -> `Fail msg) with | `Ok prog -> + cmd#dump_AST (snd prog); (match cmd#get_mode with | `Default | `Compile -> ignore @@ X86.build cmd prog diff --git a/src/Language.ml b/src/Language.ml index 3531af655..1bec29a46 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -329,7 +329,7 @@ module Expr = (* intrinsic (for evaluation) *) | Intrinsic of (t config, t config) arrow (* control (for control flow) *) | Control of (t config, t * t config) arrow and decl = [`Local | `Public | `Extern | `PublicExtern ] * [`Fun of string list * t | `Variable of t option] - with show,html + with show, html (* Reff : parsed expression should return value Reff (look for ":="); Val : -//- returns simple value; diff --git a/src/SM.ml b/src/SM.ml index 6f29ec4fa..264bbeed3 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -37,7 +37,10 @@ with show (* The type for the stack machine program *) @type prg = insn list with show -let print_prg p = List.iter (fun i -> Printf.eprintf "%s\n%!" (show(insn) i)) p;; +let show_prg p = + let b = Buffer.create 512 in + List.iter (fun i -> Buffer.add_string b (show(insn) i); Buffer.add_string b "\n") p; + Buffer.contents b;; (* Values *) @type value = (string, value array) Value.t with show @@ -760,4 +763,5 @@ let compile cmd ((imports, infixes), p) = 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 + cmd#dump_SM prg; prg diff --git a/src/X86.ml b/src/X86.ml index 365a759d9..827e4bab6 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -689,6 +689,9 @@ let build cmd prog = in iterate [] S.empty imports in + cmd#dump_file "s" (genasm cmd prog); + cmd#dump_file "i" (Interface.gen prog); + (* let name = Filename.chop_suffix cmd#get_infile ".expr" in let outf = open_out (Printf.sprintf "%s.s" name) in Printf.fprintf outf "%s" (genasm cmd prog); @@ -696,13 +699,14 @@ let build cmd prog = let outf = open_out (Printf.sprintf "%s.i" name) in Printf.fprintf outf "%s" (Interface.gen prog); close_out outf; - let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in + *) + let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in match cmd#get_mode with | `Default -> 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; - Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s %s/runtime.a" name name (Buffer.contents buf) inc) + Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s %s/runtime.a" cmd#basename cmd#basename (Buffer.contents buf) inc) | `Compile -> - Sys.command (Printf.sprintf "gcc -g -m32 -c %s.s" name) + Sys.command (Printf.sprintf "gcc -g -m32 -c %s.s" cmd#basename) | _ -> invalid_arg "must not happen"