|
From: Matthew F. <fl...@ml...> - 2006-12-19 10:17:34
|
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)), |