[MLton-commit] r6751
Matthew Fluet
fluet at mlton.org
Tue Aug 19 15:14:43 PDT 2008
Fix MLton_bug prototype.
MLton_bug (the C function) is the realization of MLton_bug (the
primitive) and Bug (the SSA2 transfer). Within the compiler MLton_bug
(the primitive) is expected to take an ML string argument. In
SSA-to-RSSA, Bug (the SSA2 transfer) is translated to a call of
MLton_bug (the C function) with an ML string argument. However,
MLton_bug (the C function) was expecting a null-terminated string,
which wasn't guaranteed by the compiler.
----------------------------------------------------------------------
U mlton/trunk/basis-library/primitive/basis-ffi.sml
U mlton/trunk/basis-library/primitive/prim2.sml
U mlton/trunk/mlton/backend/rep-type.fun
U mlton/trunk/runtime/basis/MLton/bug.c
U mlton/trunk/runtime/basis-ffi.h
U mlton/trunk/runtime/gen/basis-ffi.def
U mlton/trunk/runtime/gen/basis-ffi.h
U mlton/trunk/runtime/gen/basis-ffi.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/trunk/basis-library/primitive/basis-ffi.sml 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/basis-library/primitive/basis-ffi.sml 2008-08-19 22:14:40 UTC (rev 6751)
@@ -69,7 +69,7 @@
end
structure MLton =
struct
-val bug = _import "MLton_bug" internal : NullString8.t -> unit;
+val bug = _import "MLton_bug" internal : String8.t -> unit;
structure Itimer =
struct
val PROF = _const "MLton_Itimer_PROF" : C_Int.t;
Modified: mlton/trunk/basis-library/primitive/prim2.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim2.sml 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/basis-library/primitive/prim2.sml 2008-08-19 22:14:40 UTC (rev 6751)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -46,8 +46,7 @@
; PFFI.Stdio.print msg)
| _ => PFFI.Stdio.print (P.Exn.name exn)
; PFFI.Stdio.print "\n"
- ; P.MLton.bug (P.NullString8.fromString
- "unhandled exception in Basis Library\000")))
+ ; P.MLton.bug ("unhandled exception in Basis Library")))
in
end
@@ -58,7 +57,6 @@
P.TopLevel.setSuffix
(fn () =>
(P.MLton.halt 0
- ; P.MLton.bug (P.NullString8.fromString
- "missing suffix in Basis Library\000")))
+ ; P.MLton.bug ("missing suffix in Basis Library")))
in
end
Modified: mlton/trunk/mlton/backend/rep-type.fun
===================================================================
--- mlton/trunk/mlton/backend/rep-type.fun 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/mlton/backend/rep-type.fun 2008-08-19 22:14:40 UTC (rev 6751)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -830,7 +830,7 @@
fun bug () =
vanilla {args = Vector.new1 (string ()),
name = "MLton_bug",
- prototype = (Vector.new1 CType.cpointer, NONE),
+ prototype = (Vector.new1 CType.objptr, NONE),
return = unit}
local
Modified: mlton/trunk/runtime/basis/MLton/bug.c
===================================================================
--- mlton/trunk/runtime/basis/MLton/bug.c 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/runtime/basis/MLton/bug.c 2008-08-19 22:14:40 UTC (rev 6751)
@@ -1,9 +1,12 @@
#include "platform.h"
/* print a bug message and exit (2) */
-void MLton_bug (NullString8_t msg) {
- fprintf (stderr, "MLton bug: %s.\n%s\n",
- (const char*)msg,
- "Please send a bug report to MLton at mlton.org.");
+void MLton_bug (String8_t msg) {
+ uintmax_t size = GC_getArrayLength ((pointer)msg);
+ fprintf (stderr, "MLton bug: ");
+ unless (0 == size)
+ while (1 != fwrite ((const void*)msg, (size_t)size, 1, stderr))
+ /* nothing */;
+ fprintf (stderr, "\nPlease send a bug report to MLton at mlton.org.\n");
exit (2);
}
Modified: mlton/trunk/runtime/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/basis-ffi.h 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/runtime/basis-ffi.h 2008-08-19 22:14:40 UTC (rev 6751)
@@ -45,7 +45,7 @@
INTERNAL extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
INTERNAL void IEEEReal_setRoundingMode(C_Int_t);
INTERNAL C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
-INTERNAL __attribute__((noreturn)) void MLton_bug(NullString8_t);
+INTERNAL __attribute__((noreturn)) void MLton_bug(String8_t);
INTERNAL extern const C_Int_t MLton_Itimer_PROF;
INTERNAL extern const C_Int_t MLton_Itimer_REAL;
INTERNAL C_Errno_t(C_Int_t) MLton_Itimer_set(C_Int_t,C_Time_t,C_SUSeconds_t,C_Time_t,C_SUSeconds_t);
Modified: mlton/trunk/runtime/gen/basis-ffi.def
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.def 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/runtime/gen/basis-ffi.def 2008-08-19 22:14:40 UTC (rev 6751)
@@ -37,7 +37,7 @@
IEEEReal.RoundingMode.FE_UPWARD = _const : C_Int.t
IEEEReal.getRoundingMode = _import INTERNAL : unit -> C_Int.t
IEEEReal.setRoundingMode = _import INTERNAL : C_Int.t -> unit
-MLton.bug = _import INTERNAL __attribute__((noreturn)) : NullString8.t -> unit
+MLton.bug = _import INTERNAL __attribute__((noreturn)) : String8.t -> unit
MLton.Itimer.PROF = _const : C_Int.t
MLton.Itimer.REAL = _const : C_Int.t
MLton.Itimer.VIRTUAL = _const : C_Int.t
Modified: mlton/trunk/runtime/gen/basis-ffi.h
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.h 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/runtime/gen/basis-ffi.h 2008-08-19 22:14:40 UTC (rev 6751)
@@ -45,7 +45,7 @@
INTERNAL extern const C_Int_t IEEEReal_RoundingMode_FE_UPWARD;
INTERNAL void IEEEReal_setRoundingMode(C_Int_t);
INTERNAL C_Size_t MinGW_getTempPath(C_Size_t,Array(Char8_t));
-INTERNAL __attribute__((noreturn)) void MLton_bug(NullString8_t);
+INTERNAL __attribute__((noreturn)) void MLton_bug(String8_t);
INTERNAL extern const C_Int_t MLton_Itimer_PROF;
INTERNAL extern const C_Int_t MLton_Itimer_REAL;
INTERNAL C_Errno_t(C_Int_t) MLton_Itimer_set(C_Int_t,C_Time_t,C_SUSeconds_t,C_Time_t,C_SUSeconds_t);
Modified: mlton/trunk/runtime/gen/basis-ffi.sml
===================================================================
--- mlton/trunk/runtime/gen/basis-ffi.sml 2008-08-19 22:14:29 UTC (rev 6750)
+++ mlton/trunk/runtime/gen/basis-ffi.sml 2008-08-19 22:14:40 UTC (rev 6751)
@@ -69,7 +69,7 @@
end
structure MLton =
struct
-val bug = _import "MLton_bug" internal : NullString8.t -> unit;
+val bug = _import "MLton_bug" internal : String8.t -> unit;
structure Itimer =
struct
val PROF = _const "MLton_Itimer_PROF" : C_Int.t;
More information about the MLton-commit
mailing list