byterun/finalise.c: support pour les lazy finalises

byterun/gc_ctrl.c: ajout Gc.major_slice
byterun/major_gc.c: gros bug dans les valeurs finalisees + ajout Gc.major_slice
byterun/major_gc.h: gros bug dans les valeurs finalisees + ajout Gc.major_slice
byterun/memory.c: typo dans un commentaire
byterun/minor_gc.c: petit bug, ajout Gc.major_slice
parsing/parser.mly: plus de conflits; l'automate reste identique
stdlib/gc.ml: ajout Gc.major_slice
stdlib/gc.mli: ajout Gc.major_slice
stdlib/sys.ml: ajout Sys.ocaml_version
stdlib/sys.mli: ajout Sys.ocaml_version
utils/config.mlp: ajout Sys.ocaml_version


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

14 files changed, 224 insertions, 143 deletions

diff --git a/boot/ocamlc b/boot/ocamlc
index 315f81d69..2c9468a9b 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index 3db8a3574..06d41c6c0 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/byterun/finalise.c b/byterun/finalise.c
index 0ad97f552..b2c51d086 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -48,8 +48,15 @@ void final_update (void)
   for (i = 0; i < old; i++){
     Assert (Is_block (final_table[i].val));
     Assert (Is_in_heap (final_table[i].val));
+  again:
     if (Is_white_val (final_table[i].val)){
-      struct final f = final_table[i];
+      struct final f;
+
+      if (Tag_val (final_table[i].val) == Forward_tag){
+        final_table[i].val = Forward_val (final_table[i].val);
+        goto again;
+      }
+      f = final_table[i];
       final_table[i] = final_table[--old];
       final_table[--active] = f;
       -- i;
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index 7d6249057..b8e89c470 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -377,6 +377,13 @@ CAMLprim value gc_full_major(value v)
   return Val_unit;
 }
 
+CAMLprim value gc_major_slice (value v)
+{
+  Assert (Is_long (v));
+  empty_minor_heap ();
+  return Val_long (major_collection_slice (Long_val (v)));
+}
+
 CAMLprim value gc_compaction(value v)
 {                                                    Assert (v == Val_unit);
   empty_minor_heap ();
diff --git a/byterun/major_gc.c b/byterun/major_gc.c
index c94e86cc9..a7f2fb996 100644
--- a/byterun/major_gc.c
+++ b/byterun/major_gc.c
@@ -35,7 +35,7 @@ char *heap_start, *heap_end;
 page_table_entry *page_table;
 asize_t page_low, page_high;
 char *gc_sweep_hp;
-int gc_phase;
+int gc_phase;        /* always Phase_mark, Phase_sweep, or Phase_idle */
 static value *gray_vals;
 value *gray_vals_cur, *gray_vals_end;
 static asize_t gray_vals_size;
@@ -47,7 +47,11 @@ extern char *fl_merge;  /* Defined in freelist.c. */
 
 static char *markhp, *chunk, *limit;
 
-static void update_weak_pointers (void);
+static int gc_subphase;     /* Subphase_main, Subphase_weak, Subphase_final */
+#define Subphase_main 10
+#define Subphase_weak 11
+#define Subphase_final 12
+static value *weak_prev;
 
 static void realloc_gray_vals (void)
 {
@@ -94,6 +98,7 @@ static void start_cycle (void)
   gc_message (0x01, "Starting new major GC cycle\n", 0);
   darken_all_roots();
   gc_phase = Phase_mark;
+  gc_subphase = Subphase_main;
   markhp = NULL;
 #ifdef DEBUG
   heap_check ();
@@ -107,7 +112,7 @@ static void mark_slice (long work)
   header_t hd;
   mlsize_t size, i;
 
-  gc_message (0x40, "Marking %lu words\n", work);
+  gc_message (0x40, "Marking %ld words\n", work);
   gray_vals_ptr = gray_vals_cur;
   while (work > 0){
     if (gray_vals_ptr > gray_vals){
@@ -119,13 +124,13 @@ static void mark_slice (long work)
       if (Tag_hd (hd) < No_scan_tag){
         for (i = 0; i < size; i++){
           child = Field (v, i);
-        again:
+        mark_again:
           if (Is_block (child) && Is_in_heap (child)) {
             hd = Hd_val(child);
             if (Tag_hd (hd) == Forward_tag){
               child = Forward_val (child);
               Field (v, i) = child;
-              goto again;
+              goto mark_again;
             }
             if (Tag_hd(hd) == Infix_tag) {
               child -= Infix_offset_val(child);
@@ -165,17 +170,50 @@ static void mark_slice (long work)
       chunk = heap_start;
       markhp = chunk;
       limit = chunk + Chunk_size (chunk);
-    }else if (gc_phase == Phase_mark){
-      /* The main marking phase is over.  Handle finalised values. */
-      gray_vals_cur = gray_vals_ptr;
-      final_update ();
-      gray_vals_ptr = gray_vals_cur;
-      gc_phase = Phase_mark_final;
+    }else if (gc_subphase == Subphase_main){
+      /* The main marking phase is over.  Start removing weak pointers to
+         dead values. */
+      gc_subphase = Subphase_weak;
+      weak_prev = &weak_list_head;
+    }else if (gc_subphase == Subphase_weak){
+      value cur, curfield;
+      mlsize_t sz, i;
+      header_t hd;
+
+      cur = *weak_prev;
+      if (cur != NULL){
+        hd = Hd_val (cur);
+        if (Color_hd (hd) == Caml_white){
+          /* The whole array is dead, remove it from the list. */
+          *weak_prev = Field (cur, 0);
+        }else{
+          sz = Wosize_hd (hd);
+          for (i = 1; i < sz; i++){
+            curfield = Field (cur, i);
+          weak_again:
+            if (curfield != 0 && Is_block (curfield) && Is_in_heap (curfield)
+                && Is_white_val (curfield)){
+              if (Tag_val (curfield) == Forward_tag){
+                curfield = Forward_val (curfield);
+                Field (cur, i) = curfield;
+                goto weak_again;
+              }
+              Field (cur, i) = 0;
+            }
+          }
+          weak_prev = &Field (cur, 0);
+        }
+        work -= Whsize_hd (hd);
+      }else{
+        Assert (weak_prev == NULL);
+        /* Subphase_weak is done.  Handle finalised values. */
+        gray_vals_cur = gray_vals_ptr;
+        final_update ();
+        gray_vals_ptr = gray_vals_cur;
+        gc_subphase = Subphase_final;
+      }
     }else{
-      /* Marking is done. */
-
-      update_weak_pointers ();
-
+      Assert (gc_subphase == Subphase_final);
       /* Initialise the sweep phase. */
       gray_vals_cur = gray_vals_ptr;
       gc_sweep_hp = heap_start;
@@ -190,43 +228,12 @@ static void mark_slice (long work)
   gray_vals_cur = gray_vals_ptr;
 }
 
-/* Walk through the linked list of weak arrays.
-   Arrays that are white are removed from this list.
-   For the other arrays, pointers to white objects are erased.
-*/
-static void update_weak_pointers (void)
-{
-  value *prev = &weak_list_head;
-  value *cur = (value *) *prev;
-  mlsize_t sz, i;
-
-  while (cur != NULL){
-    if (Color_val (cur) == Caml_white){
-      *prev = Field (cur, 0);
-      cur = (value *) *prev;
-    }else{
-      value curfield;
-
-      sz = Wosize_val (cur);
-      for (i = 1; i < sz; i++){
-        curfield = Field (cur, i);
-        if (curfield != 0 && Is_block (curfield) && Is_in_heap (curfield)
-            && Is_white_val (curfield)){
-          Field (cur, i) = 0;
-        }
-      }
-      prev = &Field (cur, 0);
-      cur = (value *) *prev;
-    }
-  }
-}
-
-static void sweep_slice (long int work)
+static void sweep_slice (long work)
 {
   char *hp;
   header_t hd;
 
-  gc_message (0x40, "Sweeping %lu words\n", work);
+  gc_message (0x40, "Sweeping %ld words\n", work);
   while (work > 0){
     if (gc_sweep_hp < limit){
       hp = gc_sweep_hp;
@@ -266,10 +273,14 @@ static void sweep_slice (long int work)
   }
 }
 
-/* The main entry point for the GC.  Called after each minor GC. */
-void major_collection_slice (void)
+/* The main entry point for the GC.  Called after each minor GC.
+   [howmuch] is the amount of work to do, 0 to let the GC compute it.
+   Return the computed amount of work to do.
+ */
+long major_collection_slice (long howmuch)
 {
   double p;
+  long computed_work;
   /*
      Free memory at the start of the GC cycle (garbage + free list) (assumed):
                  FM = stat_heap_size * percent_free / (100 + percent_free)
@@ -310,14 +321,21 @@ void major_collection_slice (void)
   gc_message (0x40, "amount of work to do = %luu\n",
               (unsigned long) (p * 1000000));
 
-  if (gc_phase == Phase_mark || gc_phase == Phase_mark_final){
-    long work = (long) (p * stat_heap_size * 100 / (100+percent_free)) + Margin;
-    mark_slice (work);
+  if (gc_phase == Phase_mark){
+    computed_work = (long) (p * stat_heap_size * 100 / (100+percent_free));
+  }else{
+    computed_work = (long) (p * stat_heap_size);
+  }
+  computed_work += Margin;
+  gc_message (0x40, "ordered work = %ld words\n", howmuch);
+  gc_message (0x40, "computed work = %ld words\n", computed_work);
+  if (howmuch == 0) howmuch = computed_work;
+  if (gc_phase == Phase_mark){
+    mark_slice (howmuch);
     gc_message (0x02, "!", 0);
   }else{
-    long work = (long) (p * stat_heap_size) + Margin;
     Assert (gc_phase == Phase_sweep);
-    sweep_slice (work);
+    sweep_slice (howmuch);
     gc_message (0x02, "$", 0);
   }
 
@@ -326,6 +344,7 @@ void major_collection_slice (void)
   stat_major_words += allocated_words;
   allocated_words = 0;
   extra_heap_memory = 0.0;
+  return computed_work;
 }
 
 /* The minor heap must be empty when this function is called;
@@ -338,9 +357,9 @@ void major_collection_slice (void)
 void finish_major_cycle (void)
 {
   if (gc_phase == Phase_idle) start_cycle ();
-  if (gc_phase == Phase_mark) mark_slice (LONG_MAX);
+  while (gc_phase == Phase_mark) mark_slice (LONG_MAX);
   Assert (gc_phase == Phase_sweep);
-  sweep_slice (LONG_MAX);
+  while (gc_phase == Phase_sweep) sweep_slice (LONG_MAX);
   Assert (gc_phase == Phase_idle);
   stat_major_words += allocated_words;
   allocated_words = 0;
diff --git a/byterun/major_gc.h b/byterun/major_gc.h
index 2d516ca27..ac6b6fa6b 100644
--- a/byterun/major_gc.h
+++ b/byterun/major_gc.h
@@ -37,7 +37,6 @@ extern unsigned long allocated_words;
 extern double extra_heap_memory;
 
 #define Phase_mark 0
-#define Phase_mark_final 3
 #define Phase_sweep 1
 #define Phase_idle 2
 
@@ -65,7 +64,7 @@ extern char *gc_sweep_hp;
 void init_major_heap (asize_t);
 asize_t round_heap_chunk_size (asize_t);
 void darken (value, value *);
-void major_collection_slice (void);
+long major_collection_slice (long);
 void major_collection (void);
 void finish_major_cycle (void);
 
diff --git a/byterun/memory.c b/byterun/memory.c
index 88336d6b9..6349887c3 100644
--- a/byterun/memory.c
+++ b/byterun/memory.c
@@ -206,7 +206,7 @@ void shrink_heap (char *chunk)
     page_table [i] = Not_in_heap;
   }
 
-  /* Free the [malloc]ed block that contains [chunk]. */
+  /* Free the [malloc] block that contains [chunk]. */
   free (Chunk_block (chunk));
 }
 
diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c
index c23fe5022..e6ecfcd46 100644
--- a/byterun/minor_gc.c
+++ b/byterun/minor_gc.c
@@ -67,7 +67,7 @@ void set_minor_heap_size (asize_t size)
   ref_table_end = ref_table + ref_table_size + ref_table_reserve;
 }
 
-static value oldify_todo_list = NULL;
+static value oldify_todo_list = 0;
 
 /* Note that the tests on the tag depend on the fact that Infix_tag,
    Forward_tag, and No_scan_tag are contiguous. */
@@ -135,7 +135,7 @@ void oldify_mopup (void)
   value v, new_v, f;
   mlsize_t i;
 
-  while (oldify_todo_list != NULL){
+  while (oldify_todo_list != 0){
     v = oldify_todo_list;                /* Get the head. */
     Assert (Hd_val (v) == 0);            /* It must be forwarded. */
     new_v = Field (v, 0);                /* Follow forward pointer. */
@@ -200,9 +200,9 @@ void minor_collection (void)
 
   stat_promoted_words += allocated_words - prev_alloc_words;
   ++ stat_minor_collections;
-  major_collection_slice ();
+  major_collection_slice (0);
   force_major_slice = 0;
-  
+
   final_do_calls ();
 
   empty_minor_heap ();
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4348d733a..d6dabc057 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -50,7 +50,7 @@ let mkoperator name pos =
     not to instrument them.
 
     Every grammar rule that generates an element with a location must
-    make exaclty one non-ghost element, the topmost one.
+    make exactly one non-ghost element, the topmost one.
 *)
 let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
 let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
@@ -271,34 +271,64 @@ let bigarray_set arr arg newval =
 %token WHILE
 %token WITH
 
-/* Precedences and associativities. Lower precedences come first. */
-
-%right prec_let                         /* let ... in ... */
-%right prec_type_def                    /* = in type definitions */
-%right SEMI                             /* e1; e2 (sequence) */
-%right prec_fun prec_match prec_try     /* match ... with ... */
-%right prec_list                        /* e1; e2 (list, array, record) */
-%right prec_if                          /* if ... then ... else ... */
-%right COLONEQUAL LESSMINUS             /* assignments */
-%left  AS                               /* as in patterns */
-%left  BAR                              /* | in patterns */
-%nonassoc p_comma_list                  /* must be lower than COMMA */
-%left  COMMA                            /* , in expressions, patterns, types */
-%right MINUSGREATER                     /* -> in type expressions */
-%right OR BARBAR                        /* or */
-%right AMPERSAND AMPERAMPER             /* & */
-%left  INFIXOP0 EQUAL LESS GREATER      /* = < > etc */
-%right INFIXOP1                         /* @ ^ etc */
-%right COLONCOLON                       /* :: */
-%left  INFIXOP2 PLUS MINUS MINUSDOT     /* + - */
-%left  INFIXOP3 STAR                    /* * / */
-%right INFIXOP4                         /* ** */
-%right prec_unary_minus                 /* - unary */
-%left  prec_appl                        /* function application */
-%right prec_constr_appl                 /* constructor application */
-%right SHARP                            /* method call */
-%left  DOT                              /* record access, array access */
-%right PREFIXOP                         /* ! */
+/* Precedences and associativities.
+
+Tokens and rules have precedences.  A reduce/reduce conflict is resolved
+by comparing the precedences of the two rules.  A shift/reduce conflict
+is resolved by comparing the precedence of the token to be shifted with
+the rule to be reduced.
+
+By default, a rule has the precedence of its rightmost terminal (if any).
+
+When there is a shift/reduce conflict between a rule and a token that
+have the same precedence, it is resolved using the associativity:
+if the token is left-associative, the parser will reduce; if
+right-associative, the parser will shift; if non-associative,
+the parser will declare a syntax error.
+
+We will only use associativities with operators of the kind  x * x -> x
+for example, in the rules of the form    expr: expr BINOP expr
+in all other cases, we define two precedences if needed to resolve
+conflicts.
+
+The precedences must be listed from low to high.
+*/
+
+%nonassoc IN
+%nonassoc below_SEMI
+%nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
+%nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
+%nonassoc below_WITH
+%nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
+%nonassoc THEN                          /* below ELSE (if ... then ...) */
+%nonassoc ELSE                          /* (if ... then ... else ...) */
+%nonassoc LESSMINUS                     /* below COLONEQUAL (lbl <- x := e) */
+%right    COLONEQUAL                    /* expr (e := e := e) */
+%nonassoc AS
+%left     BAR                           /* pattern (p|p|p) */
+%nonassoc below_COMMA
+%left     COMMA                         /* expr/expr_comma_list (e,e,e) */
+%right    MINUSGREATER                  /* core_type2 (t -> t -> t) */
+%right    OR BARBAR                     /* expr (e || e || e) */
+%right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
+%nonassoc below_EQUAL
+%left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
+%right    INFIXOP1                      /* expr (e OP e OP e) */
+%right    COLONCOLON                    /* expr (e :: e :: e) */
+%left     INFIXOP2 PLUS MINUS MINUSDOT  /* expr (e OP e OP e) */
+%left     INFIXOP3 STAR                 /* expr (e OP e OP e) */
+%right    INFIXOP4                      /* expr (e OP e OP e) */
+%nonassoc prec_unary_minus              /* unary - */
+%nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
+%nonassoc prec_constr_appl              /* above AS BAR COLONCOLON COMMA */
+%nonassoc below_SHARP
+%nonassoc SHARP                         /* simple_expr/toplevel_directive */
+%nonassoc below_DOT
+%nonassoc DOT
+/* Finally, the first tokens of simple_expr are above everything else. */
+%nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT LBRACE LBRACELESS LBRACKET
+          LBRACKETBAR LIDENT LPAREN NEW PREFIXOP STRING TRUE UIDENT
+
 
 /* Entry points */
 
@@ -355,7 +385,6 @@ module_expr:
   | STRUCT structure error
       { unclosed "struct" 1 "end" 3 }
   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
-    %prec prec_fun
       { mkmod(Pmod_functor($3, $5, $8)) }
   | module_expr LPAREN module_expr RPAREN
       { mkmod(Pmod_apply($1, $3)) }
@@ -426,7 +455,7 @@ module_type:
   | SIG signature error
       { unclosed "sig" 1 "end" 3 }
   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
-    %prec prec_fun
+      %prec below_WITH
       { mkmty(Pmty_functor($3, $5, $8)) }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
@@ -683,7 +712,7 @@ class_type_declaration:
 /* Core expressions */
 
 seq_expr:
-  | expr              %prec SEMI  { $1 }
+  | expr        %prec below_SEMI  { $1 }
   | expr SEMI                     { $1 }
   | expr SEMI seq_expr            { mkexp(Pexp_sequence($1, $3)) }
 ;
@@ -728,33 +757,33 @@ let_pattern:
       { mkpat(Ppat_constraint($1, $3)) }
 ;
 expr:
-    simple_expr %prec SHARP
+    simple_expr %prec below_SHARP
       { $1 }
-  | simple_expr simple_labeled_expr_list %prec prec_appl
+  | simple_expr simple_labeled_expr_list
       { mkexp(Pexp_apply($1, List.rev $2)) }
-  | LET rec_flag let_bindings IN seq_expr %prec prec_let
+  | LET rec_flag let_bindings IN seq_expr
       { mkexp(Pexp_let($2, List.rev $3, $5)) }
-  | LET MODULE UIDENT module_binding IN seq_expr %prec prec_let
+  | LET MODULE UIDENT module_binding IN seq_expr
       { mkexp(Pexp_letmodule($3, $4, $6)) }
-  | FUNCTION opt_bar match_cases %prec prec_fun
+  | FUNCTION opt_bar match_cases
       { mkexp(Pexp_function("", None, List.rev $3)) }
-  | FUN labeled_simple_pattern fun_def %prec prec_fun
+  | FUN labeled_simple_pattern fun_def
       { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
-  | MATCH seq_expr WITH opt_bar match_cases %prec prec_match
+  | MATCH seq_expr WITH opt_bar match_cases
       { mkexp(Pexp_match($2, List.rev $5)) }
-  | TRY seq_expr WITH opt_bar match_cases %prec prec_try
+  | TRY seq_expr WITH opt_bar match_cases
       { mkexp(Pexp_try($2, List.rev $5)) }
-  | TRY seq_expr WITH error %prec prec_try
+  | TRY seq_expr WITH error
       { syntax_error() }
-  | expr_comma_list %prec p_comma_list
+  | expr_comma_list %prec below_COMMA
       { mkexp(Pexp_tuple(List.rev $1)) }
-  | constr_longident simple_expr %prec prec_constr_appl
+  | constr_longident simple_expr %prec below_SHARP
       { mkexp(Pexp_construct($1, Some $2, false)) }
-  | name_tag simple_expr %prec prec_constr_appl
+  | name_tag simple_expr %prec below_SHARP
       { mkexp(Pexp_variant($1, Some $2)) }
-  | IF seq_expr THEN expr ELSE expr %prec prec_if
+  | IF seq_expr THEN expr ELSE expr
       { mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
-  | IF seq_expr THEN expr %prec prec_if
+  | IF seq_expr THEN expr
       { mkexp(Pexp_ifthenelse($2, $4, None)) }
   | WHILE seq_expr DO seq_expr DONE
       { mkexp(Pexp_while($2, $4)) }
@@ -822,9 +851,9 @@ expr:
                                         loc_ghost = false } },
                          List.rev $4)) }
 */
-  | ASSERT simple_expr %prec prec_appl
+  | ASSERT simple_expr %prec below_SHARP
       { mkassert $2 }
-  | LAZY simple_expr %prec prec_appl
+  | LAZY simple_expr %prec below_SHARP
       { mkexp (Pexp_lazy ($2)) }
 ;
 simple_expr:
@@ -832,9 +861,9 @@ simple_expr:
       { mkexp(Pexp_ident $1) }
   | constant
       { mkexp(Pexp_constant $1) }
-  | constr_longident        %prec prec_constr_appl
+  | constr_longident %prec prec_constant_constructor
       { mkexp(Pexp_construct($1, None, false)) }
-  | name_tag
+  | name_tag %prec prec_constant_constructor
       { mkexp(Pexp_variant($1, None)) }
   | LPAREN seq_expr RPAREN
       { $2 }
@@ -898,19 +927,19 @@ simple_labeled_expr_list:
       { $2 :: $1 }
 ;
 labeled_simple_expr:
-    simple_expr %prec SHARP
+    simple_expr %prec below_SHARP
       { ("", $1) }
   | label_expr
       { $1 }
 ;
 label_expr:
-    LABEL simple_expr %prec SHARP
+    LABEL simple_expr %prec below_SHARP
       { ($1, $2) }
   | TILDE label_ident
       { $2 }
   | QUESTION label_ident
       { ("?" ^ fst $2, snd $2) }
-  | OPTLABEL simple_expr %prec SHARP
+  | OPTLABEL simple_expr %prec below_SHARP
       { ("?" ^ $1, $2) }
 ;
 label_ident:
@@ -931,13 +960,13 @@ let_bindings:
 let_binding:
     val_ident fun_binding
       { ({ppat_desc = Ppat_var $1; ppat_loc = rhs_loc 1}, $2) }
-  | pattern EQUAL seq_expr %prec prec_let
+  | pattern EQUAL seq_expr
       { ($1, $3) }
 ;
 fun_binding:
-    EQUAL seq_expr %prec prec_let
+    EQUAL seq_expr
       { $2 }
-  | type_constraint EQUAL seq_expr %prec prec_let
+  | type_constraint EQUAL seq_expr
       { let (t, t') = $1 in mkexp(Pexp_constraint($3, t, t')) }
   | labeled_simple_pattern fun_binding
       { let (l, o, p) = $1 in mkexp(Pexp_function(l, o, [p, $2])) }
@@ -964,20 +993,20 @@ record_expr:
   | lbl_expr_list opt_semi                      { (None, List.rev $1) }
 ;
 lbl_expr_list:
-    label_longident EQUAL expr %prec prec_list
+    label_longident EQUAL expr
       { [$1,$3] }
-  | lbl_expr_list SEMI label_longident EQUAL expr %prec prec_list
+  | lbl_expr_list SEMI label_longident EQUAL expr
       { ($3, $5) :: $1 }
 ;
 field_expr_list:
-    label EQUAL expr %prec prec_list
+    label EQUAL expr
       { [$1,$3] }
-  | field_expr_list SEMI label EQUAL expr %prec prec_list
+  | field_expr_list SEMI label EQUAL expr
       { ($3, $5) :: $1 }
 ;
 expr_semi_list:
-    expr %prec prec_list                        { [$1] }
-  | expr_semi_list SEMI expr %prec prec_list    { $3 :: $1 }
+    expr                                        { [$1] }
+  | expr_semi_list SEMI expr                    { $3 :: $1 }
 ;
 type_constraint:
     COLON core_type                             { (Some $2, None) }
@@ -994,7 +1023,7 @@ pattern:
       { $1 }
   | pattern AS val_ident
       { mkpat(Ppat_alias($1, $3)) }
-  | pattern_comma_list  %prec p_comma_list
+  | pattern_comma_list  %prec below_COMMA
       { mkpat(Ppat_tuple(List.rev $1)) }
   | constr_longident pattern %prec prec_constr_appl
       { mkpat(Ppat_construct($1, Some $2, false)) }
@@ -1007,7 +1036,7 @@ pattern:
       { mkpat(Ppat_or($1, $3)) }
 ;
 simple_pattern:
-    val_ident %prec prec_let
+    val_ident %prec below_EQUAL
       { mkpat(Ppat_var $1) }
   | UNDERSCORE
       { mkpat(Ppat_any) }
@@ -1089,7 +1118,7 @@ constraints:
 type_kind:
     /*empty*/
       { (Ptype_abstract, None) }
-  | EQUAL core_type %prec prec_type_def
+  | EQUAL core_type
       { (Ptype_abstract, Some $2) }
   | EQUAL constructor_declarations
       { (Ptype_variant(List.rev $2), None) }
@@ -1097,10 +1126,9 @@ type_kind:
       { (Ptype_variant(List.rev $3), None) }
   | EQUAL LBRACE label_declarations opt_semi RBRACE
       { (Ptype_record(List.rev $3), None) }
-  | EQUAL core_type EQUAL opt_bar constructor_declarations %prec prec_type_def
+  | EQUAL core_type EQUAL opt_bar constructor_declarations
       { (Ptype_variant(List.rev $5), Some $2) }
   | EQUAL core_type EQUAL LBRACE label_declarations opt_semi RBRACE
-    %prec prec_type_def
       { (Ptype_record(List.rev $5), Some $2) }
 ;
 type_parameters:
@@ -1186,9 +1214,9 @@ core_type2:
 ;
 
 simple_core_type:
-    simple_core_type2  %prec SHARP
+    simple_core_type2  %prec below_SHARP
       { $1 }
-  | LPAREN core_type_comma_list RPAREN %prec SHARP      /* FIXME duh ?? */
+  | LPAREN core_type_comma_list RPAREN %prec below_SHARP
       { match $2 with [sty] -> sty | _ -> raise Parse_error }
 ;
 simple_core_type2:
@@ -1198,9 +1226,9 @@ simple_core_type2:
       { mktyp(Ptyp_any) }
   | type_longident
       { mktyp(Ptyp_constr($1, [])) }
-  | simple_core_type2 type_longident %prec prec_constr_appl
+  | simple_core_type2 type_longident
       { mktyp(Ptyp_constr($2, [$1])) }
-  | LPAREN core_type_comma_list RPAREN type_longident %prec prec_constr_appl
+  | LPAREN core_type_comma_list RPAREN type_longident
       { mktyp(Ptyp_constr($4, List.rev $2)) }
   | LESS meth_list GREATER
       { mktyp(Ptyp_object $2) }
@@ -1208,10 +1236,9 @@ simple_core_type2:
       { mktyp(Ptyp_object []) }
   | SHARP class_longident opt_present
       { mktyp(Ptyp_class($2, [], $3)) }
-  | simple_core_type2 SHARP class_longident opt_present %prec prec_constr_appl
+  | simple_core_type2 SHARP class_longident opt_present
       { mktyp(Ptyp_class($3, [$1], $4)) }
   | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
-      %prec prec_constr_appl
       { mktyp(Ptyp_class($5, List.rev $2, $6)) }
   | LBRACKET tag_field RBRACKET
       { mktyp(Ptyp_variant([$2], true, None)) }
@@ -1347,7 +1374,7 @@ val_longident:
   | mod_longident DOT val_ident                 { Ldot($1, $3) }
 ;
 constr_longident:
-    mod_longident     %prec prec_constr_appl    { $1 }
+    mod_longident       %prec below_DOT         { $1 }
   | LBRACKET RBRACKET                           { Lident "[]" }
   | LPAREN RPAREN                               { Lident "()" }
   | FALSE                                       { Lident "false" }
diff --git a/stdlib/gc.ml b/stdlib/gc.ml
index c50dbaef4..b2d89cce5 100644
--- a/stdlib/gc.ml
+++ b/stdlib/gc.ml
@@ -45,6 +45,7 @@ external counters : unit -> (float * float * float) = "gc_counters";;
 external get : unit -> control = "gc_get";;
 external set : control -> unit = "gc_set";;
 external minor : unit -> unit = "gc_minor";;
+external major_slice : int -> int = "gc_major_slice";;
 external major : unit -> unit = "gc_major";;
 external full_major : unit -> unit = "gc_full_major";;
 external compact : unit -> unit = "gc_compaction";;
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index 81b7be578..a14fef87d 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -150,12 +150,18 @@ external set : control -> unit = "gc_set"
 external minor : unit -> unit = "gc_minor"
 (** Trigger a minor collection. *)
 
+external major_slice : int -> int = "gc_major_slice";;
+(** Do a minor collection and a slice of major collection.  The argument
+    is the size of the slice, 0 to use the automatically-computed
+    slice size.  In all cases, the result is the computed slice size. *)
+
 external major : unit -> unit = "gc_major"
-(** Finish the current major collection cycle. *)
+(** Do a minor collection and finish the current major collection cycle. *)
 
 external full_major : unit -> unit = "gc_full_major"
-(** Finish the current major collection cycle and perform a complete
-   new cycle.  This will collect all currently unreachable blocks. *)
+(** Do a minor collection, finish the current major collection cycle,
+   and perform a complete new cycle.  This will collect all currently
+   unreachable blocks. *)
 
 external compact : unit -> unit = "gc_compaction"
 (** Perform a full major collection and compact the heap.  Note that heap
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index d7baca331..b666a5a8a 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -73,3 +73,9 @@ let catch_break on =
     set_signal sigint (Signal_handle(fun _ -> raise Break))
   else
     set_signal sigint Signal_default
+
+
+(* OCaml version numbers and strings, moved from utils/config.mlp.
+   Must be in the format described in sys.mli. *)
+
+let ocaml_version = "3.04+6 (2002-02-05)"
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 236c63561..5333628e2 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -169,3 +169,11 @@ val catch_break : bool -> unit
    Call [catch_break true] to enable raising [Break],
    and [catch_break false] to let the system
    terminate the program on user interrupt. *)
+
+
+val ocaml_version : string;;
+(** [ocaml_version] is the version of Objective Caml.
+    It is a string of the form ["major.minor[additional-info] (date)"]
+    Where major and minor are integers, date is in standard format
+    (i.e. YYYY-MM-DD), and [additional-info] is a string that may be
+    empty and does not start with a digit. *)
diff --git a/utils/config.mlp b/utils/config.mlp
index 7a1a0984f..7899d3809 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -12,7 +12,8 @@
 
 (* $Id$ *)
 
-let version = "3.04+5 (2002-02-01)"
+(* The main OCaml version string has moved to stdlib/sys.ml *)
+let version = Sys.ocaml_version
 
 let standard_library =
   try