Begin_roots -> CAMLparam

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

byterun/alloc.c

@@ -49,7 +49,7 @@ value alloc (mlsize_t wosize, tag_t tag)
 value alloc_small (mlsize_t wosize, tag_t tag)
 {
   value result;
-  
+
   Assert (wosize > 0 && wosize <= Max_young_wosize);
   Alloc_small (result, wosize, tag);
   return result;
@@ -101,25 +101,24 @@ value copy_string(char *s)
 
 value alloc_array(value (*funct)(char *), char ** arr)
 {
+  CAMLparam0 ();
   mlsize_t nbr, n;
-  value v, result;
+  CAMLlocal2 (v, result);
 
   nbr = 0;
   while (arr[nbr] != 0) nbr++;
   if (nbr == 0) {
-    return Atom(0);
+    CAMLreturn (Atom(0));
   } else {
     result = alloc (nbr, 0);
-    Begin_root(result);
-      for (n = 0; n < nbr; n++) {
-	/* The two statements below must be separate because of evaluation
-           order (don't take the address &Field(result, n) before
-           calling funct, which may cause a GC and move result). */
-	v = funct(arr[n]);
-	modify(&Field(result, n), v);
-      }
-    End_roots();
-    return result;
+    for (n = 0; n < nbr; n++) {
+      /* The two statements below must be separate because of evaluation
+         order (don't take the address &Field(result, n) before
+         calling funct, which may cause a GC and move result). */
+      v = funct(arr[n]);
+      modify(&Field(result, n), v);
+    }
+    CAMLreturn (result);
   }
 }
 

byterun/array.c

@@ -128,7 +128,8 @@ value array_unsafe_set(value array, value index, value newval)   /* ML */
 
 value make_vect(value len, value init) /* ML */
 {
-  value res;
+  CAMLparam2 (len, init);
+  CAMLlocal1 (res);
   mlsize_t size, wsize, i;
   double d;
 
@@ -146,49 +147,46 @@ value make_vect(value len, value init) /* ML */
     }
   } else {
     if (size > Max_wosize) invalid_argument("Array.make");
-    Begin_root(init);
-      if (size < Max_young_wosize) {
-	res = alloc_small(size, 0);
-	for (i = 0; i < size; i++) Field(res, i) = init;
-      }
-      else if (Is_block(init) && Is_young(init)) {
-	minor_collection();
-	res = alloc_shr(size, 0);
-	for (i = 0; i < size; i++) Field(res, i) = init;
-	res = check_urgent_gc (res);
-      }
-      else {
-	res = alloc_shr(size, 0);
-	for (i = 0; i < size; i++) initialize(&Field(res, i), init);
-	res = check_urgent_gc (res);
-      }
-    End_roots();
+    if (size < Max_young_wosize) {
+      res = alloc_small(size, 0);
+      for (i = 0; i < size; i++) Field(res, i) = init;
+    }
+    else if (Is_block(init) && Is_young(init)) {
+      minor_collection();
+      res = alloc_shr(size, 0);
+      for (i = 0; i < size; i++) Field(res, i) = init;
+      res = check_urgent_gc (res);
+    }
+    else {
+      res = alloc_shr(size, 0);
+      for (i = 0; i < size; i++) initialize(&Field(res, i), init);
+      res = check_urgent_gc (res);
+    }
   }
-  return res;
+  CAMLreturn (res);
 }
 
 value make_array(value init)    /* ML */
 {
+  CAMLparam1 (init);
   mlsize_t wsize, size, i;
-  value v, res;
+  CAMLlocal2 (v, res);
 
   size = Wosize_val(init);
   if (size == 0) {
-    return init;
+    CAMLreturn (init);
   } else {
     v = Field(init, 0);
     if (Is_long(v) || Tag_val(v) != Double_tag) {
-      return init;
+      CAMLreturn (init);
     } else {
       Assert(size < Max_young_wosize);
       wsize = size * Double_wosize;
-      Begin_root(init);
-        res = alloc_small(wsize, Double_array_tag);
-	for (i = 0; i < size; i++) {
-	  Store_double_field(res, i, Double_val(Field(init, i)));
-	}
-      End_roots();
-      return res;
+      res = alloc_small(wsize, Double_array_tag);
+      for (i = 0; i < size; i++) {
+        Store_double_field(res, i, Double_val(Field(init, i)));
+      }
+      CAMLreturn (res);
     }
   }
 }

