[MLton-commit] r5769
Matthew Fluet
fluet at mlton.org
Thu Jul 12 08:26:34 PDT 2007
Restore 'native' option to -codegen
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2007-07-12 04:41:47 UTC (rev 5768)
+++ mlton/trunk/doc/changelog 2007-07-12 15:26:32 UTC (rev 5769)
@@ -1,5 +1,8 @@
Here are the changes since version 20051202.
+* 2007-07-12
+ - Restored native option to -codegen flag.
+
* 2007-07-11
- Fixed bug in Real32.toInt.
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2007-07-12 04:41:47 UTC (rev 5768)
+++ mlton/trunk/mlton/control/control-flags.sig 2007-07-12 15:26:32 UTC (rev 5769)
@@ -35,14 +35,21 @@
val chunk: chunk ref
- datatype codegen =
- Bytecode
- | CCodegen
- | x86Codegen
- | amd64Codegen
+ structure Codegen:
+ sig
+ datatype t =
+ Bytecode
+ | CCodegen
+ | x86Codegen
+ | amd64Codegen
+ val all: t list
+ val toString: t -> string
+ end
- val codegen: codegen ref
+ datatype codegen = datatype Codegen.t
+ val codegen: Codegen.t ref
+
val contifyIntoMain: bool ref
(* Generate an executable with debugging info. *)
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2007-07-12 04:41:47 UTC (rev 5768)
+++ mlton/trunk/mlton/control/control-flags.sml 2007-07-12 15:26:32 UTC (rev 5769)
@@ -57,22 +57,24 @@
structure Codegen =
struct
datatype t =
- Bytecode
+ amd64Codegen
+ | Bytecode
| CCodegen
| x86Codegen
- | amd64Codegen
+ val all = [x86Codegen,amd64Codegen,CCodegen,Bytecode]
+
val toString: t -> string =
- fn Bytecode => "Bytecode"
- | CCodegen => "C"
+ fn amd64Codegen => "amd64"
+ | Bytecode => "bytecode"
+ | CCodegen => "c"
| x86Codegen => "x86"
- | amd64Codegen => "amd64"
end
datatype codegen = datatype Codegen.t
val codegen = control {name = "codegen",
- default = x86Codegen,
+ default = Codegen.x86Codegen,
toString = Codegen.toString}
val contifyIntoMain = control {name = "contifyIntoMain",
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2007-07-12 04:41:47 UTC (rev 5768)
+++ mlton/trunk/mlton/main/main.fun 2007-07-12 15:26:32 UTC (rev 5769)
@@ -62,7 +62,8 @@
val expert: bool ref = ref false
val explicitAlign: Control.align option ref = ref NONE
val explicitChunk: Control.chunk option ref = ref NONE
-val explicitCodegen: Control.codegen option ref = ref NONE
+datatype explicitCodegen = Native | Explicit of Control.codegen
+val explicitCodegen: explicitCodegen option ref = ref NONE
val keepGenerated = ref false
val keepO = ref false
val keepSML = ref false
@@ -126,6 +127,14 @@
| x86Codegen => false
| _ => true)
end
+fun hasNativeCodegen () =
+ let
+ datatype z = datatype Control.codegen
+ in
+ hasCodegen amd64Codegen
+ orelse hasCodegen x86Codegen
+ end
+
fun defaultAlignIs8 () =
let
@@ -218,21 +227,25 @@
concat [" {",
String.concatWith
(List.keepAllMap
- ([(x86Codegen,"x86"),(amd64Codegen,"amd64"),
- (CCodegen,"c"),(Bytecode,"bytecode")],
- fn (cg,str) => if hasCodegen cg then SOME str else NONE),
+ (Native :: (List.map (Control.Codegen.all, Explicit)),
+ fn cg =>
+ case cg of
+ Native => if hasNativeCodegen () then SOME "native" else NONE
+ | Explicit cg => if hasCodegen cg
+ then SOME (Control.Codegen.toString cg)
+ else NONE),
"|"),
"}"],
"which code generator to use",
SpaceString (fn s =>
explicitCodegen
- := SOME (case s of
- "bytecode" => Bytecode
- | "c" => CCodegen
- | "x86" => x86Codegen
- | "amd64" => amd64Codegen
- | _ => usage (concat
- ["invalid -codegen flag: ", s])))),
+ := SOME (if s = "native"
+ then Native
+ else (case List.peek
+ (Control.Codegen.all, fn cg =>
+ s = Control.Codegen.toString cg) of
+ SOME cg => Explicit cg
+ | NONE => usage (concat ["invalid -codegen flag: ", s]))))),
(Normal, "const", " '<name> <value>'", "set compile-time constant",
SpaceString (fn s =>
case String.tokens (s, Char.isSpace) of
@@ -649,7 +662,14 @@
else if hasCodegen (amd64Codegen)
then amd64Codegen
else CCodegen
- | SOME c => c)
+ | SOME Native => if hasCodegen (x86Codegen)
+ then x86Codegen
+ else if hasCodegen (amd64Codegen)
+ then amd64Codegen
+ else usage (concat ["can't use native codegen on ",
+ MLton.Platform.Arch.toString targetArch,
+ " target"])
+ | SOME (Explicit cg) => cg)
val () = MLton.Rusage.measureGC (!verbosity <> Silent)
val () = if !profileTimeSet
then (case !codegen of
@@ -749,17 +769,21 @@
| Self => []
val _ =
if not (hasCodegen (!codegen))
- then usage (concat ["can't use codegen on ",
- MLton.Platform.Arch.toString targetArch])
+ then usage (concat ["can't use ",
+ Control.Codegen.toString (!codegen),
+ " codegen on ",
+ MLton.Platform.Arch.toString targetArch,
+ " target"])
else ()
val _ =
chunk :=
(case !explicitChunk of
NONE => (case !codegen of
- Bytecode => OneChunk
+ amd64Codegen => ChunkPerFunc
+ | Bytecode => OneChunk
| CCodegen => Coalesce {limit = 4096}
| x86Codegen => ChunkPerFunc
- | amd64Codegen => ChunkPerFunc)
+ )
| SOME c => c)
val _ = if not (!Control.codegen = x86Codegen) andalso !Native.IEEEFP
then usage "must use x86 codegen with -ieee-fp true"
@@ -785,7 +809,7 @@
andalso not (!keepDefUse))
val _ =
if !codegen = Bytecode andalso !profile = ProfileTimeLabel
- then usage (concat ["bytecode doesn't support time-label profiling\n"])
+ then usage (concat ["bytecode codegen doesn't support -profile time-label\n"])
else ()
val _ =
case targetOS of
More information about the MLton-commit
mailing list