diff options
Diffstat (limited to 'driver.fun')
| -rw-r--r-- | driver.fun | 244 |
1 files changed, 209 insertions, 35 deletions
@@ -2,33 +2,95 @@ functor Driver(E: EMIT): DRIVER = struct structure I = E.I structure P = E.I.P - datatype execMode = Normal | DebugE | DebugT + datatype execMode = EmAsm | EmObj | EmExe type config = { file: string option, + outFile: string option, includeDirs: string list, - mode: execMode + libDir: string option, + mode: execMode, + verbose: bool, + debugParser: bool, + debugIl: bool, + debugEmit: bool } + fun mod2int m = + case m of + EmAsm => 0 + | EmObj => 1 + | EmExe => 2 + + fun modCmp (m1, m2) = compare (mod2int m1) (mod2int m2) + val updateC = fn z => let - fun from file includeDirs mode = { file, includeDirs, mode } - fun to f { file, includeDirs, mode } = f file includeDirs mode + fun from file outFile includeDirs libDir mode verbose + debugParser debugIl debugEmit = + { file, outFile, includeDirs, libDir, mode, verbose, + debugParser, debugIl, debugEmit } + fun to f { file, outFile, includeDirs, libDir, mode, verbose, + debugParser, debugIl, debugEmit } + = + f file outFile includeDirs libDir mode verbose + debugParser debugIl debugEmit in - FRU.makeUpdate3 (from, from, to) + FRU.makeUpdate9 (from, from, to) end z - val initConfig: config = { file = NONE, includeDirs = [], mode = Normal } + val initConfig: config = { file = NONE, outFile = NONE, + includeDirs = [], libDir = NONE, mode = EmExe, + verbose = false, + debugParser = false, debugIl = false, debugEmit = false } val die = fn z => die 1 z fun finish ({ file = NONE, ... }: config) = die `"No file specified" % - | finish conf = updateC conf u#includeDirs rev % + | finish conf = + let + val conf = updateC conf u#includeDirs rev % + in + case #outFile conf of + NONE => + let + val sfx = + case #mode conf of + EmAsm => ".s" + | EmObj => ".o" + | EmExe => "" + in + updateC conf s#outFile (SOME (valOf (#file conf) ^ sfx)) % + end + | SOME _ => conf + end - fun parseFlag conf "-dE" tail = - parseCmdArgs (updateC conf s#mode DebugE %) tail - | parseFlag conf "-dT" tail = - parseCmdArgs (updateC conf s#mode DebugT %) tail + fun parseFlag conf "-v" tail = + parseCmdArgs (updateC conf s#verbose true %) tail + | parseFlag conf "-dp" tail = + parseCmdArgs (updateC conf s#debugParser true %) tail + | parseFlag conf "-di" tail = + parseCmdArgs (updateC conf s#debugIl true %) tail + | parseFlag conf "-de" tail = + parseCmdArgs (updateC conf s#debugEmit true %) tail + | parseFlag conf "-c" tail = + parseCmdArgs (updateC conf s#mode EmObj %) tail + | parseFlag conf "-S" tail = + parseCmdArgs (updateC conf s#mode EmAsm %) tail + | parseFlag _ "-o" [] = + die `"-o: expected file name after argument" % + | parseFlag (C as { outFile, ... }) "-o" (file :: tail) = ( + case outFile of + NONE => parseCmdArgs (updateC C s#outFile (SOME file) %) tail + | SOME _ => die `file `": output file name is already specified" % + ) + | parseFlag _ "-L" [] = + die `"-L: expected directory name after argument" % + | parseFlag (C as { libDir, ... }) "-L" ((dir: string) :: tail) = ( + case libDir of + NONE => parseCmdArgs (updateC C s#libDir (SOME dir) %) tail + | SOME _ => die `dir `": libdir name is already specified" % + ) | parseFlag _ arg _ = die `arg `": unknown flag" % and parseCmdArgs conf [] = finish conf @@ -57,34 +119,146 @@ functor Driver(E: EMIT): DRIVER = struct end | SOME _ => die `arg `": file already specified" % - fun exec () = + fun callProgram verbose name args clean = let - val config = parseCmdArgs initConfig (CommandLine.arguments ()) - val file = valOf $ #file config + open Posix.Process + fun exec () = + let + val args = name :: args + fun ps s out = Printf out `s % + val () = + if verbose then + printfn Plist ps args (" ", false, 0) % + else + () + in + execp (name, args); + die `"canot exec " `name `": exec failed" % + end in - case (#mode config) of - Normal => + case fork () of + NONE => exec () + | SOME _ => let - val parseCtx = P.createCtx file (#includeDirs config) true - - fun collect ctx = - let - val (continue, ctx) = P.parseDef ctx - in - if continue then - collect ctx - else - P.finalize ctx - end - - val parseCtx = collect parseCtx - val progInfo = P.explode parseCtx - val ilCtx = I.createCtx progInfo (SOME $ file ^ ".i") + val (_, status) = wait () in - E.emit (file ^ ".s") ilCtx (SOME $ file ^ ".e") + case status of + W_EXITED => clean () + | W_EXITSTATUS st => + die `name `": failed with " W (Word8.toLargeWord st) `"code" % + | _ => raise Unimplemented end - | DebugT => P.P.T.debugPrint file - | DebugE => P.P.debugPrint file (#includeDirs config) end -end + fun linkArgs _ _ NONE = die `"libdir: is not specified" % + | linkArgs input output (SOME d) = + let + open OS + val crt = Path.joinDirFile { dir = d, file = "crt1.o" } + val libc = Path.joinDirFile { dir = d, file = "libc.a" } + in + ["-o", output, input, crt, libc] + end + + fun assemble { mode, outFile, verbose, ... } asmFile = + let + val outputFile = + case mode of + EmObj => valOf outFile + | _ => String.substring (asmFile, 0, size asmFile - 2) ^ ".o" + + val args = ["-f", "elf64", "-o", outputFile, asmFile] + val clean = + fn () => + let + val () = if verbose then printfn `"removing " `asmFile % else () + in + Posix.FileSys.unlink asmFile + end + in + callProgram verbose "nasm" args clean; + outputFile + end + + fun link { libDir, outFile, verbose, ... } objFile = + let + val args = linkArgs objFile (valOf outFile) libDir + val clean = + fn () => + let + val () = if verbose then printfn `"removing " `objFile % else () + in + Posix.FileSys.unlink objFile + end + in + callProgram verbose "ld" args clean + end + + fun parse { file, includeDirs, debugParser, ... } = + let + val file = valOf file + val debugFile = if debugParser then SOME (file ^ ".p") else NONE + val parseCtx = P.createCtx file includeDirs debugFile + + fun collect ctx = + let + val (continue, ctx) = P.parseDef ctx + in + if continue then + collect ctx + else + P.finalize ctx + end + in + collect parseCtx + end + + fun ilConv parseCtx config = + let + val debugFile = + if #debugIl config then + SOME (valOf (#file config) ^ ".i") + else + NONE + val progInfo = P.explode parseCtx + in + I.createCtx progInfo debugFile + end + + fun emit ilCtx { debugEmit, file, outFile, mode, ... }= + let + val debugFile = + if debugEmit then + SOME (valOf file ^ ".e") + else + NONE + val out = + case mode of + EmAsm => valOf $ outFile + | _ => OS.FileSys.tmpName () ^ ".s" + in + E.emit out ilCtx debugFile; + out + end + + fun exec () = + let + val config = parseCmdArgs initConfig (CommandLine.arguments ()) + + val parseCtx = parse config + val ilCtx = ilConv parseCtx config + val asmFile = emit ilCtx config + in + if modCmp (#mode config, EmAsm) = GREATER then + let + val objFile = assemble config asmFile + in + if modCmp (#mode config, EmObj) = GREATER then + link config objFile + else + () + end + else + () + end +end |