[MLton-commit] r6815
Matthew Fluet
fluet at mlton.org
Sat Aug 30 15:03:37 PDT 2008
Apply Wesley Terpstra's darwin-ptrs.patch.
Hey. I've been working on a patch to generate symbol stubs for darwin-i386.
I can't test it, as I don't have an i386 mac. Also, I'm not sure how to get
the assembly I generate to end up in the output. The function
makeDarwinNonLazySymbolPointers needs to be called somewhere to output the
symbols at the bottom of each assembler file.
Once the patch works, the following should compile (as an executable):
val f = _import "cos" external: real -> real;
val g = _import * : MLton.Pointer.t -> real -> real;
val h = _address "sin" external: MLton.Pointer.t;
val () = print (Real.toString (f 4.0) ^ "\n")
val () = print (Real.toString (g h 4.0) ^ "\n")
As far as I understand it, this will not work currently. That's what my
patch is attempting to fix.
If you could take a whack on the attached patch when you have some spare
time, I'd appreciate it.
----------------------------------------------------------------------
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/codegen/x86-codegen/x86-pseudo.sig
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-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-08-27 16:37:25 UTC (rev 6814)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-generate-transfers.fun 2008-08-30 22:03:34 UTC (rev 6815)
@@ -463,41 +463,39 @@
else AppendList.single (Assembly.directive_unreserve
{registers = [Register.esp]})
- val (mkCCallLabel, mkSymbolStubs) =
- if !Control.Target.os = 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 () => [])
+ local
+ val set: (word * String.t * Label.t) HashSet.t =
+ HashSet.new {hash = #1}
+ in
+ fun markDarwinSymbolStub name =
+ let
+ val hash = String.hash name
+ val mungedName = "L_" ^ name ^ "_stub"
+ val _ =
+ HashSet.lookupOrInsert
+ (set, hash,
+ fn (hash', name', _) =>
+ hash = hash' andalso name = name',
+ fn () =>
+ (hash, name, Label.newString mungedName))
+ in
+ ()
+ end
+ fun makeDarwinSymbolStubs () =
+ 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)
+ end
+
datatype z = datatype Entry.t
datatype z = datatype Transfer.t
fun generateAll (gef as GEF {effect,...})
@@ -1393,14 +1391,6 @@
{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 (),
@@ -1436,7 +1426,8 @@
(* Darwin needs to generate special stubs
* that are filled in by the dynamic linker.
*)
- | (External, Darwin, _) => darwinStub ()
+ | (External, Darwin, _) =>
+ (markDarwinSymbolStub name; plt)
(* ELF systems create procedure lookup
* tables (PLT) which proxy the call to
* libraries. The PLT does not contain an
@@ -2060,7 +2051,7 @@
of [] => doit ()
| block => block::(doit ())))
val assembly = doit ()
- val symbol_stubs = mkSymbolStubs ()
+ val symbol_stubs = makeDarwinSymbolStubs ()
val _ = destLayoutInfo ()
val _ = destProfileLabel ()
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-08-27 16:37:25 UTC (rev 6814)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-mlton.fun 2008-08-30 22:03:34 UTC (rev 6815)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -704,6 +704,32 @@
| W16 => sral i
| W32 => sral i
| W64 => Error.bug "x86MLton.prim: shift, W64"
+
+ val symbolPointerSet: (word * String.t * Label.t) HashSet.t =
+ HashSet.new {hash = #1}
+ fun markDarwinNonLazySymbolPointer name =
+ let
+ val hash = String.hash name
+ val mungedName = "L_" ^ name ^ "_non_lazy_ptr"
+ val _ =
+ HashSet.lookupOrInsert
+ (symbolPointerSet, hash,
+ fn (hash', name', _) =>
+ hash = hash' andalso name = name',
+ fn () =>
+ (hash, name, Label.newString mungedName))
+ in
+ ()
+ end
+ fun makeDarwinNonLazySymbolPointers () =
+ HashSet.fold
+ (symbolPointerSet, [],
+ fn ((_, name, label), assembly) =>
+ (Assembly.pseudoop_non_lazy_symbol_pointer ()) ::
+ (Assembly.label label) ::
+ (Assembly.pseudoop_indirect_symbol (Label.fromString name)) ::
+ (Assembly.pseudoop_long [Immediate.zero]) ::
+ assembly)
in
AppendList.appends
[comment_begin,
@@ -788,8 +814,9 @@
(* 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)
+ | (External, Darwin, _) =>
+ (markDarwinNonLazySymbolPointer 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
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2008-08-27 16:37:25 UTC (rev 6814)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-pseudo.sig 2008-08-30 22:03:34 UTC (rev 6815)
@@ -270,9 +270,13 @@
val pseudoop : PseudoOp.t -> t
val pseudoop_data : unit -> t
val pseudoop_text : unit -> t
+ val pseudoop_symbol_stub : unit -> t
+ val pseudoop_non_lazy_symbol_pointer : unit -> t
val pseudoop_p2align : Immediate.t * Immediate.t option * Immediate.t option -> t
val pseudoop_byte : Immediate.t list -> t
val pseudoop_global: Label.t -> t
+ val pseudoop_hidden : Label.t -> t
+ val pseudoop_indirect_symbol : Label.t -> t
val pseudoop_word : Immediate.t list -> t
val pseudoop_long : Immediate.t list -> t
val label : Label.t -> t
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-08-27 16:37:25 UTC (rev 6814)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-08-30 22:03:34 UTC (rev 6815)
@@ -3284,6 +3284,7 @@
= Data
| Text
| SymbolStub
+ | NonLazySymbolPointer
| 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
@@ -3305,6 +3306,8 @@
| Text => str ".text"
| SymbolStub
=> str ".section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5"
+ | NonLazySymbolPointer
+ => str ".section __IMPORT,__pointers,non_lazy_symbol_pointers"
| Balign (i,fill,max)
=> seq [str ".balign ",
Immediate.layout i,
@@ -3405,6 +3408,7 @@
fn Data => Data
| Text => Text
| SymbolStub => SymbolStub
+ | NonLazySymbolPointer => NonLazySymbolPointer
| Balign (i,fill,max) => Balign (replacerImmediate i,
Option.map(fill, replacerImmediate),
Option.map(max, replacerImmediate))
@@ -3428,6 +3432,7 @@
val data = fn () => Data
val text = fn () => Text
val symbol_stub = fn () => SymbolStub
+ val non_lazy_symbol_pointer = fn () => NonLazySymbolPointer
val balign = Balign
val p2align = P2align
val space = Space
@@ -3508,6 +3513,8 @@
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_non_lazy_symbol_pointer =
+ PseudoOp o PseudoOp.non_lazy_symbol_pointer
val pseudoop_balign = PseudoOp o PseudoOp.balign
val pseudoop_p2align = PseudoOp o PseudoOp.p2align
val pseudoop_space = PseudoOp o PseudoOp.space
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.sig
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2008-08-27 16:37:25 UTC (rev 6814)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.sig 2008-08-30 22:03:34 UTC (rev 6815)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -794,6 +794,7 @@
= Data
| Text
| SymbolStub
+ | NonLazySymbolPointer
| 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
@@ -812,6 +813,7 @@
val data : unit -> t
val text : unit -> t
val symbol_stub : unit -> t
+ val non_lazy_symbol_pointer : 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
@@ -879,6 +881,7 @@
val pseudoop_data : unit -> t
val pseudoop_text : unit -> t
val pseudoop_symbol_stub : unit -> t
+ val pseudoop_non_lazy_symbol_pointer : 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
More information about the MLton-commit
mailing list