2016-02-18 07:11:59 -08:00
|
|
|
/**************************************************************************/
|
|
|
|
/* */
|
|
|
|
/* OCaml */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
|
/* en Automatique. */
|
|
|
|
/* */
|
|
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
|
|
/* special exception on linking described in the file LICENSE. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
1995-07-11 11:09:15 -07:00
|
|
|
/* Operations on objects */
|
|
|
|
|
2003-06-23 05:46:13 -07:00
|
|
|
#include <string.h>
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/alloc.h"
|
|
|
|
#include "caml/fail.h"
|
|
|
|
#include "caml/gc.h"
|
|
|
|
#include "caml/interp.h"
|
|
|
|
#include "caml/major_gc.h"
|
|
|
|
#include "caml/memory.h"
|
|
|
|
#include "caml/minor_gc.h"
|
|
|
|
#include "caml/misc.h"
|
|
|
|
#include "caml/mlvalues.h"
|
|
|
|
#include "caml/prims.h"
|
2016-08-02 09:52:07 -07:00
|
|
|
#include "caml/spacetime.h"
|
1995-07-11 11:09:15 -07:00
|
|
|
|
2014-12-12 07:18:04 -08:00
|
|
|
/* [size] is a value encoding a number of bytes */
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_static_alloc(value size)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
2003-12-31 06:20:40 -08:00
|
|
|
return (value) caml_stat_alloc((asize_t) Long_val(size));
|
1995-07-11 11:09:15 -07:00
|
|
|
}
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_static_free(value blk)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
2003-12-31 06:20:40 -08:00
|
|
|
caml_stat_free((void *) blk);
|
1995-07-11 11:09:15 -07:00
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_static_resize(value blk, value new_size)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
2003-12-31 06:20:40 -08:00
|
|
|
return (value) caml_stat_resize((char *) blk, (asize_t) Long_val(new_size));
|
1995-07-11 11:09:15 -07:00
|
|
|
}
|
2016-01-14 11:20:09 -08:00
|
|
|
|
2016-01-15 21:50:17 -08:00
|
|
|
/* unused since GPR#427 */
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_obj_is_block(value arg)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
|
|
|
return Val_bool(Is_block(arg));
|
|
|
|
}
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_obj_tag(value arg)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
2003-10-16 16:22:23 -07:00
|
|
|
if (Is_long (arg)){
|
2008-01-29 05:11:15 -08:00
|
|
|
return Val_int (1000); /* int_tag */
|
|
|
|
}else if ((long) arg & (sizeof (value) - 1)){
|
|
|
|
return Val_int (1002); /* unaligned_tag */
|
2008-01-03 01:37:10 -08:00
|
|
|
}else if (Is_in_value_area (arg)){
|
2003-10-16 16:22:23 -07:00
|
|
|
return Val_int(Tag_val(arg));
|
|
|
|
}else{
|
2008-01-29 05:11:15 -08:00
|
|
|
return Val_int (1001); /* out_of_heap_tag */
|
2003-10-16 16:22:23 -07:00
|
|
|
}
|
1995-07-11 11:09:15 -07:00
|
|
|
}
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_obj_set_tag (value arg, value new_tag)
|
2002-01-20 09:39:10 -08:00
|
|
|
{
|
|
|
|
Tag_val (arg) = Int_val (new_tag);
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2019-02-12 03:12:59 -08:00
|
|
|
CAMLprim value caml_obj_make_forward (value blk, value fwd)
|
|
|
|
{
|
|
|
|
caml_modify(&Field(blk, 0), fwd);
|
|
|
|
Tag_val (blk) = Forward_tag;
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2014-12-12 07:18:04 -08:00
|
|
|
/* [size] is a value encoding a number of blocks */
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_obj_block(value tag, value size)
|
1995-07-11 11:09:15 -07:00
|
|
|
{
|
|
|
|
value res;
|
|
|
|
mlsize_t sz, i;
|
|
|
|
tag_t tg;
|
|
|
|
|
|
|
|
sz = Long_val(size);
|
|
|
|
tg = Long_val(tag);
|
|
|
|
if (sz == 0) return Atom(tg);
|
2003-12-29 14:15:02 -08:00
|
|
|
res = caml_alloc(sz, tg);
|
1995-07-11 11:09:15 -07:00
|
|
|
for (i = 0; i < sz; i++)
|
|
|
|
Field(res, i) = Val_long(0);
|
|
|
|
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|
2016-07-29 07:07:10 -07:00
|
|
|
/* Spacetime profiling assumes that this function is only called from OCaml. */
|
2019-02-12 03:12:59 -08:00
|
|
|
CAMLprim value caml_obj_with_tag(value new_tag_v, value arg)
|
1998-06-24 12:22:26 -07:00
|
|
|
{
|
2019-02-12 03:12:59 -08:00
|
|
|
CAMLparam2 (new_tag_v, arg);
|
1999-11-29 11:03:05 -08:00
|
|
|
CAMLlocal1 (res);
|
1998-06-24 12:22:26 -07:00
|
|
|
mlsize_t sz, i;
|
|
|
|
tag_t tg;
|
|
|
|
|
|
|
|
sz = Wosize_val(arg);
|
2019-02-12 03:12:59 -08:00
|
|
|
tg = (tag_t)Long_val(new_tag_v);
|
2005-01-04 08:29:33 -08:00
|
|
|
if (sz == 0) CAMLreturn (arg);
|
2003-06-23 05:46:13 -07:00
|
|
|
if (tg >= No_scan_tag) {
|
2003-12-29 14:15:02 -08:00
|
|
|
res = caml_alloc(sz, tg);
|
2003-06-23 05:46:13 -07:00
|
|
|
memcpy(Bp_val(res), Bp_val(arg), sz * sizeof(value));
|
|
|
|
} else if (sz <= Max_young_wosize) {
|
2016-07-29 07:07:10 -07:00
|
|
|
uintnat profinfo;
|
|
|
|
Get_my_profinfo_with_cached_backtrace(profinfo, sz);
|
|
|
|
res = caml_alloc_small_with_my_or_given_profinfo(sz, tg, profinfo);
|
2003-06-23 05:46:13 -07:00
|
|
|
for (i = 0; i < sz; i++) Field(res, i) = Field(arg, i);
|
|
|
|
} else {
|
2003-12-31 06:20:40 -08:00
|
|
|
res = caml_alloc_shr(sz, tg);
|
|
|
|
for (i = 0; i < sz; i++) caml_initialize(&Field(res, i), Field(arg, i));
|
2003-06-23 05:46:13 -07:00
|
|
|
}
|
1999-11-29 11:03:05 -08:00
|
|
|
CAMLreturn (res);
|
1998-06-24 12:22:26 -07:00
|
|
|
}
|
1998-08-27 05:11:51 -07:00
|
|
|
|
2019-02-12 03:12:59 -08:00
|
|
|
/* Spacetime profiling assumes that this function is only called from OCaml. */
|
|
|
|
CAMLprim value caml_obj_dup(value arg)
|
|
|
|
{
|
|
|
|
return caml_obj_with_tag(Val_long(Tag_val(arg)), arg);
|
|
|
|
}
|
|
|
|
|
1998-08-27 05:11:51 -07:00
|
|
|
/* Shorten the given block to the given size and return void.
|
|
|
|
Raise Invalid_argument if the given size is less than or equal
|
|
|
|
to 0 or greater than the current size.
|
|
|
|
|
|
|
|
algorithm:
|
2015-11-20 08:54:26 -08:00
|
|
|
Change the length field of the header. Make up a black object
|
1998-08-27 05:11:51 -07:00
|
|
|
with the leftover part of the object: this is needed in the major
|
2015-11-20 08:54:26 -08:00
|
|
|
heap and harmless in the minor heap. The object cannot be white
|
|
|
|
because there may still be references to it in the ref table. By
|
|
|
|
using a black object we ensure that the ref table will be emptied
|
|
|
|
before the block is reallocated (since there must be a minor
|
|
|
|
collection within each major cycle).
|
2014-12-12 07:18:04 -08:00
|
|
|
|
2017-08-31 06:25:15 -07:00
|
|
|
[newsize] is a value encoding a number of fields (words, except
|
|
|
|
for float arrays on 32-bit architectures).
|
1998-08-27 05:11:51 -07:00
|
|
|
*/
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_obj_truncate (value v, value newsize)
|
1998-08-27 05:11:51 -07:00
|
|
|
{
|
|
|
|
mlsize_t new_wosize = Long_val (newsize);
|
|
|
|
header_t hd = Hd_val (v);
|
|
|
|
tag_t tag = Tag_hd (hd);
|
|
|
|
color_t color = Color_hd (hd);
|
|
|
|
mlsize_t wosize = Wosize_hd (hd);
|
2000-03-30 09:29:09 -08:00
|
|
|
mlsize_t i;
|
1998-08-27 05:11:51 -07:00
|
|
|
|
2000-07-10 04:28:38 -07:00
|
|
|
if (tag == Double_array_tag) new_wosize *= Double_wosize; /* PR#156 */
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
if (new_wosize <= 0 || new_wosize > wosize){
|
|
|
|
caml_invalid_argument ("Obj.truncate");
|
|
|
|
}
|
1998-08-27 05:11:51 -07:00
|
|
|
if (new_wosize == wosize) return Val_unit;
|
2000-03-30 09:29:09 -08:00
|
|
|
/* PR#61: since we're about to lose our references to the elements
|
|
|
|
beyond new_wosize in v, erase them explicitly so that the GC
|
|
|
|
can darken them as appropriate. */
|
2000-03-30 09:33:43 -08:00
|
|
|
if (tag < No_scan_tag) {
|
2000-04-03 01:34:22 -07:00
|
|
|
for (i = new_wosize; i < wosize; i++){
|
2003-12-31 06:20:40 -08:00
|
|
|
caml_modify(&Field(v, i), Val_unit);
|
2000-04-03 01:34:22 -07:00
|
|
|
#ifdef DEBUG
|
|
|
|
Field (v, i) = Debug_free_truncate;
|
|
|
|
#endif
|
|
|
|
}
|
2000-03-30 09:33:43 -08:00
|
|
|
}
|
2002-06-05 05:10:40 -07:00
|
|
|
/* We must use an odd tag for the header of the leftovers so it does not
|
|
|
|
look like a pointer because there may be some references to it in
|
|
|
|
ref_table. */
|
1998-08-27 05:11:51 -07:00
|
|
|
Field (v, new_wosize) =
|
2015-11-20 08:54:26 -08:00
|
|
|
Make_header (Wosize_whsize (wosize-new_wosize), Abstract_tag, Caml_black);
|
2016-07-29 07:07:10 -07:00
|
|
|
Hd_val (v) =
|
|
|
|
Make_header_with_profinfo (new_wosize, tag, color, Profinfo_val(v));
|
1998-08-27 05:11:51 -07:00
|
|
|
return Val_unit;
|
|
|
|
}
|
2002-09-18 06:59:27 -07:00
|
|
|
|
2010-01-20 08:26:46 -08:00
|
|
|
CAMLprim value caml_obj_add_offset (value v, value offset)
|
|
|
|
{
|
2010-01-25 03:55:30 -08:00
|
|
|
return v + (unsigned long) Int32_val (offset);
|
2010-01-20 08:26:46 -08:00
|
|
|
}
|
2002-09-18 06:59:27 -07:00
|
|
|
|
2003-10-16 16:22:23 -07:00
|
|
|
/* The following functions are used in stdlib/lazy.ml.
|
2012-02-10 08:15:24 -08:00
|
|
|
They are not written in OCaml because they must be atomic with respect
|
2002-09-18 06:59:27 -07:00
|
|
|
to the GC.
|
|
|
|
*/
|
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_lazy_follow_forward (value v)
|
2002-09-18 06:59:27 -07:00
|
|
|
{
|
2008-01-03 01:37:10 -08:00
|
|
|
if (Is_block (v) && Is_in_value_area(v)
|
2003-10-16 16:22:23 -07:00
|
|
|
&& Tag_val (v) == Forward_tag){
|
2002-09-18 06:59:27 -07:00
|
|
|
return Forward_val (v);
|
|
|
|
}else{
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
}
|
2003-10-16 16:22:23 -07:00
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
CAMLprim value caml_lazy_make_forward (value v)
|
2003-10-16 16:22:23 -07:00
|
|
|
{
|
|
|
|
CAMLparam1 (v);
|
|
|
|
CAMLlocal1 (res);
|
|
|
|
|
2003-12-29 14:15:02 -08:00
|
|
|
res = caml_alloc_small (1, Forward_tag);
|
2011-12-30 08:29:14 -08:00
|
|
|
Field (res, 0) = v;
|
2003-10-16 16:22:23 -07:00
|
|
|
CAMLreturn (res);
|
|
|
|
}
|
2004-05-26 04:10:52 -07:00
|
|
|
|
2008-01-25 00:39:49 -08:00
|
|
|
/* For mlvalues.h and camlinternalOO.ml
|
2004-05-26 04:10:52 -07:00
|
|
|
See also GETPUBMET in interp.c
|
|
|
|
*/
|
|
|
|
|
|
|
|
CAMLprim value caml_get_public_method (value obj, value tag)
|
|
|
|
{
|
|
|
|
value meths = Field (obj, 0);
|
|
|
|
int li = 3, hi = Field(meths,0), mi;
|
|
|
|
while (li < hi) {
|
|
|
|
mi = ((li+hi) >> 1) | 1;
|
|
|
|
if (tag < Field(meths,mi)) hi = mi-2;
|
|
|
|
else li = mi;
|
|
|
|
}
|
2008-01-25 00:39:49 -08:00
|
|
|
/* return 0 if tag is not there */
|
|
|
|
return (tag == Field(meths,li) ? Field (meths, li-1) : 0);
|
2004-05-26 04:10:52 -07:00
|
|
|
}
|
|
|
|
|
2004-06-04 06:05:18 -07:00
|
|
|
/* these two functions might be useful to an hypothetical JIT */
|
|
|
|
|
|
|
|
#ifdef CAML_JIT
|
2004-06-04 18:15:53 -07:00
|
|
|
#ifdef NATIVE_CODE
|
|
|
|
#define MARK 1
|
|
|
|
#else
|
|
|
|
#define MARK 0
|
|
|
|
#endif
|
2004-05-26 04:10:52 -07:00
|
|
|
value caml_cache_public_method (value meths, value tag, value *cache)
|
|
|
|
{
|
|
|
|
int li = 3, hi = Field(meths,0), mi;
|
|
|
|
while (li < hi) {
|
|
|
|
mi = ((li+hi) >> 1) | 1;
|
|
|
|
if (tag < Field(meths,mi)) hi = mi-2;
|
|
|
|
else li = mi;
|
|
|
|
}
|
2004-06-04 18:15:53 -07:00
|
|
|
*cache = (li-3)*sizeof(value) + MARK;
|
2004-05-26 04:10:52 -07:00
|
|
|
return Field (meths, li-1);
|
|
|
|
}
|
|
|
|
|
|
|
|
value caml_cache_public_method2 (value *meths, value tag, value *cache)
|
|
|
|
{
|
|
|
|
value ofs = *cache & meths[1];
|
2004-06-04 18:15:53 -07:00
|
|
|
if (*(value*)(((char*)(meths+3)) + ofs - MARK) == tag)
|
|
|
|
return *(value*)(((char*)(meths+2)) + ofs - MARK);
|
2004-05-26 04:10:52 -07:00
|
|
|
{
|
|
|
|
int li = 3, hi = meths[0], mi;
|
|
|
|
while (li < hi) {
|
|
|
|
mi = ((li+hi) >> 1) | 1;
|
|
|
|
if (tag < meths[mi]) hi = mi-2;
|
|
|
|
else li = mi;
|
|
|
|
}
|
2004-06-04 18:15:53 -07:00
|
|
|
*cache = (li-3)*sizeof(value) + MARK;
|
2004-05-26 04:10:52 -07:00
|
|
|
return meths[li-1];
|
|
|
|
}
|
|
|
|
}
|
2004-06-04 06:05:18 -07:00
|
|
|
#endif /*CAML_JIT*/
|
2013-10-23 07:28:31 -07:00
|
|
|
|
|
|
|
static value oo_last_id = Val_int(0);
|
|
|
|
|
|
|
|
CAMLprim value caml_set_oo_id (value obj) {
|
|
|
|
Field(obj, 1) = oo_last_id;
|
|
|
|
oo_last_id += 2;
|
|
|
|
return obj;
|
|
|
|
}
|
2014-05-02 05:47:02 -07:00
|
|
|
|
2015-10-28 03:56:49 -07:00
|
|
|
CAMLprim value caml_fresh_oo_id (value v) {
|
|
|
|
v = oo_last_id;
|
|
|
|
oo_last_id += 2;
|
|
|
|
return v;
|
|
|
|
}
|
|
|
|
|
2014-05-02 05:47:02 -07:00
|
|
|
CAMLprim value caml_int_as_pointer (value n) {
|
|
|
|
return n - 1;
|
|
|
|
}
|
2016-04-25 09:27:38 -07:00
|
|
|
|
|
|
|
/* Compute how many words in the heap are occupied by blocks accessible
|
|
|
|
from a given value */
|
|
|
|
|
|
|
|
#define ENTRIES_PER_QUEUE_CHUNK 4096
|
|
|
|
struct queue_chunk {
|
|
|
|
struct queue_chunk *next;
|
|
|
|
value entries[ENTRIES_PER_QUEUE_CHUNK];
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
|
|
CAMLprim value caml_obj_reachable_words(value v)
|
|
|
|
{
|
|
|
|
static struct queue_chunk first_chunk;
|
|
|
|
struct queue_chunk *read_chunk, *write_chunk;
|
|
|
|
int write_pos, read_pos, i;
|
|
|
|
|
|
|
|
intnat size = 0;
|
|
|
|
header_t hd;
|
|
|
|
mlsize_t sz;
|
|
|
|
|
|
|
|
if (Is_long(v) || !Is_in_heap_or_young(v)) return Val_int(0);
|
|
|
|
if (Tag_hd(Hd_val(v)) == Infix_tag) v -= Infix_offset_hd(Hd_val(v));
|
|
|
|
hd = Hd_val(v);
|
|
|
|
sz = Wosize_hd(hd);
|
|
|
|
|
|
|
|
read_chunk = write_chunk = &first_chunk;
|
|
|
|
read_pos = 0;
|
|
|
|
write_pos = 1;
|
|
|
|
write_chunk->entries[0] = v | Colornum_hd(hd);
|
|
|
|
Hd_val(v) = Bluehd_hd(hd);
|
|
|
|
|
|
|
|
/* We maintain a queue of "interesting" blocks that have been seen.
|
|
|
|
An interesting block is a block in the heap which does not
|
|
|
|
represent an infix pointer. Infix pointers are normalized to the
|
|
|
|
beginning of their block. Blocks in the static data area are excluded.
|
|
|
|
|
|
|
|
The function maintains a queue of block pointers. Concretely,
|
|
|
|
the queue is stored as a linked list of chunks, each chunk
|
|
|
|
holding a number of pointers to interesting blocks. Initially,
|
|
|
|
it contains only the "root" value. The first chunk of the queue
|
|
|
|
is allocated statically. More chunks can be allocated as needed
|
|
|
|
and released before this function exits.
|
|
|
|
|
|
|
|
When a block is inserted in the queue, it is marked as blue.
|
|
|
|
This mark is used to avoid a second visit of the same block.
|
|
|
|
The real color is stored in the last 2 bits of the pointer in the
|
|
|
|
queue. (Same technique as in extern.c.)
|
|
|
|
|
|
|
|
Note: we make the assumption that there is no pointer
|
|
|
|
from the static data area to the heap.
|
|
|
|
*/
|
|
|
|
|
|
|
|
/* First pass: mark accessible blocks and compute their total size */
|
|
|
|
while (read_pos != write_pos || read_chunk != write_chunk) {
|
|
|
|
/* Pop the next element from the queue */
|
|
|
|
if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
|
|
|
|
read_pos = 0;
|
|
|
|
read_chunk = read_chunk->next;
|
|
|
|
}
|
|
|
|
v = read_chunk->entries[read_pos++] & ~3;
|
|
|
|
|
|
|
|
hd = Hd_val(v);
|
|
|
|
sz = Wosize_hd(hd);
|
|
|
|
|
|
|
|
size += Whsize_wosize(sz);
|
|
|
|
|
|
|
|
if (Tag_hd(hd) < No_scan_tag) {
|
|
|
|
/* Push the interesting fields on the queue */
|
|
|
|
for (i = 0; i < sz; i++) {
|
|
|
|
value v2 = Field(v, i);
|
|
|
|
if (Is_block(v2) && Is_in_heap_or_young(v2)) {
|
2016-08-01 07:06:59 -07:00
|
|
|
if (Tag_hd(Hd_val(v2)) == Infix_tag){
|
|
|
|
v2 -= Infix_offset_hd(Hd_val(v2));
|
|
|
|
}
|
2016-04-25 09:27:38 -07:00
|
|
|
hd = Hd_val(v2);
|
|
|
|
if (Color_hd(hd) != Caml_blue) {
|
|
|
|
if (write_pos == ENTRIES_PER_QUEUE_CHUNK) {
|
2016-08-01 07:06:59 -07:00
|
|
|
struct queue_chunk *new_chunk =
|
|
|
|
malloc(sizeof(struct queue_chunk));
|
2016-04-25 09:27:38 -07:00
|
|
|
if (new_chunk == NULL) {
|
|
|
|
size = (-1);
|
|
|
|
goto release;
|
|
|
|
}
|
|
|
|
write_chunk->next = new_chunk;
|
|
|
|
write_pos = 0;
|
|
|
|
write_chunk = new_chunk;
|
|
|
|
}
|
|
|
|
write_chunk->entries[write_pos++] = v2 | Colornum_hd(hd);
|
|
|
|
Hd_val(v2) = Bluehd_hd(hd);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Second pass: restore colors and free extra queue chunks */
|
|
|
|
release:
|
|
|
|
read_pos = 0;
|
|
|
|
read_chunk = &first_chunk;
|
|
|
|
while (read_pos != write_pos || read_chunk != write_chunk) {
|
|
|
|
color_t colornum;
|
|
|
|
if (read_pos == ENTRIES_PER_QUEUE_CHUNK) {
|
|
|
|
struct queue_chunk *prev = read_chunk;
|
|
|
|
read_pos = 0;
|
|
|
|
read_chunk = read_chunk->next;
|
|
|
|
if (prev != &first_chunk) free(prev);
|
|
|
|
}
|
|
|
|
v = read_chunk->entries[read_pos++];
|
|
|
|
colornum = v & 3;
|
|
|
|
v &= ~3;
|
|
|
|
Hd_val(v) = Coloredhd_hd(Hd_val(v), colornum);
|
|
|
|
}
|
|
|
|
if (read_chunk != &first_chunk) free(read_chunk);
|
|
|
|
|
|
|
|
if (size < 0)
|
|
|
|
caml_raise_out_of_memory();
|
|
|
|
return Val_int(size);
|
|
|
|
}
|