Ajout de printexc.c

minor_gc.h: declaration de garbage_collection.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1177 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

8 files changed, 80 insertions, 48 deletions

diff --git a/byterun/.depend b/byterun/.depend
index b8bf0f754..0947d706e 100644
--- a/byterun/.depend
+++ b/byterun/.depend
@@ -28,9 +28,9 @@ intern.o: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
  minor_gc.h reverse.h
 interp.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h fix_code.h instruct.h interp.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h prims.h signals.h stacks.h str.h \
- instrtrace.h jumptbl.h
+ mlvalues.h fail.h fix_code.h instrtrace.h instruct.h interp.h \
+ major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h signals.h \
+ stacks.h str.h jumptbl.h
 ints.o: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  str.h
@@ -40,7 +40,8 @@ io.o: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \
 lexing.o: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  str.h
-main.o: main.c misc.h config.h ../config/m.h ../config/s.h
+main.o: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \
+ sys.h
 major_gc.o: major_gc.c config.h ../config/m.h ../config/s.h fail.h \
  misc.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h
 md5.o: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
@@ -61,8 +62,11 @@ parsing.o: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \
  misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h
 prims.o: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \
  misc.h prims.h
+printexc.o: printexc.c fail.h misc.h config.h ../config/m.h \
+ ../config/s.h mlvalues.h
 roots.o: roots.c memory.h config.h ../config/m.h ../config/s.h gc.h \
  mlvalues.h misc.h major_gc.h freelist.h minor_gc.h roots.h stacks.h
+rotatecursor.o: rotatecursor.c rotatecursor.h
 signals.o: signals.c alloc.h misc.h config.h ../config/m.h \
  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
  minor_gc.h roots.h signals.h
@@ -111,9 +115,9 @@ intern.d.o: intern.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h gc.h intext.h io.h memory.h major_gc.h freelist.h \
  minor_gc.h reverse.h
 interp.d.o: interp.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
- mlvalues.h fail.h fix_code.h instruct.h interp.h memory.h gc.h \
- major_gc.h freelist.h minor_gc.h prims.h signals.h stacks.h str.h \
- instrtrace.h
+ mlvalues.h fail.h fix_code.h instrtrace.h instruct.h interp.h \
+ major_gc.h freelist.h memory.h gc.h minor_gc.h prims.h signals.h \
+ stacks.h str.h
 ints.d.o: ints.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  str.h
@@ -123,7 +127,8 @@ io.d.o: io.c config.h ../config/m.h ../config/s.h alloc.h misc.h \
 lexing.d.o: lexing.c fail.h misc.h config.h ../config/m.h ../config/s.h \
  mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
  str.h
-main.d.o: main.c misc.h config.h ../config/m.h ../config/s.h
+main.d.o: main.c misc.h config.h ../config/m.h ../config/s.h mlvalues.h \
+ sys.h
 major_gc.d.o: major_gc.c config.h ../config/m.h ../config/s.h fail.h \
  misc.h mlvalues.h freelist.h gc.h gc_ctrl.h major_gc.h roots.h
 md5.d.o: md5.c alloc.h misc.h config.h ../config/m.h ../config/s.h \
@@ -144,8 +149,11 @@ parsing.d.o: parsing.c config.h ../config/m.h ../config/s.h mlvalues.h \
  misc.h memory.h gc.h major_gc.h freelist.h minor_gc.h alloc.h
 prims.d.o: prims.c mlvalues.h config.h ../config/m.h ../config/s.h \
  misc.h prims.h
+printexc.d.o: printexc.c fail.h misc.h config.h ../config/m.h \
+ ../config/s.h mlvalues.h
 roots.d.o: roots.c memory.h config.h ../config/m.h ../config/s.h gc.h \
  mlvalues.h misc.h major_gc.h freelist.h minor_gc.h roots.h stacks.h
+rotatecursor.d.o: rotatecursor.c rotatecursor.h
 signals.d.o: signals.c alloc.h misc.h config.h ../config/m.h \
  ../config/s.h mlvalues.h fail.h memory.h gc.h major_gc.h freelist.h \
  minor_gc.h roots.h signals.h
