nouvelles fonctions alloc/alloc_small
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2134 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
59cb8750d2
commit
3be947947e
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -71,7 +71,7 @@ void raise_constant(value tag)
|
|||
{
|
||||
value bucket;
|
||||
Begin_root (tag);
|
||||
bucket = alloc (1, 0);
|
||||
bucket = alloc_small (1, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
End_roots ();
|
||||
mlraise(bucket);
|
||||
|
@ -81,7 +81,7 @@ void raise_with_arg(value tag, value arg)
|
|||
{
|
||||
value bucket;
|
||||
Begin_roots2 (tag, arg);
|
||||
bucket = alloc (2, 0);
|
||||
bucket = alloc_small (2, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
Field(bucket, 1) = arg;
|
||||
End_roots ();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -275,7 +275,7 @@ value install_signal_handler(value signal_number, value action) /* ML */
|
|||
if (oldact == SIG_ERR) sys_error(NO_ARG);
|
||||
#endif
|
||||
if (oldact == (void (*)(int)) handle_signal) {
|
||||
res = alloc(1, 0); /* Signal_handle */
|
||||
res = alloc_small(1, 0); /* Signal_handle */
|
||||
Field(res, 0) = Field(signal_handlers, sig);
|
||||
}
|
||||
else if (oldact == SIG_IGN)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -27,6 +27,25 @@
|
|||
#define Restore_after_gc
|
||||
|
||||
value alloc (mlsize_t wosize, tag_t tag)
|
||||
{
|
||||
value result;
|
||||
mlsize_t i;
|
||||
|
||||
Assert (wosize > 0);
|
||||
if (wosize <= Max_young_wosize){
|
||||
Alloc_small (result, wosize, tag);
|
||||
if (tag < No_scan_tag){
|
||||
for (i = 0; i < wosize; i++) Field (result, i) = 0;
|
||||
}
|
||||
}else{
|
||||
result = alloc_shr (wosize, tag);
|
||||
if (tag < No_scan_tag) memset (Bp_val (result), 0, Bsize_wsize (wosize));
|
||||
result = check_urgent_gc (result);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
value alloc_small (mlsize_t wosize, tag_t tag)
|
||||
{
|
||||
value result;
|
||||
|
||||
|
@ -89,8 +108,7 @@ value alloc_array(value (*funct)(char *), char ** arr)
|
|||
if (nbr == 0) {
|
||||
return Atom(0);
|
||||
} else {
|
||||
result = nbr < Max_young_wosize ? alloc(nbr, 0) : alloc_shr(nbr, 0);
|
||||
for (n = 0; n < nbr; n++) Field(result, n) = Val_int(0);
|
||||
result = alloc (nbr, 0);
|
||||
Begin_root(result);
|
||||
for (n = 0; n < nbr; n++) {
|
||||
/* The two statements below must be separate because of evaluation
|
||||
|
@ -125,13 +143,9 @@ int convert_flag_list(value list, int *flags)
|
|||
value alloc_dummy(value size) /* ML */
|
||||
{
|
||||
mlsize_t wosize = Int_val(size);
|
||||
value result;
|
||||
mlsize_t i;
|
||||
|
||||
if (wosize == 0) return Atom(0);
|
||||
result = alloc(wosize, 0);
|
||||
for (i = 0; i < wosize; i++) Field(result, i) = Val_int(0);
|
||||
return result;
|
||||
return alloc (wosize, 0);
|
||||
}
|
||||
|
||||
value update_dummy(value dummy, value newval) /* ML */
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -19,6 +19,7 @@
|
|||
#include "mlvalues.h"
|
||||
|
||||
value alloc (mlsize_t, tag_t);
|
||||
value alloc_small (mlsize_t, tag_t);
|
||||
value alloc_tuple (mlsize_t);
|
||||
value alloc_string (mlsize_t);
|
||||
value alloc_final (mlsize_t, final_fun, mlsize_t, mlsize_t);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -139,12 +139,7 @@ value make_vect(value len, value init) /* ML */
|
|||
d = Double_val(init);
|
||||
wsize = size * Double_wosize;
|
||||
if (wsize > Max_wosize) invalid_argument("Array.make");
|
||||
if (wsize < Max_young_wosize) {
|
||||
res = alloc(wsize, Double_array_tag);
|
||||
} else {
|
||||
res = alloc_shr(wsize, Double_array_tag);
|
||||
res = check_urgent_gc (res);
|
||||
}
|
||||
res = alloc(wsize, Double_array_tag);
|
||||
for (i = 0; i < size; i++) {
|
||||
Store_double_field(res, i, d);
|
||||
}
|
||||
|
@ -152,7 +147,7 @@ value make_vect(value len, value init) /* ML */
|
|||
if (size > Max_wosize) invalid_argument("Array.make");
|
||||
Begin_root(init);
|
||||
if (size < Max_young_wosize) {
|
||||
res = alloc(size, 0);
|
||||
res = alloc_small(size, 0);
|
||||
for (i = 0; i < size; i++) Field(res, i) = init;
|
||||
}
|
||||
else if (Is_block(init) && Is_young(init)) {
|
||||
|
@ -187,7 +182,7 @@ value make_array(value init) /* ML */
|
|||
Assert(size < Max_young_wosize);
|
||||
wsize = size * Double_wosize;
|
||||
Begin_root(init);
|
||||
res = alloc(wsize, Double_array_tag);
|
||||
res = alloc_small(wsize, Double_array_tag);
|
||||
for (i = 0; i < size; i++) {
|
||||
Store_double_field(res, i, Double_val(Field(init, i)));
|
||||
}
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -38,7 +38,7 @@ void raise_constant(value tag)
|
|||
{
|
||||
value bucket;
|
||||
Begin_root (tag);
|
||||
bucket = alloc (1, 0);
|
||||
bucket = alloc_small (1, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
End_roots ();
|
||||
mlraise(bucket);
|
||||
|
@ -48,7 +48,7 @@ void raise_with_arg(value tag, value arg)
|
|||
{
|
||||
value bucket;
|
||||
Begin_roots2 (tag, arg);
|
||||
bucket = alloc (2, 0);
|
||||
bucket = alloc_small (2, 0);
|
||||
Field(bucket, 0) = tag;
|
||||
Field(bucket, 1) = arg;
|
||||
End_roots ();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -105,7 +105,7 @@ value gc_stat(value v) /* ML */
|
|||
|
||||
Assert (live_words + free_words + fragments == Wsize_bsize (stat_heap_size));
|
||||
|
||||
res = alloc (14, 0);
|
||||
res = alloc_small (14, 0);
|
||||
Field (res, 0) = Val_long (stat_minor_words
|
||||
+ Wsize_bsize (young_end - young_ptr));
|
||||
Field (res, 1) = Val_long (stat_promoted_words);
|
||||
|
@ -129,7 +129,7 @@ value gc_get(value v) /* ML */
|
|||
value res;
|
||||
|
||||
Assert (v == Val_unit);
|
||||
res = alloc (6, 0);
|
||||
res = alloc_small (6, 0);
|
||||
Field (res, 0) = Wsize_bsize (Val_long (minor_heap_size)); /* s */
|
||||
Field (res, 1) = Wsize_bsize (Val_long (major_heap_increment)); /* i */
|
||||
Field (res, 2) = Val_long (percent_free); /* o */
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -276,11 +276,7 @@ static void intern_alloc(mlsize_t whsize, mlsize_t num_objects)
|
|||
intern_color = allocation_color(intern_extra_block);
|
||||
intern_dest = intern_extra_block;
|
||||
} else {
|
||||
if (wosize < Max_young_wosize) {
|
||||
intern_block = alloc(wosize, String_tag);
|
||||
} else {
|
||||
intern_block = alloc_shr(wosize, String_tag);
|
||||
}
|
||||
intern_block = alloc(wosize, String_tag);
|
||||
intern_header = Hd_val(intern_block);
|
||||
intern_color = Color_hd(intern_header);
|
||||
Assert (intern_color == White || intern_color == Black);
|
||||
|
|
|
@ -286,8 +286,7 @@ void adjust_gc_speed (mlsize_t mem, mlsize_t max)
|
|||
void initialize (value *fp, value val)
|
||||
{
|
||||
*fp = val;
|
||||
Assert (Is_in_heap (fp));
|
||||
if (Is_block (val) && Is_young (val)){
|
||||
if (Is_in_heap (fp) && Is_block (val) && Is_young (val)){
|
||||
*ref_table_ptr++ = fp;
|
||||
if (ref_table_ptr >= ref_table_limit){
|
||||
realloc_ref_table ();
|
||||
|
|
179
byterun/memory.h
179
byterun/memory.h
|
@ -5,7 +5,7 @@
|
|||
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -78,7 +78,172 @@ color_t allocation_color (void *hp);
|
|||
} \
|
||||
} \
|
||||
|
||||
|
||||
struct caml__roots_block {
|
||||
struct caml__roots_block *next;
|
||||
long ntables;
|
||||
long nitems;
|
||||
value *tables [5];
|
||||
};
|
||||
|
||||
extern struct caml__roots_block *local_roots; /* defined in roots.c */
|
||||
|
||||
/* The following macros are used to declare C local variables and
|
||||
function parameters of type [value].
|
||||
|
||||
The function body must start with one of the [CAMLparam] macros.
|
||||
If the function has no parameter of type [value], use [CAMLparam0].
|
||||
If the function has 1 to 5 [value] parameters, use the corresponding
|
||||
[CAMLparam] with the parameters as arguments.
|
||||
If the function has more than 5 [value] parameters, use [CAMLparam5]
|
||||
for the first 5 parameters, and one or more calls to the [CAMLxparam]
|
||||
macros for the others.
|
||||
|
||||
If you need local variables of type [value], declare them with one
|
||||
or more calls to the [CAMLlocal] macros.
|
||||
Use [CAMLlocalN] to declare an array of [value]s.
|
||||
|
||||
Your function may raise and exception or return a [value] with the
|
||||
[CAMLreturn] macro. Its argument is simply the [value] returned by
|
||||
your function. Do NOT directly return a [value] with the [return]
|
||||
keyword.
|
||||
|
||||
All the identifiers beginning with "caml__" are reserved by Caml.
|
||||
Do not use them for anything (local or global variables, struct or
|
||||
union tags, macros, etc.)
|
||||
*/
|
||||
|
||||
#define CAMLparam0() \
|
||||
caml__roots_block *caml__frame = local_roots
|
||||
|
||||
#define CAMLparam1(x) \
|
||||
CAMLparam0 (); \
|
||||
CAMLxparam1 (x)
|
||||
|
||||
#define CAMLparam2(x, y) \
|
||||
CAMLparam0 (); \
|
||||
CAMLxparam2 (x, y)
|
||||
|
||||
#define CAMLparam3(x, y, z) \
|
||||
CAMLparam0 (); \
|
||||
CAMLxparam3 (x, y, z)
|
||||
|
||||
#define CAMLparam4(x, y, z, t) \
|
||||
CAMLparam0 (); \
|
||||
CAMLxparam4 (x, y, z, t)
|
||||
|
||||
#define CAMLparam5(x, y, z, t, u) \
|
||||
CAMLparam0 (); \
|
||||
CAMLxparam4 (x, y, z, t, u)
|
||||
|
||||
#define CAMLxparam1(x) \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml__frame, \
|
||||
(caml__roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = 1), \
|
||||
(caml__roots_##x.ntables = 1), \
|
||||
(caml__roots_##x.tables [0] = &x), \
|
||||
NULL)
|
||||
|
||||
#define CAMLxparam2(x, y) \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml__frame, \
|
||||
(caml__roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = 1), \
|
||||
(caml__roots_##x.ntables = 2), \
|
||||
(caml__roots_##x.tables [0] = &x), \
|
||||
(caml__roots_##x.tables [1] = &y), \
|
||||
NULL)
|
||||
|
||||
#define CAMLxparam3(x, y, z) \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml__frame, \
|
||||
(caml__roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = 1), \
|
||||
(caml__roots_##x.ntables = 3), \
|
||||
(caml__roots_##x.tables [0] = &x), \
|
||||
(caml__roots_##x.tables [1] = &y), \
|
||||
(caml__roots_##x.tables [2] = &z), \
|
||||
NULL)
|
||||
|
||||
#define CAMLxparam4(x, y, z, t) \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml__frame, \
|
||||
(caml__roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = 1), \
|
||||
(caml__roots_##x.ntables = 4), \
|
||||
(caml__roots_##x.tables [0] = &x), \
|
||||
(caml__roots_##x.tables [1] = &y), \
|
||||
(caml__roots_##x.tables [2] = &z), \
|
||||
(caml__roots_##x.tables [3] = &t), \
|
||||
NULL)
|
||||
|
||||
#define CAMLxparam5(x, y, z, t, u) \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml__frame, \
|
||||
(caml__roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = 1), \
|
||||
(caml__roots_##x.ntables = 5), \
|
||||
(caml__roots_##x.tables [0] = &x), \
|
||||
(caml__roots_##x.tables [1] = &y), \
|
||||
(caml__roots_##x.tables [2] = &z), \
|
||||
(caml__roots_##x.tables [3] = &t), \
|
||||
(caml__roots_##x.tables [4] = &u), \
|
||||
NULL)
|
||||
|
||||
#define CAMLlocal1(x) \
|
||||
value x = Val_unit; \
|
||||
CAMLxparam1 (x)
|
||||
|
||||
#define CAMLlocal2(x, y) \
|
||||
value x = Val_unit, y = Val_unit; \
|
||||
CAMLxparam1 (x, y)
|
||||
|
||||
#define CAMLlocal3(x, y, z) \
|
||||
value x = Val_unit, y = Val_unit, z = Val_unit; \
|
||||
CAMLxparam1 (x, y, z)
|
||||
|
||||
#define CAMLlocal4(x, y, z, t) \
|
||||
value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit; \
|
||||
CAMLxparam1 (x, y, z, t)
|
||||
|
||||
#define CAMLlocal5(x, y, z, t, u) \
|
||||
value x = Val_unit, y = Val_unit, z = Val_unit, t = Val_unit, u = Val_unit; \
|
||||
CAMLxparam1 (x, y, z, t, u)
|
||||
|
||||
#define CAMLlocalN(x, size) \
|
||||
value x [(size)] = { NULL }; \
|
||||
caml__roots_block caml__roots_##x; \
|
||||
void *caml__dummy_##x = ( \
|
||||
caml_frame, \
|
||||
(caml_roots_##x.next = local_roots), \
|
||||
(local_roots = &caml__roots##x), \
|
||||
(caml__roots_##x.nitems = (size)), \
|
||||
(caml__roots_##x.ntables = 1), \
|
||||
(caml__roots_##x.tables [0] = &(x [0])), \
|
||||
NULL)
|
||||
|
||||
#define CAMLreturn(x) \
|
||||
local_roots = caml__frame; \
|
||||
return (x)
|
||||
|
||||
/* convenience macro */
|
||||
#define Store_field(block, offset, val) modify (&Field (block, offset), val)
|
||||
|
||||
/*
|
||||
NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*,
|
||||
[CAMLxparam]*, [CAMLlocal]*, [CAMLreturn].
|
||||
|
||||
[Begin_roots] and [End_roots] are used for C variables that are GC roots.
|
||||
It must contain all values in C local variables and function parameters
|
||||
at the time the minor GC is called.
|
||||
|
@ -95,16 +260,6 @@ color_t allocation_color (void *hp);
|
|||
You can use [Val_unit] as a dummy initial value for your variables.
|
||||
*/
|
||||
|
||||
|
||||
struct caml__roots_block {
|
||||
struct caml__roots_block *next;
|
||||
long ntables;
|
||||
long nitems;
|
||||
value *tables [5];
|
||||
};
|
||||
|
||||
extern struct caml__roots_block *local_roots; /* defined in roots.c */
|
||||
|
||||
#define Begin_root Begin_roots1
|
||||
|
||||
#define Begin_roots1(r0) { \
|
||||
|
@ -170,7 +325,7 @@ extern struct caml__roots_block *local_roots; /* defined in roots.c */
|
|||
|
||||
/*
|
||||
[Push_roots] and [Pop_roots] are obsolete.
|
||||
Use [Begin_roots] and [End_roots] instead.
|
||||
Use [CAMLparam], [CAMLxparam], [CAMLlocal], [CAMLreturn] instead.
|
||||
*/
|
||||
|
||||
/* [Push_roots] and [Pop_roots] are used for C variables that are GC roots.
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -42,7 +42,7 @@ value reify_bytecode(value prog, value len) /* ML */
|
|||
#ifdef THREADED_CODE
|
||||
thread_code((code_t) prog, (asize_t) Long_val(len));
|
||||
#endif
|
||||
clos = alloc(1, Closure_tag);
|
||||
clos = alloc_small (1, Closure_tag);
|
||||
Code_val(clos) = (code_t) prog;
|
||||
return clos;
|
||||
}
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -26,21 +26,21 @@
|
|||
val: The ML representation of something. A long or a block or a pointer
|
||||
outside the heap. If it is a block, it is the (encoded) address
|
||||
of an object. If it is a long, it is encoded as well.
|
||||
object: Something allocated. It always has a header and some
|
||||
block: Something allocated. It always has a header and some
|
||||
fields or some number of bytes (a multiple of the word size).
|
||||
field: A word-sized val which is part of an object.
|
||||
bp: Pointer to the first byte of an object. (a char *)
|
||||
op: Pointer to the first field of an object. (a value *)
|
||||
hp: Pointer to the header of an object. (a char *)
|
||||
field: A word-sized val which is part of a block.
|
||||
bp: Pointer to the first byte of a block. (a char *)
|
||||
op: Pointer to the first field of a block. (a value *)
|
||||
hp: Pointer to the header of a block. (a char *)
|
||||
int32: Four bytes on all architectures.
|
||||
|
||||
Remark: An object size is always a multiple of the word size, and at least
|
||||
Remark: A block size is always a multiple of the word size, and at least
|
||||
one word plus the header.
|
||||
|
||||
bosize: Size (in bytes) of the "bytes" part.
|
||||
wosize: Size (in words) of the "fields" part.
|
||||
bhsize: Size (in bytes) of the object with its header.
|
||||
whsize: Size (in words) of the object with its header.
|
||||
bhsize: Size (in bytes) of the block with its header.
|
||||
whsize: Size (in words) of the block with its header.
|
||||
|
||||
hd: A header.
|
||||
tag: The value of the tag field of the header.
|
||||
|
@ -173,7 +173,7 @@ typedef opcode_t * code_t;
|
|||
|
||||
/* If tag == Infix_tag : an infix header inside a closure */
|
||||
/* Infix_tag must be odd so that the infix header is scanned as an integer */
|
||||
/* Infix_tag must be 1 modulo 4 and infix headers can only occur in objects
|
||||
/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
|
||||
with tag Closure_tag (see compact.c). */
|
||||
|
||||
#define Infix_tag 249
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -209,7 +209,7 @@ value install_signal_handler(value signal_number, value action) /* ML */
|
|||
if (oldact == SIG_ERR) sys_error(NO_ARG);
|
||||
#endif
|
||||
if (oldact == handle_signal) {
|
||||
res = alloc(1, 0); /* Signal_handle */
|
||||
res = alloc_small (1, 0); /* Signal_handle */
|
||||
Field(res, 0) = Field(signal_handlers, sig);
|
||||
}
|
||||
else if (oldact == SIG_IGN)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -244,7 +244,7 @@ value sys_get_config(value unit) /* ML */
|
|||
|
||||
ostype = copy_string(OCAML_OS_TYPE);
|
||||
Begin_root(ostype);
|
||||
result = alloc_tuple(2);
|
||||
result = alloc_small (2, 0);
|
||||
Field(result, 0) = ostype;
|
||||
Field(result, 1) = Val_long (8 * sizeof(value));
|
||||
End_roots ();
|
||||
|
|
|
@ -62,7 +62,7 @@ value terminfo_setup (value vchan) /* ML */
|
|||
|| standout == NULL || standend == NULL){
|
||||
return Bad_term;
|
||||
}
|
||||
result = alloc (1, Good_term_tag);
|
||||
result = alloc_small (1, Good_term_tag);
|
||||
Field (result, 0) = Val_int (num_lines);
|
||||
return result;
|
||||
}
|
||||
|
|
|
@ -65,7 +65,7 @@ value weak_get (value ar, value n) /* ML */
|
|||
elt = Field (ar, offset);
|
||||
if (gc_phase == Phase_mark) darken (elt, NULL);
|
||||
Begin_root(elt);
|
||||
res = alloc (1, Some_tag);
|
||||
res = alloc_small (1, Some_tag);
|
||||
End_roots ();
|
||||
Field (res, 0) = elt;
|
||||
}
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Francois Rouaix, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -163,7 +163,7 @@ value caml_db_seq(value cdb, value vkey, value vflags) /* ML */
|
|||
Begin_roots3(reskey, resdata, res);
|
||||
reskey = alloc_string(key.size);
|
||||
resdata = alloc_string(data.size);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
bcopy(key.data, String_val(reskey), key.size);
|
||||
bcopy(data.data, String_val(resdata), data.size);
|
||||
Field(res, 0) = reskey;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -35,7 +35,7 @@ value gr_moveto(value vx, value vy)
|
|||
value gr_current_point(void)
|
||||
{
|
||||
value res;
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(grx);
|
||||
Field(res, 1) = Val_int(gry);
|
||||
return res;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -16,22 +16,6 @@
|
|||
#include <alloc.h>
|
||||
#include <memory.h>
|
||||
|
||||
static value gr_alloc_int_vect(mlsize_t size)
|
||||
{
|
||||
value res;
|
||||
mlsize_t i;
|
||||
|
||||
if (size <= Max_young_wosize) {
|
||||
res = alloc(size, 0);
|
||||
} else {
|
||||
res = alloc_shr(size, 0);
|
||||
}
|
||||
for (i = 0; i < size; i++) {
|
||||
Field(res, i) = Val_long(0);
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
value gr_dump_image(value image)
|
||||
{
|
||||
int width, height, i, j;
|
||||
|
@ -42,9 +26,9 @@ value gr_dump_image(value image)
|
|||
gr_check_open();
|
||||
width = Width_im(image);
|
||||
height = Height_im(image);
|
||||
m = gr_alloc_int_vect(height);
|
||||
m = alloc(height, 0);
|
||||
for (i = 0; i < height; i++) {
|
||||
value v = gr_alloc_int_vect(width);
|
||||
value v = alloc(width, 0);
|
||||
modify(&Field(m, i), v);
|
||||
}
|
||||
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -129,7 +129,7 @@ value gr_wait_event(value eventlist)
|
|||
XFlush(grdisplay);
|
||||
}
|
||||
}
|
||||
res = alloc_tuple(5);
|
||||
res = alloc_small(5, 0);
|
||||
Field(res, 0) = Val_int(mouse_x);
|
||||
Field(res, 1) = Val_int(mouse_y == -1 ? -1 : Wcvt(mouse_y));
|
||||
Field(res, 2) = Val_bool(button);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -73,7 +73,7 @@ value gr_text_size(value str)
|
|||
gr_check_open();
|
||||
if (grfont == NULL) gr_font(DEFAULT_FONT);
|
||||
width = XTextWidth(grfont, String_val(str), string_length(str));
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(width);
|
||||
Field(res, 1) = Val_int(grfont->ascent + grfont->descent);
|
||||
return res;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -26,11 +26,7 @@ value create_nat(value size)
|
|||
{
|
||||
mlsize_t sz = Long_val(size);
|
||||
|
||||
if (sz < Max_young_wosize) {
|
||||
return alloc(sz, Nat_tag);
|
||||
} else {
|
||||
return check_urgent_gc(alloc_shr(sz, Nat_tag));
|
||||
}
|
||||
return alloc(sz, Nat_tag);
|
||||
}
|
||||
|
||||
value set_to_zero_nat(value nat, value ofs, value len)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1995 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -274,7 +274,7 @@ value caml_thread_initialize(value unit) /* ML */
|
|||
mu = caml_mutex_new(Val_unit);
|
||||
caml_mutex_lock(mu);
|
||||
/* Create a descriptor for the current thread */
|
||||
descr = alloc_tuple(3);
|
||||
descr = alloc_small(3, 0);
|
||||
Ident(descr) = Val_long(thread_next_ident);
|
||||
Start_closure(descr) = Val_unit;
|
||||
Terminated(descr) = mu;
|
||||
|
@ -357,7 +357,7 @@ value caml_thread_new(value clos) /* ML */
|
|||
mu = caml_mutex_new(Val_unit);
|
||||
caml_mutex_lock(mu);
|
||||
/* Create a descriptor for the new thread */
|
||||
descr = alloc_tuple(3);
|
||||
descr = alloc_small(3, 0);
|
||||
Ident(descr) = Val_long(thread_next_ident);
|
||||
Start_closure(descr) = clos;
|
||||
Terminated(descr) = mu;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -354,7 +354,7 @@ try_again:
|
|||
w = inter_fdlist_set(th->writefds, &writefds);
|
||||
e = inter_fdlist_set(th->exceptfds, &exceptfds);
|
||||
if (r != NO_FDS || w != NO_FDS || e != NO_FDS) {
|
||||
value retval = alloc(3, TAG_RESUMED_IO);
|
||||
value retval = alloc_small(3, TAG_RESUMED_IO);
|
||||
Field(retval, 0) = r;
|
||||
Field(retval, 1) = w;
|
||||
Field(retval, 2) = e;
|
||||
|
@ -588,7 +588,7 @@ static value inter_fdlist_set(value fdl, fd_set *set)
|
|||
for (res = NO_FDS; fdl != NO_FDS; fdl = Field(fdl, 1)) {
|
||||
int fd = Int_val(Field(fdl, 0));
|
||||
if (FD_ISSET(fd, set)) {
|
||||
cons = alloc(2, 0);
|
||||
cons = alloc_small(2, 0);
|
||||
Field(cons, 0) = Val_int(fd);
|
||||
Field(cons, 1) = res;
|
||||
res = cons;
|
||||
|
@ -620,19 +620,19 @@ static value alloc_process_status(int pid, int status)
|
|||
value st, res;
|
||||
|
||||
if (WIFEXITED(status)) {
|
||||
st = alloc(1, TAG_WEXITED);
|
||||
st = alloc_small(1, TAG_WEXITED);
|
||||
Field(st, 0) = Val_int(WEXITSTATUS(status));
|
||||
}
|
||||
else if (WIFSTOPPED(status)) {
|
||||
st = alloc(1, TAG_WSTOPPED);
|
||||
st = alloc_small(1, TAG_WSTOPPED);
|
||||
Field(st, 0) = Val_int(WSTOPSIG(status));
|
||||
}
|
||||
else {
|
||||
st = alloc(1, TAG_WSIGNALED);
|
||||
st = alloc_small(1, TAG_WSIGNALED);
|
||||
Field(st, 0) = Val_int(WTERMSIG(status));
|
||||
}
|
||||
Begin_root(st);
|
||||
res = alloc(2, TAG_RESUMED_WAIT);
|
||||
res = alloc_small(2, TAG_RESUMED_WAIT);
|
||||
Field(res, 0) = Val_int(pid);
|
||||
Field(res, 1) = st;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -34,7 +34,7 @@ value unix_accept(value sock) /* ML */
|
|||
if (retcode == -1) uerror("accept", Nothing);
|
||||
a = alloc_sockaddr();
|
||||
Begin_root (a);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(retcode);
|
||||
Field(res, 1) = a;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -28,7 +28,7 @@ static value alloc_group_entry(struct group *entry)
|
|||
name = copy_string(entry->gr_name);
|
||||
pass = copy_string(entry->gr_passwd);
|
||||
mem = copy_string_array(entry->gr_mem);
|
||||
res = alloc_tuple(4);
|
||||
res = alloc_small(4, 0);
|
||||
Field(res,0) = name;
|
||||
Field(res,1) = pass;
|
||||
Field(res,2) = Val_int(entry->gr_gid);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -50,10 +50,10 @@ static value alloc_host_entry(struct hostent *entry)
|
|||
addr_list = alloc_array(alloc_one_addr, entry->h_addr_list);
|
||||
#else
|
||||
adr = alloc_one_addr(entry->h_addr);
|
||||
addr_list = alloc_tuple(1);
|
||||
addr_list = alloc_small(1, 0);
|
||||
Field(addr_list, 0) = adr;
|
||||
#endif
|
||||
res = alloc_tuple(4);
|
||||
res = alloc_small(4, 0);
|
||||
Field(res, 0) = name;
|
||||
Field(res, 1) = aliases;
|
||||
Field(res, 2) = entry->h_addrtype == PF_UNIX ? Val_int(0) : Val_int(1);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -33,7 +33,7 @@ static value alloc_proto_entry(struct protoent *entry)
|
|||
Begin_roots2 (name, aliases);
|
||||
name = copy_string(entry->p_name);
|
||||
aliases = copy_string_array(entry->p_aliases);
|
||||
res = alloc_tuple(3);
|
||||
res = alloc_small(3, 0);
|
||||
Field(res,0) = name;
|
||||
Field(res,1) = aliases;
|
||||
Field(res,2) = Val_int(entry->p_proto);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -30,7 +30,7 @@ static value alloc_passwd_entry(struct passwd *entry)
|
|||
gecos = copy_string(entry->pw_gecos);
|
||||
dir = copy_string(entry->pw_dir);
|
||||
shell = copy_string(entry->pw_shell);
|
||||
res = alloc_tuple(7);
|
||||
res = alloc_small(7, 0);
|
||||
Field(res,0) = name;
|
||||
Field(res,1) = passwd;
|
||||
Field(res,2) = Val_int(entry->pw_uid);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -38,7 +38,7 @@ static value alloc_service_entry(struct servent *entry)
|
|||
name = copy_string(entry->s_name);
|
||||
aliases = copy_string_array(entry->s_aliases);
|
||||
proto = copy_string(entry->s_proto);
|
||||
res = alloc_tuple(4);
|
||||
res = alloc_small(4, 0);
|
||||
Field(res,0) = name;
|
||||
Field(res,1) = aliases;
|
||||
Field(res,2) = Val_int(ntohs(entry->s_port));
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -20,7 +20,7 @@
|
|||
static value alloc_tm(struct tm *tm)
|
||||
{
|
||||
value res;
|
||||
res = alloc_tuple(9);
|
||||
res = alloc_small(9, 0);
|
||||
Field(res,0) = Val_int(tm->tm_sec);
|
||||
Field(res,1) = Val_int(tm->tm_min);
|
||||
Field(res,2) = Val_int(tm->tm_hour);
|
||||
|
@ -69,7 +69,7 @@ value unix_mktime(value t) /* ML */
|
|||
clock = mktime(&tm);
|
||||
tmval = alloc_tm(&tm);
|
||||
clkval = copy_double((double) clock);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = clkval;
|
||||
Field(res, 1) = tmval;
|
||||
End_roots ();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -28,7 +28,7 @@
|
|||
|
||||
static value unix_convert_itimer(struct itimerval *tp)
|
||||
{
|
||||
value res = alloc(Double_wosize * 2, Double_array_tag);
|
||||
value res = alloc_small(Double_wosize * 2, Double_array_tag);
|
||||
Store_double_field(res, 0, Get_timeval(tp->it_interval));
|
||||
Store_double_field(res, 1, Get_timeval(tp->it_value));
|
||||
return res;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -20,7 +20,7 @@ value unix_pipe(void) /* ML */
|
|||
int fd[2];
|
||||
value res;
|
||||
if (pipe(fd) == -1) uerror("pipe", Nothing);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(fd[0]);
|
||||
Field(res, 1) = Val_int(fd[1]);
|
||||
return res;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -58,7 +58,7 @@ static value fdset_to_fdlist(file_descr_set *fdset)
|
|||
Begin_root(res);
|
||||
for (i = FD_SETSIZE - 1; i >= 0; i--) {
|
||||
if (FD_ISSET(i, fdset)) {
|
||||
value newres = alloc(2, 0);
|
||||
value newres = alloc_small(2, 0);
|
||||
Field(newres, 0) = Val_int(i);
|
||||
Field(newres, 1) = res;
|
||||
res = newres;
|
||||
|
@ -97,7 +97,7 @@ value unix_select(value readfds, value writefds, value exceptfds, value timeout)
|
|||
read_list = fdset_to_fdlist(&read);
|
||||
write_list = fdset_to_fdlist(&write);
|
||||
except_list = fdset_to_fdlist(&except);
|
||||
res = alloc_tuple(3);
|
||||
res = alloc_small(3, 0);
|
||||
Field(res, 0) = read_list;
|
||||
Field(res, 1) = write_list;
|
||||
Field(res, 2) = except_list;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -64,7 +64,7 @@ value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) /
|
|||
if (ret == -1) uerror("recvfrom", Nothing);
|
||||
bcopy(iobuf, &Byte(buff, Long_val(ofs)), ret);
|
||||
adr = alloc_sockaddr();
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(ret);
|
||||
Field(res, 1) = adr;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1998 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -38,7 +38,7 @@ static value encode_sigset(sigset_t * set)
|
|||
Begin_root(res)
|
||||
for (i = 1; i < NSIG; i++)
|
||||
if (sigismember(set, i)) {
|
||||
value newcons = alloc(2, 0);
|
||||
value newcons = alloc_small(2, 0);
|
||||
Field(newcons, 0) = Val_int(i);
|
||||
Field(newcons, 1) = res;
|
||||
res = newcons;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -82,7 +82,7 @@ value alloc_sockaddr(void)
|
|||
case AF_UNIX:
|
||||
{ value n = copy_string(sock_addr.s_unix.sun_path);
|
||||
Begin_root (n);
|
||||
res = alloc(1, 0);
|
||||
res = alloc_small(1, 0);
|
||||
Field(res,0) = n;
|
||||
End_roots();
|
||||
break;
|
||||
|
@ -91,7 +91,7 @@ value alloc_sockaddr(void)
|
|||
case AF_INET:
|
||||
{ value a = alloc_inet_addr(sock_addr.s_inet.sin_addr.s_addr);
|
||||
Begin_root (a);
|
||||
res = alloc(2, 1);
|
||||
res = alloc_small(2, 1);
|
||||
Field(res,0) = a;
|
||||
Field(res,1) = Val_int(ntohs(sock_addr.s_inet.sin_port));
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -29,7 +29,7 @@ value unix_socketpair(value domain, value type, value proto) /* ML */
|
|||
socket_type_table[Int_val(type)],
|
||||
Int_val(proto), sv) == -1)
|
||||
uerror("socketpair", Nothing);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res,0) = Val_int(sv[0]);
|
||||
Field(res,1) = Val_int(sv[1]);
|
||||
return res;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -45,7 +45,7 @@ static value stat_aux(struct stat *buf)
|
|||
atime = copy_double((double) buf->st_atime);
|
||||
mtime = copy_double((double) buf->st_mtime);
|
||||
ctime = copy_double((double) buf->st_ctime);
|
||||
v = alloc_tuple(12);
|
||||
v = alloc_small(12, 0);
|
||||
Field (v, 0) = Val_int (buf->st_dev);
|
||||
Field (v, 1) = Val_int (buf->st_ino);
|
||||
Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -33,7 +33,7 @@ value unix_times(void) /* ML */
|
|||
struct tms buffer;
|
||||
|
||||
times(&buffer);
|
||||
res = alloc(4 * Double_wosize, Double_array_tag);
|
||||
res = alloc_small(4 * Double_wosize, Double_array_tag);
|
||||
Store_double_field(res, 0, (double) buffer.tms_utime / CLK_TCK);
|
||||
Store_double_field(res, 1, (double) buffer.tms_stime / CLK_TCK);
|
||||
Store_double_field(res, 2, (double) buffer.tms_cutime / CLK_TCK);
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -254,7 +254,7 @@ void unix_error(int errcode, char *cmdname, value cmdarg)
|
|||
errconstr =
|
||||
cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
|
||||
if (errconstr == Val_int(-1)) {
|
||||
err = alloc(1, 0);
|
||||
err = alloc_small(1, 0);
|
||||
Field(err, 0) = Val_int(errcode);
|
||||
} else {
|
||||
err = errconstr;
|
||||
|
@ -264,7 +264,7 @@ void unix_error(int errcode, char *cmdname, value cmdarg)
|
|||
if (unix_error_exn == NULL)
|
||||
invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
|
||||
}
|
||||
res = alloc(4, 0);
|
||||
res = alloc_small(4, 0);
|
||||
Field(res, 0) = *unix_error_exn;
|
||||
Field(res, 1) = err;
|
||||
Field(res, 2) = name;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -39,19 +39,19 @@ static value alloc_process_status(int pid, int status)
|
|||
value st, res;
|
||||
|
||||
if (WIFEXITED(status)) {
|
||||
st = alloc(1, TAG_WEXITED);
|
||||
st = alloc_small(1, TAG_WEXITED);
|
||||
Field(st, 0) = Val_int(WEXITSTATUS(status));
|
||||
}
|
||||
else if (WIFSTOPPED(status)) {
|
||||
st = alloc(1, TAG_WSTOPPED);
|
||||
st = alloc_small(1, TAG_WSTOPPED);
|
||||
Field(st, 0) = Val_int(WSTOPSIG(status));
|
||||
}
|
||||
else {
|
||||
st = alloc(1, TAG_WSIGNALED);
|
||||
st = alloc_small(1, TAG_WSIGNALED);
|
||||
Field(st, 0) = Val_int(WTERMSIG(status));
|
||||
}
|
||||
Begin_root (st);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(pid);
|
||||
Field(res, 1) = st;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -39,7 +39,7 @@ value unix_accept(sock) /* ML */
|
|||
Begin_roots2 (fd, adr)
|
||||
fd = win_alloc_handle((HANDLE) snew);
|
||||
adr = alloc_sockaddr();
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = fd;
|
||||
Field(res, 1) = adr;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -35,7 +35,7 @@ value unix_pipe(value unit) /* ML */
|
|||
Begin_roots2(readfd, writefd)
|
||||
readfd = win_alloc_handle(readh);
|
||||
writefd = win_alloc_handle(writeh);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = readfd;
|
||||
Field(res, 1) = writefd;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -34,7 +34,7 @@ static value fdset_to_fdlist(value fdlist, fd_set *fdset)
|
|||
for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) {
|
||||
value s = Field(fdlist, 0);
|
||||
if (FD_ISSET((SOCKET) Handle_val(s), fdset)) {
|
||||
value newres = alloc(2, 0);
|
||||
value newres = alloc_small(2, 0);
|
||||
Field(newres, 0) = s;
|
||||
Field(newres, 1) = res;
|
||||
res = newres;
|
||||
|
@ -74,7 +74,7 @@ value unix_select(value readfds, value writefds, value exceptfds, value timeout)
|
|||
read_list = fdset_to_fdlist(readfds, &read);
|
||||
write_list = fdset_to_fdlist(writefds, &write);
|
||||
except_list = fdset_to_fdlist(exceptfds, &except);
|
||||
res = alloc_tuple(3);
|
||||
res = alloc_small(3, 0);
|
||||
Field(res, 0) = read_list;
|
||||
Field(res, 1) = write_list;
|
||||
Field(res, 2) = except_list;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -61,7 +61,7 @@ value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) /
|
|||
if (ret == -1) unix_error(WSAGetLastError(), "recvfrom", Nothing);
|
||||
bcopy(iobuf, &Byte(buff, Long_val(ofs)), ret);
|
||||
adr = alloc_sockaddr();
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_int(ret);
|
||||
Field(res, 1) = adr;
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -29,7 +29,7 @@ value win_system(cmd) /* ML */
|
|||
ret = system(String_val(cmd));;
|
||||
leave_blocking_section();
|
||||
if (ret == -1) uerror("system", Nothing);
|
||||
st = alloc(1, 0); /* Tag 0: Exited */
|
||||
st = alloc_small(1, 0); /* Tag 0: Exited */
|
||||
Field(st, 0) = Val_int(ret);
|
||||
return st;
|
||||
}
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -25,7 +25,7 @@
|
|||
|
||||
value win_alloc_handle(HANDLE h)
|
||||
{
|
||||
value res = alloc(sizeof(HANDLE) / sizeof(value), Abstract_tag);
|
||||
value res = alloc_small(sizeof(HANDLE) / sizeof(value), Abstract_tag);
|
||||
Handle_val(res) = h;
|
||||
return res;
|
||||
}
|
||||
|
@ -100,7 +100,7 @@ void unix_error(int errcode, char *cmdname, value cmdarg)
|
|||
errconstr =
|
||||
cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1);
|
||||
if (errconstr == Val_int(-1)) {
|
||||
err = alloc(1, 0);
|
||||
err = alloc_small(1, 0);
|
||||
Field(err, 0) = Val_int(errcode);
|
||||
} else {
|
||||
err = errconstr;
|
||||
|
@ -110,7 +110,7 @@ void unix_error(int errcode, char *cmdname, value cmdarg)
|
|||
if (unix_error_exn == NULL)
|
||||
invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma");
|
||||
}
|
||||
res = alloc(4, 0);
|
||||
res = alloc_small(4, 0);
|
||||
Field(res, 0) = *unix_error_exn;
|
||||
Field(res, 1) = err;
|
||||
Field(res, 2) = name;
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -34,7 +34,7 @@ value win_findfirst(name) /* ML */
|
|||
uerror("opendir", Nothing);
|
||||
}
|
||||
valname = copy_string(fileinfo.name);
|
||||
v = alloc_tuple(2);
|
||||
v = alloc_small(2, 0);
|
||||
Field(v,0) = valname;
|
||||
Field(v,1) = Val_int(h);
|
||||
End_roots();
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
/* Pascal Cuoq and Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
||||
/* */
|
||||
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
||||
/* Automatique. Distributed only by permission. */
|
||||
/* en Automatique. Distributed only by permission. */
|
||||
/* */
|
||||
/***********************************************************************/
|
||||
|
||||
|
@ -25,7 +25,7 @@ static value alloc_process_status(HANDLE pid, int status)
|
|||
st = alloc(1, 0);
|
||||
Field(st, 0) = Val_int(status);
|
||||
Begin_root (st);
|
||||
res = alloc_tuple(2);
|
||||
res = alloc_small(2, 0);
|
||||
Field(res, 0) = Val_long((long) pid);
|
||||
Field(res, 1) = st;
|
||||
End_roots();
|
||||
|
|
|
@ -11,7 +11,7 @@
|
|||
|
||||
(* $Id$ *)
|
||||
|
||||
let version = "2.00+3"
|
||||
let version = "2.00+4"
|
||||
|
||||
let standard_library =
|
||||
try
|
||||
|
|
Loading…
Reference in New Issue