[MLton-commit] r4990

[Matthew Fluet]

Fixed an assertion failure with IntInf operations and alignment.

fenrir:~/devel/mlton/mlton.svn.trunk/regression fluet$ ./conv2
gc/new-object.c:90: assert((size_t)(p - s->frontier) <= bytes) failed.
Abort trap

The cause and solution are discussed at:
http://mlton.org/pipermail/mlton/2006-December/029452.html

Essentially:

1) Require any primitive or C call with bytesNeeded to include
sufficient bytes for any necessary headers and alignment restrictions.
[The only primitives or C calls with bytesNeeded are the IntInf
operations, which already satisfy the former, but not the later.]

2) Remove the extraneous arrayHeaderSize from bigAllocation (in
mlton/backend/limit-check.fun).

3) Include a _build_const: "MLton_Align_align", with the obvious
meaning.

4) Modify the IntInf implementation to include sufficient bytes for
the necessary alignment.


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

U   mlton/trunk/basis-library/integer/int-inf0.sml
U   mlton/trunk/basis-library/primitive/prim-mlton.sml
U   mlton/trunk/mlton/backend/limit-check.fun
U   mlton/trunk/mlton/main/lookup-constant.fun

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

Modified: mlton/trunk/basis-library/integer/int-inf0.sml
===================================================================
--- mlton/trunk/basis-library/integer/int-inf0.sml	2006-12-19 18:09:25 UTC (rev 4989)
+++ mlton/trunk/basis-library/integer/int-inf0.sml	2006-12-19 18:17:31 UTC (rev 4990)
@@ -334,6 +334,7 @@
 structure IntInf =
    struct
       structure Prim = Primitive.IntInf
+      structure MLton = Primitive.MLton
 
       structure A = Primitive.Array
       structure V = Primitive.Vector
@@ -876,8 +877,11 @@
             Sz.+ (Sz.* (bytesPerMPLimb, Sz.zextdFromSeqIndex num),
             Sz.+ (Sz.* (bytesPerMPLimb, Sz.zextdFromSeqIndex extra),
             Sz.+ (bytesPerMPLimb, (* isneg Field *)
-                  bytesPerArrayHeader (* Array Header *)
-            )))
+            Sz.+ (bytesPerArrayHeader, (* Array Header *)
+                  case MLton.Align.align of (* alignment *)
+                     MLton.Align.Align4 => 0w3
+                   | MLton.Align.Align8 => 0w7
+            ))))
       end
 
       (* badObjptr{Int,Word}{,Tagged} is the fixnum IntInf.int whose 
@@ -1202,13 +1206,16 @@
                        Int32.+ (Int32.quot (bpl, bpd),
                                 if Int32.mod (bpl, bpd) = 0
                                    then 0 else 1)
+                    val bytes =
+                       Sz.+ (Sz.+ (bytesPerArrayHeader (* Array Header *),
+                             Sz.+ (0w1 (* sign *),
+                                   case MLton.Align.align of (* alignment *)
+                                      MLton.Align.Align4 => 0w3
+                                    | MLton.Align.Align8 => 0w7)),
+                             Sz.* (Sz.zextdFromInt32 dpl, 
+                                   Sz.zextdFromSeqIndex (numLimbs arg)))
                  in
-                    Prim.toString
-                    (arg, base, 
-                     Sz.+ (Sz.+ (bytesPerArrayHeader (* Array Header *),
-                                 0w1 (* sign *)),
-                           Sz.* (Sz.zextdFromInt32 dpl, 
-                                 Sz.zextdFromSeqIndex (numLimbs arg))))
+                    Prim.toString (arg, base, bytes)
                  end
 
       fun mkBigLog2 {fromSmall: {smallLog2: Primitive.Int32.int} -> 'a,

Modified: mlton/trunk/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-mlton.sml	2006-12-19 18:09:25 UTC (rev 4989)
+++ mlton/trunk/basis-library/primitive/prim-mlton.sml	2006-12-19 18:17:31 UTC (rev 4990)
@@ -32,6 +32,17 @@
       val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
    end
 
+structure Align =
+   struct
+      datatype t = Align4 | Align8
+
+      val align =
+         case _build_const "MLton_Align_align": Int32.int; of
+            4 => Align4
+          | 8 => Align8
+          | _ => raise Primitive.Exn.Fail8 "MLton_Align_align"
+   end
+
 structure CallStack =
    struct
       (* The most recent caller is at index 0 in the array. *)

Modified: mlton/trunk/mlton/backend/limit-check.fun
===================================================================
--- mlton/trunk/mlton/backend/limit-check.fun	2006-12-19 18:09:25 UTC (rev 4989)
+++ mlton/trunk/mlton/backend/limit-check.fun	2006-12-19 18:17:31 UTC (rev 4990)
@@ -429,9 +429,7 @@
                 end
              fun bigAllocation (bytesNeeded: Operand.t): unit =
                 let
-                   val extraBytes =
-                      Bytes.+ (Runtime.arrayHeaderSize,
-                               blockCheckAmount {blockIndex = i})
+                   val extraBytes = blockCheckAmount {blockIndex = i}
                 in
                    case bytesNeeded of
                       Operand.Const c =>

Modified: mlton/trunk/mlton/main/lookup-constant.fun
===================================================================
--- mlton/trunk/mlton/main/lookup-constant.fun	2006-12-19 18:09:25 UTC (rev 4989)
+++ mlton/trunk/mlton/main/lookup-constant.fun	2006-12-19 18:17:31 UTC (rev 4990)
@@ -24,7 +24,10 @@
       val int = Int.toString
       open Control
    in
-      [("MLton_Codegen_codegen", fn () => int (case !codegen of
+      [("MLton_Align_align", fn () => int (case !align of
+                                              Align4 => 4
+                                            | Align8 => 8)),
+       ("MLton_Codegen_codegen", fn () => int (case !codegen of
                                                   Bytecode => 0
                                                 | CCodegen => 1
                                                 | Native => 2)),