[MLton-commit] r7137

Matthew Fluet fluet at mlton.org
Thu Jun 11 15:55:59 PDT 2009


Use thunk suspensions to avoid allocating labels that will not be used.
----------------------------------------------------------------------

U   mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun
U   mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun	2009-06-11 22:55:55 UTC (rev 7136)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun	2009-06-11 22:55:58 UTC (rev 7137)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -1491,40 +1492,40 @@
                                  datatype z = datatype MLton.Platform.OS.t
                                  datatype z = datatype Control.Format.t
                                  
-                                 val label = Label.fromString name
+                                 val label = fn () => Label.fromString name
                                  
                                  (* how to access imported functions: *)
                                  (* Windows rewrites the symbol __imp__name *)
-                                 val coff = Label.fromString ("_imp__" ^ name)
-                                 val macho = label (* @PLT is implicit *)
-                                 val elf = Label.fromString (name ^ "@PLT")
+                                 val coff = fn () => Label.fromString ("_imp__" ^ name)
+                                 val macho = fn () => label () (* @PLT is implicit *)
+                                 val elf = fn () => Label.fromString (name ^ "@PLT")
                                  
-                                 val importLabel = 
+                                 val importLabel = fn () =>
                                     case !Control.Target.os of
-                                       Cygwin => coff
-                                     | Darwin => macho
-                                     | MinGW => coff
-                                     |  _ => elf
+                                       Cygwin => coff ()
+                                     | Darwin => macho ()
+                                     | MinGW => coff ()
+                                     |  _ => elf ()
                                  
-                                 val direct =
+                                 val direct = fn () =>
                                    AppendList.fromList
                                    [Assembly.directive_ccall (),
                                     Assembly.instruction_call
-                                    {target = Operand.label label,
+                                    {target = Operand.label (label ()),
                                      absolute = false}]
                                      
-                                 val plt =
+                                 val plt = fn () =>
                                    AppendList.fromList
                                    [Assembly.directive_ccall (),
                                     Assembly.instruction_call
-                                    {target = Operand.label importLabel,
+                                    {target = Operand.label (importLabel ()),
                                      absolute = false}]
                                 
-                                 val indirect =
+                                 val indirect = fn () =>
                                    AppendList.fromList
                                    [Assembly.directive_ccall (),
                                     Assembly.instruction_call
-                                    {target = Operand.memloc_label importLabel,
+                                    {target = Operand.memloc_label (importLabel ()),
                                      absolute = true}]
                               in
                                 case (symbolScope,
@@ -1533,21 +1534,21 @@
                                    (* Private functions can be easily reached
                                     * with a direct (rip-relative) call.
                                     *)
-                                   (Private, _, _) => direct
+                                   (Private, _, _) => direct ()
                                    (* Call at the point of definition. *)
-                                 | (Public, MinGW, _) => direct
-                                 | (Public, Cygwin, _) => direct
-                                 | (Public, Darwin, _) => direct
+                                 | (Public, MinGW, _) => direct ()
+                                 | (Public, Cygwin, _) => direct ()
+                                 | (Public, Darwin, _) => direct ()
                                    (* ELF requires PLT even for public fns. *)
-                                 | (Public, _, true) => plt
-                                 | (Public, _, false) => direct
+                                 | (Public, _, true) => plt ()
+                                 | (Public, _, false) => direct ()
                                    (* Windows always does indirect calls to
                                     * imported functions. The importLabel has
                                     * the function address written to it.
                                     *)
-                                 | (External, MinGW, _) => indirect
-                                 | (External, Cygwin, _) => indirect
-                                 | (External, Darwin, _) => plt
+                                 | (External, MinGW, _) => indirect ()
+                                 | (External, Cygwin, _) => indirect ()
+                                 | (External, Darwin, _) => plt ()
                                    (* ELF systems (and darwin too) create
                                     * procedure lookup tables (PLT) which 
                                     * proxy the call to libraries. The PLT
@@ -1557,8 +1558,8 @@
                                     * darwin-x86_64 function calls and calls
                                     * made from an ELF executable.
                                     *)
-                                 | (External, _, true) => plt
-                                 | (External, _, false) => 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	2009-06-11 22:55:55 UTC (rev 7136)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-mlton.fun	2009-06-11 22:55:58 UTC (rev 7137)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2009 Matthew Fluet.
+ * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -667,40 +668,40 @@
                    datatype z = datatype MLton.Platform.OS.t
 
                    val (dst, dstsize) = getDst1 ()
-                   val label = Label.fromString name
+                   val label = fn () => 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 (name ^ "@GOTPCREL")
-                   val elf = Label.fromString (name ^ "@GOTPCREL")
+                   val coff = fn () => Label.fromString ("_imp__" ^ name)
+                   val macho = fn () => Label.fromString (name ^ "@GOTPCREL")
+                   val elf = fn () => Label.fromString (name ^ "@GOTPCREL")
                    
-                   val importLabel = 
+                   val importLabel = fn () =>
                       case !Control.Target.os of
-                         Cygwin => coff
-                       | Darwin => macho
-                       | MinGW => coff
-                       | _ => elf
+                         Cygwin => coff ()
+                       | Darwin => macho ()
+                       | MinGW => coff ()
+                       | _ => elf ()
                    
-                   val direct = 
+                   val direct = fn () =>
                       AppendList.fromList
                       [Block.mkBlock'
                        {entry = NONE,
                         statements =
                         [Assembly.instruction_lea
                          {dst = dst,
-                          src = Operand.memloc_label label,
+                          src = Operand.memloc_label (label ()),
                           size = dstsize}],
                         transfer = NONE}]
                    
-                   val indirect = 
+                   val indirect = fn () =>
                       AppendList.fromList
                       [Block.mkBlock'
                        {entry = NONE,
                         statements =
                         [Assembly.instruction_mov
                          {dst = dst,
-                          src = Operand.memloc_label importLabel,
+                          src = Operand.memloc_label (importLabel ()),
                           size = dstsize}],
                         transfer = NONE}]
                 in
@@ -711,7 +712,7 @@
                      * exported to code outside this text segment), then 
                      * RIP-relative addressing works on every OS/format. 
                      *)
-                      (Private, _, _) => direct
+                      (Private, _, _) => direct ()
                     (* 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
@@ -729,13 +730,13 @@
                      * 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
+                    | (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
+                    | (External, MinGW, _) => indirect ()
+                    | (External, Cygwin, _) => 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
@@ -744,8 +745,8 @@
                      * Windows rewrites __imp__name symbols in our segment.
                      * ELF and darwin-x86_64 rewrite name at GOTPCREL.
                      *)
-                    | (External, _, true) => indirect
-                    | (External, _, false) => direct
+                    | (External, _, true) => indirect ()
+                    | (External, _, false) => direct ()
                 end
              | Real_Math_sqrt _ => sse_unas Instruction.SSE_SQRTS
              | Real_abs s =>




More information about the MLton-commit mailing list