[MLton-commit] r7236
Wesley Terpstra
wesley at mlton.org
Thu Oct 8 08:50:07 PDT 2009
Stub LLVM codegen based on the RSSA intermediate langauge.
Next step: port the old Machine pass to RSSA.
----------------------------------------------------------------------
U mlton/branches/llvm/basis-library/primitive/prim-mlton.sml
U mlton/branches/llvm/mlton/backend/backend.fun
U mlton/branches/llvm/mlton/backend/backend.sig
U mlton/branches/llvm/mlton/backend/sources.cm
U mlton/branches/llvm/mlton/backend/sources.mlb
A mlton/branches/llvm/mlton/codegen/llvm-codegen/
A mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.fun
A mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.sig
A mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.cm
A mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.mlb
U mlton/branches/llvm/mlton/codegen/sources.cm
U mlton/branches/llvm/mlton/codegen/sources.mlb
U mlton/branches/llvm/mlton/control/control-flags.sig
U mlton/branches/llvm/mlton/control/control-flags.sml
U mlton/branches/llvm/mlton/control/control.sig
U mlton/branches/llvm/mlton/control/control.sml
U mlton/branches/llvm/mlton/main/compile.fun
U mlton/branches/llvm/mlton/main/compile.sig
U mlton/branches/llvm/mlton/main/lookup-constant.fun
U mlton/branches/llvm/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/branches/llvm/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/llvm/basis-library/primitive/prim-mlton.sml 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/basis-library/primitive/prim-mlton.sml 2009-10-08 15:49:57 UTC (rev 7236)
@@ -61,7 +61,7 @@
structure Codegen =
struct
- datatype t = Bytecode | C | x86 | amd64
+ datatype t = Bytecode | C | LLVM | x86 | amd64
val codegen =
case _build_const "MLton_Codegen_codegen": Int32.int; of
@@ -69,12 +69,14 @@
| 1 => C
| 2 => x86
| 3 => amd64
+ | 4 => LLVM
| _ => raise Primitive.Exn.Fail8 "MLton_Codegen_codegen"
val isBytecode = codegen = Bytecode
val isC = codegen = C
val isX86 = codegen = x86
val isAmd64 = codegen = amd64
+ val isLLVM = codegen = LLVM
(* val isNative = isX86 orelse isAmd64 *)
end
Modified: mlton/branches/llvm/mlton/backend/backend.fun
===================================================================
--- mlton/branches/llvm/mlton/backend/backend.fun 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/backend/backend.fun 2009-10-08 15:49:57 UTC (rev 7236)
@@ -143,6 +143,86 @@
start = start}
end
+fun rssaSimplify {handlers} p =
+ let
+ open Rssa
+ fun pass' ({name, doit}, sel, p) =
+ let
+ val _ =
+ let open Control
+ in maybeSaveToFile
+ ({name = name,
+ suffix = "pre.rssa"},
+ Control.No, p, Control.Layouts Program.layouts)
+ end
+ val p =
+ Control.passTypeCheck
+ {display = Control.Layouts
+ (fn (r,output) =>
+ Program.layouts (sel r, output)),
+ name = name,
+ stats = Program.layoutStats o sel,
+ style = Control.No,
+ suffix = "post.rssa",
+ thunk = fn () => doit p,
+ typeCheck = Program.typeCheck o sel}
+ in
+ p
+ end
+ fun pass ({name, doit}, p) =
+ pass' ({name = name, doit = doit}, fn p => p, p)
+ fun maybePass ({name, doit}, p) =
+ if List.exists (!Control.dropPasses, fn re =>
+ Regexp.Compiled.matchesAll (re, name))
+ then p
+ else pass ({name = name, doit = doit}, p)
+ val p = maybePass ({name = "rssaShrink1",
+ doit = Program.shrink}, p)
+ val p = pass ({name = "insertLimitChecks",
+ doit = LimitCheck.insert}, p)
+ val p = pass ({name = "insertSignalChecks",
+ doit = SignalCheck.insert}, p)
+ val p = if not handlers then p else
+ pass ({name = "implementHandlers",
+ doit = ImplementHandlers.doit}, p)
+ val p = maybePass ({name = "rssaShrink2",
+ doit = Program.shrink}, p)
+ val () = Program.checkHandlers p
+ val (p, makeProfileInfo) =
+ pass' ({name = "implementProfiling",
+ doit = ImplementProfiling.doit},
+ fn (p,_) => p, p)
+ val p = maybePass ({name = "rssaOrderFunctions",
+ doit = Program.orderFunctions}, p)
+ in
+ (p, makeProfileInfo)
+ end
+
+fun toRssa (program: Ssa.Program.t, codegen) =
+ let
+ val program =
+ Control.passTypeCheck {display = Control.Layouts Rssa.Program.layouts,
+ name = "toRssa",
+ stats = R.Program.layoutStats,
+ style = Control.No,
+ suffix = "rssa",
+ thunk = fn () => SsaToRssa.convert (program,
+ codegen),
+ typeCheck = R.Program.typeCheck}
+ val (program, makeProfileInfo) =
+ Control.passTypeCheck
+ {display = Control.Layouts (fn ((program, _), output) =>
+ Rssa.Program.layouts (program, output)),
+ name = "rssaSimplify",
+ stats = fn (program,_) => Rssa.Program.layoutStats program,
+ style = Control.No,
+ suffix = "rssa",
+ thunk = fn () => rssaSimplify {handlers=false} program,
+ typeCheck = R.Program.typeCheck o #1}
+ in
+ program
+ end
+
fun toMachine (program: Ssa.Program.t, codegen) =
let
fun pass (name, doit, program) =
@@ -154,59 +234,6 @@
thunk = fn () => doit program,
typeCheck = R.Program.typeCheck}
val program = pass ("toRssa", SsaToRssa.convert, (program, codegen))
- fun rssaSimplify p =
- let
- open Rssa
- fun pass' ({name, doit}, sel, p) =
- let
- val _ =
- let open Control
- in maybeSaveToFile
- ({name = name,
- suffix = "pre.rssa"},
- Control.No, p, Control.Layouts Program.layouts)
- end
- val p =
- Control.passTypeCheck
- {display = Control.Layouts
- (fn (r,output) =>
- Program.layouts (sel r, output)),
- name = name,
- stats = Program.layoutStats o sel,
- style = Control.No,
- suffix = "post.rssa",
- thunk = fn () => doit p,
- typeCheck = Program.typeCheck o sel}
- in
- p
- end
- fun pass ({name, doit}, p) =
- pass' ({name = name, doit = doit}, fn p => p, p)
- fun maybePass ({name, doit}, p) =
- if List.exists (!Control.dropPasses, fn re =>
- Regexp.Compiled.matchesAll (re, name))
- then p
- else pass ({name = name, doit = doit}, p)
- val p = maybePass ({name = "rssaShrink1",
- doit = Program.shrink}, p)
- val p = pass ({name = "insertLimitChecks",
- doit = LimitCheck.insert}, p)
- val p = pass ({name = "insertSignalChecks",
- doit = SignalCheck.insert}, p)
- val p = pass ({name = "implementHandlers",
- doit = ImplementHandlers.doit}, p)
- val p = maybePass ({name = "rssaShrink2",
- doit = Program.shrink}, p)
- val () = Program.checkHandlers p
- val (p, makeProfileInfo) =
- pass' ({name = "implementProfiling",
- doit = ImplementProfiling.doit},
- fn (p,_) => p, p)
- val p = maybePass ({name = "rssaOrderFunctions",
- doit = Program.orderFunctions}, p)
- in
- (p, makeProfileInfo)
- end
val (program, makeProfileInfo) =
Control.passTypeCheck
{display = Control.Layouts (fn ((program, _), output) =>
@@ -215,7 +242,7 @@
stats = fn (program,_) => Rssa.Program.layoutStats program,
style = Control.No,
suffix = "rssa",
- thunk = fn () => rssaSimplify program,
+ thunk = fn () => rssaSimplify {handlers=true} program,
typeCheck = R.Program.typeCheck o #1}
val _ =
let
Modified: mlton/branches/llvm/mlton/backend/backend.sig
===================================================================
--- mlton/branches/llvm/mlton/backend/backend.sig 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/backend/backend.sig 2009-10-08 15:49:57 UTC (rev 7236)
@@ -18,10 +18,17 @@
signature BACKEND =
sig
+ structure Rssa : RSSA
include BACKEND_STRUCTS
val toMachine:
Ssa.Program.t
* {codegenImplementsPrim: Machine.Type.t Machine.Prim.t -> bool}
-> Machine.Program.t
+
+ (* Leaves exceptions unmodified *)
+ val toRssa:
+ Ssa.Program.t
+ * {codegenImplementsPrim: Machine.Type.t Machine.Prim.t -> bool}
+ -> Rssa.Program.t
end
Modified: mlton/branches/llvm/mlton/backend/sources.cm
===================================================================
--- mlton/branches/llvm/mlton/backend/sources.cm 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/backend/sources.cm 2009-10-08 15:49:57 UTC (rev 7236)
@@ -11,6 +11,7 @@
signature MACHINE
signature REP_TYPE
signature RUNTIME
+signature RSSA
functor Backend
functor Machine
Modified: mlton/branches/llvm/mlton/backend/sources.mlb
===================================================================
--- mlton/branches/llvm/mlton/backend/sources.mlb 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/backend/sources.mlb 2009-10-08 15:49:57 UTC (rev 7236)
@@ -57,6 +57,7 @@
signature MACHINE
signature REP_TYPE
signature RUNTIME
+ signature RSSA
functor Backend
functor Machine
Added: mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.fun
===================================================================
--- mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.fun 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.fun 2009-10-08 15:49:57 UTC (rev 7236)
@@ -0,0 +1,13 @@
+(* Copyright (C) 2009 Wesley W. Terpstra.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor LLVMCodegen(S: LLVM_CODEGEN_STRUCTS): LLVM_CODEGEN =
+ struct
+ open S
+
+ fun implementsPrim _ = true
+ fun output _ = ()
+ end
Copied: mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.sig (from rev 7233, mlton/trunk/mlton/codegen/c-codegen/c-codegen.sig)
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/c-codegen.sig 2009-10-04 14:23:49 UTC (rev 7233)
+++ mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.sig 2009-10-08 15:49:57 UTC (rev 7236)
@@ -0,0 +1,24 @@
+(* Copyright (C) 2009 Wesley W. Terpstra.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature LLVM_CODEGEN_STRUCTS =
+ sig
+ structure Ffi: FFI
+ structure Rssa: RSSA
+ sharing Ffi.CFunction = Rssa.CFunction
+ end
+
+signature LLVM_CODEGEN =
+ sig
+ include LLVM_CODEGEN_STRUCTS
+
+ val implementsPrim: 'a Rssa.Prim.t -> bool
+ val output: {program: Rssa.Program.t,
+ outputLL: unit -> {file: File.t,
+ print: string -> unit,
+ done: unit -> unit}
+ } -> unit
+ end
Property changes on: mlton/branches/llvm/mlton/codegen/llvm-codegen/llvm-codegen.sig
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.cm (from rev 7233, mlton/trunk/mlton/codegen/c-codegen/sources.cm)
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/sources.cm 2009-10-04 14:23:49 UTC (rev 7233)
+++ mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.cm 2009-10-08 15:49:57 UTC (rev 7236)
@@ -0,0 +1,22 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+Group
+
+signature LLVM_CODEGEN
+functor LLVMCodegen
+
+is
+
+../../atoms/sources.cm
+../../control/sources.cm
+../../../lib/mlton/sources.cm
+../../backend/sources.cm
+
+llvm-codegen.sig
+llvm-codegen.fun
Property changes on: mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.cm
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.mlb (from rev 7233, mlton/trunk/mlton/codegen/c-codegen/sources.mlb)
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/sources.mlb 2009-10-04 14:23:49 UTC (rev 7233)
+++ mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.mlb 2009-10-08 15:49:57 UTC (rev 7236)
@@ -0,0 +1,20 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+local
+ ../../atoms/sources.mlb
+ ../../control/sources.mlb
+ ../../../lib/mlton/sources.mlb
+ ../../backend/sources.mlb
+
+ llvm-codegen.sig
+ llvm-codegen.fun
+in
+ signature LLVM_CODEGEN
+ functor LLVMCodegen
+end
Property changes on: mlton/branches/llvm/mlton/codegen/llvm-codegen/sources.mlb
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: mlton/branches/llvm/mlton/codegen/sources.cm
===================================================================
--- mlton/branches/llvm/mlton/codegen/sources.cm 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/codegen/sources.cm 2009-10-08 15:49:57 UTC (rev 7236)
@@ -11,6 +11,7 @@
functor amd64Codegen
functor Bytecode
functor CCodegen
+functor LLVMCodegen
functor x86Codegen
is
@@ -18,4 +19,5 @@
amd64-codegen/sources.cm
bytecode/sources.cm
c-codegen/sources.cm
+llvm-codegen/sources.cm
x86-codegen/sources.cm
Modified: mlton/branches/llvm/mlton/codegen/sources.mlb
===================================================================
--- mlton/branches/llvm/mlton/codegen/sources.mlb 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/codegen/sources.mlb 2009-10-08 15:49:57 UTC (rev 7236)
@@ -9,11 +9,13 @@
local
amd64-codegen/sources.mlb
c-codegen/sources.mlb
+ llvm-codegen/sources.mlb
bytecode/sources.mlb
x86-codegen/sources.mlb
in
functor amd64Codegen
functor Bytecode
functor CCodegen
+ functor LLVMCodegen
functor x86Codegen
end
Modified: mlton/branches/llvm/mlton/control/control-flags.sig
===================================================================
--- mlton/branches/llvm/mlton/control/control-flags.sig 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/control/control-flags.sig 2009-10-08 15:49:57 UTC (rev 7236)
@@ -39,6 +39,7 @@
datatype t =
Bytecode
| CCodegen
+ | LLVMCodegen
| x86Codegen
| amd64Codegen
val all: t list
Modified: mlton/branches/llvm/mlton/control/control-flags.sml
===================================================================
--- mlton/branches/llvm/mlton/control/control-flags.sml 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/control/control-flags.sml 2009-10-08 15:49:57 UTC (rev 7236)
@@ -66,14 +66,16 @@
amd64Codegen
| Bytecode
| CCodegen
+ | LLVMCodegen
| x86Codegen
- val all = [x86Codegen,amd64Codegen,CCodegen,Bytecode]
+ val all = [x86Codegen,amd64Codegen,CCodegen,LLVMCodegen,Bytecode]
val toString: t -> string =
fn amd64Codegen => "amd64"
| Bytecode => "bytecode"
| CCodegen => "c"
+ | LLVMCodegen => "llvm"
| x86Codegen => "x86"
end
Modified: mlton/branches/llvm/mlton/control/control.sig
===================================================================
--- mlton/branches/llvm/mlton/control/control.sig 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/control/control.sig 2009-10-08 15:49:57 UTC (rev 7236)
@@ -45,7 +45,7 @@
(*------------------------------------*)
(* Compiler Passes *)
(*------------------------------------*)
- datatype style = No | Assembly | C | Dot | ML
+ datatype style = No | Assembly | C | Dot | LLVM | ML
datatype 'a display =
NoDisplay
Modified: mlton/branches/llvm/mlton/control/control.sml
===================================================================
--- mlton/branches/llvm/mlton/control/control.sml 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/control/control.sml 2009-10-08 15:49:57 UTC (rev 7236)
@@ -25,13 +25,14 @@
| _ => false
end
-datatype style = No | Assembly | C | Dot | ML
+datatype style = No | Assembly | C | Dot | LLVM | ML
val preSuf =
fn No => ("", "")
| Assembly => ("/* ", " */")
| C => ("/* ", " */")
| Dot => ("// ", "")
+ | LLVM => ("; ", "")
| ML => ("(* ", " *)")
fun outputHeader (style: style, output: Layout.t -> unit) =
Modified: mlton/branches/llvm/mlton/main/compile.fun
===================================================================
--- mlton/branches/llvm/mlton/main/compile.fun 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/main/compile.fun 2009-10-08 15:49:57 UTC (rev 7236)
@@ -111,6 +111,8 @@
fun funcToLabel f = f)
structure CCodegen = CCodegen (structure Ffi = Ffi
structure Machine = Machine)
+structure LLVMCodegen = LLVMCodegen (structure Ffi = Ffi
+ structure Rssa = Backend.Rssa)
structure Bytecode = Bytecode (structure CCodegen = CCodegen
structure Machine = Machine)
structure x86Codegen = x86Codegen (structure CCodegen = CCodegen
@@ -578,7 +580,7 @@
xml
end
-fun preCodegen {input: MLBString.t}: Machine.Program.t =
+fun preCodegen {input: MLBString.t}: Ssa2.Program.t =
let
val xml = elaborate {input = input}
val xml =
@@ -680,10 +682,17 @@
Layouts Ssa2.Program.layouts)
else ()
end
+ in
+ ssa2
+ end
+
+fun machineBackend ssa2 =
+ let
val codegenImplementsPrim =
case !Control.codegen of
Control.Bytecode => Bytecode.implementsPrim
| Control.CCodegen => CCodegen.implementsPrim
+ | Control.LLVMCodegen => LLVMCodegen.implementsPrim
| Control.x86Codegen => x86Codegen.implementsPrim
| Control.amd64Codegen => amd64Codegen.implementsPrim
val machine =
@@ -715,46 +724,102 @@
machine
end
-fun compile {input: MLBString.t, outputC, outputS}: unit =
+fun rssaBackend ssa2 =
let
- val machine =
- Control.trace (Control.Top, "pre codegen")
- preCodegen {input = input}
- fun clearNames () =
- (Machine.Program.clearLabelNames machine
- ; Machine.Label.printNameAlphaNumeric := true)
+ val codegenImplementsPrim =
+ case !Control.codegen of
+ Control.Bytecode => Bytecode.implementsPrim
+ | Control.CCodegen => CCodegen.implementsPrim
+ | Control.LLVMCodegen => LLVMCodegen.implementsPrim
+ | Control.x86Codegen => x86Codegen.implementsPrim
+ | Control.amd64Codegen => amd64Codegen.implementsPrim
+ val rssa =
+ Control.passTypeCheck
+ {display = Control.Layouts Backend.Rssa.Program.layouts,
+ name = "backend",
+ stats = fn _ => Layout.empty,
+ style = Control.No,
+ suffix = "rssa",
+ thunk = fn () =>
+ (Backend.toRssa
+ (ssa2,
+ {codegenImplementsPrim = codegenImplementsPrim})),
+ typeCheck = Backend.Rssa.Program.typeCheck}
+ val _ =
+ let
+ open Control
+ in
+ if !keepMachine
+ then saveToFile ({suffix = "rssa"}, No, rssa,
+ Layouts Backend.Rssa.Program.layouts)
+ else ()
+ end
+ in
+ rssa
+ end
+
+fun compile {input: MLBString.t, outputC, outputLL, outputS}: unit =
+ let
+ fun machine () =
+ let
+ val ssa2 =
+ Control.trace (Control.Top, "pre codegen")
+ preCodegen {input = input}
+ val machine =
+ Control.trace (Control.Top, "machine backend")
+ machineBackend ssa2
+ val () = Machine.Program.clearLabelNames machine
+ val () = Machine.Label.printNameAlphaNumeric := true
+ in
+ machine
+ end
+
+ fun rssa () =
+ let
+ val ssa2 =
+ Control.trace (Control.Top, "pre codegen")
+ preCodegen {input = input}
+ val rssa =
+ Control.trace (Control.Top, "rssa backend")
+ rssaBackend ssa2
+ in
+ rssa
+ end
+
val () =
case !Control.codegen of
Control.Bytecode =>
Control.trace (Control.Top, "bytecode gen")
- Bytecode.output {program = machine,
+ Bytecode.output {program = machine (),
outputC = outputC}
| Control.CCodegen =>
- (clearNames ()
- ; (Control.trace (Control.Top, "C code gen")
- CCodegen.output {program = machine,
- outputC = outputC}))
+ Control.trace (Control.Top, "C code gen")
+ CCodegen.output {program = machine (),
+ outputC = outputC}
+ | Control.LLVMCodegen =>
+ Control.trace (Control.Top, "llvm code gen")
+ LLVMCodegen.output {program = rssa (),
+ outputLL = outputLL}
| Control.x86Codegen =>
- (clearNames ()
- ; (Control.trace (Control.Top, "x86 code gen")
- x86Codegen.output {program = machine,
- outputC = outputC,
- outputS = outputS}))
+ Control.trace (Control.Top, "x86 code gen")
+ x86Codegen.output {program = machine (),
+ outputC = outputC,
+ outputS = outputS}
| Control.amd64Codegen =>
- (clearNames ()
- ; (Control.trace (Control.Top, "amd64 code gen")
- amd64Codegen.output {program = machine,
- outputC = outputC,
- outputS = outputS}))
+ Control.trace (Control.Top, "amd64 code gen")
+ amd64Codegen.output {program = machine (),
+ outputC = outputC,
+ outputS = outputS}
val _ = Control.message (Control.Detail, PropertyList.stats)
val _ = Control.message (Control.Detail, HashSet.stats)
in
()
end handle Done => ()
-fun compileMLB {input: File.t, outputC, outputS}: unit =
+fun compileMLB {input: File.t, outputC, outputLL, outputS}: unit =
compile {input = MLBString.fromFile input,
outputC = outputC,
+ outputLL = outputLL,
outputS = outputS}
val elaborateMLB =
@@ -783,9 +848,10 @@
end)
end
in
- fun compileSML {input: File.t list, outputC, outputS}: unit =
+ fun compileSML {input: File.t list, outputC, outputLL, outputS}: unit =
compile {input = genMLB {input = input},
outputC = outputC,
+ outputLL = outputLL,
outputS = outputS}
val elaborateSML =
fn {input: File.t list} =>
Modified: mlton/branches/llvm/mlton/main/compile.sig
===================================================================
--- mlton/branches/llvm/mlton/main/compile.sig 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/main/compile.sig 2009-10-08 15:49:57 UTC (rev 7236)
@@ -18,6 +18,9 @@
outputC: unit -> {file: File.t,
print: string -> unit,
done: unit -> unit},
+ outputLL: unit -> {file: File.t,
+ print: string -> unit,
+ done: unit -> unit},
outputS: unit -> {file: File.t,
print: string -> unit,
done: unit -> unit}} -> unit
@@ -25,6 +28,9 @@
outputC: unit -> {file: File.t,
print: string -> unit,
done: unit -> unit},
+ outputLL: unit -> {file: File.t,
+ print: string -> unit,
+ done: unit -> unit},
outputS: unit -> {file: File.t,
print: string -> unit,
done: unit -> unit}} -> unit
Modified: mlton/branches/llvm/mlton/main/lookup-constant.fun
===================================================================
--- mlton/branches/llvm/mlton/main/lookup-constant.fun 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/main/lookup-constant.fun 2009-10-08 15:49:57 UTC (rev 7236)
@@ -31,7 +31,8 @@
Bytecode => 0
| CCodegen => 1
| x86Codegen => 2
- | amd64Codegen => 3)),
+ | amd64Codegen => 3
+ | LLVMCodegen => 4)),
("MLton_FFI_numExports", fn () => int (Ffi.numExports ())),
("MLton_Platform_Format", fn () => case !format of
Archive => "archive"
Modified: mlton/branches/llvm/mlton/main/main.fun
===================================================================
--- mlton/branches/llvm/mlton/main/main.fun 2009-10-08 15:47:10 UTC (rev 7235)
+++ mlton/branches/llvm/mlton/main/main.fun 2009-10-08 15:49:57 UTC (rev 7236)
@@ -1012,6 +1012,7 @@
amd64Codegen => ChunkPerFunc
| Bytecode => OneChunk
| CCodegen => Coalesce {limit = 4096}
+ | LLVMCodegen => OneChunk
| x86Codegen => ChunkPerFunc
)
| SOME c => c)
@@ -1299,6 +1300,15 @@
in
output
end
+ fun compileLL (c: Counter.t, input: File.t): File.t =
+ let
+ val output = mkOutputO (c, input)
+ val _ =
+ System.system
+ ("llvm-as", ["-f", "-o", output, input])
+ in
+ output
+ end
fun compileS (c: Counter.t, input: File.t): File.t =
let
val output = mkOutputO (c, input)
@@ -1333,6 +1343,8 @@
then input :: ac
else if SOME "c" = extension
then (compileC (c, input)) :: ac
+ else if SOME "ll" = extension
+ then (compileLL (c, input)) :: ac
else if SOME "s" = extension
orelse SOME "S" = extension
then (compileS (c, input)) :: ac
@@ -1397,6 +1409,7 @@
compile
{input = input,
outputC = make (Control.C, ".c"),
+ outputLL = make (Control.LLVM, ".ll"),
outputS = make (Control.Assembly, ".s")}
in
case stop of
More information about the MLton-commit
mailing list