Begin_roots -> CAMLparam
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2617 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
de805ef04e
commit
63e272ecc5
|
@ -101,16 +101,16 @@ 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
|
||||
|
@ -118,8 +118,7 @@ value alloc_array(value (*funct)(char *), char ** arr)
|
|||
v = funct(arr[n]);
|
||||
modify(&Field(result, n), v);
|
||||
}
|
||||
End_roots();
|
||||
return result;
|
||||
CAMLreturn (result);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -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,7 +147,6 @@ 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;
|
||||
|
@ -162,33 +162,31 @@ value make_vect(value len, value init) /* ML */
|
|||
for (i = 0; i < size; i++) initialize(&Field(res, i), init);
|
||||
res = check_urgent_gc (res);
|
||||
}
|
||||
End_roots();
|
||||
}
|
||||
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;
|
||||
CAMLreturn (res);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
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)) return res;
|
||||
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)) return res;
|
||||
if (Is_exception_result(res)) CAMLreturn (res);
|
||||
i += 3;
|
||||
break;
|
||||
}
|
||||
}
|
||||
End_roots();
|
||||
End_roots();
|
||||
return res;
|
||||
CAMLreturn (res);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
|
@ -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;
|
||||
CAMLreturn (Val_unit);
|
||||
}
|
||||
|
||||
value output_value_to_string(value v, value flags) /* ML */
|
||||
|
|
|
@ -38,31 +38,31 @@ void mlraise(value v)
|
|||
|
||||
void raise_constant(value tag)
|
||||
{
|
||||
value bucket;
|
||||
Begin_root (tag);
|
||||
CAMLparam1 (tag);
|
||||
CAMLlocal1 (bucket);
|
||||
|
||||
bucket = alloc_small (1, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
End_roots ();
|
||||
mlraise(bucket);
|
||||
}
|
||||
|
||||
void raise_with_arg(value tag, value arg)
|
||||
{
|
||||
value bucket;
|
||||
Begin_roots2 (tag, arg);
|
||||
CAMLparam2 (tag, arg);
|
||||
CAMLlocal1 (bucket);
|
||||
|
||||
bucket = alloc_small (2, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
Field(bucket, 1) = arg;
|
||||
End_roots ();
|
||||
mlraise(bucket);
|
||||
}
|
||||
|
||||
void raise_with_string(value tag, char *msg)
|
||||
{
|
||||
value vmsg;
|
||||
Begin_root(tag);
|
||||
CAMLparam1 (tag);
|
||||
CAMLlocal1 (vmsg);
|
||||
|
||||
vmsg = copy_string(msg);
|
||||
End_roots();
|
||||
raise_with_arg(tag, vmsg);
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
mantissa = copy_double(frexp (Double_val(f), &exponent));
|
||||
res = alloc_tuple(2);
|
||||
Field(res, 0) = mantissa;
|
||||
Field(res, 1) = Val_int(exponent);
|
||||
End_roots();
|
||||
return res;
|
||||
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;
|
||||
CAMLreturn (res);
|
||||
}
|
||||
|
||||
value sqrt_float(value f) /* ML */
|
||||
|
|
|
@ -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;
|
||||
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_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 */
|
||||
|
|
16
byterun/io.c
16
byterun/io.c
|
@ -461,23 +461,23 @@ 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);
|
||||
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);
|
||||
|
@ -485,8 +485,7 @@ value caml_output(value vchannel, value buff, value start, value length) /* ML *
|
|||
len -= written;
|
||||
}
|
||||
Unlock(channel);
|
||||
End_roots();
|
||||
return Val_unit;
|
||||
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);
|
||||
CAMLreturn (Val_long(res));
|
||||
}
|
||||
|
||||
value caml_seek_in(value vchannel, value pos) /* ML */
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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();
|
||||
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);
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
CAMLreturn (result);
|
||||
}
|
||||
|
||||
/* Search path function */
|
||||
|
|
|
@ -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 ();
|
||||
Field (res, 0) = elt;
|
||||
}
|
||||
return res;
|
||||
CAMLreturn (res);
|
||||
}
|
||||
|
||||
#undef Setup_for_gc
|
||||
|
|
Loading…
Reference in New Issue