[MLton-commit] r5839

Matthew Fluet fluet at mlton.org
Wed Aug 8 18:34:00 PDT 2007


Don't hardcode the expected target sizes.

This has some overlap with the LookupConstants functionality;
unfortunately, we need to know the right sizes for mplimb, objptr,
header, and seqIndex in order to parseAndElaborate the Basis Library
(via the MLB path variables) to discover the other constants.


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

U   mlton/trunk/Makefile
U   mlton/trunk/mlton/main/main.fun
U   mlton/trunk/runtime/Makefile
_U  mlton/trunk/runtime/gen/
U   mlton/trunk/runtime/gen/.ignore
A   mlton/trunk/runtime/gen/gen-sizes.c

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

Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2007-08-09 01:04:29 UTC (rev 5838)
+++ mlton/trunk/Makefile	2007-08-09 01:33:59 UTC (rev 5839)
@@ -284,6 +284,7 @@
 	$(MAKE) -C runtime
 	$(CP) include/*.h "$(INC)/"
 	$(CP) runtime/*.a "$(LIB)/$(TARGET)/"
+	$(CP) runtime/gen/sizes "$(LIB)/$(TARGET)/"
 	mkdir -p "$(SRC)/basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)"
 	$(CP) runtime/gen/c-types.sml \
 		basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml	

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2007-08-09 01:04:29 UTC (rev 5838)
+++ mlton/trunk/mlton/main/main.fun	2007-08-09 01:33:59 UTC (rev 5839)
@@ -734,25 +734,40 @@
           | _ => Error.bug "incorrect args from shell script"
       val () = setTargetType ("self", usage)
       val result = parse args
+
+      val target = !target
+      val targetStr =
+         case target of
+            Cross s => s
+          | Self => "self"
+      val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
       val targetArch = !Target.arch
+      val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
+      val targetOS = !Target.os
+      val OSStr = String.toLower (MLton.Platform.OS.toString targetOS)
+
+      val stop = !stop
+
       val () =
          align := (case !explicitAlign of
                       NONE => if defaultAlignIs8 () then Align8 else Align4
                     | SOME a => a)
       val () =
          codegen := (case !explicitCodegen of
-                        NONE => if hasCodegen (x86Codegen) 
-                                   then x86Codegen 
-                                else if hasCodegen (amd64Codegen) 
-                                   then amd64Codegen
-                                else CCodegen
-                      | SOME Native => if hasCodegen (x86Codegen)
-                                          then x86Codegen
-                                       else if hasCodegen (amd64Codegen)
-                                          then amd64Codegen
-                                       else usage (concat ["can't use native codegen on ",
-                                                           MLton.Platform.Arch.toString targetArch, 
-                                                           " target"])
+                        NONE => 
+                           if hasCodegen (x86Codegen) 
+                              then x86Codegen 
+                           else if hasCodegen (amd64Codegen) 
+                               then amd64Codegen
+                           else CCodegen
+                      | SOME Native => 
+                           if hasCodegen (x86Codegen)
+                              then x86Codegen
+                           else if hasCodegen (amd64Codegen)
+                              then amd64Codegen
+                           else usage (concat ["can't use native codegen on ",
+                                               MLton.Platform.Arch.toString targetArch, 
+                                               " target"])
                       | SOME (Explicit cg) => cg)
       val () = MLton.Rusage.measureGC (!verbosity <> Silent)
       val () = if !profileTimeSet
@@ -768,60 +783,46 @@
                          | _ => usage "can't use -profile with Exn.keepHistory"
                         ; profileRaise := true)
                else ()
+
       val () =
          Compile.setCommandLineConstant
          {name = "CallStack.keep",
           value = Bool.toString (!Control.profile = Control.ProfileCallStack)}
-      val gcc = !gcc
-      val stop = !stop
-      val target = !target
-      val targetStr =
-         case target of
-            Cross s => s
-          | Self => "self"
-      val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
-      val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
-      val targetOS = !Target.os
+
       val () =
-         Control.labelsHaveExtra_ := (case targetOS of
-                                         Cygwin => true
-                                       | Darwin => true
-                                       | MinGW => true
-                                       | _ => false)
-      val () =
-         case targetArch of
-            AMD64 => 
-               let
-                  val word32 = Bits.fromInt 32
-                  val word64 = Bits.fromInt 64
-               in
-                  Control.Target.setSizes
-                  {cint = word32,
-                   cpointer = word64,
-                   cptrdiff = word64,
-                   csize = word64,
-                   header = word64,
-                   mplimb = word64,
-                   objptr = word64,
-                   seqIndex = word64}
-               end
-          | _ =>
-               let
-                  val word32 = Bits.fromInt 32
-               in
-                  Control.Target.setSizes
-                  {cint = word32,
-                   cpointer = word32,
-                   cptrdiff = word32,
-                   csize = word32,
-                   header = word32,
-                   mplimb = word32,
-                   objptr = word32,
-                   seqIndex = word32}
-               end
-      val OSStr = String.toLower (MLton.Platform.OS.toString targetOS)
+         let
+            val sizeMap =
+               List.map
+               (File.lines (OS.Path.joinDirFile {dir = !Control.libTargetDir,
+                                                 file = "sizes"}),
+                fn line =>
+                case String.tokens (line, Char.isSpace) of
+                   [ty, "=", size] =>
+                      (case Int.fromString size of
+                          NONE => Error.bug (concat ["strange size: ", size])
+                        | SOME size => 
+                             (ty, Bytes.toBits (Bytes.fromInt size)))
+                 | _ => Error.bug (concat ["strange size mapping: ", line]))
+            fun lookup ty' =
+               case List.peek (sizeMap, fn (ty, _) => String.equals (ty, ty')) of
+                  NONE => Error.bug (concat ["missing size mapping: ", ty'])
+                | SOME (_, size) => size
+         in
+            Control.Target.setSizes
+            {cint = lookup "cint",
+             cpointer = lookup "cpointer",
+             cptrdiff = lookup "cptrdiff",
+             csize = lookup "csize",
+             header = lookup "header",
+             mplimb = lookup "mplimb",
+             objptr = lookup "objptr",
+             seqIndex = lookup "seqIndex"}
+         end
+
       fun tokenize l =
          String.tokens (concat (List.separate (l, " ")), Char.isSpace)
+
+      val gcc = !gcc
       fun addTargetOpts opts =
          List.fold
          (!opts, [], fn ({opt, pred}, ac) =>
@@ -859,6 +860,12 @@
                                 MLton.Platform.Arch.toString targetArch,
                                 " target"])
          else ()
+      val () =
+         Control.labelsHaveExtra_ := (case targetOS of
+                                         Cygwin => true
+                                       | Darwin => true
+                                       | MinGW => true
+                                       | _ => false)
       val _ =
          chunk :=
          (case !explicitChunk of

Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile	2007-08-09 01:04:29 UTC (rev 5838)
+++ mlton/trunk/runtime/Makefile	2007-08-09 01:33:59 UTC (rev 5839)
@@ -228,7 +228,7 @@
 endif
 
 ALL := libgdtoa.a libmlton.a libmlton-gdb.a
-ALL += gen/c-types.sml gen/basis-ffi.sml
+ALL += gen/c-types.sml gen/basis-ffi.sml gen/sizes
 ifeq ($(OMIT_BYTECODE), yes)
 else
   ALL += bytecode/opcodes
@@ -289,6 +289,12 @@
 	rm -f basis-ffi.h
 	cp gen/basis-ffi.h basis-ffi.h
 
+gen/sizes: gen/gen-sizes.c libmlton.a
+	$(CC) $(OPTCFLAGS) $(WARNCFLAGS) -o gen/gen-sizes -I. -L. -lmlton gen/gen-sizes.c util.o
+	rm -f gen/sizes
+	cd gen && ./gen-sizes
+	rm -f gen/gen-sizes$(EXE)
+
 bytecode/opcodes: bytecode/print-opcodes.c bytecode/opcode.h
 	$(CC) $(OPTCFLAGS) $(WARNCFLAGS) -o bytecode/print-opcodes bytecode/print-opcodes.c
 	rm -f bytecode/opcodes


Property changes on: mlton/trunk/runtime/gen
___________________________________________________________________
Name: svn:ignore
   - c-types.h
c-types.sml
ml-types.h

   + c-types.h
c-types.sml
ml-types.h
sizes


Modified: mlton/trunk/runtime/gen/.ignore
===================================================================
--- mlton/trunk/runtime/gen/.ignore	2007-08-09 01:04:29 UTC (rev 5838)
+++ mlton/trunk/runtime/gen/.ignore	2007-08-09 01:33:59 UTC (rev 5839)
@@ -1,3 +1,4 @@
 c-types.h
 c-types.sml
 ml-types.h
+sizes

Added: mlton/trunk/runtime/gen/gen-sizes.c
===================================================================
--- mlton/trunk/runtime/gen/gen-sizes.c	2007-08-09 01:04:29 UTC (rev 5838)
+++ mlton/trunk/runtime/gen/gen-sizes.c	2007-08-09 01:33:59 UTC (rev 5839)
@@ -0,0 +1,23 @@
+#define MLTON_GC_INTERNAL_TYPES
+#include "platform.h"
+struct GC_state gcState;
+
+int main (__attribute__ ((unused)) int argc, 
+          __attribute__ ((unused)) char* argv[]) {
+  FILE *sizesFd;
+
+  sizesFd = fopen_safe ("sizes", "w");
+
+  fprintf (sizesFd, "cint = %zu\n", sizeof(C_Int_t));
+  fprintf (sizesFd, "cpointer = %zu\n", sizeof(C_Pointer_t));
+  fprintf (sizesFd, "cptrdiff = %zu\n", sizeof(C_Ptrdiff_t));
+  fprintf (sizesFd, "csize = %zu\n", sizeof(C_Size_t));
+  fprintf (sizesFd, "header = %zu\n", sizeof(GC_header));
+  fprintf (sizesFd, "mplimb = %zu\n", sizeof(C_MPLimb_t));
+  fprintf (sizesFd, "objptr = %zu\n", sizeof(objptr));
+  fprintf (sizesFd, "seqIndex = %zu\n", sizeof(GC_arrayLength));
+
+  fclose_safe(sizesFd);
+
+  return 0;
+}




More information about the MLton-commit mailing list