[MLton-commit] r6858
Wesley Terpstra
wesley at mlton.org
Wed Sep 17 14:38:38 PDT 2008
Unfortunately, there is a fourth case I'd forgotten. Archives which will be
compiled into shared libraries must be compiled differently from those that
are compiled into executables. Thus LibArchive needed to be added. Ugh.
Introduce a control, positionIndependent, which simplifies the codegen tests
and also control the -fPIC compile options in main.fun.
----------------------------------------------------------------------
U mlton/trunk/basis-library/mlton/exit.sml
U mlton/trunk/basis-library/mlton/platform.sig
U mlton/trunk/basis-library/mlton/platform.sml
U mlton/trunk/basis-library/primitive/prim-mlton.sml
U mlton/trunk/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun
U mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun
U mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun
U mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/lookup-constant.fun
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/mlton/exit.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exit.sml 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/basis-library/mlton/exit.sml 2008-09-17 21:38:32 UTC (rev 6858)
@@ -71,6 +71,7 @@
case host of
Archive => suffixArchiveOrLibrary
| Executable => suffixExecutable
+ | LibArchive => suffixArchiveOrLibrary
| Library => suffixArchiveOrLibrary
end
in
Modified: mlton/trunk/basis-library/mlton/platform.sig
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sig 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/basis-library/mlton/platform.sig 2008-09-17 21:38:32 UTC (rev 6858)
@@ -19,7 +19,7 @@
structure Format:
sig
- datatype t = Archive | Executable | Library
+ datatype t = Archive | Executable | LibArchive | Library
val fromString: string -> t option
val host: t
Modified: mlton/trunk/basis-library/mlton/platform.sml
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sml 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/basis-library/mlton/platform.sml 2008-09-17 21:38:32 UTC (rev 6858)
@@ -46,6 +46,7 @@
val all = [
(Archive, "Archive"),
(Executable, "Executable"),
+ (LibArchive, "LibArchive"),
(Library, "Library")]
fun fromString s =
Modified: mlton/trunk/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-mlton.sml 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/basis-library/primitive/prim-mlton.sml 2008-09-17 21:38:32 UTC (rev 6858)
@@ -181,12 +181,14 @@
datatype t =
Archive
| Executable
+ | LibArchive
| Library
val host: t =
case _build_const "MLton_Platform_Format": String8.string; of
"archive" => Archive
| "executable" => Executable
+ | "libarchive" => LibArchive
| "library" => Library
| _ => raise Primitive.Exn.Fail8 "strange MLton_Platform_Format"
end
Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -3779,7 +3779,7 @@
(* The base register gets supplied by three distinct cases:
* 1 - memBase (which means that there is no label)
* 2 - RIP (which means there is no index)
- * 3 - lea (which means this is a library)
+ * 3 - lea (which means this is PIC)
* else nothing
*)
val {disp,
@@ -3822,9 +3822,8 @@
register = SOME Register.rip,
assembly = AppendList.empty,
registerAllocation = registerAllocation}
- | (_, NONE, SOME memIndex) (* label + index => use lea if library *)
- => if !Control.format <> Control.Library
- andalso !Control.Target.os <> MLton.Platform.OS.Darwin
+ | (_, NONE, SOME memIndex) (* label + index => use lea if PIC *)
+ => if !Control.positionIndependent = false
then {disp = SOME disp,
register = NONE,
assembly = AppendList.empty,
Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -1527,9 +1527,9 @@
{target = Operand.memloc_label importLabel,
absolute = true}]
in
- case (symbolScope,
+ case (symbolScope,
!Control.Target.os,
- !Control.format) of
+ !Control.positionIndependent) of
(* Private functions can be easily reached
* with a direct (rip-relative) call.
*)
@@ -1554,9 +1554,8 @@
* darwin-x86_64 function calls and calls
* made from an ELF executable.
*)
- | (External, Darwin, _) => direct
- | (External, _, Library) => plt
- | _ => direct
+ | (External, _, true) => plt
+ | (External, _, false) => direct
end
| Indirect =>
AppendList.fromList
Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -682,7 +682,6 @@
| MinGW => coff
| _ => elf
- (* It's direct, but still PIC *)
val direct =
AppendList.fromList
[Block.mkBlock'
@@ -705,34 +704,14 @@
size = dstsize}],
transfer = NONE}]
in
- case (symbolScope, !Control.Target.os, !Control.format) of
+ case (symbolScope,
+ !Control.Target.os,
+ !Control.positionIndependent) of
(* As long as the symbol is private (this means it is not
* exported to code outside this text segment), then
* RIP-relative addressing works on every OS/format.
*)
(Private, _, _) => direct
- (* Windows MUST access locally defined symbols directly.
- * An indirect access would lead to a linker error.
- *)
- | (Public, MinGW, _) => direct
- | (Public, Cygwin, _) => direct
- (* On ELF&darwin, a public symbol must be accessed via
- * the GOT. This is because the final value may not be
- * in this text segment. If the executable uses it, then
- * the unique C address resides in the executable's
- * text segment. The loader does this by creating a PLT
- * proxy or copying values to the executable text segment.
- *)
- | (Public, _, Library) => indirect
- (* When compiling to a library, we need to access external
- * symbols via some address that is updated by the loader.
- * That address resides within our data segment, and can
- * be easily referenced using RIP-relative addressing.
- * This trick is used on every platform MLton supports.
- * Windows rewrites __imp__name symbols in our segment.
- * ELF and darwin-x86_64 rewrite name at GOTPCREL.
- *)
- | (External, _, Library) => indirect
(* When linking an executable, ELF and darwin-x86_64 use
* a special trick to "simplify" the code. All exported
* functions and symbols have pointers that correspond to
@@ -743,12 +722,30 @@
* and archive formats. (It also means direct access is
* NOT fine for a library, even if it defines the symbol)
*
- * On windows, the address is the point of definition. So
+ * On ELF&darwin, a public symbol must be accessed via
+ * the GOT. This is because the final value may not be
+ * in this text segment. If the executable uses it, then
+ * the unique C address resides in the executable's
+ * text segment. The loader does this by creating a PLT
+ * proxy or copying values to the executable text segment.
+ *)
+ | (Public, _, true) => indirect
+ | (Public, _, false) => direct
+ (* On windows, the address is the point of definition. So
* we must use an indirect lookup even in executables.
*)
| (External, MinGW, _) => indirect
| (External, Cygwin, _) => indirect
- | _ => direct
+ (* When compiling to a library, we need to access external
+ * symbols via some address that is updated by the loader.
+ * That address resides within our data segment, and can
+ * be easily referenced using RIP-relative addressing.
+ * This trick is used on every platform MLton supports.
+ * Windows rewrites __imp__name symbols in our segment.
+ * ELF and darwin-x86_64 rewrite name at GOTPCREL.
+ *)
+ | (External, _, true) => indirect
+ | (External, _, false) => direct
end
| Real_Math_sqrt _ => sse_unas Instruction.SSE_SQRTS
| Real_abs s =>
Modified: mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -410,6 +410,7 @@
C.callNoSemi (case !Control.format of
Control.Archive => "MLtonLibrary"
| Control.Executable => "MLtonMain"
+ | Control.LibArchive => "MLtonLibrary"
| Control.Library => "MLtonLibrary",
[C.int align,
magic,
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -33,17 +33,15 @@
Label.fromString (s ^ "@GOTOFF")
(* !!! PIC on darwin not done yet !!! *)
+ (* It will work using %esp -> MLtonLocalBaseSymbol *)
fun mungeLabelDarwin l =
- Label.fromString (Label.toString l ^ "-someKnownSymbol")
+ Label.fromString (Label.toString l ^ "-MLtonLocalBaseSymbol")
in
- case (!Control.format, !Control.Target.os) of
- (* Windows doesn't do PIC at all *)
- (_, MinGW) => (fn l => l, NONE)
- | (_, Cygwin) => (fn l => l, NONE)
- (* We only need PIC to output libraries *)
- | (Library, Darwin) => (mungeLabelDarwin, SOME Register.ebx)
- | (Library, _) => (mungeLabelELF, SOME Register.ebx)
- | _ => (fn l => l, NONE)
+ case (!Control.Target.os, !Control.positionIndependent) of
+ (* Only darwin and ELF might be using PIC *)
+ (Darwin, true) => (mungeLabelDarwin, SOME Register.esp)
+ | (_, true) => (mungeLabelELF, SOME Register.ebx)
+ | (_, false) => (fn l => l, NONE)
end
fun track memloc = let
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -1389,7 +1389,7 @@
{target = Operand.label (label ()),
absolute = false}]
- val stub = fn () =>
+ val plt = fn () =>
AppendList.fromList
[Assembly.directive_ccall (),
Assembly.instruction_call
@@ -1405,7 +1405,7 @@
in
case (symbolScope,
!Control.Target.os,
- !Control.format) of
+ !Control.positionIndependent) of
(* Private functions can be easily reached
* with a direct (eip-relative) call.
*)
@@ -1423,15 +1423,16 @@
| (External, Cygwin, _) => indirect ()
(* Darwin needs to generate special stubs
* that are filled in by the dynamic linker.
+ * This is needed even for non-PIC.
*)
- | (External, Darwin, _) => stub ()
+ | (External, Darwin, _) => plt ()
(* ELF systems create procedure lookup
* tables (PLT) which proxy the call to
* libraries. The PLT does not contain an
* address, but instead a stub function.
*)
- | (External, _, Library) => stub ()
- | _ => direct ()
+ | (External, _, true) => plt ()
+ | (External, _, false) => direct ()
end
| Indirect =>
AppendList.fromList
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -750,7 +750,6 @@
| MinGW => coff ()
| _ => elf ()
- (* It's direct, but still PIC if library code *)
val direct = fn () =>
AppendList.fromList
[Block.mkBlock'
@@ -773,19 +772,18 @@
size = dstsize}],
transfer = NONE}]
in
- case (symbolScope, !Control.Target.os, !Control.format) of
- (* As long as the symbol is private (this means it is not
+ case (symbolScope,
+ !Control.Target.os,
+ !Control.positionIndependent) of
+ (* Even private PIC symbols on darwin need indirection. *)
+ (Private, Darwin, true) => indirect ()
+ (* As long as the symbol is private (thus it is not
* exported to code outside this text segment), then
* use normal addressing. If PIC is needed, then the
- * memloc_label is updated to %rbx relative in the
+ * memloc_label is updated to relative access in the
* allocate-registers pass.
*)
- (Private, _, _) => direct ()
- (* Windows MUST access locally defined symbols directly.
- * An indirect access would lead to a linker error.
- *)
- | (Public, MinGW, _) => direct ()
- | (Public, Cygwin, _) => direct ()
+ | (Private, _, _) => direct ()
(* On darwin, even executables use the defintion address.
* Therefore we don't need to do indirection.
*)
@@ -796,37 +794,39 @@
* the unique C address resides in the executable's
* text segment. The loader does this by creating a PLT
* proxy or copying values to the executable text segment.
- *)
- | (Public, _, Library) => indirect ()
- (* On darwin, the address is the point of definition. So
- * indirection is needed. We also need to make a stub!
- *)
- | (External, Darwin, _) => indirect ()
- (* When compiling to a library, we need to access external
- * symbols via some address that is updated by the loader.
- * That address resides within our data segment, and can
- * be easily referenced using RBX-relative addressing.
- * This trick is used on every platform MLton supports.
- * Windows rewrites __imp__name symbols in our segment.
- * ELF rewrite name at GOT.
- *)
- | (External, _, Library) => indirect ()
- (* When linking an executable, ELF uses a special trick
+ * When linking an executable, ELF uses a special trick
* to "simplify" the code. All exported functions and
* symbols have pointers that correspond to the
* executable. Function pointers point to the
* automatically created PLT entry in the executable.
* Variables are copied/relocated into the executable bss.
+ *
* This means that direct access is fine for executable
* and archive formats. (It also means direct access is
* NOT fine for a library, even if it defines the symbol)
*
- * On windows, the address is the point of definition. So
- * we must use an indirect lookup even in executables.
*)
+ | (Public, _, true) => indirect ()
+ | (Public, _, false) => direct ()
+ (* On darwin, the address is the point of definition. So
+ * indirection is needed. We also need to make a stub!
+ *)
+ | (External, Darwin, _) => indirect ()
+ (* On windows, the address is the point of definition. So
+ * we must always use an indirect lookup to the symbols
+ * windows rewrites (__imp__name) in our segment.
+ *)
| (External, MinGW, _) => indirect ()
| (External, Cygwin, _) => indirect ()
- | _ => direct ()
+ (* When compiling ELF to a library, we access external
+ * symbols via some address that is updated by the loader.
+ * That address resides within our data segment, and can
+ * be easily referenced using RBX-relative addressing.
+ * This trick is used on every platform MLton supports.
+ * ELF rewrites symbols of form name at GOT.
+ *)
+ | (External, _, true) => indirect ()
+ | (External, _, false) => direct ()
end
| Real_Math_acos _
=> let
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/control/control-flags.sig 2008-09-17 21:38:32 UTC (rev 6858)
@@ -151,6 +151,7 @@
datatype t =
Archive
| Executable
+ | LibArchive
| Library
val all: t list
val toString: t -> string
@@ -266,6 +267,8 @@
val optimizationPasses:
{il: string, set: string -> unit Result.t, get: unit -> string} list ref
+
+ val positionIndependent : bool ref
(* Only duplicate big functions when
* (size - small) * (number of occurrences - 1) <= product
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/control/control-flags.sml 2008-09-17 21:38:32 UTC (rev 6858)
@@ -623,14 +623,16 @@
datatype t =
Archive
| Executable
+ | LibArchive
| Library
(* Default option first for usage message. *)
- val all = [Executable, Archive, Library]
+ val all = [Executable, Archive, LibArchive, Library]
val toString: t -> string =
fn Archive => "archive"
| Executable => "executable"
+ | LibArchive => "libarchive"
| Library => "library"
end
@@ -854,6 +856,8 @@
("product", Int.layout product)])
p)}
+val positionIndependent = ref false
+
val preferAbsPaths = control {name = "prefer abs paths",
default = false,
toString = Bool.toString}
Modified: mlton/trunk/mlton/main/lookup-constant.fun
===================================================================
--- mlton/trunk/mlton/main/lookup-constant.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/main/lookup-constant.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -36,6 +36,7 @@
("MLton_Platform_Format", fn () => case !format of
Archive => "archive"
| Executable => "executable"
+ | LibArchive => "libarchive"
| Library => "library"),
("MLton_Profile_isOn", fn () => bool (case !profile of
ProfileNone => false
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2008-09-16 12:04:31 UTC (rev 6857)
+++ mlton/trunk/mlton/main/main.fun 2008-09-17 21:38:32 UTC (rev 6858)
@@ -823,6 +823,28 @@
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !Target.os
val OSStr = String.toLower (MLton.Platform.OS.toString targetOS)
+
+ (* Determine whether code should be PIC (position independent) or not.
+ * This decision depends on the platform and output format.
+ *)
+ val positionIndependent =
+ case (targetOS, targetArch, !format) of
+ (* Windows is never position independent *)
+ (MinGW, _, _) => false
+ | (Cygwin, _, _) => false
+ (* Technically, Darwin should always be PIC.
+ * However, PIC on i386/darwin is unimplemented so we avoid it.
+ * PowerPC PIC is bad too, but the C codegen will use PIC behind
+ * our back unless forced, so let's just admit that it's PIC.
+ *)
+ | (Darwin, X86, Executable) => false
+ | (Darwin, X86, Archive) => false
+ | (Darwin, _, _) => true
+ (* On ELF systems, we only need PIC for LibArchive/Library *)
+ | (_, _, Library) => true
+ | (_, _, LibArchive) => true
+ | _ => false
+ val () = Control.positionIndependent := positionIndependent
val stop = !stop
@@ -939,7 +961,7 @@
:: ccOpts
val linkOpts =
List.concat [[concat ["-L", !libTargetDir]],
- if !format = Library then
+ if positionIndependent then
["-lmlton-pic", "-lgdtoa-pic"]
else if !debugRuntime then
["-lmlton-gdb", "-lgdtoa-gdb"]
@@ -1163,11 +1185,13 @@
case !format of
Archive => maybeOut ".a"
| Executable => maybeOut ""
+ | LibArchive => maybeOut ".a"
| Library => maybeOut libExt
val _ =
trace (Top, "Link")
(fn () =>
- if !format = Archive
+ if !format = Archive orelse
+ !format = LibArchive
then System.system
(arScript,
List.concat
@@ -1230,7 +1254,7 @@
[[ "-std=gnu99", "-c" ],
if !format = Executable
then [] else [ "-DLIBNAME=" ^ libname () ],
- if !format = Library
+ if positionIndependent
then [ "-fPIC", "-DPIC" ] else [],
if !debug then debugSwitches else [],
ccOpts,
More information about the MLton-commit
mailing list