[MLton-commit] r4451
Matthew Fluet
MLton@mlton.org
Thu, 4 May 2006 12:38:40 -0700
Move MLton_bug to basis-ffi
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/bug.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/bug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/bug.c 2006-05-04 19:37:46 UTC (rev 4450)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/MLton/bug.c 2006-05-04 19:38:40 UTC (rev 4451)
@@ -1,8 +1,9 @@
#include "platform.h"
-void MLton_bug (Pointer msg) {
- fprintf (stderr, "MLton bug: %s.\n%s\n",
- (char*)msg,
- "Please send a bug report to MLton@mlton.org.");
- exit (2);
+/* 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@mlton.org.");
+ exit (2);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-05-04 19:37:46 UTC (rev 4450)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-05-04 19:38:40 UTC (rev 4451)
@@ -36,6 +36,7 @@
IEEEReal.RoundingMode.FE_UPWARD = _const : C_Int.t
IEEEReal.getRoundingMode = _import : unit -> C_Int.t
IEEEReal.setRoundingMode = _import : C_Int.t -> unit
+MLton.bug = _import noreturn : NullString8.t -> unit
MLton.Itimer.PROF = _const : C_Int.t
MLton.Itimer.REAL = _const : C_Int.t
MLton.Itimer.VIRTUAL = _const : C_Int.t
@@ -578,7 +579,7 @@
Posix.Process.alarm = _import : C_UInt.t -> C_UInt.t
Posix.Process.exece = _import : NullString8.t * NullString8Array.t * NullString8Array.t -> C_Int.t C_Errno.t
Posix.Process.execp = _import : NullString8.t * NullString8Array.t -> C_Int.t C_Errno.t
-Posix.Process.exit = _import : C_Status.t -> unit
+Posix.Process.exit = _import noreturn : C_Status.t -> unit
Posix.Process.exitStatus = _import : C_Status.t -> C_Int.t
Posix.Process.fork = _import : unit -> C_PId.t C_Errno.t
Posix.Process.ifExited = _import : C_Status.t -> Bool.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-05-04 19:37:46 UTC (rev 4450)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-05-04 19:38:40 UTC (rev 4451)
@@ -161,7 +161,8 @@
datatype t =
Const of {name: Name.t,
ty: Type.t}
- | Import of {maybeStatic: bool,
+ | Import of {attr: {noreturn: bool,
+ static: bool},
name: Name.t,
ty: {args: Type.t list,
ret: Type.t}}
@@ -186,7 +187,7 @@
" ",
Name.toC name,
";"]
- | Import {maybeStatic, name, ty = {args, ret}} =>
+ | Import {attr = {noreturn, static}, name, ty = {args, ret}} =>
let
val s =
String.concat
@@ -195,9 +196,13 @@
Name.toC name,
"(",
String.concatWith "," (List.map Type.toC args),
- ");"]
+ ")",
+ if noreturn
+ then " __attribute__ ((noreturn))"
+ else "",
+ ";"]
in
- if maybeStatic
+ if static
then String.concat
["#if (defined (MLTON_BASIS_FFI_STATIC))\n",
"static ", s, "\n",
@@ -224,7 +229,7 @@
"\" : ",
Type.toML ty,
";"]
- | Import {maybeStatic, name, ty = {args, ret}} =>
+ | Import {attr, name, ty = {args, ret}} =>
String.concat
["val ",
Name.last name,
@@ -265,14 +270,25 @@
ty = ret}
end
+ fun parseImportAttr (s) =
+ let
+ fun loop (attr as {noreturn, static}, s) =
+ if Substring.isPrefix "noreturn" s
+ then loop ({noreturn = true, static = static},
+ Substring.droplSpace (#2 (Substring.splitAt (s, 8))))
+ else if Substring.isPrefix "static" s
+ then loop ({noreturn = noreturn, static = true},
+ Substring.droplSpace (#2 (Substring.splitAt (s, 6))))
+ else (attr, s)
+ in
+ loop ({noreturn = false, static = false}, s)
+ end
+
fun parseImport (s, name) =
let
val s = #2 (Substring.splitAt (s, 7))
val s = Substring.droplSpace s
- val (maybeStatic, s) =
- if Substring.isPrefix "static" s
- then (true, Substring.droplSpace (#2 (Substring.splitAt (s, 6))))
- else (false, s)
+ val (attr, s) = parseImportAttr s
val s = if Substring.isPrefix ":" s
then #2 (Substring.splitAt (s, 1))
else raise Fail (concat ["Entry.parseImport: \"", Substring.string s, "\""])
@@ -281,7 +297,7 @@
then ()
else raise Fail (concat ["Entry.parseImport: \"", Substring.string s, "\""])
in
- Import {maybeStatic = maybeStatic,
+ Import {attr = attr,
name = name,
ty = {args = args, ret = ret}}
end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-05-04 19:37:46 UTC (rev 4450)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-05-04 19:38:40 UTC (rev 4451)
@@ -149,8 +149,6 @@
/* ------------------------------------------------- */
void MLton_allocTooLarge (void) __attribute__ ((noreturn));
-/* print a bug message and exit (2) */
-void MLton_bug (Pointer msg) __attribute__ ((noreturn));
/* ---------------------------------- */
/* MLton.Platform */