1995-08-09 08:06:35 -07:00
|
|
|
/***********************************************************************/
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Objective Caml */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* */
|
|
|
|
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
|
|
|
/* */
|
1996-04-30 07:53:58 -07:00
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
1995-08-09 08:06:35 -07:00
|
|
|
/* Automatique. Distributed only by permission. */
|
|
|
|
/* */
|
|
|
|
/***********************************************************************/
|
|
|
|
|
|
|
|
/* $Id$ */
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
/* Allocation macros and functions */
|
|
|
|
|
|
|
|
#ifndef _memory_
|
|
|
|
#define _memory_
|
|
|
|
|
|
|
|
|
|
|
|
#include "config.h"
|
|
|
|
#include "gc.h"
|
|
|
|
#include "major_gc.h"
|
|
|
|
#include "minor_gc.h"
|
|
|
|
#include "misc.h"
|
|
|
|
#include "mlvalues.h"
|
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
value alloc_shr (mlsize_t, tag_t);
|
|
|
|
void adjust_gc_speed (mlsize_t, mlsize_t);
|
|
|
|
void modify (value *, value);
|
|
|
|
void initialize (value *, value);
|
|
|
|
value check_urgent_gc (value);
|
1997-11-20 07:30:43 -08:00
|
|
|
void * stat_alloc (asize_t); /* Size in bytes. */
|
|
|
|
void stat_free (void *);
|
|
|
|
void * stat_resize (void *, asize_t); /* Size in bytes. */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
/* void shrink_heap (char *); Only used in compact.c */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1995-12-22 09:49:35 -08:00
|
|
|
#ifdef NATIVE_CODE
|
|
|
|
#define Garbage_collection_function garbage_collection
|
|
|
|
#else
|
|
|
|
#define Garbage_collection_function minor_collection
|
|
|
|
#endif
|
|
|
|
|
1997-05-20 02:20:16 -07:00
|
|
|
#define Alloc_small(result, wosize, tag) { Assert (wosize >= 1); \
|
1995-07-10 02:48:27 -07:00
|
|
|
young_ptr -= Bhsize_wosize (wosize); \
|
1995-12-22 09:49:35 -08:00
|
|
|
if (young_ptr < young_limit){ \
|
1995-05-04 03:15:53 -07:00
|
|
|
Setup_for_gc; \
|
1995-12-22 09:49:35 -08:00
|
|
|
Garbage_collection_function (); \
|
1995-05-04 03:15:53 -07:00
|
|
|
Restore_after_gc; \
|
1995-07-10 02:48:27 -07:00
|
|
|
young_ptr -= Bhsize_wosize (wosize); \
|
1995-05-04 03:15:53 -07:00
|
|
|
} \
|
1995-07-10 02:48:27 -07:00
|
|
|
Hd_hp (young_ptr) = Make_header ((wosize), (tag), Black); \
|
|
|
|
(result) = Val_hp (young_ptr); \
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
|
|
|
/* You must use [Modify] to change a field of an existing shared block,
|
|
|
|
unless you are sure the value being overwritten is not a shared block and
|
|
|
|
the value being written is not a young block. */
|
|
|
|
/* [Modify] never calls the GC. */
|
|
|
|
|
|
|
|
#define Modify(fp, val) { \
|
|
|
|
value _old_ = *(fp); \
|
|
|
|
*(fp) = (val); \
|
|
|
|
if (Is_in_heap (fp)){ \
|
1997-05-13 07:45:38 -07:00
|
|
|
if (gc_phase == Phase_mark) darken (_old_, NULL); \
|
1995-05-04 03:15:53 -07:00
|
|
|
if (Is_block (val) && Is_young (val) \
|
1997-05-19 08:42:21 -07:00
|
|
|
&& ! (Is_block (_old_) && Is_young (_old_))){ \
|
1995-05-04 03:15:53 -07:00
|
|
|
*ref_table_ptr++ = (fp); \
|
|
|
|
if (ref_table_ptr >= ref_table_limit){ \
|
|
|
|
Assert (ref_table_ptr == ref_table_limit); \
|
1997-05-19 08:42:21 -07:00
|
|
|
realloc_ref_table (); \
|
1995-05-04 03:15:53 -07:00
|
|
|
} \
|
|
|
|
} \
|
|
|
|
} \
|
|
|
|
} \
|
|
|
|
|
1997-05-26 10:16:31 -07:00
|
|
|
/*
|
|
|
|
[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.
|
|
|
|
Usage:
|
|
|
|
After initialising your local variables to legal Caml values, but before
|
|
|
|
calling allocation functions, insert [Begin_roots_n(v1, ... vn)], where
|
|
|
|
v1 ... vn are your variables of type [value] that you want to be updated
|
|
|
|
across allocations.
|
|
|
|
At the end, insert [End_roots()].
|
|
|
|
|
|
|
|
Note that [Begin_roots] opens a new block, and [End_roots] closes it.
|
|
|
|
Thus they must occur in matching pairs at the same brace nesting level.
|
|
|
|
|
|
|
|
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];
|
|
|
|
};
|
|
|
|
|
1998-02-06 10:35:29 -08:00
|
|
|
extern struct caml__roots_block *local_roots; /* defined in roots.c */
|
1997-05-26 10:16:31 -07:00
|
|
|
|
|
|
|
#define Begin_root Begin_roots1
|
|
|
|
|
|
|
|
#define Begin_roots1(r0) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = 1; \
|
|
|
|
caml__roots_block.ntables = 1; \
|
|
|
|
caml__roots_block.tables[0] = &(r0);
|
|
|
|
|
|
|
|
#define Begin_roots2(r0, r1) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = 1; \
|
|
|
|
caml__roots_block.ntables = 2; \
|
|
|
|
caml__roots_block.tables[0] = &(r0); \
|
|
|
|
caml__roots_block.tables[1] = &(r1);
|
|
|
|
|
|
|
|
#define Begin_roots3(r0, r1, r2) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = 1; \
|
|
|
|
caml__roots_block.ntables = 3; \
|
|
|
|
caml__roots_block.tables[0] = &(r0); \
|
|
|
|
caml__roots_block.tables[1] = &(r1); \
|
|
|
|
caml__roots_block.tables[2] = &(r2);
|
|
|
|
|
|
|
|
#define Begin_roots4(r0, r1, r2, r3) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = 1; \
|
|
|
|
caml__roots_block.ntables = 4; \
|
|
|
|
caml__roots_block.tables[0] = &(r0); \
|
|
|
|
caml__roots_block.tables[1] = &(r1); \
|
|
|
|
caml__roots_block.tables[2] = &(r2); \
|
|
|
|
caml__roots_block.tables[3] = &(r3);
|
|
|
|
|
|
|
|
#define Begin_roots5(r0, r1, r2, r3, r4) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = 1; \
|
|
|
|
caml__roots_block.ntables = 5; \
|
|
|
|
caml__roots_block.tables[0] = &(r0); \
|
|
|
|
caml__roots_block.tables[1] = &(r1); \
|
|
|
|
caml__roots_block.tables[2] = &(r2); \
|
|
|
|
caml__roots_block.tables[3] = &(r3); \
|
|
|
|
caml__roots_block.tables[4] = &(r4);
|
|
|
|
|
|
|
|
#define Begin_roots_block(table, size) { \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
1997-05-26 10:16:31 -07:00
|
|
|
caml__roots_block.nitems = (size); \
|
|
|
|
caml__roots_block.ntables = 1; \
|
|
|
|
caml__roots_block.tables[0] = (table);
|
|
|
|
|
1997-06-01 10:15:19 -07:00
|
|
|
#define End_roots() local_roots = caml__roots_block.next; }
|
1997-05-26 10:16:31 -07:00
|
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
[Push_roots] and [Pop_roots] are obsolete.
|
|
|
|
Use [Begin_roots] and [End_roots] instead.
|
|
|
|
*/
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
/* [Push_roots] and [Pop_roots] are used for C variables that are GC roots.
|
|
|
|
* It must contain all values in C local variables at the time the minor GC is
|
|
|
|
* called.
|
|
|
|
* Usage:
|
|
|
|
* At the end of the declarations of your C local variables, add
|
|
|
|
* [ Push_roots (variable_name, size); ]
|
|
|
|
* The size is the number of declared roots. They are accessed as
|
|
|
|
* [ variable_name [0] ... variable_name [size - 1] ].
|
|
|
|
* The [variable_name] and the [size] must not be [ _ ].
|
|
|
|
* Just before the function return, add a call to [Pop_roots].
|
|
|
|
*/
|
|
|
|
|
1997-06-01 10:15:19 -07:00
|
|
|
#define Push_roots(name, size) \
|
|
|
|
value name [(size)]; \
|
|
|
|
struct caml__roots_block caml__roots_block; \
|
1997-06-15 05:36:20 -07:00
|
|
|
{ long _; for (_ = 0; _ < (size); name [_++] = Val_unit); } \
|
1997-06-01 10:15:19 -07:00
|
|
|
caml__roots_block.next = local_roots; \
|
|
|
|
local_roots = &caml__roots_block; \
|
|
|
|
caml__roots_block.nitems = (size); \
|
|
|
|
caml__roots_block.ntables = 1; \
|
|
|
|
caml__roots_block.tables[0] = name;
|
|
|
|
|
|
|
|
#define Pop_roots() local_roots = caml__roots_block.next;
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
/* [register_global_root] registers a global C variable as a memory root
|
1996-12-10 07:41:11 -08:00
|
|
|
for the duration of the program, or until [remove_global_root] is
|
|
|
|
called. */
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
void register_global_root (value *);
|
1995-05-04 03:15:53 -07:00
|
|
|
|
1996-12-10 07:41:11 -08:00
|
|
|
/* [remove_global_root] removes a memory root registered on a global C
|
|
|
|
variable with [register_global_root]. */
|
|
|
|
|
1997-09-02 05:55:01 -07:00
|
|
|
void remove_global_root (value *);
|
1996-12-10 07:41:11 -08:00
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
|
|
|
|
#endif /* _memory_ */
|
|
|
|
|