diff --git a/byterun/Makefile b/byterun/Makefile
index a0c828474..d62727e57 100644
--- a/byterun/Makefile
+++ b/byterun/Makefile
@@ -6,7 +6,7 @@ DFLAGS=-g -DDEBUG $(BYTECCCOMPOPTS)
 
 OBJS=interp.o misc.o stacks.o fix_code.o startup.o main.o \
   freelist.o major_gc.o minor_gc.o memory.o alloc.o roots.o \
-  fail.o signals.o \
+  fail.o signals.o printexc.o \
   compare.o ints.o floats.o str.o array.o io.o extern.o intern.o \
   hash.o sys.o meta.o parsing.o gc_ctrl.o terminfo.o md5.o obj.o \
   lexing.o
diff --git a/byterun/Makefile.Mac b/byterun/Makefile.Mac
index 5d9dc303a..52bd06b9a 100644
--- a/byterun/Makefile.Mac
+++ b/byterun/Makefile.Mac
@@ -19,7 +19,7 @@ OBJS = interp.a.o misc.c.o stacks.c.o fix_code.c.o startup.c.o main.c.o ¶
   compare.c.o ints.c.o floats.c.o str.c.o array.c.o io.c.o extern.c.o ¶
   intern.c.o ¶
   hash.c.o sys.c.o meta.c.o parsing.c.o gc_ctrl.c.o terminfo.c.o md5.c.o ¶
-  obj.c.o lexing.c.o macintosh.c.o rotatecursor.c.o
+  obj.c.o lexing.c.o macintosh.c.o rotatecursor.c.o printexc.c.o
 
 PPCOBJS = interp.c.x misc.c.x stacks.c.x fix_code.c.x startup.c.x main.c.x ¶
   freelist.c.x major_gc.c.x minor_gc.c.x memory.c.x alloc.c.x roots.c.x ¶
@@ -27,7 +27,7 @@ PPCOBJS = interp.c.x misc.c.x stacks.c.x fix_code.c.x startup.c.x main.c.x ¶
   compare.c.x ints.c.x floats.c.x str.c.x array.c.x io.c.x extern.c.x ¶
   intern.c.x ¶
   hash.c.x sys.c.x meta.c.x parsing.c.x gc_ctrl.c.x terminfo.c.x md5.c.x ¶
-  obj.c.x lexing.c.x macintosh.c.x rotatecursor.c.x
+  obj.c.x lexing.c.x macintosh.c.x rotatecursor.c.x printexc.c.x
 
 PRIMS = array.c compare.c extern.c floats.c gc_ctrl.c hash.c ¶
   intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c ¶
diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt
index 11a97b65c..56fa901c9 100644
--- a/byterun/Makefile.nt
+++ b/byterun/Makefile.nt
@@ -8,7 +8,7 @@ OBJS=interp.obj misc.obj stacks.obj fix_code.obj startup.obj main.obj \
   memory.obj alloc.obj roots.obj compare.obj ints.obj floats.obj \
   str.obj array.obj io.obj extern.obj intern.obj hash.obj sys.obj \
   meta.obj parsing.obj gc_ctrl.obj terminfo.obj md5.obj obj.obj lexing.obj \
-  wincmdline.obj
+  wincmdline.obj printexc.obj
 
 PRIMS=array.c compare.c extern.c floats.c gc_ctrl.c hash.c \
   intern.c interp.c ints.c io.c lexing.c md5.c meta.c obj.c parsing.c \
diff --git a/byterun/fail.h b/byterun/fail.h
index d7fe755d7..72233a9da 100644
--- a/byterun/fail.h
+++ b/byterun/fail.h
@@ -54,5 +54,6 @@ void raise_sys_error P((value)) Noreturn;
 void raise_end_of_file P((void)) Noreturn;
 void raise_zero_divide P((void)) Noreturn;
 void raise_not_found P((void)) Noreturn;
+void fatal_uncaught_exception P((value)) Noreturn;
 
 #endif /* _fail_ */
