[MLton-devel] cvs commit: MLton.platform and gcc flags
Stephen Weeks
sweeks@users.sourceforge.net
Tue, 26 Aug 2003 13:36:46 -0700
sweeks 03/08/26 13:36:46
Modified: . Makefile
basis-library/integer pack32.sml
basis-library/misc primitive.sml
basis-library/mlton platform.sig platform.sml process.sml
basis-library/posix process.sml
basis-library/real real.fun
basis-library/sml-nj sml-nj.sml
bin mlton
lib/mlton-stubs mlton.sml platform.sig
mlton/codegen/c-codegen c-codegen.fun
mlton/codegen/x86-codegen x86-codegen.fun
x86-mlton-basic.fun x86.fun
mlton/control control.sig control.sml
mlton/elaborate elaborate-core.fun
mlton/main main.sml
runtime basis-constants.h
Log:
Split MLton.Platform.{arch,os} into MLton.Platform.{Arch,OS}.t.
Moved platform-specific gcc and linker flags from main.sml into the
bin/mlton script. This was done by adding two new expert options,
-target-cc-opt and -target-link-opt, which are like -cc-opt and
-link-opt, except that they take an extra argument specifying the
target (either arch or os) where they apply.
This should make it much easier for people to customize the flags on
their platform.
Revision Changes Path
1.95 +2 -2 mlton/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/Makefile,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -r1.94 -r1.95
--- Makefile 26 Aug 2003 16:40:13 -0000 1.94
+++ Makefile 26 Aug 2003 20:36:43 -0000 1.95
@@ -106,7 +106,7 @@
.PHONY: dirs
dirs:
- mkdir -p $(BIN) $(LIB)/$(HOST)/include
+ mkdir -p $(BIN) $(LIB)/$(HOST) $(LIB)/include
.PHONY: docs
docs:
@@ -170,7 +170,7 @@
@echo 'Compiling MLton runtime system for $(HOST).'
$(MAKE) -C runtime
$(CP) $(RUN)/*.a $(LIB)/$(HOST)/
- $(CP) runtime/*.h include/*.h $(LIB)/$(HOST)/include/
+ $(CP) runtime/*.h include/*.h $(LIB)/include/
.PHONY: script
script:
1.8 +1 -1 mlton/basis-library/integer/pack32.sml
Index: pack32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/pack32.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- pack32.sml 11 Apr 2003 04:31:08 -0000 1.7
+++ pack32.sml 26 Aug 2003 20:36:43 -0000 1.8
@@ -22,7 +22,7 @@
end
fun maybeRev w =
- if isBigEndian = Primitive.MLton.Platform.isBigEndian
+ if isBigEndian = Primitive.MLton.Platform.Arch.isBigEndian
then w
else revWord w
1.72 +26 -20 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- primitive.sml 18 Aug 2003 06:19:50 -0000 1.71
+++ primitive.sml 26 Aug 2003 20:36:43 -0000 1.72
@@ -514,29 +514,35 @@
structure Platform =
struct
- datatype arch = Sparc | X86
+ structure Arch =
+ struct
+ datatype t = Sparc | X86
- val arch: arch =
- case _const "MLton_Platform_arch": int; of
- 0 => Sparc
- | 1 => X86
- | _ => raise Fail "strange MLton_Platform_arch"
-
- datatype os = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+ val host: t =
+ case _const "MLton_Platform_Arch_host": int; of
+ 0 => Sparc
+ | 1 => X86
+ | _ => raise Fail "strange MLton_Platform_Arch_host"
- val os: os =
- case _const "MLton_Platform_os": int; of
- 0 => Cygwin
- | 1 => FreeBSD
- | 2 => Linux
- | 3 => NetBSD
- | 4 => SunOS
- | _ => raise Fail "strange MLton_Platform_os"
+ val isBigEndian =
+ case host of
+ X86 => false
+ | Sparc => true
+ end
- val isBigEndian =
- case arch of
- X86 => false
- | Sparc => true
+ structure OS =
+ struct
+ datatype t = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+
+ val host: t =
+ case _const "MLton_Platform_OS_host": int; of
+ 0 => Cygwin
+ | 1 => FreeBSD
+ | 2 => Linux
+ | 3 => NetBSD
+ | 4 => SunOS
+ | _ => raise Fail "strange MLton_Platform_OS_Host"
+ end
end
structure Profile =
1.3 +16 -4 mlton/basis-library/mlton/platform.sig
Index: platform.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/platform.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- platform.sig 18 Aug 2003 06:19:51 -0000 1.2
+++ platform.sig 26 Aug 2003 20:36:44 -0000 1.3
@@ -1,8 +1,20 @@
signature MLTON_PLATFORM =
sig
- datatype arch = Sparc | X86
- val arch: arch
+ structure Arch:
+ sig
+ datatype t = Sparc | X86
+
+ val host: t
+ val fromString: string -> t option
+ val toString: t -> string
+ end
- datatype os = Cygwin | FreeBSD | Linux | NetBSD | SunOS
- val os: os
+ structure OS:
+ sig
+ datatype t = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+
+ val host: t
+ val fromString: string -> t option
+ val toString: t -> string
+ end
end
1.2 +29 -0 mlton/basis-library/mlton/platform.sml
Index: platform.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/platform.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- platform.sml 11 Apr 2003 04:31:09 -0000 1.1
+++ platform.sml 26 Aug 2003 20:36:44 -0000 1.2
@@ -1,4 +1,33 @@
structure MLtonPlatform: MLTON_PLATFORM =
struct
open Primitive.MLton.Platform
+
+ fun peek (l, f) = List.find f l
+ fun omap (opt, f) = Option.map f opt
+
+ structure Arch =
+ struct
+ open Arch
+
+ val all = [(Sparc, "sparc"), (X86, "x86")]
+
+ fun fromString s = omap (peek (all, fn (_, s') => s = s'), #1)
+
+ fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+ end
+
+ structure OS =
+ struct
+ open OS
+
+ val all = [(Cygwin, "cygwin"),
+ (FreeBSD, "freebsd"),
+ (Linux, "linux"),
+ (NetBSD, "netbsd"),
+ (SunOS, "sunos")]
+
+ fun fromString s = omap (peek (all, fn (_, s') => s = s'), #1)
+
+ fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+ end
end
1.8 +3 -3 mlton/basis-library/mlton/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/process.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- process.sml 5 Jul 2003 19:01:44 -0000 1.7
+++ process.sml 26 Aug 2003 20:36:44 -0000 1.8
@@ -6,10 +6,10 @@
type pid = Posix.Process.pid
- structure Platform = MLton.Platform
+ val isCygwin = let open MLton.Platform.OS in host = Cygwin end
fun spawne {path, args, env} =
- if Platform.os = Platform.Cygwin
+ if isCygwin
then Error.checkReturnResult (Prim.spawne (String.nullTerm path,
C.CSS.fromList args,
C.CSS.fromList env))
@@ -22,7 +22,7 @@
spawne {path = path, args = args, env = Posix.ProcEnv.environ ()}
fun spawnp {file, args} =
- if Platform.os = Platform.Cygwin
+ if isCygwin
then Error.checkReturnResult (Prim.spawnp (String.nullTerm file,
C.CSS.fromList args))
else
1.13 +1 -2 mlton/basis-library/posix/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- process.sml 3 Jul 2003 17:10:07 -0000 1.12
+++ process.sml 26 Aug 2003 20:36:44 -0000 1.13
@@ -24,9 +24,8 @@
| 0 => NONE
| n => SOME n
- structure Platform = MLton.Platform
val fork =
- if Platform.os <> Platform.Cygwin
+ if let open MLton.Platform.OS in host <> Cygwin end
then fork
else
fn () =>
1.4 +8 -5 mlton/basis-library/real/real.fun
Index: real.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- real.fun 25 Aug 2003 20:00:04 -0000 1.3
+++ real.fun 26 Aug 2003 20:36:44 -0000 1.4
@@ -59,16 +59,19 @@
open Prim.Math
structure MLton = Primitive.MLton
- structure Platform = MLton.Platform
(* Patches for Cygwin and SunOS, whose math libraries do not handle
* out-of-range args.
*)
val (acos, asin, ln, log10) =
if not MLton.native
- andalso (case Platform.os of
- Platform.Cygwin => true
- | Platform.SunOS => true
- | _ => false)
+ andalso let
+ open MLton.Platform.OS
+ in
+ case host of
+ Cygwin => true
+ | SunOS => true
+ | _ => false
+ end
then
let
fun patch f x =
1.10 +4 -4 mlton/basis-library/sml-nj/sml-nj.sml
Index: sml-nj.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/sml-nj/sml-nj.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- sml-nj.sml 18 Aug 2003 06:19:52 -0000 1.9
+++ sml-nj.sml 26 Aug 2003 20:36:44 -0000 1.10
@@ -23,9 +23,9 @@
fun getHostArch () =
let
- open Primitive.MLton.Platform
+ open MLton.Platform.Arch
in
- case arch of
+ case host of
X86 => "X86"
| Sparc => "SPARC"
end
@@ -33,9 +33,9 @@
fun getOSKind () = UNIX
fun getOSName () =
let
- open Primitive.MLton.Platform
+ open MLton.Platform.OS
in
- case os of
+ case host of
Cygwin => "Cygwin"
| FreeBSD => "FreeBSD"
| Linux => "Linux"
1.24 +4 -3 mlton/bin/mlton
Index: mlton
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/mlton,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- mlton 26 Aug 2003 16:38:04 -0000 1.23
+++ mlton 26 Aug 2003 20:36:44 -0000 1.24
@@ -41,12 +41,13 @@
# about -m. Someday, when we think we won't run into older gcc's,
# these should be changed to -f.
-# You may need to add -link-opt '-L/path/to/libgmp' before the "$@" so that the
-# linker can find the gmp.
+# You may need to add a line with -link-opt '-L/path/to/libgmp' so
+# that the linker can find the gmp.
doit "$lib" \
-cc "$gcc" \
-cc-opt "-I$lib/include" \
+ -cc-opt '-O1' \
-cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w' \
-target-cc-opt x86 \
'-fno-strength-reduce
@@ -55,7 +56,7 @@
-malign-functions=5
-malign-jumps=2
-malign-loops=2
- -mcpu=pentiumpro'
+ -mcpu=pentiumpro' \
-target-cc-opt sparc \
'-Wa,-xarch=v8plusa
-fcall-used-g5
1.24 +31 -6 mlton/lib/mlton-stubs/mlton.sml
Index: mlton.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/mlton.sml,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- mlton.sml 18 Aug 2003 06:19:52 -0000 1.23
+++ mlton.sml 26 Aug 2003 20:36:44 -0000 1.24
@@ -143,13 +143,38 @@
structure Platform =
struct
- datatype arch = Sparc | X86
-
- val arch: arch = X86
-
- datatype os = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+ fun peek (l, f) = List.find f l
+ fun omap (opt, f) = Option.map f opt
+
+ structure Arch =
+ struct
+ datatype t = Sparc | X86
- val os: os = SunOS
+ val host: t = X86
+
+ val all = [(Sparc, "sparc"), (X86, "x86")]
+
+ fun fromString s = omap (peek (all, fn (_, s') => s = s'), #1)
+
+ fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+ end
+
+ structure OS =
+ struct
+ datatype t = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+
+ val host: t = Linux
+
+ val all = [(Cygwin, "cygwin"),
+ (FreeBSD, "freebsd"),
+ (Linux, "linux"),
+ (NetBSD, "netbsd"),
+ (SunOS, "sunos")]
+
+ fun fromString s = omap (peek (all, fn (_, s') => s = s'), #1)
+
+ fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+ end
end
structure ProcEnv =
1.3 +16 -4 mlton/lib/mlton-stubs/platform.sig
Index: platform.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/platform.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- platform.sig 18 Aug 2003 06:19:52 -0000 1.2
+++ platform.sig 26 Aug 2003 20:36:45 -0000 1.3
@@ -1,8 +1,20 @@
signature MLTON_PLATFORM =
sig
- datatype arch = Sparc | X86
- val arch: arch
+ structure Arch:
+ sig
+ datatype t = Sparc | X86
+
+ val host: t
+ val fromString: string -> t option
+ val toString: t -> string
+ end
- datatype os = Cygwin | FreeBSD | Linux | NetBSD | SunOS
- val os: os
+ structure OS:
+ sig
+ datatype t = Cygwin | FreeBSD | Linux | NetBSD | SunOS
+
+ val host: t
+ val fromString: string -> t option
+ val toString: t -> string
+ end
end
1.65 +1 -1 mlton/mlton/codegen/c-codegen/c-codegen.fun
Index: c-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/c-codegen/c-codegen.fun,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- c-codegen.fun 26 Aug 2003 03:53:28 -0000 1.64
+++ c-codegen.fun 26 Aug 2003 20:36:45 -0000 1.65
@@ -563,7 +563,7 @@
end
val handleMisalignedReals =
!Control.align = Control.Align4
- andalso !Control.hostArch = Control.Sparc
+ andalso !Control.hostArch = MLton.Platform.Arch.Sparc
fun addr z = concat ["&(", z, ")"]
fun realFetch z = concat ["Real64_fetch(", addr z, ")"]
fun realMove {dst, src} =
1.48 +4 -12 mlton/mlton/codegen/x86-codegen/x86-codegen.fun
Index: x86-codegen.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-codegen.fun,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- x86-codegen.fun 18 Aug 2003 06:19:52 -0000 1.47
+++ x86-codegen.fun 26 Aug 2003 20:36:45 -0000 1.48
@@ -92,12 +92,7 @@
* that don't handle signals, since signals get used under the hood
* in Cygwin.
*)
- case !Control.hostOS of
- Control.Cygwin => true
- | Control.FreeBSD => false
- | Control.Linux => false
- | Control.NetBSD => false
- | _ => Error.bug "x86 can't handle hostType"
+ !Control.hostOS = MLton.Platform.OS.Cygwin
val makeC = outputC
val makeS = outputS
@@ -158,12 +153,9 @@
(* Drop the leading _ with Cygwin, because gcc will add it.
*)
val mainLabel =
- case !Control.hostOS of
- Control.Cygwin => String.dropPrefix (mainLabel, 1)
- | Control.FreeBSD => mainLabel
- | Control.Linux => mainLabel
- | Control.NetBSD => mainLabel
- | _ => Error.bug "x86 can't handle hostType"
+ if !Control.hostOS = MLton.Platform.OS.Cygwin
+ then String.dropPrefix (mainLabel, 1)
+ else mainLabel
in
[mainLabel, if reserveEsp then C.truee else C.falsee]
end
1.24 +3 -6 mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun
Index: x86-mlton-basic.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton-basic.fun,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- x86-mlton-basic.fun 18 Aug 2003 06:19:52 -0000 1.23
+++ x86-mlton-basic.fun 26 Aug 2003 20:36:45 -0000 1.24
@@ -371,12 +371,9 @@
val fileLineLabel =
Promise.lazy
(fn () =>
- Label.fromString (case !Control.hostOS of
- Control.Cygwin => "_LINE__"
- | Control.FreeBSD => "__LINE__"
- | Control.Linux => "__LINE__"
- | Control.NetBSD => "__LINE__"
- | _ => Error.bug "x86 can't handle hostOS"))
+ Label.fromString (if !Control.hostOS = MLton.Platform.OS.Cygwin
+ then "_LINE__"
+ else "__LINE__"))
val fileLine
= fn () => if !Control.debug
1.43 +3 -6 mlton/mlton/codegen/x86-codegen/x86.fun
Index: x86.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86.fun,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- x86.fun 22 Aug 2003 04:25:25 -0000 1.42
+++ x86.fun 26 Aug 2003 20:36:45 -0000 1.43
@@ -62,12 +62,9 @@
open Label
fun toString l =
- case !Control.hostOS of
- Control.Cygwin => concat ["_", Label.toString l]
- | Control.FreeBSD => Label.toString l
- | Control.Linux => Label.toString l
- | Control.NetBSD => Label.toString l
- | _ => Error.bug "x86 can't handle hostOS"
+ if !Control.hostOS = MLton.Platform.OS.Cygwin
+ then concat ["_", Label.toString l]
+ else Label.toString l
val layout = Layout.str o toString
end
1.78 +2 -4 mlton/mlton/control/control.sig
Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- control.sig 7 Jul 2003 22:50:29 -0000 1.77
+++ control.sig 26 Aug 2003 20:36:45 -0000 1.78
@@ -69,11 +69,9 @@
| Self
val host: host ref
- datatype hostArch = datatype MLton.Platform.arch
- val hostArch: hostArch ref
+ val hostArch: MLton.Platform.Arch.t ref
- datatype hostOS = datatype MLton.Platform.os
- val hostOS: hostOS ref
+ val hostOS: MLton.Platform.OS.t ref
(* Indentation used in laying out ILs. *)
val indentation: int ref
1.95 +4 -29 mlton/mlton/control/control.sml
Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -r1.94 -r1.95
--- control.sml 18 Aug 2003 06:19:52 -0000 1.94
+++ control.sml 26 Aug 2003 20:36:46 -0000 1.95
@@ -145,38 +145,13 @@
default = Self,
toString = Host.toString}
-structure HostArch =
- struct
- datatype t = datatype MLton.Platform.arch
-
- val toString =
- fn X86 => "X86"
- | Sparc => "SPARC"
- end
-
-datatype hostArch = datatype HostArch.t
-
val hostArch = control {name = "host arch",
- default = X86,
- toString = HostArch.toString}
-
-structure HostOS =
- struct
- datatype t = datatype MLton.Platform.os
-
- val toString =
- fn Cygwin => "Cygwin"
- | FreeBSD => "FreeBSD"
- | Linux => "Linux"
- | NetBSD => "NetBSD"
- | SunOS => "SunOS"
- end
+ default = MLton.Platform.Arch.X86,
+ toString = MLton.Platform.Arch.toString}
-datatype hostOS = datatype HostOS.t
-
val hostOS = control {name = "host OS",
- default = Linux,
- toString = HostOS.toString}
+ default = MLton.Platform.OS.Linux,
+ toString = MLton.Platform.OS.toString}
val indentation = control {name = "indentation",
default = 3,
1.26 +1 -1 mlton/mlton/elaborate/elaborate-core.fun
Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- elaborate-core.fun 18 Aug 2003 05:34:56 -0000 1.25
+++ elaborate-core.fun 26 Aug 2003 20:36:46 -0000 1.26
@@ -405,7 +405,7 @@
SOME (case a of
Attribute.Cdecl => Convention.Cdecl
| Attribute.Stdcall =>
- if !Control.hostOS = Control.Cygwin
+ if !Control.hostOS = MLton.Platform.OS.Cygwin
then Convention.Stdcall
else Convention.Cdecl)
| _ => NONE
1.154 +64 -143 mlton/mlton/main/main.sml
Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.153
retrieving revision 1.154
diff -u -r1.153 -r1.154
--- main.sml 22 Aug 2003 04:10:39 -0000 1.153
+++ main.sml 26 Aug 2003 20:36:46 -0000 1.154
@@ -40,20 +40,20 @@
val coalesce: int option ref = ref NONE
val expert: bool ref = ref false
val gcc: string ref = ref "<unset>"
-val includeDirs: string list ref = ref []
val keepGenerated = ref false
val keepO = ref false
val keepSML = ref false
val linkOpts: string list ref = ref []
val output: string option ref = ref NONE
-val optimization: int ref = ref 1
val profileSet: bool ref = ref false
val showBasis: bool ref = ref false
val stop = ref Place.OUT
+val targetCCOpts: {opt: string, target: string} list ref = ref []
+val targetLinkOpts: {opt: string, target: string} list ref = ref []
-val hostMap: unit -> {arch: Control.hostArch,
+val hostMap: unit -> {arch: MLton.Platform.Arch.t,
host: string,
- os: Control.hostOS} list =
+ os: MLton.Platform.OS.t} list =
Promise.lazy
(fn () =>
List.map
@@ -62,18 +62,13 @@
[host, arch, os] =>
let
val arch =
- case arch of
- "x86" => Control.X86
- | "sparc" => Control.Sparc
- | _ => Error.bug (concat ["strange arch: ", arch])
+ case MLton.Platform.Arch.fromString arch of
+ NONE => Error.bug (concat ["strange arch: ", arch])
+ | SOME a => a
val os =
- case os of
- "cygwin" => Control.Cygwin
- | "freebsd" => Control.FreeBSD
- | "linux" => Control.Linux
- | "netbsd" => Control.NetBSD
- | "sunos" => Control.SunOS
- | _ => Error.bug (concat ["strange os: ", os])
+ case MLton.Platform.OS.fromString os of
+ NONE => Error.bug (concat ["strange os: ", os])
+ | SOME os => os
in
{arch = arch, host = host, os = os}
end
@@ -84,6 +79,7 @@
NONE => usage (concat ["invalid host ", hostString])
| SOME {arch, os, ...} =>
let
+ datatype z = datatype MLton.Platform.Arch.t
open Control
in
hostArch := arch
@@ -100,6 +96,7 @@
val usage = fn s => (usage s; raise Fail "unreachable")
open Control Popt
fun push r = SpaceString (fn s => List.push (r, s))
+ datatype z = datatype MLton.Platform.Arch.t
in
List.map
(
@@ -135,17 +132,7 @@
(Expert, "cc", " <gcc>", "path to gcc executable",
SpaceString (fn s => gcc := s)),
(Normal, "cc-opt", " <opt>", "pass option to C compiler",
- SpaceString (fn opt =>
- if opt = ""
- then ccOpts := []
- else
- if (3 = String.size opt
- andalso String.isPrefix {prefix = "-O",
- string = opt})
- then optimization := (Char.toInt
- (String.sub (opt, 2))
- - Char.toInt #"0")
- else List.push (ccOpts, opt))),
+ push ccOpts),
(Expert, "coalesce", " <n>", "coalesce chunk size for C codegen",
Int (fn n => coalesce := SOME n)),
(Expert, "debug", " {false|true}", "produce executable with debug info",
@@ -248,10 +235,7 @@
"compute dynamic counts of limit checks",
boolRef limitCheckCounts),
(Normal, "link-opt", " <opt>", "pass option to linker",
- SpaceString (fn s =>
- if s = ""
- then linkOpts := []
- else List.push (linkOpts, s))),
+ push linkOpts),
(Expert, "loop-passes", " <n>", "loop optimization passes (1)",
Int
(fn i =>
@@ -264,7 +248,9 @@
"may @MLton load-world be used",
boolRef mayLoadWorld),
(Normal, "native",
- if !hostArch = Sparc then " {false}" else " {true|false}",
+ if !hostArch = MLton.Platform.Arch.Sparc
+ then " {false}"
+ else " {true|false}",
"use native code generator",
boolRef Native.native),
(Expert, "native-commented", " <n>", "level of comments (0)",
@@ -346,6 +332,15 @@
| "o" => Place.O
| "sml" => Place.SML
| _ => usage (concat ["invalid -stop arg: ", s])))),
+ (Expert, "target-cc-opt", " target <opt>", "target-dependent CC option",
+ (SpaceString2
+ (fn (target, opt) =>
+ List.push (targetCCOpts, {opt = opt, target = target})))),
+ (Expert, "target-link-opt", " target <opt>",
+ "target-dependent link option",
+ (SpaceString2
+ (fn (target, opt) =>
+ List.push (targetLinkOpts, {opt = opt, target = target})))),
(Expert, #1 trace, " name1,...", "trace compiler internals", #2 trace),
(Expert, "text-io-buf-size", " <n>", "TextIO buffer size",
intRef textIOBufSize),
@@ -400,89 +395,26 @@
| Self => "self"
val lib = concat [!libDir, "/", hostString]
val _ = Control.libDir := lib
- val includeDirs = concat [lib, "/include"] :: !includeDirs
- (* Much of the commentary for the C flags is taken from the gcc docs. *)
- val standardCFlags =
- [
- (* Do not allow gcc to assume the strictest aliasing rules, in which
- * an object of one type is assumed never to reside at the same
- * address as an object of a different type, unless the types are
- * almost the same.
- *)
- "-fno-strict-aliasing",
- (* Don't keep the frame pointer in a register for functions that
- * don't need one.
- *)
- "-fomit-frame-pointer",
- "-w"]
- val x86CFlags =
- standardCFlags
- @ [
- (* Don't perform the optimizations of loop strength reduction and
- * elimination of iteration variables.
- *)
- "-fno-strength-reduce",
- (* Attempt to reorder instructions to eliminate execution stalls
- * due to required data being unavailable.
- *)
- "-fschedule-insns",
- "-fschedule-insns2",
- (* For align-{functions,jumps,loops, we use -m for now instead of
- * -f because old gcc's will barf on -f, while newer ones only warn
- * about -m. Someday, when we think we won't run into older gcc's,
- * these should be changed to -f.
- *)
- (* `-falign-functions=N'
- * Align the start of functions to the next power-of-two greater
- * than N, skipping up to N bytes.
- *)
- "-malign-functions=5",
- (* Align branch targets to a power-of-two boundary. *)
- "-malign-jumps=2",
- (* Align loops to a power-of-two boundary. *)
- "-malign-loops=2",
- (* Assume the defaults for the machine type when scheduling
- * instructions.
- * pentiumpro is the same as i686.
- *)
- "-mcpu=pentiumpro"]
- val x86LinkLibs = []
- val sparcCFlags =
- standardCFlags
- @ [
- (* Enable the SPARC V9 instruction set with UltraSPARC extensions. *)
- "-Wa,-xarch=v8plusa",
- (* Treat the registers g5, g7 as allocable registers that are
- * clobbered by function calls.
- *)
- "-fcall-used-g5",
- "-fcall-used-g7",
- (* Generate code for a 32 bit environment. *)
- "-m32",
- (* Emit integer multiply and integer divide instructions that exist
- * in SPARC v8 but not in SPARC v7.
- *)
- "-mv8",
- (* Set the instruction set, register set, and instruction scheduling
- * parameters for machine type.
- *)
- "-mcpu=ultrasparc",
- (* Emit exit code inline at every function exit. *)
- "-mno-epilogue"]
- val sparcLinkLibs = ["dl", "nsl", "socket"]
- val (ccDefaultOpts, defaultLibs) =
- case !hostArch of
- X86 => (x86CFlags, x86LinkLibs)
- | Sparc => (sparcCFlags, sparcLinkLibs)
- fun prefixAll (prefix: string, l: string list): string list =
- List.map (l, fn s => concat [prefix, s])
- val defaultLibs =
- prefixAll ("-l", defaultLibs @ ["gdtoa", "m"])
+ val hostArch = !hostArch
+ val archStr = MLton.Platform.Arch.toString hostArch
+ val hostOS = !hostOS
+ val OSStr = MLton.Platform.OS.toString hostOS
fun tokenize l =
- String.tokens (concat (List.separate (rev (!l), " ")), Char.isSpace)
- val ccOpts = tokenize ccOpts
+ String.tokens (concat (List.separate (l, " ")), Char.isSpace)
+ fun addTargetOpts (opts, targetOpts) =
+ tokenize
+ (List.append
+ (List.fold
+ (!targetOpts, [], fn ({opt, target}, ac) =>
+ if target = archStr orelse target = OSStr
+ then opt :: ac
+ else ac),
+ rev (!opts)))
+ val ccOpts = addTargetOpts (ccOpts, targetCCOpts)
+ val linkOpts = addTargetOpts (linkOpts, targetLinkOpts)
+ datatype z = datatype MLton.Platform.OS.t
val linkWithGmp =
- case !hostOS of
+ case hostOS of
Cygwin => ["-lgmp"]
| FreeBSD => ["-L/usr/local/lib/", "-lgmp"]
| Linux =>
@@ -514,11 +446,10 @@
val linkOpts =
List.concat [[concat ["-L", lib],
if !debug then "-lmlton-gdb" else "-lmlton"],
- tokenize linkOpts,
- defaultLibs,
+ linkOpts,
linkWithGmp]
val _ =
- if !Native.native andalso !hostArch = Sparc
+ if !Native.native andalso hostArch = MLton.Platform.Arch.Sparc
then usage "can't use -native true on Sparc"
else ()
val _ =
@@ -538,7 +469,7 @@
then keepSSA := true
else ()
val _ =
- if !hostOS = Cygwin andalso !profile = ProfileTime
+ if hostOS = MLton.Platform.OS.Cygwin andalso !profile = ProfileTime
then usage "can't use -profile time on Cygwin"
else ()
fun printVersion (out: Out.t): unit =
@@ -626,15 +557,9 @@
| SOME f => f
fun docc (inputs: File.t list,
output: File.t,
- switches: string list,
- linkOpts: string list): unit =
+ switches: string list): unit =
System.system
- (gcc, List.concat [switches,
- ["-o", output],
- inputs,
- linkOpts])
- val definesAndIncludes =
- prefixAll ("-I", rev (includeDirs))
+ (gcc, List.concat [switches, ["-o", output], inputs])
datatype debugFormat =
Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
(* The -Wa,--gstabs says to pass the --gstabs option to the
@@ -655,23 +580,26 @@
val _ =
trace (Top, "Link")
(fn () =>
- docc (inputs, output,
- List.concat
- [case host of
- Cross s => ["-b", s]
- | Self => [],
- if !debug then gccDebug else [],
- if !static then ["-static"] else []],
- linkOpts))
+ System.system
+ (gcc,
+ List.concat
+ [["-o", output],
+ (case host of
+ Cross s => ["-b", s]
+ | Self => []),
+ if !debug then gccDebug else [],
+ if !static then ["-static"] else [],
+ inputs,
+ linkOpts]))
()
(* gcc on Cygwin appends .exe, which I don't want, so
* move the output file to it's rightful place.
- * Notice that we do not use !hostOS here, since we
+ * Notice that we do not use hostOS here, since we
* care about the platform we're running on, not the
* platform we're generating for.
*)
val _ =
- if MLton.Platform.os = Cygwin
+ if let open MLton.Platform.OS in host = Cygwin end
then
if String.contains (output, #".")
then ()
@@ -705,13 +633,7 @@
if SOME "c" = extension
then
(gccDebug @ ["-DASSERT=1"],
- List.concat
- [definesAndIncludes,
- [concat
- ["-O", (Int.toString
- (!optimization))]],
- ccDefaultOpts,
- ccOpts])
+ ccOpts)
else ([asDebug], [])
val switches =
if !debug
@@ -738,8 +660,7 @@
(Counter.next c),
".o"])
else temp ".o"
- val _ =
- docc ([input], output, switches, [])
+ val _ = docc ([input], output, switches)
in
output :: ac
end
1.16 +9 -9 mlton/runtime/basis-constants.h
Index: basis-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis-constants.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- basis-constants.h 18 Aug 2003 06:19:53 -0000 1.15
+++ basis-constants.h 26 Aug 2003 20:36:46 -0000 1.16
@@ -31,25 +31,25 @@
/* ------------------------------------------------- */
#if (defined (__sparc__))
-#define MLton_Platform_arch 0
+#define MLton_Platform_Arch_host 0
#elif (defined (__i386__))
-#define MLton_Platform_arch 1
+#define MLton_Platform_Arch_host 1
#else
-#error MLton_Platform_arch not defined
+#error MLton_Platform_Arch_host not defined
#endif
#if (defined (__CYGWIN__))
-#define MLton_Platform_os 0
+#define MLton_Platform_OS_host 0
#elif (defined (__FreeBSD__))
-#define MLton_Platform_os 1
+#define MLton_Platform_OS_host 1
#elif (defined (__linux__))
-#define MLton_Platform_os 2
+#define MLton_Platform_OS_host 2
#elif (defined (__NetBSD__))
-#define MLton_Platform_os 3
+#define MLton_Platform_OS_host 3
#elif (defined (__sun__))
-#define MLton_Platform_os 4
+#define MLton_Platform_OS_host 4
#else
-#error MLton_Platform_os not defined
+#error MLton_Platform_OS_host not defined
#endif
#if (defined (__sun__))
-------------------------------------------------------
This SF.net email is sponsored by: VM Ware
With VMware you can run multiple operating systems on a single machine.
WITHOUT REBOOTING! Mix Linux / Windows / Novell virtual machines
at the same time. Free trial click here:http://www.vmware.com/wl/offer/358/0
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel