From 02209117f467934fc15b5c53d152f5d6d1af7c8e Mon Sep 17 00:00:00 2001 From: Roman Venediktov Date: Fri, 5 Jul 2024 13:23:20 +0200 Subject: [PATCH] Added flags and style fixed --- Makefile | 16 +--- runtime/Makefile | 6 -- src/Driver.ml | 194 +------------------------------------------ src/Options.ml | 211 +++++++++++++++++++++++++++++++++++++++++++++++ src/X86_64.ml | 199 ++++++++++++++++++++++---------------------- src/dune | 2 +- 6 files changed, 314 insertions(+), 314 deletions(-) create mode 100644 src/Options.ml diff --git a/Makefile b/Makefile index 0835a1b28..7df448f80 100644 --- a/Makefile +++ b/Makefile @@ -8,23 +8,14 @@ BUILDDIR = build all: $(MAKE) -C src $(MAKE) -C runtime - # $(MAKE) -C byterun $(MAKE) -C stdlib - # $(MAKE) -C runtime unit_tests.o - # $(MAKE) -C runtime invariants_check.o - # $(MAKE) -C runtime invariants_check_debug_print.o STD_FILES=$(shell ls stdlib/*.[oi] stdlib/*.lama runtime/runtime.a runtime/Std.i) -remake_runtime: - $(MAKE) -C runtime clean - $(MAKE) -C runtime all - -copy_to_build: all remake_runtime +build: all mkdir -p $(BUILDDIR) cp -r runtime/Std.i runtime/runtime.a stdlib/* src/lamac $(BUILDDIR) - install: all $(INSTALL) $(EXECUTABLE) `opam var bin` $(MKDIR) -p `opam var share`/Lama @@ -44,11 +35,6 @@ regression-expressions: $(MAKE) clean check -j8 -C regression/expressions $(MAKE) clean check -j8 -C regression/deep-expressions -unit_tests: - ./runtime/unit_tests.o - ./runtime/invariants_check.o - ./runtime/invariants_check_debug_print.o - negative_scenarios_tests: $(MAKE) -C runtime negative_tests diff --git a/runtime/Makefile b/runtime/Makefile index 55768a6be..3f91acbef 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -14,11 +14,9 @@ TEST_FLAGS=$(COMMON_FLAGS) -DDEBUG_VERSION UNIT_TESTS_FLAGS=$(TEST_FLAGS) INVARIANTS_CHECK_FLAGS=$(TEST_FLAGS) -DFULL_INVARIANT_CHECKS -# this target is the most important one, its' artefacts should be used as a runtime of x86-64 version of Lama all: gc64.o runtime64.o printf.o ar rc runtime.a runtime64.o gc64.o printf.o -# this target is the most important one, its' artefacts should be used as a runtime of x86 (32-bits) version Lama all32: gc.o runtime.o ar rc runtime.a runtime.o gc.o @@ -31,16 +29,12 @@ $(NEGATIVE_TESTS): %: negative_scenarios/%.c negative_tests: $(NEGATIVE_TESTS) -# this is a target that runs unit tests, scenarios are written in a single file `test_main.c` unit_tests.o: gc.c gc.h runtime.c runtime.h runtime_common.h virt_stack.c virt_stack.h test_main.c test_util.s $(CC) -o unit_tests.o $(UNIT_TESTS_FLAGS) gc.c virt_stack.c runtime.c test_main.c test_util.s -# this target also runs unit tests but with additional expensive checks of GC invariants which aren't used in production version invariants_check.o: gc.c gc.h runtime.c runtime.h runtime_common.h virt_stack.c virt_stack.h test_main.c test_util.s $(CC) -o invariants_check.o $(INVARIANTS_CHECK_FLAGS) gc.c virt_stack.c runtime.c test_main.c test_util.s -# this target also runs unit tests but with additional expensive checks of GC invariants which aren't used in production version -# additionally, it prints debug information invariants_check_debug_print.o: gc.c gc.h runtime.c runtime.h runtime_common.h virt_stack.c virt_stack.h test_main.c test_util.s $(CC) -o invariants_check_debug_print.o $(INVARIANTS_CHECK_FLAGS) -DDEBUG_PRINT gc.c virt_stack.c runtime.c test_main.c test_util.s diff --git a/src/Driver.ml b/src/Driver.ml index d9dea4279..581a76383 100644 --- a/src/Driver.ml +++ b/src/Driver.ml @@ -1,196 +1,4 @@ -exception Commandline_error of string - -class options args = - let n = Array.length args in - let dump_ast = 0b1 in - let dump_sm = 0b010 in - let dump_source = 0b100 in - (* Kakadu: binary masks are cool for C code, but for OCaml I don't see any reason to save memory like this *) - let runtime_path_ = - match Sys.getenv_opt "LAMA" with Some s -> s | None -> Stdpath.path - in - let help_string = - "Lama compiler. (C) JetBrains Reserach, 2017-2020.\n" - ^ "Usage: lamac \n\n" - ^ "When no options specified, builds the source file into executable.\n" - ^ "Options:\n" ^ " -c --- compile into object file\n" - ^ " -o --- write executable into file \n" - ^ " -I --- add into unit search path list\n" - ^ " -i --- interpret on a source-level interpreter\n" - ^ " -s --- compile into stack machine code and interpret on the \ - stack machine initerpreter\n" - ^ " -dp --- dump AST (the output will be written into .ast file)\n" - ^ " -dsrc --- dump pretty-printed source code\n" - ^ " -ds --- dump stack machine code (the output will be written \ - into .sm file; has no\n" - ^ " effect if -i option is specfied)\n" - ^ " -b --- compile to a stack machine bytecode\n" - ^ " -v --- show version\n" ^ " -h --- show this help\n" - in - object (self) - val version = ref false - val help = ref false - val i = ref 1 - val infile = ref (None : string option) - val outfile = ref (None : string option) - val runtime_path = runtime_path_ - val paths = ref [ runtime_path_ ] - val mode = ref (`Default : [ `Default | `Eval | `SM | `Compile | `BC ]) - val curdir = Unix.getcwd () - val debug = ref false - - (* Workaround until Ostap starts to memoize properly *) - val const = ref false - - (* end of the workaround *) - val dump = ref 0 - - initializer - let rec loop () = - match self#peek with - | Some opt -> - (match opt with - (* Workaround until Ostap starts to memoize properly *) - | "-w" -> self#set_workaround - (* end of the workaround *) - | "-c" -> self#set_mode `Compile - | "-o" -> ( - match self#peek with - | None -> - raise - (Commandline_error - "File name expected after '-o' specifier") - | Some fname -> self#set_outfile fname) - | "-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 - | "-b" -> self#set_mode `BC - | "-i" -> self#set_mode `Eval - | "-ds" -> self#set_dump dump_sm - | "-dsrc" -> self#set_dump dump_source - | "-dp" -> self#set_dump dump_ast - | "-h" -> self#set_help - | "-v" -> self#set_version - | "-g" -> self#set_debug - | _ -> - if opt.[0] = '-' then - raise - (Commandline_error - (Printf.sprintf "Invalid command line specifier ('%s')" - opt)) - else self#set_infile opt); - loop () - | None -> () - in - loop () - - (* Workaround until Ostap starts to memoize properly *) - method is_workaround = !const - method private set_workaround = const := true - - (* end of the workaround *) - method private set_help = help := true - method private set_version = version := true - method private set_dump mask = dump := !dump lor mask - - method private set_infile name = - match !infile with - | None -> infile := Some name - | Some name' -> - raise - (Commandline_error - (Printf.sprintf "Input file ('%s') already specified" name')) - - method private set_outfile name = - match !outfile with - | None -> outfile := Some name - | Some name' -> - raise - (Commandline_error - (Printf.sprintf "Output file ('%s') already specified" name')) - - method private add_include_path path = paths := path :: !paths - - method private set_mode s = - match !mode with - | `Default -> mode := s - | _ -> raise (Commandline_error "Extra compilation mode specifier") - - method private peek = - let j = !i in - if j < n then ( - incr i; - Some args.(j)) - else None - - method get_mode = !mode - - method get_output_option = - 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") - | Some name -> name - - method get_help = !help - method get_include_paths = !paths - method get_runtime_path = runtime_path - - method basename = - Filename.chop_suffix (Filename.basename self#get_infile) ".lama" - - 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 - Printf.fprintf outf "%s" contents; - close_out outf - - method dump_AST ast = - if !dump land dump_ast > 0 then ( - let buf = Buffer.create 1024 in - Buffer.add_string buf ""; - Buffer.add_string buf - (Printf.sprintf " %s " self#get_infile); - Buffer.add_string buf "
  • "; - GT.html Language.Expr.t ast buf; - Buffer.add_string buf "
    • "; - Buffer.add_string buf ""; - self#dump_file "html" (Buffer.contents buf)) - - method dump_source (ast : Language.Expr.t) = - if !dump land dump_source > 0 then Pprinter.pp Format.std_formatter ast - - method dump_SM sm = - if !dump land dump_sm > 0 then self#dump_file "sm" (SM.show_prg sm) - else () - - method greet = - (match !outfile with - | None -> () - | Some _ -> ( - match !mode with - | `Default -> () - | _ -> Printf.printf "Output file option ignored in this mode.\n")); - if !version then Printf.printf "%s\n" Version.version; - if !help then Printf.printf "%s" help_string - - method get_debug = if !debug then "" else "-g" - method set_debug = debug := true - end +open Options let[@ocaml.warning "-32"] main = try diff --git a/src/Options.ml b/src/Options.ml new file mode 100644 index 000000000..159aed15f --- /dev/null +++ b/src/Options.ml @@ -0,0 +1,211 @@ +exception Commandline_error of string + +type arch_t = X86_64 | X86 +type os_t = Linux | Darwin + +class options args = + let n = Array.length args in + let dump_ast = 0b1 in + let dump_sm = 0b010 in + let dump_source = 0b100 in + (* Kakadu: binary masks are cool for C code, but for OCaml I don't see any reason to save memory like this *) + let runtime_path_ = + match Sys.getenv_opt "LAMA" with Some s -> s | None -> Stdpath.path + in + let host_os = + let uname = Posix_uname.uname () in + match uname.sysname with + | "Darwin" -> Darwin + | "Linux" -> Linux + | _ -> failwith "Unsupported OS" + in + let help_string = + "Lama compiler. (C) JetBrains Reserach, 2017-2020.\n" + ^ "Usage: lamac \n\n" + ^ "When no options specified, builds the source file into executable.\n" + ^ "Options:\n" ^ " -c --- compile into object file\n" + ^ " -o --- write executable into file \n" + ^ " -I --- add into unit search path list\n" + ^ " -i --- interpret on a source-level interpreter\n" + ^ " -s --- compile into stack machine code and interpret on the \ + stack machine initerpreter\n" + ^ " -m32 --- compile into x86 architecture\n" + ^ " -g --- add more debug info and runtime checks\n" + ^ " -dp --- dump AST (the output will be written into .ast file)\n" + ^ " -dsrc --- dump pretty-printed source code\n" + ^ " -ds --- dump stack machine code (the output will be written \ + into .sm file; has no\n" + ^ " effect if -i option is specfied)\n" + ^ " -b --- compile to a stack machine bytecode\n" + ^ " -v --- show version\n" ^ " -h --- show this help\n" + in + object (self) + val version = ref false + val help = ref false + val i = ref 1 + val infile = ref (None : string option) + val outfile = ref (None : string option) + val runtime_path = runtime_path_ + val paths = ref [ runtime_path_ ] + val mode = ref (`Default : [ `Default | `Eval | `SM | `Compile | `BC ]) + val curdir = Unix.getcwd () + val debug = ref false + val arch = ref X86_64 + val target_os = host_os + + (* Workaround until Ostap starts to memoize properly *) + val const = ref false + + (* end of the workaround *) + val dump = ref 0 + + initializer + let set_debug () = debug := true in + let set_x86 () = arch := X86 in + let rec loop () = + match self#peek with + | Some opt -> + (match opt with + (* Workaround until Ostap starts to memoize properly *) + | "-w" -> self#set_workaround + (* end of the workaround *) + | "-c" -> self#set_mode `Compile + | "-o" -> ( + match self#peek with + | None -> + raise + (Commandline_error + "File name expected after '-o' specifier") + | Some fname -> self#set_outfile fname) + | "-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 + | "-b" -> self#set_mode `BC + | "-i" -> self#set_mode `Eval + | "-ds" -> self#set_dump dump_sm + | "-dsrc" -> self#set_dump dump_source + | "-dp" -> self#set_dump dump_ast + | "-h" -> self#set_help + | "-v" -> self#set_version + | "-g" -> set_debug () + | "-m32" -> set_x86 () + | _ -> + if opt.[0] = '-' then + raise + (Commandline_error + (Printf.sprintf "Invalid command line specifier ('%s')" + opt)) + else self#set_infile opt); + loop () + | None -> () + in + loop () + + (* Workaround until Ostap starts to memoize properly *) + method is_workaround = !const + method private set_workaround = const := true + + (* end of the workaround *) + method private set_help = help := true + method private set_version = version := true + method private set_dump mask = dump := !dump lor mask + + method private set_infile name = + match !infile with + | None -> infile := Some name + | Some name' -> + raise + (Commandline_error + (Printf.sprintf "Input file ('%s') already specified" name')) + + method private set_outfile name = + match !outfile with + | None -> outfile := Some name + | Some name' -> + raise + (Commandline_error + (Printf.sprintf "Output file ('%s') already specified" name')) + + method private add_include_path path = paths := path :: !paths + + method private set_mode s = + match !mode with + | `Default -> mode := s + | _ -> raise (Commandline_error "Extra compilation mode specifier") + + method private peek = + let j = !i in + if j < n then ( + incr i; + Some args.(j)) + else None + + method get_mode = !mode + + method get_output_option = + 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") + | Some name -> name + + method get_help = !help + method get_include_paths = !paths + method get_runtime_path = runtime_path + + method basename = + Filename.chop_suffix (Filename.basename self#get_infile) ".lama" + + 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 + Printf.fprintf outf "%s" contents; + close_out outf + + method dump_AST ast = + if !dump land dump_ast > 0 then ( + let buf = Buffer.create 1024 in + Buffer.add_string buf ""; + Buffer.add_string buf + (Printf.sprintf " %s " self#get_infile); + Buffer.add_string buf "
  • "; + GT.html Language.Expr.t ast buf; + Buffer.add_string buf "
    • "; + Buffer.add_string buf ""; + self#dump_file "html" (Buffer.contents buf)) + + method dump_source (ast : Language.Expr.t) = + if !dump land dump_source > 0 then Pprinter.pp Format.std_formatter ast + + method dump_SM sm = + if !dump land dump_sm > 0 then self#dump_file "sm" (SM.show_prg sm) + else () + + method greet = + (match !outfile with + | None -> () + | Some _ -> ( + match !mode with + | `Default -> () + | _ -> Printf.printf "Output file option ignored in this mode.\n")); + if !version then Printf.printf "%s\n" Version.version; + if !help then Printf.printf "%s" help_string + + method is_debug = !debug + method arch = !arch + method target_os = target_os + end diff --git a/src/X86_64.ml b/src/X86_64.ml index e51a966f8..2f1e8a243 100644 --- a/src/X86_64.ml +++ b/src/X86_64.ml @@ -1,20 +1,11 @@ open GT open Language open SM +open Options (* X86 codegeneration interface *) -type os_t = Linux | Darwin - -let os = - let uname = Posix_uname.uname () in - match uname.sysname with - | "Darwin" -> Darwin - | "Linux" -> Linux - | _ -> failwith "Unsupported OS" - -let prefix = match os with Linux -> "" | Darwin -> "_" -let prefixed name = prefix ^ name +type compilation_mode_t = { is_debug : bool; target_os : os_t } module Register : sig type t @@ -214,16 +205,16 @@ let stack_offset i = if i >= 0 then (i + 1) * word_size else (-i + 1) * word_size (* Instruction printer *) -let show instr = +let show env instr = let rec opnd = function | R r -> Register.show r | S i -> if i >= 0 then Printf.sprintf "-%d(%%rbp)" (stack_offset i) else Printf.sprintf "%d(%%rbp)" (stack_offset i) - | M (_, I, _, s) -> Printf.sprintf "%s(%%rip)" (prefixed s) - | M (F, E, _, s) -> Printf.sprintf "%s(%%rip)" (prefixed s) - | M (D, E, _, s) -> Printf.sprintf "%s@GOTPCREL(%%rip)" (prefixed s) - | C s -> Printf.sprintf "$%s" (prefixed s) + | M (_, I, _, s) -> Printf.sprintf "%s(%%rip)" (env#prefixed s) + | M (F, E, _, s) -> Printf.sprintf "%s(%%rip)" (env#prefixed s) + | M (D, E, _, s) -> Printf.sprintf "%s@GOTPCREL(%%rip)" (env#prefixed s) + | C s -> Printf.sprintf "$%s" (env#prefixed s) | L i -> Printf.sprintf "$%d" i | I (0, x) -> Printf.sprintf "(%s)" (opnd x) | I (n, x) -> Printf.sprintf "%d(%s)" n (opnd x) @@ -252,12 +243,12 @@ let show instr = | Push s -> Printf.sprintf "\tpushq\t%s" (opnd s) | Pop s -> Printf.sprintf "\tpopq\t%s" (opnd s) | Ret -> "\tret" - | Call p -> Printf.sprintf "\tcall\t%s" (prefixed p) + | Call p -> Printf.sprintf "\tcall\t%s" (env#prefixed p) | CallI o -> Printf.sprintf "\tcall\t*(%s)" (opnd o) - | Label l -> Printf.sprintf "%s:\n" (prefixed l) - | Jmp l -> Printf.sprintf "\tjmp\t%s" (prefixed l) + | Label l -> Printf.sprintf "%s:\n" (env#prefixed l) + | Jmp l -> Printf.sprintf "\tjmp\t%s" (env#prefixed l) | JmpI o -> Printf.sprintf "\tjmp\t*(%s)" (opnd o) - | CJmp (s, l) -> Printf.sprintf "\tj%s\t%s" s (prefixed l) + | CJmp (s, l) -> Printf.sprintf "\tj%s\t%s" s (env#prefixed l) | Meta s -> Printf.sprintf "%s\n" s | Dec s -> Printf.sprintf "\tdecq\t%s" (opnd s) | Or1 s -> Printf.sprintf "\torq\t$0x0001,\t%s" (opnd s) @@ -632,6 +623,9 @@ let compile_call env ?fname nargs tail = compile_tail_call env fname nargs else compile_common_call env fname nargs +let opt_stabs env stabs = + match env#mode.target_os with Darwin -> [] | Linux -> stabs + (* Symbolic stack machine evaluator compile : env -> prg -> env * instr list @@ -644,8 +638,7 @@ let compile cmd env imports code = match scode with | [] -> (env, []) | instr :: scode' -> - (* Stack state for comment in generated code. TODO: add debug flag *) - let stack = "" (* env#show_stack*) in + let stack_state = if env#mode.is_debug then env#show_stack else "" in let env', code' = if env#is_barrier then match instr with @@ -766,27 +759,25 @@ let compile cmd env imports code = else f in let stabs = - match os with - | Darwin -> [] - | Linux -> - if f = "main" then - [ Meta (Printf.sprintf "\t.type main, @function") ] - else - let func = - [ - Meta (Printf.sprintf "\t.type %s, @function" name); - Meta - (Printf.sprintf "\t.stabs \"%s:F1\",36,0,0,%s" - name f); - ] - in - let arguments = - [] (* TODO: stabs for function arguments *) - in - let variables = - List.flatten @@ List.map stabs_scope scopes - in - func @ arguments @ variables + opt_stabs env + (if f = "main" then + [ Meta (Printf.sprintf "\t.type main, @function") ] + else + let func = + [ + Meta (Printf.sprintf "\t.type %s, @function" name); + Meta + (Printf.sprintf "\t.stabs \"%s:F1\",36,0,0,%s" name + f); + ] + in + let arguments = + [] (* TODO: stabs for function arguments *) + in + let variables = + List.flatten @@ List.map stabs_scope scopes + in + func @ arguments @ variables) in env#assert_empty_stack; let has_closure = closure <> [] in @@ -856,10 +847,8 @@ let compile cmd env imports code = env#assert_empty_stack; let name = env#fname in let stabs = - match os with - | Darwin -> [] - | Linux -> - [ Meta (Printf.sprintf "\t.size %s, .-%s" name name) ] + opt_stabs env + [ Meta (Printf.sprintf "\t.size %s, .-%s" name name) ] in ( env#leave, [ @@ -878,13 +867,14 @@ let compile cmd env imports code = Meta (* Allocate space for the symbolic stack Add extra word if needed to preserve alignment *) - (Printf.sprintf "\t.set\t%s,\t%d" (prefixed env#lsize) + (Printf.sprintf "\t.set\t%s,\t%d" + (env#prefixed env#lsize) (if env#allocated mod 2 == 0 then env#allocated * word_size else (env#allocated + 1) * word_size)); Meta (Printf.sprintf "\t.set\t%s,\t%d" - (prefixed env#allocated_size) + (env#prefixed env#allocated_size) env#allocated); ] @ stabs ) @@ -931,7 +921,7 @@ let compile cmd env imports code = (Printf.sprintf "Unexpected pattern: StrCmp %s: %d" __FILE__ __LINE__)) 1 false - | LINE _line -> env#gen_line + | LINE line -> env#gen_line line | FAIL ((line, col), value) -> let v, env = if value then (env#peek, env) else env#pop in let msg_addr, env = env#string cmd#get_infile in @@ -956,9 +946,13 @@ let compile cmd env imports code = (Printf.sprintf "invalid SM insn: %s\n" (GT.show insn i)) in let env'', code'' = compile' env' scode' in - ( env'', - [ Meta (Printf.sprintf "# %s / %s" (GT.show SM.insn instr) stack) ] - @ code' @ code'' ) + let debug_info = + let insn = GT.show SM.insn instr in + if env#mode.is_debug then + [ Meta ("# " ^ insn); Meta ("# " ^ stack_state) ] + else [ Meta ("# " ^ insn) ] + in + (env'', debug_info @ code' @ code'') in compile' env code @@ -1079,8 +1073,6 @@ end = struct (opnd_from_loc v loc1, opnd_from_loc v loc2) end -(* Environment for symbolic stack machine *) - (* A set of strings *) module S = Set.Make (String) @@ -1088,7 +1080,7 @@ module S = Set.Make (String) module M = Map.Make (String) (* Environment implementation *) -class env prg = +class env prg mode = let chars = "_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'" in @@ -1109,6 +1101,7 @@ class env prg = val fname = "" (* function name *) val stackmap = M.empty (* labels to stack map *) val barrier = false (* barrier condition *) + val mode = mode (* compilation mode *) val max_locals_size = 0 (* maximal number of stack position in all functions *) @@ -1118,6 +1111,7 @@ class env prg = val externs = S.empty val nlabels = 0 val first_line = true + method mode = mode method publics = S.elements publics method register_public name = {} method register_extern name = {} @@ -1129,7 +1123,14 @@ class env prg = if stack_slots > max_locals_size then {} else self - method show_stack = show_opnd (SymbolicStack.peek stack) + method show_stack = + let rec show stack acc = + if SymbolicStack.is_empty stack then acc + else + let stack, loc = SymbolicStack.pop stack in + show stack (show_opnd loc ^ " " ^ acc) + in + show stack "" method print_locals = Printf.printf "LOCALS: size = %d\n" static_size; @@ -1291,50 +1292,52 @@ class env prg = @ SymbolicStack.live_registers stack (* generate a line number information for current function *) - method gen_line = + method gen_line line = let lab = Printf.sprintf ".L%d" nlabels in ( {}, if fname = "main" then - [ - (* Meta (Printf.sprintf "\t.stabn 68,0,%d,%s" line lab); *) - Label lab; - ] + opt_stabs self + [ 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) *) ] + opt_stabs self [ 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; - ] ) + @ opt_stabs self + [ Meta (Printf.sprintf "\t.stabn 68,0,%d,%s-%s" line lab fname) ] + @ [ Label lab ] ) + + method prefixed label = + match mode.target_os with Darwin -> "_" ^ label | Linux -> label end (* Generates an assembler text for a program: first compiles the program into the stack code, - then generates x86 assember code, + then generates assember code, then prints the assembler file *) let genasm cmd prog = + let mode = { is_debug = cmd#is_debug; target_os = cmd#target_os } in let sm = SM.compile cmd prog in - let env, code = compile cmd (new env sm) (fst (fst prog)) sm in + let env, code = compile cmd (new env sm mode) (fst (fst prog)) sm in let globals = List.map - (fun s -> Meta (Printf.sprintf "\t.globl\t%s" (prefixed s))) + (fun s -> Meta (Printf.sprintf "\t.globl\t%s" (env#prefixed s))) env#publics in let data = [ Meta "\t.data" ] @ List.map (fun (s, v) -> - Meta (Printf.sprintf "%s:\t.string\t\"%s\"" (prefixed v) s)) + Meta (Printf.sprintf "%s:\t.string\t\"%s\"" (env#prefixed v) s)) env#strings @ [ - Meta (prefixed "init" ^ ":\t.quad 0"); + Meta (env#prefixed "init" ^ ":\t.quad 0"); Meta - (match os with + (match env#mode.target_os with | Darwin -> "\t.section __DATA, custom_data, regular, no_dead_strip" | Linux -> "\t.section custom_data,\"aw\",@progbits"); Meta - (Printf.sprintf "%s:\t.fill\t%d, 8, 1" (prefixed "filler") + (Printf.sprintf "%s:\t.fill\t%d, 8, 1" (env#prefixed "filler") env#max_locals_size); ] @ List.concat @@ -1345,33 +1348,26 @@ let genasm cmd prog = (String.length global_label) (String.length s - String.length global_label) in - (match os with - | Darwin -> [] - | Linux -> - [ - Meta - (Printf.sprintf "\t.stabs \"%s:S1\",40,0,0,%s" unlabled_s s); - ]) - @ [ Meta (Printf.sprintf "%s:\t.quad\t1" (prefixed s)) ]) + opt_stabs env + [ + Meta (Printf.sprintf "\t.stabs \"%s:S1\",40,0,0,%s" unlabled_s s); + ] + @ [ Meta (Printf.sprintf "%s:\t.quad\t1" (env#prefixed s)) ]) env#globals in let asm = Buffer.create 1024 in List.iter - (fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i)) + (fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show env i)) ([ Meta (Printf.sprintf "\t.file \"%s\"" cmd#get_absolute_infile) ] - @ (match os with - | Darwin -> [] - | Linux -> - [ - Meta - (Printf.sprintf "\t.stabs \"%s\",100,0,0,.Ltext" - cmd#get_absolute_infile); - ]) + @ opt_stabs env + [ + Meta + (Printf.sprintf "\t.stabs \"%s\",100,0,0,.Ltext" + cmd#get_absolute_infile); + ] @ globals @ data @ [ Meta "\t.text"; Label ".Ltext" ] - @ (match os with - | Darwin -> [] - | Linux -> [ Meta "\t.stabs \"data:t1=r1;0;4294967295;\",128,0,0,0" ]) + @ opt_stabs env [ Meta "\t.stabs \"data:t1=r1;0;4294967295;\",128,0,0,0" ] @ code); Buffer.contents asm @@ -1398,10 +1394,15 @@ let build cmd prog = in cmd#dump_file "s" (genasm cmd prog); cmd#dump_file "i" (Interface.gen prog); - let compiler = match os with Darwin -> "clang" | Linux -> "gcc" in - let compiler_flags, linker_flags = - match os with Darwin -> ("-arch x86_64", "-ld_classic") | Linux -> ("", "") + let compiler = + match cmd#target_os with Darwin -> "clang" | Linux -> "gcc" in + let compiler_flags, linker_flags = + match cmd#target_os with + | Darwin -> ("-arch x86_64", "-ld_classic") + | Linux -> ("", "") + in + let debug_flags = if cmd#is_debug then "-g" else "" in match cmd#get_mode with | `Default -> let objs = find_objects (fst @@ fst prog) cmd#get_include_paths in @@ -1413,12 +1414,12 @@ let build cmd prog = objs; let gcc_cmdline = Printf.sprintf "%s %s %s %s %s %s.s %s %s/runtime.a" compiler - compiler_flags linker_flags cmd#get_debug cmd#get_output_option + compiler_flags linker_flags debug_flags cmd#get_output_option cmd#basename (Buffer.contents buf) cmd#get_runtime_path in Sys.command gcc_cmdline | `Compile -> Sys.command (Printf.sprintf "%s %s %s -c -g %s.s" compiler compiler_flags - cmd#get_debug cmd#basename) + debug_flags cmd#basename) | _ -> invalid_arg "must not happen" diff --git a/src/dune b/src/dune index 955cc5ee6..5c4e0d7c1 100644 --- a/src/dune +++ b/src/dune @@ -45,7 +45,7 @@ (library (name liba) - (modules Language Pprinter stdpath version X86_64 SM) + (modules Language Pprinter stdpath version X86_64 SM Options) (libraries GT ostap posix-uname) (flags (:standard