diff --git a/byterun/minor_gc.h b/byterun/minor_gc.h
index fa0558a3d..7df657f27 100644
--- a/byterun/minor_gc.h
+++ b/byterun/minor_gc.h
@@ -27,6 +27,7 @@ extern int in_minor_collection;
 
 extern void set_minor_heap_size P((asize_t));
 extern void minor_collection P((void));
+extern void garbage_collection P((void)); /* for the native-code system */
 extern void realloc_ref_table P((void));
 extern void oldify P((value, value *));
 
diff --git a/byterun/printexc.c b/byterun/printexc.c
new file mode 100644
index 000000000..3d9a02118
--- /dev/null
+++ b/byterun/printexc.c
@@ -0,0 +1,58 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  Automatique.  Distributed only by permission.                      */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+/* Print an uncaught exception and abort */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "fail.h"
+#include "misc.h"
+#include "mlvalues.h"
+#ifdef HAS_UI
+#include "ui.h"
+#endif
+
+#ifdef HAS_UI
+#define errprintf1(fmt) ui_print_stderr(fmt, NULL)
+#define errprintf2(fmt,arg) ui_print_stderr(fmt, (char *)(arg))
+#else
+#define errprintf1(fmt) fprintf(stderr, fmt)
+#define errprintf2(fmt,arg) fprintf(stderr, fmt, arg)
+#endif
+
+void fatal_uncaught_exception(exn)
+     value exn;
+{
+  mlsize_t i;
+  value v;
+
+  errprintf2("Fatal error: uncaught exception %s",
+             String_val(Field(Field(exn, 0), 0)));
+  if (Wosize_val(exn) >= 2) {
+    errprintf1("(");
+    for (i = 1; i < Wosize_val(exn); i++) {
+      if (i > 1) errprintf1(", ");
+      v = Field(exn, i);
+      if (Is_long(v))
+        errprintf2("%ld", Long_val(v));
+      else if (Tag_val(v) == String_tag)
+        errprintf2("\"%s\"", String_val(v));
+      else
+        errprintf1("_");
+    }
+    errprintf1(")");
+  }
+  errprintf1("\n");
+  exit(2);
+}
+
diff --git a/byterun/startup.c b/byterun/startup.c
index 99af427f0..6d66a0403 100644
--- a/byterun/startup.c
+++ b/byterun/startup.c
@@ -34,9 +34,6 @@
 #include "mlvalues.h"
 #include "stacks.h"
 #include "sys.h"
-#ifdef HAS_UI
-#include "ui.h"
-#endif
 
 #ifndef O_BINARY
 #define O_BINARY 0
@@ -182,39 +179,6 @@ static void parse_camlrunparam()
   }
 }
 
-/* Print an uncaught exception and abort */
-
-static void fatal_uncaught_exception(exn)
-     value exn;
-{
-  mlsize_t i;
-  value v;
-#ifdef HAS_UI
-#define errprintf1(fmt) ui_print_stderr(fmt, NULL)
-#define errprintf2(fmt,arg) ui_print_stderr(fmt, (char *)(arg))
-#else
-#define errprintf1(fmt) fprintf(stderr, fmt)
-#define errprintf2(fmt,arg) fprintf(stderr, fmt, arg)
-#endif
-  errprintf2("Fatal error: uncaught exception %s",
-             String_val(Field(Field(exn, 0), 0)));
-  if (Wosize_val(exn) >= 2) {
-    errprintf1("(");
-    for (i = 1; i < Wosize_val(exn); i++) {
-      if (i > 1) errprintf1(", ");
-      v = Field(exn, i);
-      if (Is_long(v))
-        errprintf2("%ld", Long_val(v));
-      else if (Tag_val(v) == String_tag)
-        errprintf2("\"%s\"", String_val(v));
-      else
-        errprintf1("_");
-    }
-    errprintf1(")");
-  }
-  errprintf1("\n");
-}
-             
 extern void init_ieee_floats P((void));
 
 /* Main entry point when loading code from a file */