Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

nouvelles fonctions alloc/alloc_small 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2134 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 1998-10-26 19:19:32 +00:00
parent 59cb8750d2
commit 3be947947e
51 changed files with 314 additions and 174 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
asmrun/fail.c
View File

@ -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 ();

4
asmrun/signals.c
View File

@ -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)

30
byterun/alloc.c
View File

@ -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 */

3
byterun/alloc.h
View File

@ -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);

13
byterun/array.c
View File

@ -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)));
}

6
byterun/fail.c
View File

@ -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 ();

6
byterun/gc_ctrl.c
View File

@ -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 */

8
byterun/intern.c
View File

@ -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);

3
byterun/memory.c
View File

@ -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
View File

@ -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.

4
byterun/meta.c
View File

@ -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;
}

20
byterun/mlvalues.h
View File

@ -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

4
byterun/signals.c
View File

@ -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)

4
byterun/sys.c
View File

@ -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 ();

2
byterun/terminfo.c
View File

@ -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;
}

2
byterun/weak.c
View File

@ -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;
}

4
otherlibs/db/dbstubs.c
View File

@ -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;

4
otherlibs/graph/draw.c
View File

@ -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;

22
otherlibs/graph/dump_img.c
View File

@ -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);
}

4
otherlibs/graph/events.c
View File

@ -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);

4
otherlibs/graph/text.c
View File

@ -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;

8
otherlibs/num/nat_stubs.c
View File

@ -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)

6
otherlibs/systhreads/posix.c
View File

@ -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;

14
otherlibs/threads/scheduler.c
View File

@ -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();

4
otherlibs/unix/accept.c
View File

@ -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();

4
otherlibs/unix/getgr.c
View File

@ -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);

6
otherlibs/unix/gethost.c
View File

@ -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);

4
otherlibs/unix/getproto.c
View File

@ -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);

4
otherlibs/unix/getpw.c
View File

@ -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);

4
otherlibs/unix/getserv.c
View File

@ -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));

6
otherlibs/unix/gmtime.c
View File

@ -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 ();

4
otherlibs/unix/itimer.c
View File

@ -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;

4
otherlibs/unix/pipe.c
View File

@ -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;

6
otherlibs/unix/select.c
View File

@ -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;

4
otherlibs/unix/sendrecv.c
View File

@ -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();

4
otherlibs/unix/signals.c
View File

@ -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;

6
otherlibs/unix/socketaddr.c
View File

@ -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();

4
otherlibs/unix/socketpair.c
View File

@ -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;

4
otherlibs/unix/stat.c
View File

@ -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,

4
otherlibs/unix/times.c
View File

@ -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);

6
otherlibs/unix/unixsupport.c
View File

@ -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;

10
otherlibs/unix/wait.c
View File

@ -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();

4
otherlibs/win32unix/accept.c
View File

@ -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();

4
otherlibs/win32unix/pipe.c
View File

@ -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();

6
otherlibs/win32unix/select.c
View File

@ -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;

4
otherlibs/win32unix/sendrecv.c
View File

@ -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();

4
otherlibs/win32unix/system.c
View File

@ -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;
}

8
otherlibs/win32unix/unixsupport.c
View File

@ -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;

4
otherlibs/win32unix/windir.c
View File

@ -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();

4
otherlibs/win32unix/winwait.c
View File

@ -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();

2
utils/config.mlp
View File

@ -11,7 +11,7 @@
(* $Id$ *)
let version = "2.00+3"
let version = "2.00+4"
let standard_library =
try