byterun/callback.c

@@ -98,35 +98,33 @@ value callback3_exn(value closure, value arg1, value arg2, value arg3)
 
 value callbackN_exn(value closure, int narg, value args[])
 {
-  value res;
+  CAMLparam1 (closure);
+  CAMLxparamN (args, nargs);
+  CAMLlocal1 (res);
   int i;
 
   res = closure;
-  Begin_roots1(res)
-    Begin_roots_block(args, narg)
-      for (i = 0; i < narg; /*nothing*/) {
-        /* Pass as many arguments as possible */
-        switch (narg - i) {
-        case 1:
-          res = callback_exn(res, args[i]);
-          if (Is_exception_result(res)) return res;
-          i += 1;
-          break;
-        case 2:
-          res = callback2(res, args[i], args[i + 1]);
-          if (Is_exception_result(res)) return res;
-          i += 2;
-          break;
-        default:
-          res = callback3(res, args[i], args[i + 1], args[i + 2]);
-          if (Is_exception_result(res)) return res;
-          i += 3;
-          break;
-        }
-      }
-    End_roots();
-  End_roots();
-  return res;
+  for (i = 0; i < narg; /*nothing*/) {
+    /* Pass as many arguments as possible */
+    switch (narg - i) {
+    case 1:
+      res = callback_exn(res, args[i]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 1;
+      break;
+    case 2:
+      res = callback2(res, args[i], args[i + 1]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 2;
+      break;
+    default:
+      res = callback3(res, args[i], args[i + 1], args[i + 2]);
+      if (Is_exception_result(res)) CAMLreturn (res);
+      i += 3;
+      break;
+    }
+  }
+  CAMLreturn (res);
 }
 
 #endif

byterun/extern.c

@@ -401,13 +401,13 @@ void output_val(struct channel *chan, value v, value flags)
 
 value output_value(value vchan, value v, value flags) /* ML */
 {
+  CAMLparam3 (vchan, v, flags);
   struct channel * channel = Channel(vchan);
-  Begin_roots2(v, flags)
-    Lock(channel);
-    output_val(channel, v, flags);
-    Unlock(channel);
-  End_roots();
-  return Val_unit;
+
+  Lock(channel);
+  output_val(channel, v, flags);
+  Unlock(channel);
+  CAMLreturn (Val_unit);
 }
 
 value output_value_to_string(value v, value flags) /* ML */

byterun/fail.c

@@ -38,31 +38,31 @@ void mlraise(value v)
 
 void raise_constant(value tag)
 {
-  value bucket;
-  Begin_root (tag);
-    bucket = alloc_small (1, 0);
-    Field(bucket, 0) = tag;
-  End_roots ();
+  CAMLparam1 (tag);
+  CAMLlocal1 (bucket);
+
+  bucket = alloc_small (1, 0);
+  Field(bucket, 0) = tag;
   mlraise(bucket);
 }
 
 void raise_with_arg(value tag, value arg)
 {
-  value bucket;
-  Begin_roots2 (tag, arg);
-    bucket = alloc_small (2, 0);
-    Field(bucket, 0) = tag;
-    Field(bucket, 1) = arg;
-  End_roots ();
+  CAMLparam2 (tag, arg);
+  CAMLlocal1 (bucket);
+
+  bucket = alloc_small (2, 0);
+  Field(bucket, 0) = tag;
+  Field(bucket, 1) = arg;
   mlraise(bucket);
 }
 
 void raise_with_string(value tag, char *msg)
 {
-  value vmsg;
-  Begin_root(tag);
-    vmsg = copy_string(msg);
-  End_roots();
+  CAMLparam1 (tag);
+  CAMLlocal1 (vmsg);
+
+  vmsg = copy_string(msg);
   raise_with_arg(tag, vmsg);
 }
 

byterun/floats.c

@@ -162,15 +162,15 @@ value fmod_float(value f1, value f2)              /* ML */
 
 value frexp_float(value f)              /* ML */
 {
+  CAMLparam1 (f);
+  CAMLlocal2 (res, mantissa);
   int exponent;
-  value res;
-  value mantissa = copy_double(frexp (Double_val(f), &exponent));
-  Begin_root(mantissa);
-    res = alloc_tuple(2);
-    Field(res, 0) = mantissa;
-    Field(res, 1) = Val_int(exponent);
-  End_roots();
-  return res;
+
+  mantissa = copy_double(frexp (Double_val(f), &exponent));
+  res = alloc_tuple(2);
+  Field(res, 0) = mantissa;
+  Field(res, 1) = Val_int(exponent);
+  CAMLreturn (res);
 }
 
 value ldexp_float(value f, value i)              /* ML */
@@ -190,22 +190,20 @@ value log10_float(value f)              /* ML */
 
 value modf_float(value f)              /* ML */
 {
-#if __MRC__ || __SC__
-  _float_eval frem;
+#if __SC__
+  _float_eval frem;       /* Problem with Apple's <math.h> */
 #else
   double frem;
 #endif
-  value res;
-  value quo = Val_unit, rem = Val_unit;
+  CAMLparam1 (f);
+  CAMLlocal3 (res, quo, rem);
 
-  Begin_roots2(quo,rem);
-    quo = copy_double(modf (Double_val(f), &frem));
-    rem = copy_double(frem);
-    res = alloc_tuple(2);
-    Field(res, 0) = quo;
-    Field(res, 1) = rem;
-  End_roots();
-  return res;
+  quo = copy_double(modf (Double_val(f), &frem));
+  rem = copy_double(frem);
+  res = alloc_tuple(2);
+  Field(res, 0) = quo;
+  Field(res, 1) = rem;
+  CAMLreturn (res);
 }
 
 value sqrt_float(value f)             /* ML */

byterun/intern.c

@@ -347,21 +347,21 @@ value input_val(struct channel *chan)
 
 value input_value(value vchan)        /* ML */
 {
+  CAMLparam1 (vchan);
   struct channel * chan = Channel(vchan);
-  value res = Val_unit;
+  CAMLlocal1 (res);
 
-  Begin_root(res)
-    Lock(chan);
-    res = input_val(chan);
-    Unlock(chan);
-  End_roots();
-  return res;
+  Lock(chan);
+  res = input_val(chan);
+  Unlock(chan);
+  CAMLreturn (res);
 }
 
 value input_val_from_string(value str, long int ofs)
 {
+  CAMLparam1 (str);
   mlsize_t num_objects, size_32, size_64, whsize;
-  value obj;
+  CAMLlocal1 (obj);
 
   intern_src = &Byte_u(str, ofs + 2*4);
   intern_input_malloced = 0;
@@ -374,16 +374,14 @@ value input_val_from_string(value str, long int ofs)
 #else
   whsize = size_32;
 #endif
-  Begin_root(str);
-    intern_alloc(whsize, num_objects);
-  End_roots();
+  intern_alloc(whsize, num_objects);
   intern_src = &Byte_u(str, ofs + 5*4); /* If a GC occurred */
   /* Fill it in */
   intern_rec(&obj);
   intern_add_to_heap(whsize);
   /* Free everything */
   if (intern_obj_table != NULL) stat_free(intern_obj_table);
-  return obj;
+  CAMLreturn (obj);
 }
 
 value input_value_from_string(value str, value ofs) /* ML */

byterun/io.c

@@ -461,32 +461,31 @@ value caml_output_int(value vchannel, value w)    /* ML */
 
 value caml_output_partial(value vchannel, value buff, value start, value length) /* ML */
 {
+  CAMLparam4 (vchannel, buff, start, length);
   struct channel * channel = Channel(vchannel);
   int res;
-  Begin_root(buff)
-    Lock(channel);
-    res = putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
-    Unlock(channel);
-  End_roots();
-  return Val_int(res);
+
+  Lock(channel);
+  res = putblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
+  Unlock(channel);
+  CAMLreturn (Val_int(res));
 }
 
 value caml_output(value vchannel, value buff, value start, value length) /* ML */
 {
+  CAMLparam4 (vchannel, buff, start, length);
   struct channel * channel = Channel(vchannel);
   long pos = Long_val(start);
   long len = Long_val(length);
 
-  Begin_root(buff)
-    Lock(channel);
-      while (len > 0) {
-        int written = putblock(channel, &Byte(buff, pos), len);
-        pos += written;
-        len -= written;
-      }
-    Unlock(channel);
-  End_roots();
-  return Val_unit;
+  Lock(channel);
+	while (len > 0) {
+	  int written = putblock(channel, &Byte(buff, pos), len);
+	  pos += written;
+	  len -= written;
+	}
+  Unlock(channel);
+  CAMLreturn (Val_unit);
 }
 
 value caml_seek_out(value vchannel, value pos)    /* ML */
@@ -530,15 +529,14 @@ value caml_input_int(value vchannel)        /* ML */
 
 value caml_input(value vchannel, value buff, value start, value length) /* ML */
 {
+  CAMLparam4 (vchannel, buff, start, length);
   struct channel * channel = Channel(vchannel);
   long res;
 
-  Begin_root(buff)
-    Lock(channel);
-    res = getblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
-    Unlock(channel);
-  End_roots();
-  return Val_long(res);
+  Lock(channel);
+  res = getblock(channel, &Byte(buff, Long_val(start)), Long_val(length));
+  Unlock(channel);
+  CAMLreturn (Val_long(res));
 }
 
 value caml_seek_in(value vchannel, value pos)     /* ML */

byterun/minor_gc.c

@@ -142,12 +142,9 @@ void minor_collection (void)
 
 value check_urgent_gc (value extra_root)
 {
-  if (force_major_slice) {
-    Begin_root(extra_root);
-      minor_collection();
-    End_roots();
-  }
-  return extra_root;
+  CAMLparam1 (extra_root);
+  if (force_major_slice) minor_collection();
+  CAMLreturn (extra_root);
 }
 
 void realloc_ref_table (void)

byterun/obj.c

@@ -68,21 +68,20 @@ value obj_block(value tag, value size) /* ML */
 
 value obj_dup(value arg) /* ML */
 {
-  value res;
+  CAMLparam1 (arg);
+  CAMLlocal1 (res);
   mlsize_t sz, i;
   tag_t tg;
 
   sz = Wosize_val(arg);
   if (sz == 0) return arg;
 
-  Begin_root(arg);
   tg = Tag_val(arg);
   res = alloc(sz, tg);
   for (i = 0; i < sz; i++)
     Field(res, i) = Field(arg, i);
-  End_roots();
 
-  return res;
+  CAMLreturn (res);
 }
 
 /* Shorten the given block to the given size and return void.

byterun/signals.c

@@ -187,12 +187,13 @@ int convert_signal_number(int signo)
 
 value install_signal_handler(value signal_number, value action) /* ML */
 {
+  CAMLparam2 (signal_number, action);
   int sig;
   void (*act)(int signo), (*oldact)(int signo);
 #ifdef POSIX_SIGNALS
   struct sigaction sigact, oldsigact;
 #endif
-  value res;
+  CAMLlocal1 (res);
 
   sig = convert_signal_number(Int_val(signal_number));
   if (sig < 0 || sig >= NSIG) 
@@ -207,9 +208,7 @@ value install_signal_handler(value signal_number, value action) /* ML */
   default:                      /* Signal_handle */
     if (signal_handlers == 0) {
       int i;
-      Begin_root(action);
-        signal_handlers = alloc_tuple(NSIG);
-      End_roots();
+      signal_handlers = alloc_tuple(NSIG);
       for (i = 0; i < NSIG; i++) Field(signal_handlers, i) = Val_int(0);
       register_global_root(&signal_handlers);
     }
@@ -235,5 +234,5 @@ value install_signal_handler(value signal_number, value action) /* ML */
     res = Val_int(1);           /* Signal_ignore */
   else
     res = Val_int(0);           /* Signal_default */
-  return res;
+  CAMLreturn (res);
 }

byterun/sys.c

@@ -28,6 +28,9 @@
 #if !macintosh && !_WIN32
 #include <sys/wait.h>
 #endif
+#if macintosh
+#include "macintosh.h"
+#endif
 #include "config.h"
 #ifdef HAS_UNISTD
 #include <unistd.h>
@@ -85,8 +88,9 @@ char * error_message(void)
 
 void sys_error(value arg)
 {
+  CAMLparam1 (arg);
   char * err;
-  value str;
+  CAMLlocal1 (str);
   
   if (errno == EAGAIN || errno == EWOULDBLOCK) {
     raise_sys_blocked_io();
@@ -97,9 +101,7 @@ void sys_error(value arg)
     } else {
       int err_len = strlen(err);
       int arg_len = string_length(arg);
-      Begin_root(arg);
       str = alloc_string(arg_len + 2 + err_len);
-      End_roots();
       bcopy(String_val(arg), &Byte(str, 0), arg_len);
       bcopy(": ", &Byte(str, arg_len), 2);
       bcopy(err, &Byte(str, arg_len + 2), err_len);
@@ -234,6 +236,8 @@ void sys_init(char **argv)
 value sys_system_command(value command)   /* ML */
 {
   int status, retcode;
+  
+  enter_blocking_section ();
 #ifndef _WIN32
   status = system(String_val(command));
   if (WIFEXITED(status))
@@ -243,6 +247,7 @@ value sys_system_command(value command)   /* ML */
 #else
   status = retcode = win32_system(String_val(command));
 #endif
+  leave_blocking_section ();
   if (status == -1) sys_error(command);
   return Val_int(retcode);
 }
@@ -279,16 +284,14 @@ value sys_random_seed (value unit)       /* ML */
 
 value sys_get_config(value unit)  /* ML */
 {
-  value result;
-  value ostype;
+  CAMLparam0 ();   /* unit is unused */
+  CAMLlocal2 (result, ostype);
 
   ostype = copy_string(OCAML_OS_TYPE);
-  Begin_root(ostype);
-    result = alloc_small (2, 0);
-    Field(result, 0) = ostype;
-    Field(result, 1) = Val_long (8 * sizeof(value));
-  End_roots ();
-  return result;
+  result = alloc_small (2, 0);
+  Field(result, 0) = ostype;
+  Field(result, 1) = Val_long (8 * sizeof(value));
+  CAMLreturn (result);
 }
 
 /* Search path function */

byterun/weak.c

@@ -55,9 +55,9 @@ value weak_set (value ar, value n, value el)     /* ML */
 
 value weak_get (value ar, value n)        /* ML */
 {
+  CAMLparam2 (ar, n);
   mlsize_t offset = Long_val (n) + 1;
-  value res;
-  value elt;
+  CAMLlocal2 (res, elt);
                                                    Assert (Is_in_heap (ar));
   if (offset < 1 || offset >= Wosize_val (ar)) invalid_argument ("Weak.get");
   if (Field (ar, offset) == 0){
@@ -65,12 +65,10 @@ value weak_get (value ar, value n)        /* ML */
   }else{
     elt = Field (ar, offset);
     if (gc_phase == Phase_mark) darken (elt, NULL);
-    Begin_root(elt);
-      res = alloc_small (1, Some_tag);
-    End_roots ();
+    res = alloc_small (1, Some_tag);
     Field (res, 0) = elt;
   }
-  return res;
+  CAMLreturn (res);
 }
 
 #undef Setup_for_gc