[MLton-commit] r6795
Wesley Terpstra
wesley at mlton.org
Sat Aug 23 16:58:35 PDT 2008
Implemented PIC support for i386. Also implemented ported the scoped symbol
lookup code from the amd64 codegen.
On darwin only external calls will now generate stubs.
To effect the PIC support, these changes were needed:
reserve %ebx for a known address
load this address in jumpToSML (x86-codegen)
added a globalOffsetTable pseudo-location to force cache as ebx
watch for labels in immediates and memlocs, translate them to
PIC relative names during allocate-registers.
intentionally leave Operand.Labels alone
all jmps and __LINE__ use Operand.Label so they aren't PIC'd
all other uses are put in an immediate (eg: gcState)
----------------------------------------------------------------------
U mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig
U mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86.sig
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -15,6 +15,37 @@
val tracer = x86.tracer
val tracerTop = x86.tracerTop
+ fun picRelative () =
+ (* When outputing position-independent-code (PIC), we need to keep
+ * one register pointing at a known local address. Addresses are
+ * then computed relative to this register.
+ *)
+ let
+ datatype z = datatype Control.Format.t
+ datatype z = datatype MLton.Platform.OS.t
+
+ (* If the ELF symbol is external, we already setup an indirect
+ * mov to load the address. Don't munge the symbol more.
+ *)
+ fun mungeLabelELF l =
+ case Label.toString l of s =>
+ if String.hasSuffix (s, { suffix = "@GOT" }) then l else
+ Label.fromString (s ^ "@GOTOFF")
+
+ (* !!! PIC on darwin not done yet !!! *)
+ fun mungeLabelDarwin l =
+ Label.fromString (Label.toString l ^ "-someKnownSymbol")
+ 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)
+ end
+
fun track memloc = let
val trackClasses
= ClassSet.add(ClassSet.+
@@ -3446,48 +3477,69 @@
val MemLoc.U {immBase, memBase, immIndex, memIndex, scale, ...}
= MemLoc.destruct memloc
+ (* If PIC, find labels with RBX-relative addressing.
+ * It's bigger and slower, so only use it if we must.
+ *)
+ val (mungeLabel, base) = picRelative ()
+
val disp
= case (immBase, immIndex) of
(NONE, NONE) => Immediate.zero
- | (SOME immBase, NONE) => immBase
- | (NONE, SOME immIndex) => immIndex
+ | (SOME immBase, NONE)
+ => (case Immediate.destruct immBase of
+ Immediate.Word _ => immBase
+ | Immediate.Label l =>
+ Immediate.label (mungeLabel l)
+ | Immediate.LabelPlusWord (l, w) =>
+ Immediate.labelPlusWord (mungeLabel l, w))
+ | (NONE, SOME immIndex)
+ => (case Immediate.destruct immIndex of
+ Immediate.Word _ => immIndex
+ | _ => Error.bug "x86AllocateRegisters.RegisterAllocation.toAddressMemLoc:indexLabel")
| (SOME immBase, SOME immIndex)
=> (case (Immediate.destruct immBase, Immediate.destruct immIndex) of
(Immediate.Label l1, Immediate.Word w2) =>
- Immediate.labelPlusWord (l1, w2)
+ Immediate.labelPlusWord (mungeLabel l1, w2)
| (Immediate.LabelPlusWord (l1, w1), Immediate.Word w2) =>
- Immediate.labelPlusWord (l1, WordX.add (w1, w2))
+ Immediate.labelPlusWord (mungeLabel l1, WordX.add (w1, w2))
| _ => Error.bug "x86AllocateRegisters.RegisterAllocation.toAddressMemLoc:disp")
val {register = register_base,
assembly = assembly_base,
registerAllocation}
- = case memBase
- of NONE => {register = NONE,
- assembly = AppendList.empty,
- registerAllocation = registerAllocation}
- | SOME memBase
- => let
- val {register, assembly, registerAllocation}
- = toRegisterMemLoc
- {memloc = memBase,
- info = info,
- size = MemLoc.size memBase,
- move = true,
- supports
- = case memIndex
- of NONE => supports
- | SOME memIndex
- => (Operand.memloc memIndex)::
- supports,
- saves = saves,
- force = Register.baseRegisters,
- registerAllocation = registerAllocation}
- in
- {register = SOME register,
- assembly = assembly,
- registerAllocation = registerAllocation}
- end
+ = case (Immediate.destruct disp, memBase) of
+ (Immediate.Word _, NONE)
+ => {register = NONE,
+ assembly = AppendList.empty,
+ registerAllocation = registerAllocation}
+ | (Immediate.Word _, SOME memBase) (* no label, no PIC *)
+ => let
+ val {register, assembly, registerAllocation}
+ = toRegisterMemLoc
+ {memloc = memBase,
+ info = info,
+ size = MemLoc.size memBase,
+ move = true,
+ supports
+ = case memIndex
+ of NONE => supports
+ | SOME memIndex
+ => (Operand.memloc memIndex)::
+ supports,
+ saves = saves,
+ force = Register.baseRegisters,
+ registerAllocation = registerAllocation}
+ in
+ {register = SOME register,
+ assembly = assembly,
+ registerAllocation = registerAllocation}
+ end
+ | (_, SOME _) (* label & memBase? bad input *)
+ => Error.bug "x86AllocateRegisters.RegisterAllocation.toAddressMemLoc:base*2"
+ | (_, NONE) (* label only -> use PIC if needed *)
+ => {register = base,
+ assembly = AppendList.empty,
+ registerAllocation = registerAllocation}
val {register = register_index,
assembly = assembly_index,
@@ -3507,7 +3559,7 @@
supports = supports,
saves
= case (memBase, register_base)
- of (NONE, NONE) => saves
+ of (NONE, _) => saves
| (SOME memBase, SOME register_base)
=> (Operand.memloc memBase)::
(Operand.register register_base)::
@@ -3705,15 +3757,37 @@
force = force,
registerAllocation = registerAllocation}
val _ = Int.dec depth
+ val (mungeLabel, base) = picRelative ()
+ val instruction
+ = case Immediate.destruct immediate of
+ Immediate.Word _ =>
+ Assembly.instruction_mov
+ {dst = Operand.Register final_register,
+ src = Operand.Immediate immediate,
+ size = size}
+ | Immediate.Label l =>
+ Assembly.instruction_lea
+ {dst = Operand.Register final_register,
+ src = Operand.Address
+ (Address.T { disp = SOME (Immediate.label
+ (mungeLabel l)),
+ base = base,
+ index = NONE, scale = NONE }),
+ size = size}
+ | Immediate.LabelPlusWord (l, w) =>
+ Assembly.instruction_lea
+ {dst = Operand.Register final_register,
+ src = Operand.Address
+ (Address.T { disp = SOME (Immediate.labelPlusWord
+ (mungeLabel l, w)),
+ base = base,
+ index = NONE, scale = NONE }),
+ size = size}
in
{register = final_register,
assembly = AppendList.appends
[assembly,
- AppendList.single
- (Assembly.instruction_mov
- {dst = Operand.Register final_register,
- src = Operand.Immediate immediate,
- size = size})],
+ AppendList.single instruction],
registerAllocation = registerAllocation}
end
handle Spill
@@ -4273,7 +4347,17 @@
registerAllocation: t}
= case operand
of Operand.Immediate i
- => if immediate
+ => if immediate andalso
+ (let
+ val (_, picBase) = picRelative ()
+ val pic = picBase <> NONE
+ val hasLabel =
+ case Immediate.destruct i of
+ Immediate.Word _ => false
+ | _ => true
+ in
+ not (pic andalso hasLabel)
+ end)
then {operand = operand,
assembly = AppendList.empty,
registerAllocation = registerAllocation}
@@ -4297,10 +4381,12 @@
end
else if address
then let
+ val (mungeLabel, picBase) = picRelative ()
+ val label = mungeLabel (Label.fromString "raTemp1")
val address
= Address.T
- {disp = SOME (Immediate.label (Label.fromString "raTemp1")),
- base = NONE,
+ {disp = SOME (Immediate.label label),
+ base = picBase,
index = NONE,
scale = NONE}
in
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.sig 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.sig 2008-08-23 23:58:32 UTC (rev 6795)
@@ -24,4 +24,7 @@
x86.Assembly.t list list
val allocateRegisters_totals : unit -> unit
+
+ val picRelative : unit -> (x86.Label.t -> x86.Label.t) *
+ x86.Register.t option
end
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -73,12 +73,14 @@
print: string -> unit,
done: unit -> unit}}: unit
= let
- val reserveEsp =
+ val reserveEsp =
(* There is no sigaltstack on cygwin, we need to reserve %esp to
* hold the C stack pointer. We only need to do this in programs
* that handle signals.
*)
handlesSignals andalso let open Control.Target in !os = Cygwin end
+
+ val (picMungeLabel, picBase) = x86AllocateRegisters.picRelative ()
val makeC = outputC
val makeS = outputS
@@ -177,15 +179,17 @@
fun outputJumpToSML print =
let
val jumpToSML = x86.Label.fromString "MLton_jumpToSML"
+ val findEIP = x86.Label.fromString "MLton_findEIP"
val returnToC = x86.Label.fromString "Thread_returnToC"
+ val c_stackP = picMungeLabel x86MLton.c_stackP
+ val gcState = picMungeLabel x86MLton.gcState_label
val {frontierReg, stackTopReg} =
if reserveEsp
then {frontierReg = x86.Register.edi,
stackTopReg = x86.Register.ebp}
else {frontierReg = x86.Register.esp,
stackTopReg = x86.Register.ebp}
- val asm =
- [
+ val prefixJumpToSML = [
x86.Assembly.pseudoop_text (),
x86.Assembly.pseudoop_p2align
(x86.Immediate.int 4, NONE, NONE),
@@ -231,15 +235,28 @@
{disp = SOME (x86.Immediate.int 12),
base = SOME x86.Register.esp,
index = NONE, scale = NONE},
- size = x86.Size.LONG},
+ size = x86.Size.LONG}
+ ]
+ (* This is only included if PIC *)
+ val loadGOT = [
+ x86.Assembly.instruction_call
+ {target = x86.Operand.label findEIP,
+ absolute = false},
+ x86.Assembly.instruction_binal
+ {oper = x86.Instruction.ADD,
+ src = x86.Operand.immediate_label x86MLton.globalOffsetTable,
+ dst = x86.Operand.register x86.Register.ebx,
+ size = x86.Size.LONG}
+ ]
+ val suffixJumpToSML = [
x86.Assembly.instruction_mov
{src = (x86.Operand.address o x86.Address.T)
- {disp = SOME (x86.Immediate.label x86MLton.c_stackP),
- base = NONE, index = NONE, scale = NONE},
- dst = x86.Operand.register x86.Register.ebx,
+ {disp = SOME (x86.Immediate.label c_stackP),
+ base = picBase, index = NONE, scale = NONE},
+ dst = x86.Operand.register x86.Register.ebp,
size = x86.Size.LONG},
x86.Assembly.instruction_mov
- {src = x86.Operand.register x86.Register.ebx,
+ {src = x86.Operand.register x86.Register.ebp,
dst = (x86.Operand.address o x86.Address.T)
{disp = SOME (x86.Immediate.int 8),
base = SOME x86.Register.esp,
@@ -248,32 +265,34 @@
x86.Assembly.instruction_mov
{src = x86.Operand.register x86.Register.esp,
dst = (x86.Operand.address o x86.Address.T)
- {disp = SOME (x86.Immediate.label x86MLton.c_stackP),
- base = NONE, index = NONE, scale = NONE},
+ {disp = SOME (x86.Immediate.label c_stackP),
+ base = picBase, index = NONE, scale = NONE},
size = x86.Size.LONG},
x86.Assembly.instruction_mov
{src = (x86.Operand.address o x86.Address.T)
{disp = (SOME o x86.Immediate.labelPlusInt)
- (x86MLton.gcState_label,
+ (gcState,
Bytes.toInt
(Machine.Runtime.GCField.offset
Machine.Runtime.GCField.StackTop)),
- base = NONE, index = NONE, scale = NONE},
+ base = picBase, index = NONE, scale = NONE},
dst = x86.Operand.register stackTopReg,
size = x86.Size.LONG},
x86.Assembly.instruction_mov
{src = (x86.Operand.address o x86.Address.T)
{disp = (SOME o x86.Immediate.labelPlusInt)
- (x86MLton.gcState_label,
+ (gcState,
Bytes.toInt
(Machine.Runtime.GCField.offset
Machine.Runtime.GCField.Frontier)),
- base = NONE, index = NONE, scale = NONE},
+ base = picBase, index = NONE, scale = NONE},
dst = x86.Operand.register frontierReg,
size = x86.Size.LONG},
x86.Assembly.instruction_jmp
{target = x86.Operand.register x86.Register.eax,
- absolute = true},
+ absolute = true}
+ ]
+ val bodyReturnToC = [
x86.Assembly.pseudoop_p2align
(x86.Immediate.int 4, NONE, NONE),
x86.Assembly.pseudoop_global returnToC,
@@ -281,8 +300,8 @@
x86.Assembly.label returnToC,
x86.Assembly.instruction_mov
{src = (x86.Operand.address o x86.Address.T)
- {disp = SOME (x86.Immediate.label x86MLton.c_stackP),
- base = NONE, index = NONE, scale = NONE},
+ {disp = SOME (x86.Immediate.label c_stackP),
+ base = picBase, index = NONE, scale = NONE},
dst = x86.Operand.register x86.Register.esp,
size = x86.Size.LONG},
x86.Assembly.instruction_mov
@@ -290,13 +309,13 @@
{disp = SOME (x86.Immediate.int 8),
base = SOME x86.Register.esp,
index = NONE, scale = NONE},
- dst = x86.Operand.register x86.Register.ebx,
+ dst = x86.Operand.register x86.Register.ebp,
size = x86.Size.LONG},
x86.Assembly.instruction_mov
- {src = x86.Operand.register x86.Register.ebx,
+ {src = x86.Operand.register x86.Register.ebp,
dst = (x86.Operand.address o x86.Address.T)
- {disp = SOME (x86.Immediate.label x86MLton.c_stackP),
- base = NONE, index = NONE, scale = NONE},
+ {disp = SOME (x86.Immediate.label c_stackP),
+ base = picBase, index = NONE, scale = NONE},
size = x86.Size.LONG},
x86.Assembly.instruction_mov
{src = (x86.Operand.address o x86.Address.T)
@@ -333,6 +352,29 @@
size = x86.Size.LONG},
x86.Assembly.instruction_ret {src = NONE}
]
+ (* This is only included if PIC *)
+ val bodyFindEIP = [
+ x86.Assembly.pseudoop_p2align
+ (x86.Immediate.int 4, NONE, NONE),
+ x86.Assembly.pseudoop_global findEIP,
+ x86.Assembly.pseudoop_hidden findEIP,
+ x86.Assembly.label findEIP,
+ x86.Assembly.instruction_mov
+ {src = (x86.Operand.address o x86.Address.T)
+ {base = SOME x86.Register.esp,
+ disp = NONE, index = NONE, scale = NONE},
+ dst = x86.Operand.register x86.Register.ebx,
+ size = x86.Size.LONG},
+ x86.Assembly.instruction_ret {src = NONE}
+ ]
+
+ val asm =
+ List.concat
+ (if picBase <> NONE
+ then [prefixJumpToSML, loadGOT, suffixJumpToSML,
+ bodyReturnToC, bodyFindEIP]
+ else [prefixJumpToSML, suffixJumpToSML,
+ bodyReturnToC])
in
List.foreach
(asm,
@@ -386,7 +428,8 @@
newProfileLabel = newProfileLabel,
liveInfo = liveInfo,
jumpInfo = jumpInfo,
- reserveEsp = reserveEsp})
+ reserveEsp = reserveEsp,
+ picUsesEbx = picBase <> NONE})
val allocated_assembly : Assembly.t list list
= x86AllocateRegisters.allocateRegisters
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -99,6 +99,37 @@
| _ => []}
end
+ val picUsesEbxRegs =
+ let
+ val transferRegs
+ =
+ (*
+ Register.eax::
+ Register.al::
+ *)
+ (*
+ Register.ebx::
+ Register.bl::
+ *)
+ Register.ecx::
+ Register.cl::
+ Register.edx::
+ Register.dl::
+ Register.edi::
+ Register.esi::
+ (*
+ Register.esp::
+ Register.ebp::
+ *)
+ nil
+ in
+ {frontierReg = Register.esp,
+ stackTopReg = Register.ebp,
+ transferRegs = fn Entry.Jump _ => transferRegs
+ | Entry.CReturn _ => Register.eax::Register.al::transferRegs
+ | _ => []}
+ end
+
val transferFltRegs : Entry.t -> Int.t = fn Entry.Jump _ => 6
| Entry.CReturn _ => 6
| _ => 0
@@ -127,11 +158,14 @@
newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
liveInfo : x86Liveness.LiveInfo.t,
jumpInfo : x86JumpInfo.t,
- reserveEsp: bool}
+ reserveEsp: bool,
+ picUsesEbx: bool}
= let
val {frontierReg, stackTopReg, transferRegs} =
if reserveEsp
then reserveEspRegs
+ else if picUsesEbx
+ then picUsesEbxRegs
else normalRegs
val allClasses = !x86MLton.Classes.allClasses
val livenessClasses = !x86MLton.Classes.livenessClasses
@@ -166,14 +200,19 @@
weight = 2048, (* ??? *)
sync = false,
reserve = true}
+ val picUsesEbxAssume = {register = Register.ebx,
+ memloc = x86MLton.globalOffsetTableContents,
+ weight = 2048, (* ??? *)
+ sync = false,
+ reserve = true}
fun blockAssumes l =
let
val l = frontierAssume :: stackAssume :: l
+ val l = if reserveEsp then cStackAssume :: l else l
+ val l = if picUsesEbx then picUsesEbxAssume :: l else l
in
- Assembly.directive_assume {assumes = if reserveEsp
- then cStackAssume :: l
- else l}
+ Assembly.directive_assume {assumes = l }
end
fun runtimeTransfer live setup trans
@@ -1099,12 +1138,14 @@
| CCall {args, frameInfo, func, return}
=> let
datatype z = datatype CFunction.Convention.t
+ datatype z = datatype CFunction.SymbolScope.t
datatype z = datatype CFunction.Target.t
val CFunction.T {convention,
maySwitchThreads,
modifiesFrontier,
readsStackTop,
return = returnTy,
+ symbolScope,
target,
writesStackTop, ...} = func
val stackTopMinusWordDeref
@@ -1322,17 +1363,87 @@
case target of
Direct name =>
let
+ datatype z = datatype MLton.Platform.OS.t
+ datatype z = datatype Control.Format.t
+
val name =
case convention of
Cdecl => name
| Stdcall => concat [name, "@", Int.toString size_args]
- val target = mkCCallLabel name
+
+ val label = Label.fromString name
+
+ (* how to access imported functions: *)
+ (* Windows rewrites the symbol __imp__name *)
+ val coff = Label.fromString ("_imp__" ^ name)
+ val macho = Label.fromString ("L_" ^ name ^ "_stub")
+ val elf = Label.fromString (name ^ "@PLT")
+
+ val importLabel =
+ case !Control.Target.os of
+ Cygwin => coff
+ | Darwin => macho
+ | MinGW => coff
+ | _ => elf
+
+ val direct =
+ AppendList.fromList
+ [Assembly.directive_ccall (),
+ Assembly.instruction_call
+ {target = Operand.label label,
+ absolute = false}]
+
+ fun darwinStub () =
+ AppendList.fromList
+ [Assembly.directive_ccall (),
+ Assembly.instruction_call
+ {target = Operand.label
+ (mkCCallLabel name),
+ absolute = false}]
+
+ val plt =
+ AppendList.fromList
+ [Assembly.directive_ccall (),
+ Assembly.instruction_call
+ {target = Operand.label importLabel,
+ absolute = false}]
+
+ val indirect =
+ AppendList.fromList
+ [Assembly.directive_ccall (),
+ Assembly.instruction_call
+ {target = Operand.memloc_label importLabel,
+ absolute = true}]
in
- AppendList.fromList
- [Assembly.directive_ccall (),
- Assembly.instruction_call
- {target = Operand.label target,
- absolute = false}]
+ case (symbolScope,
+ !Control.Target.os,
+ !Control.format) of
+ (* Private functions can be easily reached
+ * with a direct (eip-relative) call.
+ *)
+ (Private, _, _) => direct
+ (* Even though it is not safe to take the
+ * address of a public function, it is ok
+ * to call it directly.
+ *)
+ | (Public, _, _) => direct
+ (* Windows always does indirect calls to
+ * imported functions. The importLabel has
+ * the function address written to it.
+ *)
+ | (External, MinGW, _) => indirect
+ | (External, Cygwin, _) => indirect
+ (* Darwin needs to generate special stubs
+ * that are filled in by the dynamic linker.
+ *)
+ | (External, Darwin, _) => darwinStub ()
+ (* 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) => plt
+ | _ => direct
end
| Indirect =>
AppendList.fromList
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.sig 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.sig 2008-08-23 23:58:32 UTC (rev 6795)
@@ -34,6 +34,7 @@
newProfileLabel: x86.ProfileLabel.t -> x86.ProfileLabel.t,
liveInfo: x86Liveness.LiveInfo.t,
jumpInfo: x86JumpInfo.t,
- reserveEsp: bool} -> x86.Assembly.t list list
+ reserveEsp: bool,
+ picUsesEbx: bool} -> x86.Assembly.t list list
val generateTransfers_totals : unit -> unit
end
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -165,6 +165,15 @@
val c_stackPDerefFloatOperand
= Operand.memloc c_stackPDerefFloat
+ (* This is more a pseudo-location. The GOT is special and cannot
+ * be simply loaded. Similarly, we don't really read the contents.
+ *)
+ val globalOffsetTable = Label.fromString "_GLOBAL_OFFSET_TABLE_"
+ val globalOffsetTableContents
+ = makeContents {base = Immediate.label globalOffsetTable,
+ size = pointerSize,
+ class = Classes.StaticNonTemp}
+
val applyFFTemp = Label.fromString "applyFFTemp"
val applyFFTempContents
= makeContents {base = Immediate.label applyFFTemp,
@@ -324,18 +333,18 @@
*
* We also have another hack because on some platforms, Label.toString appends
* an _ to the beginning of each label.
+ *
+ * Make it a label (not an immediate) so that it doesn't get PIC-ified.
*)
val fileLineLabel =
Promise.lazy (fn () => Label.fromString (if !Control.labelsHaveExtra_
- then "_LINE__"
- else "__LINE__"))
+ then "_LINE__+9"
+ else "__LINE__+9"))
val fileLine
= fn () => if !Control.debug
- then Operand.immediate (Immediate.zero)
- else (Operand.immediate
- (Immediate.labelPlusInt
- (fileLineLabel (), 9)))
+ then Operand.label (fileLineLabel ())
+ else Operand.immediate (Immediate.zero)
val gcState_label = Label.fromString "gcState"
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton-basic.sig 2008-08-23 23:58:32 UTC (rev 6795)
@@ -81,6 +81,10 @@
val c_stackPContentsOperand : x86.Operand.t
val c_stackPDerefDoubleOperand : x86.Operand.t
val c_stackPDerefFloatOperand : x86.Operand.t
+
+ (* Global offset table (GOT) *)
+ val globalOffsetTable : x86.Label.t
+ val globalOffsetTableContents : x86.MemLoc.t
(* Static temps defined in x86-main.h *)
val applyFFTempContentsOperand : x86.Operand.t
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -715,19 +715,106 @@
| CPointer_lt => cmp Instruction.B
| CPointer_sub => binal Instruction.SUB
| CPointer_toWord => mov ()
- | FFI_Symbol {name, ...}
+ | FFI_Symbol {name, symbolScope, ...}
=> let
- val (dst,dstsize) = getDst1 ()
+ datatype z = datatype CFunction.SymbolScope.t
+ datatype z = datatype Control.Format.t
+ datatype z = datatype MLton.Platform.OS.t
+
+ val (dst, dstsize) = getDst1 ()
+ val label = Label.fromString name
+
+ (* how to access an imported label's address *)
+ (* windows coff will add another leading _ to label *)
+ val coff = Label.fromString ("_imp__" ^ name)
+ val macho = Label.fromString ("L_" ^ name ^ "_non_lazy_ptr")
+ val elf = Label.fromString (name ^ "@GOT")
+
+ val importLabel =
+ case !Control.Target.os of
+ Cygwin => coff
+ | Darwin => macho
+ | MinGW => coff
+ | _ => elf
+
+ (* It's direct, but still PIC if library code *)
+ val direct =
+ AppendList.fromList
+ [Block.mkBlock'
+ {entry = NONE,
+ statements =
+ [Assembly.instruction_lea
+ {dst = dst,
+ src = Operand.memloc_label label,
+ size = dstsize}],
+ transfer = NONE}]
+
+ val indirect =
+ AppendList.fromList
+ [Block.mkBlock'
+ {entry = NONE,
+ statements =
+ [Assembly.instruction_mov
+ {dst = dst,
+ src = Operand.memloc_label importLabel,
+ size = dstsize}],
+ transfer = NONE}]
in
- AppendList.fromList
- [Block.mkBlock'
- {entry = NONE,
- statements =
- [Assembly.instruction_mov
- {dst = dst,
- src = Operand.immediate_label (Label.fromString name),
- size = dstsize}],
- transfer = NONE}]
+ case (symbolScope, !Control.Target.os, !Control.format) of
+ (* As long as the symbol is private (this means 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
+ * 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
+ (* On darwin, even executables use the defintion address.
+ * Therefore we don't need to do indirection.
+ *)
+ | (Public, Darwin, _) => direct
+ (* On ELF, 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
+ (* On darwin, the address is the point of definition. So
+ * indirection is needed. We also need to make a stub!
+ *)
+ | (External, Darwin, _) => ( (* !!! mkDarwinPtr name *)
+ 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
+ * 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.
+ *)
+ | (External, MinGW, _) => indirect
+ | (External, Cygwin, _) => indirect
+ | _ => direct
end
| Real_Math_acos _
=> let
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2008-08-23 23:58:32 UTC (rev 6795)
@@ -135,6 +135,7 @@
val label : Label.t -> t
val deLabel : t -> Label.t option
val memloc : MemLoc.t -> t
+ val memloc_label : Label.t -> t
val deMemloc : t -> MemLoc.t option
val size : t -> Size.t option
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -172,7 +172,7 @@
Vector.new1 (frontier, valOf (x86.Operand.size frontier))
end
| GCState =>
- Vector.new1 (x86.Operand.label x86MLton.gcState_label,
+ Vector.new1 (x86.Operand.immediate_label x86MLton.gcState_label,
x86MLton.pointerSize)
| Global g => Global.toX86Operand g
| Label l =>
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-08-23 23:58:32 UTC (rev 6795)
@@ -1207,6 +1207,10 @@
| _ => NONE
val address = Address
val memloc = MemLoc
+ fun memloc_label l =
+ memloc (MemLoc.makeContents { base = Immediate.label l,
+ size = Size.LONG,
+ class = MemLoc.Class.Code })
val deMemloc
= fn MemLoc x => SOME x
| _ => NONE
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2008-08-23 23:36:41 UTC (rev 6794)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2008-08-23 23:58:32 UTC (rev 6795)
@@ -282,6 +282,7 @@
val deLabel : t -> Label.t option
val address : Address.t -> t
val memloc : MemLoc.t -> t
+ val memloc_label : Label.t -> t
val deMemloc : t -> MemLoc.t option
val size : t -> Size.t option
More information about the MLton-commit
mailing list