wrong branch... rollback
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7865 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Alain Frisch
parent
a06311fc5f
commit
5b23012b0e
|
|
@ -211,8 +211,8 @@ let make_startup_file ppf filename units_list =
|
|||
compile_phrase
|
||||
(Cmmgen.globals_map
|
||||
(List.map
|
||||
(fun (unit,_,crc) ->
|
||||
try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi, crc)
|
||||
(fun (unit,_,_) ->
|
||||
try (unit.ui_name, List.assoc unit.ui_name unit.ui_imports_cmi)
|
||||
with Not_found -> assert false)
|
||||
units_list));
|
||||
compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ val send_function: int -> Cmm.phrase
|
|||
val curry_function: int -> Cmm.phrase list
|
||||
val entry_point: string list -> Cmm.phrase
|
||||
val global_table: string list -> Cmm.phrase
|
||||
val globals_map: (string * Digest.t * Digest.t) list -> Cmm.phrase
|
||||
val globals_map: (string * string) list -> Cmm.phrase
|
||||
val frame_table: string list -> Cmm.phrase
|
||||
val data_segment_table: string list -> Cmm.phrase
|
||||
val code_segment_table: string list -> Cmm.phrase
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ COBJS=startup.o main.o fail.o roots.o globroots.o signals.o \
|
|||
misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
|
||||
floats.o str.o array.o io.o extern.o intern.o hash.o sys.o parsing.o \
|
||||
gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \
|
||||
compact.o finalise.o custom.o unix.o backtrace.o natdynlink.o
|
||||
compact.o finalise.o custom.o unix.o backtrace.o
|
||||
|
||||
ASMOBJS=$(ARCH).o
|
||||
|
||||
|
|
|
|||
|
|
@ -1,55 +0,0 @@
|
|||
#include "misc.h"
|
||||
#include "mlvalues.h"
|
||||
#include "memory.h"
|
||||
#include "stack.h"
|
||||
#include "callback.h"
|
||||
|
||||
#include <dlfcn.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
void *getsym(void *handle, char *module, char *name){
|
||||
char *fullname = malloc(strlen(module) + strlen(name) + 5);
|
||||
sprintf(fullname, "caml%s%s", module, name);
|
||||
void *sym = dlsym (handle, fullname);
|
||||
if (NULL == sym) {
|
||||
printf("natdynlink: cannot find symbol %s\n", fullname);
|
||||
exit(2);
|
||||
}
|
||||
free(fullname);
|
||||
return sym;
|
||||
}
|
||||
|
||||
extern char caml_globals_map[];
|
||||
|
||||
CAMLprim value caml_natdynlink_getmap(value unit)
|
||||
{
|
||||
return (value)caml_globals_map;
|
||||
}
|
||||
|
||||
|
||||
CAMLprim value caml_natdynlink_open
|
||||
(value private, value filename, value symbol)
|
||||
{
|
||||
CAMLparam3 (private, filename, symbol);
|
||||
CAMLlocal3 (result, err, tup);
|
||||
|
||||
char *unit = String_val(symbol);
|
||||
|
||||
void *handle =
|
||||
dlopen(String_val(filename),
|
||||
(private == Val_true
|
||||
? RTLD_NOW
|
||||
: RTLD_NOW | RTLD_GLOBAL
|
||||
));
|
||||
|
||||
if (NULL == handle)
|
||||
CAMLreturn(caml_copy_string(dlerror()));
|
||||
|
||||
caml_register_frametable(getsym(handle,unit,"__frametable"));
|
||||
caml_register_dyn_global((value)getsym(handle,unit,""));
|
||||
void (*entrypoint)(void) = getsym(handle,unit,"__entry");
|
||||
err = caml_callback((value)(&entrypoint), 0);
|
||||
|
||||
CAMLreturn (Val_unit);
|
||||
}
|
||||
|
|
@ -36,37 +36,6 @@ void (*caml_scan_roots_hook) (scanning_action) = NULL;
|
|||
frame_descr ** caml_frame_descriptors = NULL;
|
||||
int caml_frame_descriptors_mask;
|
||||
|
||||
/* Linked-list of frametables */
|
||||
|
||||
typedef struct link {
|
||||
void *data;
|
||||
struct link *next;
|
||||
} link;
|
||||
|
||||
link *cons(void *data, link *tl) {
|
||||
link *lnk = caml_stat_alloc(sizeof(link));
|
||||
lnk->data = data;
|
||||
lnk->next = tl;
|
||||
return lnk;
|
||||
}
|
||||
|
||||
#define iter_list(list,lnk) \
|
||||
for (lnk = list; lnk != NULL; lnk = lnk->next)
|
||||
|
||||
|
||||
|
||||
link *frametables = NULL;
|
||||
|
||||
void caml_register_frametable(intnat *table) {
|
||||
frametables = cons(table,frametables);
|
||||
|
||||
if (NULL != caml_frame_descriptors) {
|
||||
caml_stat_free(caml_frame_descriptors);
|
||||
caml_frame_descriptors = NULL;
|
||||
/* force caml_init_frame_descriptors to be called */
|
||||
}
|
||||
}
|
||||
|
||||
void caml_init_frame_descriptors(void)
|
||||
{
|
||||
intnat num_descr, tblsize, i, j, len;
|
||||
|
|
@ -74,21 +43,11 @@ void caml_init_frame_descriptors(void)
|
|||
frame_descr * d;
|
||||
uintnat nextd;
|
||||
uintnat h;
|
||||
link *lnk;
|
||||
|
||||
static int inited = 0;
|
||||
|
||||
if (!inited) {
|
||||
for (i = 0; caml_frametable[i] != 0; i++)
|
||||
caml_register_frametable(caml_frametable[i]);
|
||||
inited = 1;
|
||||
}
|
||||
|
||||
/* Count the frame descriptors */
|
||||
num_descr = 0;
|
||||
iter_list(frametables,lnk) {
|
||||
num_descr += *((intnat*) lnk->data);
|
||||
}
|
||||
for (i = 0; caml_frametable[i] != 0; i++)
|
||||
num_descr += *(caml_frametable[i]);
|
||||
|
||||
/* The size of the hashtable is a power of 2 greater or equal to
|
||||
2 times the number of descriptors */
|
||||
|
|
@ -102,21 +61,21 @@ void caml_init_frame_descriptors(void)
|
|||
caml_frame_descriptors_mask = tblsize - 1;
|
||||
|
||||
/* Fill the hash table */
|
||||
iter_list(frametables,lnk) {
|
||||
tbl = (intnat*) lnk->data;
|
||||
for (i = 0; caml_frametable[i] != 0; i++) {
|
||||
tbl = caml_frametable[i];
|
||||
len = *tbl;
|
||||
d = (frame_descr *)(tbl + 1);
|
||||
for (j = 0; j < len; j++) {
|
||||
h = Hash_retaddr(d->retaddr);
|
||||
while (caml_frame_descriptors[h] != NULL) {
|
||||
h = (h+1) & caml_frame_descriptors_mask;
|
||||
h = (h+1) & caml_frame_descriptors_mask;
|
||||
}
|
||||
caml_frame_descriptors[h] = d;
|
||||
nextd =
|
||||
((uintnat)d +
|
||||
sizeof(char *) + sizeof(short) + sizeof(short) +
|
||||
sizeof(short) * d->num_live + sizeof(frame_descr *) - 1)
|
||||
& -sizeof(frame_descr *);
|
||||
((uintnat)d +
|
||||
sizeof(char *) + sizeof(short) + sizeof(short) +
|
||||
sizeof(short) * d->num_live + sizeof(frame_descr *) - 1)
|
||||
& -sizeof(frame_descr *);
|
||||
if (d->frame_size & 1) nextd += 8;
|
||||
d = (frame_descr *) nextd;
|
||||
}
|
||||
|
|
@ -130,11 +89,6 @@ uintnat caml_last_return_address = 1; /* not in Caml code initially */
|
|||
value * caml_gc_regs;
|
||||
intnat caml_globals_inited = 0;
|
||||
static intnat caml_globals_scanned = 0;
|
||||
static link * caml_dyn_globals = NULL;
|
||||
|
||||
void caml_register_dyn_global(value v) {
|
||||
caml_dyn_globals = cons((void*) v,caml_dyn_globals);
|
||||
}
|
||||
|
||||
/* Call [caml_oldify_one] on (at least) all the roots that point to the minor
|
||||
heap. */
|
||||
|
|
@ -151,7 +105,6 @@ void caml_oldify_local_roots (void)
|
|||
value * root;
|
||||
struct global_root * gr;
|
||||
struct caml__roots_block *lr;
|
||||
link *lnk;
|
||||
|
||||
/* The global roots */
|
||||
for (i = caml_globals_scanned;
|
||||
|
|
@ -164,14 +117,6 @@ void caml_oldify_local_roots (void)
|
|||
}
|
||||
caml_globals_scanned = caml_globals_inited;
|
||||
|
||||
/* Dynamic global roots */
|
||||
iter_list(caml_dyn_globals, lnk) {
|
||||
glob = (value) lnk->data;
|
||||
for (j = 0; j < Wosize_val(glob); j++){
|
||||
Oldify (&Field (glob, j));
|
||||
}
|
||||
}
|
||||
|
||||
/* The stack and local roots */
|
||||
if (caml_frame_descriptors == NULL) caml_init_frame_descriptors();
|
||||
sp = caml_bottom_of_stack;
|
||||
|
|
@ -253,7 +198,6 @@ void caml_do_roots (scanning_action f)
|
|||
int i, j;
|
||||
value glob;
|
||||
struct global_root * gr;
|
||||
link *lnk;
|
||||
|
||||
/* The global roots */
|
||||
for (i = 0; caml_globals[i] != 0; i++) {
|
||||
|
|
@ -261,15 +205,6 @@ void caml_do_roots (scanning_action f)
|
|||
for (j = 0; j < Wosize_val(glob); j++)
|
||||
f (Field (glob, j), &Field (glob, j));
|
||||
}
|
||||
|
||||
/* Dynamic global roots */
|
||||
iter_list(caml_dyn_globals, lnk) {
|
||||
glob = (value) lnk->data;
|
||||
for (j = 0; j < Wosize_val(glob); j++){
|
||||
f (Field (glob, j), &Field (glob, j));
|
||||
}
|
||||
}
|
||||
|
||||
/* The stack and local roots */
|
||||
if (caml_frame_descriptors == NULL) caml_init_frame_descriptors();
|
||||
caml_do_local_roots(f, caml_bottom_of_stack, caml_last_return_address,
|
||||
|
|
|
|||
|
|
@ -114,8 +114,6 @@ extern int caml_frame_descriptors_mask;
|
|||
(((uintnat)(addr) >> 3) & caml_frame_descriptors_mask)
|
||||
|
||||
extern void caml_init_frame_descriptors(void);
|
||||
extern void caml_register_frametable(intnat *);
|
||||
extern void caml_register_dyn_global(value);
|
||||
|
||||
/* Declaration of variables used in the asm code */
|
||||
extern char * caml_bottom_of_stack;
|
||||
|
|
@ -126,4 +124,5 @@ extern value caml_globals[];
|
|||
extern intnat caml_globals_inited;
|
||||
extern intnat * caml_frametable[];
|
||||
|
||||
|
||||
#endif /* CAML_STACK_H */
|
||||
|
|
|
|||
Loading…
Reference in New Issue