1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
/* Primitives for the toplevel */
#include "alloc.h"
#include "config.h"
#include "fix_code.h"
#include "interp.h"
#include "major_gc.h"
#include "memory.h"
#include "minor_gc.h"
#include "misc.h"
#include "mlvalues.h"
#include "prims.h"
#include "stacks.h"
value get_global_data(unit) /* ML */
value unit;
{
return global_data;
}
value reify_bytecode(prog, len) /* ML */
value prog, len;
{
value clos;
#ifdef BIG_ENDIAN
fixup_endianness((code_t) prog, (asize_t) Long_val(len));
#endif
#ifdef THREADED_CODE
thread_code((code_t) prog, (asize_t) Long_val(len));
#endif
clos = alloc(1, Closure_tag);
Code_val(clos) = (code_t) prog;
return clos;
}
value realloc_global(size) /* ML */
value size;
{
mlsize_t requested_size, actual_size, i;
value new_global_data;
requested_size = Long_val(size);
actual_size = Wosize_val(global_data);
if (requested_size >= actual_size) {
requested_size = (requested_size + 0x100) & 0xFFFFFF00;
new_global_data = alloc_shr(requested_size, 0);
for (i = 0; i < actual_size; i++)
initialize(&Field(new_global_data, i), Field(global_data, i));
for (i = actual_size; i < requested_size; i++){
Field (new_global_data, i) = Val_long (0);
}
global_data = new_global_data;
}
return Val_unit;
}
value available_primitives() /* ML */
{
return copy_string_array(names_of_cprim);
}
value get_current_environment() /* ML */
{
return *extern_sp;
}
|
