[MLton-commit] r4732: Generate .symbol_stub sections on x86-darwin
Matthew Fluet
fluet at mlton.org
Thu Oct 19 18:42:43 PDT 2006
MAIL Generate .symbol_stub sections on x86-darwin
The MacOS X assembler guide describes how to generate symbol stubs for
undefined functions that are called in the module.
http://tuvix.apple.com/documentation/DeveloperTools/Reference/Assembler/Assembler.pdf
This is untested, since I don't have access to an Intel Mac, but the
produced assembly appears to match the spec. I believe that this
should accomodate the _import syntax.
I don't know if anything special needs to be done on x86-darwin to
access a symbol defined in a dynamic library; i.e., the _symbol and
_address syntax. I'd be interested to know how gcc compiles:
extern int x;
void setX(int y) { x = y; }
int getX() { return x; }
int* getXAddr() { return &x; }
----------------------------------------------------------------------
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-translate.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-validate.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 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-allocate-registers.fun 2006-10-20 01:42:40 UTC (rev 4732)
@@ -6792,9 +6792,48 @@
{assembly
= AppendList.appends
[assembly_pre,
+ AppendList.single (Assembly.instruction instruction),
assembly_post],
registerAllocation = registerAllocation}
end
+ | HLT
+ (* Halt; p. 331 *)
+ => let
+ val {uses,defs,kills}
+ = Instruction.uses_defs_kills instruction
+ val {assembly = assembly_pre,
+ registerAllocation}
+ = RA.pre {uses = uses,
+ defs = defs,
+ kills = kills,
+ info = info,
+ registerAllocation = registerAllocation}
+
+ val instruction
+ = Instruction.HLT
+
+ val {uses = final_uses,
+ defs = final_defs,
+ ...}
+ = Instruction.uses_defs_kills instruction
+
+ val {assembly = assembly_post,
+ registerAllocation}
+ = RA.post {uses = uses,
+ final_uses = final_uses,
+ defs = defs,
+ final_defs = final_defs,
+ kills = kills,
+ info = info,
+ registerAllocation = registerAllocation}
+ in
+ {assembly
+ = AppendList.appends
+ [assembly_pre,
+ AppendList.single (Assembly.instruction instruction),
+ assembly_post],
+ registerAllocation = registerAllocation}
+ end
| BinAL {oper, src, dst, size}
(* Integer binary arithmetic(w/o mult & div)/logic instructions.
* Require src/dst operands as follows:
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2006-10-20 01:42:40 UTC (rev 4732)
@@ -424,6 +424,41 @@
else AppendList.single (Assembly.directive_unreserve
{registers = [Register.esp]})
+ val (mkCCallLabel, mkSymbolStubs) =
+ if !Control.targetOS = MLton.Platform.OS.Darwin
+ then
+ let
+ val set: (word * String.t * Label.t) HashSet.t =
+ HashSet.new {hash = #1}
+ fun mkCCallLabel name =
+ let
+ val hash = String.hash name
+ in
+ (#3 o HashSet.lookupOrInsert)
+ (set, hash,
+ fn (hash', name', _) => hash = hash' andalso name = name',
+ fn () => (hash, name,
+ Label.newString (concat ["L_", name, "_stub"])))
+ end
+ fun mkSymbolStubs () =
+ HashSet.fold
+ (set, [], fn ((_, name, label), assembly) =>
+ (Assembly.pseudoop_symbol_stub ()) ::
+ (Assembly.label label) ::
+ (Assembly.pseudoop_indirect_symbol (Label.fromString name)) ::
+ (Assembly.instruction_hlt ()) ::
+ (Assembly.instruction_hlt ()) ::
+ (Assembly.instruction_hlt ()) ::
+ (Assembly.instruction_hlt ()) ::
+ (Assembly.instruction_hlt ()) ::
+ assembly)
+ in
+ (mkCCallLabel, mkSymbolStubs)
+ end
+ else
+ (fn name => Label.fromString name,
+ fn () => [])
+
datatype z = datatype Entry.t
datatype z = datatype Transfer.t
fun generateAll (gef as GEF {effect,...})
@@ -434,12 +469,9 @@
| SOME (Block.T {entry, profileLabel, statements, transfer})
=> let
val _ = setLayoutInfo(label, NONE)
-
(*
val isLoopHeader = fn _ => false
*)
-
-
fun near label =
let
val align =
@@ -1293,11 +1325,12 @@
case convention of
Cdecl => name
| Stdcall => concat [name, "@", Int.toString size_args]
+ val target = mkCCallLabel name
in
AppendList.fromList
[Assembly.directive_ccall (),
Assembly.instruction_call
- {target = Operand.label (Label.fromString name),
+ {target = Operand.label target,
absolute = false}]
end
| Indirect =>
@@ -1931,10 +1964,21 @@
of [] => doit ()
| block => block::(doit ())))
val assembly = doit ()
+ val symbol_stubs = mkSymbolStubs ()
val _ = destLayoutInfo ()
val _ = destProfileLabel ()
+
+ val assembly = [Assembly.pseudoop_text ()]::assembly
+ val assembly =
+ if List.isEmpty symbol_stubs
+ then assembly
+ else symbol_stubs :: assembly
+ val assembly =
+ if List.isEmpty data
+ then assembly
+ else ((Assembly.pseudoop_data())::data)::assembly
in
- data::assembly
+ assembly
end
val (generateTransfers, generateTransfers_msg)
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-translate.fun 2006-10-20 01:42:40 UTC (rev 4732)
@@ -781,7 +781,6 @@
= let
val data = ref []
val addData = fn l => List.push (data, l)
- val _ = addData [x86.Assembly.pseudoop_data ()]
val {get = live : Label.t -> x86.Operand.t list,
set = setLive,
rem = remLive, ...}
@@ -806,7 +805,6 @@
transInfo = transInfo}))
val _ = Vector.foreach (blocks, fn Block.T {label, ...} =>
remLive label)
- val _ = addData [x86.Assembly.pseudoop_text ()]
val data = List.concatRev (!data)
in
x86.Chunk.T {data = data, blocks = x86Blocks}
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-validate.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-validate.fun 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-validate.fun 2006-10-20 01:42:40 UTC (rev 4732)
@@ -103,6 +103,7 @@
fun validate {instruction: t}
= case instruction
of NOP => true
+ | HLT => true
| BinAL {src, dst, size, ...}
(* Integer binary arithmetic(w/o mult & div)/logic instructions.
* Require src/dst operands as follows:
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2006-10-20 01:42:40 UTC (rev 4732)
@@ -1717,6 +1717,8 @@
datatype t
(* No operation *)
= NOP
+ (* Halt *)
+ | HLT
(* Integer binary arithmetic(w/o mult & div)/logic instructions.
*)
| BinAL of {oper: binal,
@@ -1990,6 +1992,8 @@
in
fn NOP
=> str "nop"
+ | HLT
+ => str "hlt"
| BinAL {oper, src, dst, size}
=> bin (binal_layout oper,
Size.layout size,
@@ -2261,6 +2265,8 @@
val uses_defs_kills
= fn NOP
=> {uses = [], defs = [], kills = []}
+ | HLT
+ => {uses = [], defs = [], kills = []}
| BinAL {src, dst, ...}
=> {uses = [src, dst], defs = [dst], kills = []}
| pMD {src, dst, ...}
@@ -2596,6 +2602,8 @@
val srcs_dsts
= fn NOP
=> {srcs = NONE, dsts = NONE}
+ | HLT
+ => {srcs = NONE, dsts = NONE}
| BinAL {src, dst, ...}
=> {srcs = SOME [src, dst], dsts = SOME [dst]}
| pMD {src, dst, ...}
@@ -2785,6 +2793,8 @@
fun replace replacer
= fn NOP
=> NOP
+ | HLT
+ => HLT
| BinAL {oper, src, dst, size}
=> BinAL {oper = oper,
src = replacer {use = true, def = false} src,
@@ -2989,6 +2999,7 @@
=> FBinASP {oper = oper}
val nop = fn () => NOP
+ val hlt = fn () => HLT
val binal = BinAL
val pmd = pMD
val md = MD
@@ -3451,6 +3462,7 @@
datatype t
= Data
| Text
+ | SymbolStub
| Balign of Immediate.t * Immediate.t option * Immediate.t option
| P2align of Immediate.t * Immediate.t option * Immediate.t option
| Space of Immediate.t * Immediate.t
@@ -3459,6 +3471,7 @@
| Long of Immediate.t list
| String of string list
| Global of Label.t
+ | IndirectSymbol of Label.t
| Local of Label.t
| Comm of Label.t * Immediate.t * Immediate.t option
@@ -3468,6 +3481,7 @@
in
fn Data => str ".data"
| Text => str ".text"
+ | SymbolStub => str ".symbol_stub"
| Balign (i,fill,max)
=> seq [str ".balign ",
Immediate.layout i,
@@ -3519,6 +3533,9 @@
| Global l
=> seq [str ".globl ",
Label.layout l]
+ | IndirectSymbol l
+ => seq [str ".indirect_symbol ",
+ Label.layout l]
| Local l
=> seq [str ".local ",
Label.layout l]
@@ -3551,6 +3568,7 @@
in
fn Data => Data
| Text => Text
+ | SymbolStub => SymbolStub
| Balign (i,fill,max) => Balign (replacerImmediate i,
Option.map(fill, replacerImmediate),
Option.map(max, replacerImmediate))
@@ -3563,6 +3581,7 @@
| Long ls => Long (List.map(ls, replacerImmediate))
| String ss => String ss
| Global l => Global (replacerLabel l)
+ | IndirectSymbol l => IndirectSymbol (replacerLabel l)
| Local l => Local (replacerLabel l)
| Comm (l, i, a) => Comm (replacerLabel l,
replacerImmediate i,
@@ -3571,6 +3590,7 @@
val data = fn () => Data
val text = fn () => Text
+ val symbol_stub = fn () => SymbolStub
val balign = Balign
val p2align = P2align
val space = Space
@@ -3579,6 +3599,7 @@
val long = Long
val string = String
val global = Global
+ val indirect_symbol = IndirectSymbol
val locall = Local
val comm = Comm
end
@@ -3648,6 +3669,7 @@
val pseudoop = PseudoOp
val pseudoop_data = PseudoOp o PseudoOp.data
val pseudoop_text = PseudoOp o PseudoOp.text
+ val pseudoop_symbol_stub = PseudoOp o PseudoOp.symbol_stub
val pseudoop_balign = PseudoOp o PseudoOp.balign
val pseudoop_p2align = PseudoOp o PseudoOp.p2align
val pseudoop_space = PseudoOp o PseudoOp.space
@@ -3656,11 +3678,13 @@
val pseudoop_long = PseudoOp o PseudoOp.long
val pseudoop_string = PseudoOp o PseudoOp.string
val pseudoop_global = PseudoOp o PseudoOp.global
+ val pseudoop_indirect_symbol = PseudoOp o PseudoOp.indirect_symbol
val pseudoop_local = PseudoOp o PseudoOp.locall
val pseudoop_comm = PseudoOp o PseudoOp.comm
val label = Label
val instruction = Instruction
val instruction_nop = Instruction o Instruction.nop
+ val instruction_hlt = Instruction o Instruction.hlt
val instruction_binal = Instruction o Instruction.binal
val instruction_pmd = Instruction o Instruction.pmd
val instruction_md = Instruction o Instruction.md
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2006-10-19 14:14:14 UTC (rev 4731)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2006-10-20 01:42:40 UTC (rev 4732)
@@ -422,7 +422,10 @@
* dst operands are changed by the instruction.
*)
datatype t
+ (* No operation *)
= NOP
+ (* Halt *)
+ | HLT
(* Integer binary arithmetic(w/o mult & div)/logic instructions.
*)
| BinAL of {oper: binal,
@@ -814,6 +817,7 @@
datatype t
= Data
| Text
+ | SymbolStub
| Balign of Immediate.t * Immediate.t option * Immediate.t option
| P2align of Immediate.t * Immediate.t option * Immediate.t option
| Space of Immediate.t * Immediate.t
@@ -822,6 +826,7 @@
| Long of Immediate.t list
| String of string list
| Global of Label.t
+ | IndirectSymbol of Label.t
| Local of Label.t
| Comm of Label.t * Immediate.t * Immediate.t option
@@ -829,6 +834,7 @@
val data : unit -> t
val text : unit -> t
+ val symbol_stub : unit -> t
val balign : Immediate.t * Immediate.t option * Immediate.t option -> t
val p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
val space : Immediate.t * Immediate.t -> t
@@ -837,6 +843,7 @@
val long : Immediate.t list -> t
val string : string list -> t
val global : Label.t -> t
+ val indirect_symbol : Label.t -> t
val locall : Label.t -> t
val comm : Label.t * Immediate.t * Immediate.t option -> t
end
@@ -893,6 +900,7 @@
val pseudoop : PseudoOp.t -> t
val pseudoop_data : unit -> t
val pseudoop_text : unit -> t
+ val pseudoop_symbol_stub : unit -> t
val pseudoop_balign : Immediate.t * Immediate.t option * Immediate.t option ->t
val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
val pseudoop_space : Immediate.t * Immediate.t -> t
@@ -901,11 +909,13 @@
val pseudoop_long : Immediate.t list -> t
val pseudoop_string : string list -> t
val pseudoop_global : Label.t -> t
+ val pseudoop_indirect_symbol : Label.t -> t
val pseudoop_local : Label.t -> t
val pseudoop_comm : Label.t * Immediate.t * Immediate.t option -> t
val label : Label.t -> t
val instruction : Instruction.t -> t
val instruction_nop : unit -> t
+ val instruction_hlt : unit -> t
val instruction_binal : {oper: Instruction.binal,
src: Operand.t,
dst: Operand.t,
More information about the MLton-commit
mailing list