1995-08-09 08:06:35 -07:00
|
|
|
/***********************************************************************/
|
|
|
|
/* */
|
|
|
|
/* Caml Special Light */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1995 Institut National de Recherche en Informatique et */
|
|
|
|
/* Automatique. Distributed only by permission. */
|
|
|
|
/* */
|
|
|
|
/***********************************************************************/
|
|
|
|
|
|
|
|
/* $Id$ */
|
|
|
|
|
1995-07-11 11:09:15 -07:00
|
|
|
/* Operations on objects */
|
|
|
|
|
|
|
|
#include "alloc.h"
|
|
|
|
#include "major_gc.h"
|
|
|
|
#include "memory.h"
|
|
|
|
#include "minor_gc.h"
|
|
|
|
#include "misc.h"
|
|
|
|
#include "mlvalues.h"
|
|
|
|
#include "prims.h"
|
|
|
|
|
|
|
|
value static_alloc(size) /* ML */
|
|
|
|
value size;
|
|
|
|
{
|
|
|
|
return (value) stat_alloc((asize_t) Long_val(size));
|
|
|
|
}
|
|
|
|
|
|
|
|
value static_free(blk) /* ML */
|
|
|
|
value blk;
|
|
|
|
{
|
|
|
|
stat_free((char *) blk);
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
|
|
|
value static_resize(blk, new_size) /* ML */
|
|
|
|
value blk, new_size;
|
|
|
|
{
|
|
|
|
return (value) stat_resize((char *) blk, (asize_t) Long_val(new_size));
|
|
|
|
}
|
|
|
|
|
|
|
|
value obj_is_block(arg) /* ML */
|
|
|
|
value arg;
|
|
|
|
{
|
|
|
|
return Val_bool(Is_block(arg));
|
|
|
|
}
|
|
|
|
|
|
|
|
value obj_tag(arg) /* ML */
|
|
|
|
value arg;
|
|
|
|
{
|
|
|
|
return Val_int(Tag_val(arg));
|
|
|
|
}
|
|
|
|
|
|
|
|
value obj_block(tag, size) /* ML */
|
|
|
|
value tag, size;
|
|
|
|
{
|
|
|
|
value res;
|
|
|
|
mlsize_t sz, i;
|
|
|
|
tag_t tg;
|
|
|
|
|
|
|
|
sz = Long_val(size);
|
|
|
|
tg = Long_val(tag);
|
|
|
|
if (sz == 0) return Atom(tg);
|
|
|
|
res = alloc(sz, tg);
|
|
|
|
for (i = 0; i < sz; i++)
|
|
|
|
Field(res, i) = Val_long(0);
|
|
|
|
|
|
|
|
return res;
|
|
|
|
}
|
|
|
|
|