Permalink
Browse files

Fixed native code support for non-multiruntime architectures (develop…

…ed on PowerPC). Fixed PowerPC assembly runtime with a cute little hack, which unfortunately will have to go.
  • Loading branch information...
Luca Saiu
Luca Saiu committed Sep 10, 2013
1 parent 0250279 commit 170eefa5f87d3c6db5532744f07a61377716d7ed
View
@@ -181,6 +181,7 @@ LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader
coldstart:
cd byterun; $(MAKE) all
cp byterun/ocamlrun$(EXE) boot/ocamlrun$(EXE)
+ cp byterun/ocamlrun$(EXE) boot/ocamlrun.boot$(EXE)
cd yacc; $(MAKE) all
cp yacc/ocamlyacc$(EXE) boot/ocamlyacc$(EXE)
cd stdlib; $(MAKE) COMPILER=../boot/ocamlc all
View
@@ -655,10 +655,31 @@ let bigarray_set unsafe elt_kind layout b args newval dbg =
(* Simplification of some primitives into C calls *)
-let default_prim name =
- { prim_name = name ^ "_r";
- prim_arity = 0 (*ignored*); prim_ctx = true;
- prim_alloc = true; prim_native_name = ""; prim_native_float = false }
+(* ***** *)
+let _ = Config.multicontext_supported
+let _ = Config.multicontext_enabled
+(* ***** *)
+
+(* FIXME: 2013-09: ask Fabrice: is this *only* used for reentrant primitives? I think so. --Luca Saiu *)
+(* let default_prim name = *)
+(* { prim_name = name ^ "_r"; *)
+(* prim_arity = 0 (\*ignored*\); prim_ctx = true; *)
+(* prim_alloc = true; prim_native_name = ""; prim_native_float = false } *)
+
+
+(* VERY experimental: BEGIN ================================================== *)
+let default_prim =
+ if Config.multicontext_supported then
+ fun name ->
+ { prim_name = name ^ "_r";
+ prim_arity = 0 (*ignored*); prim_ctx = true;
+ prim_alloc = true; prim_native_name = ""; prim_native_float = false }
+ else
+ fun name ->
+ { prim_name = name ;
+ prim_arity = 0 (*ignored*); prim_ctx = false;
+ prim_alloc = true; prim_native_name = ""; prim_native_float = false }
+(* VERY experimental: END ================================================== *)
let simplif_primitive_32bits = function
Pbintofint Pint64 -> Pccall (default_prim "caml_int64_of_int")
@@ -1833,12 +1854,8 @@ let emit_all_constants cont =
(* Translate a compilation unit *)
-(* --Luca Saiu REENTRANTRUNTIME DEBUG *)
-(* (\*FIXME: remove this crap --Luca Saiu REENTRANTRUNTIME *\) *)
-(* let rec ntimes_acc n x a = if n == 0 then a else ntimes_acc (n - 1) x (x :: a);; *)
-(* let ntimes n x = ntimes_acc n x [];; *)
-
let compunit size ulam =
+ if Config.multicontext_supported then
let glob = Compilenv.make_symbol None in
let register_module_code =
Cop(Cextcall("caml_register_module_r",
@@ -1882,7 +1899,21 @@ let compunit size ulam =
Cint8 0; (* '\0'-terminate the string *)
Calign 8; (* Don't break the alignment of what follows because of the string*)
] :: c3
-
+ else
+ (* non-contextual version *)
+ let glob = Compilenv.make_symbol None in
+ let init_code = transl ulam in
+ let c1 = [Cfunction {fun_name = Compilenv.make_symbol (Some "entry");
+ fun_args = [];
+ fun_body = init_code; fun_fast = false;
+ fun_dbg = Debuginfo.none }] in
+ let c2 = transl_all_functions StringSet.empty c1 in
+ let c3 = emit_all_constants c2 in
+ Cdata [Cint(block_header 0 size);
+ Cglobal_symbol glob;
+ Cdefine_symbol glob;
+ Cskip(size * size_addr)] :: c3
+
(*
CAMLprim value caml_cache_public_method (value meths, value tag, value *cache)
{
@@ -2180,28 +2211,50 @@ let generic_functions shared units =
(* Generate the entry point *)
let entry_point namelist =
- let incr_global_inited =
+ if Config.multicontext_supported then
+ (* multicontext version *)
+ let incr_global_inited =
(*
Cop(Cstore Word,
[Cconst_symbol "caml_globals_inited";
Cop(Caddi, [Cop(Cload Word, [Cconst_symbol "caml_globals_inited"]);
Cconst_int 1])])
*)
- Cop(Cextcall("caml_incr_globals_inited_r", typ_void, false, true, Debuginfo.none), [])
- in
- let body =
- List.fold_right
- (fun name next ->
- let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry_r") in
- Csequence(Cop(Capply(typ_void, Debuginfo.none),
- [Cconst_symbol (entry_sym, Cglobal_kind)]),
- Csequence(incr_global_inited, next)))
- namelist (Cconst_int 1) in
- Cfunction {fun_name = "caml_program_r13";
- fun_args = [];
- fun_body = body;
- fun_fast = false;
- fun_dbg = Debuginfo.none }
+ Cop(Cextcall("caml_incr_globals_inited_r", typ_void, false, true, Debuginfo.none), [])
+ in
+ let body =
+ List.fold_right
+ (fun name next ->
+ let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry_r") in
+ Csequence(Cop(Capply(typ_void, Debuginfo.none),
+ [Cconst_symbol (entry_sym, Cglobal_kind)]),
+ Csequence(incr_global_inited, next)))
+ namelist (Cconst_int 1) in
+ Cfunction {fun_name = "caml_program_r13";
+ fun_args = [];
+ fun_body = body;
+ fun_fast = false;
+ fun_dbg = Debuginfo.none }
+ else
+ (* non-multicontext version *)
+ let incr_global_inited =
+ Cop(Cstore Word,
+ [Cconst_symbol ("caml_globals_inited", Cmm.Cglobal_kind(*FIXME: Cglobal_kind?*));
+ Cop(Caddi, [Cop(Cload Word, [Cconst_symbol ("caml_globals_inited", Cmm.Cglobal_kind(*FIXME: Cglobal_kind?*))]);
+ Cconst_int 1])]) in
+ let body =
+ List.fold_right
+ (fun name next ->
+ let entry_sym = Compilenv.make_symbol ~unitname:name (Some "entry") in
+ Csequence(Cop(Capply(typ_void, Debuginfo.none),
+ [Cconst_symbol(entry_sym, Cmm.Cglobal_kind(*FIXME: Cglobal_kind?*))]),
+ Csequence(incr_global_inited, next)))
+ namelist (Cconst_int 1) in
+ Cfunction {fun_name = "caml_program";
+ fun_args = [];
+ fun_body = body;
+ fun_fast = false;
+ fun_dbg = Debuginfo.none }
(* Generate the table of globals *)
View
@@ -218,7 +218,9 @@ method select_operation op args =
(Capply(ty, dbg), Cconst_symbol (s, _) :: rem) -> (Icall_imm s, rem)
| (Capply(ty, dbg), _) -> (Icall_ind, args)
| (Cextcall(s, ty, alloc, true, dbg), _) ->
- (Iextcall(s, alloc), Cconst_symbol("caml_global_context", Cconstant_kind) :: args)
+ (* (Iextcall(s, alloc), Cconst_symbol("caml_global_context", Cconstant_kind) :: args) *)
+ (* testing, as of 2013-09 --L.S. *)
+ (Iextcall(s, alloc), Cconst_symbol("the_one_and_only_context_struct", Cconstant_kind) :: args)
| (Cextcall(s, ty, alloc, false, dbg), _) -> (Iextcall(s, alloc), args)
| (Cload chunk, [arg]) ->
let (addr, eloc) = self#select_addressing chunk arg in
View
@@ -54,12 +54,23 @@ extern caml_generated_constant
/* Exception raising */
+/* Only one of these is defined in the assembly part: */
extern void caml_raise_exception_r (CAML_R, value bucket) Noreturn;
+extern void caml_raise_exception (value bucket) Noreturn;
+
+/* /\* Only one of these is defined in the assembly part: *\/ */
+/* extern void caml_fatal_uncaught_exception_r (CAML_R, value bucket) Noreturn; */
+/* extern void caml_fatal_uncaught_exception (value bucket) Noreturn; */
void caml_raise_r(CAML_R, value v)
{
Unlock_exn();
- if (caml_exception_pointer == NULL) caml_fatal_uncaught_exception_r(ctx, v);
+ if (caml_exception_pointer == NULL)
+/* #ifdef SUPPORTS_MULTICONTEXT */
+ caml_fatal_uncaught_exception_r(ctx, v);
+/* #else */
+/* caml_fatal_uncaught_exception(v); */
+/* #endif // #ifdef SUPPORTS_MULTICONTEXT */
#ifndef Stack_grows_upwards
#define PUSHED_AFTER <
@@ -72,7 +83,11 @@ void caml_raise_r(CAML_R, value v)
}
#undef PUSHED_AFTER
+#ifdef SUPPORTS_MULTICONTEXT
caml_raise_exception_r(ctx, v);
+#else
+ caml_raise_exception(v);
+#endif // #ifdef SUPPORTS_MULTICONTEXT
}
void caml_raise_constant_r(CAML_R, value tag)
View
@@ -11,6 +11,26 @@
/* */
/***********************************************************************/
+/* experimental hack: begin */
+/* This works and isn't too complicated, but has to be done by hand on
+ each architecture (on all shitty asseblers, actually; with GNU as
+ everywhere it wouldn't be that hard). Sadly, it will have to go.
+ --L.S. */
+#define BYTES_PER_WORD 4
+.equiv caml_young_limit, the_one_and_only_context_struct + BYTES_PER_WORD*0
+.equiv caml_young_ptr, the_one_and_only_context_struct + BYTES_PER_WORD*1
+.equiv caml_last_return_address, the_one_and_only_context_struct + BYTES_PER_WORD*2
+.equiv caml_bottom_of_stack, the_one_and_only_context_struct + BYTES_PER_WORD*3
+.equiv caml_gc_regs, the_one_and_only_context_struct + BYTES_PER_WORD*4
+.equiv caml_exception_pointer, the_one_and_only_context_struct + BYTES_PER_WORD*5
+.equiv caml_backtrace_active, the_one_and_only_context_struct + BYTES_PER_WORD*6
+.section ".data"
+ .globl caml_globals_inited
+/* .type caml_globals_inited, @object */
+caml_globals_inited:
+ .long 1 /* one descriptor */
+/* experimental hack: end */
+
/* $Id$ */
#define Addrglobal(reg,glob) \
View
@@ -81,6 +81,14 @@ void caml_garbage_collection_r(CAML_R)
caml_process_pending_signals_r(ctx);
}
+#if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
+/* This is called from assembly on non-multiruntime platforms: */
+void caml_garbage_collection(void){
+ caml_garbage_collection_r(&the_one_and_only_context_struct);
+}
+#endif // #if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
+
+
DECLARE_SIGNAL_HANDLER(handle_signal)
{
#if !defined(POSIX_SIGNALS) && !defined(BSD_SIGNALS)
View
@@ -178,7 +178,10 @@ caml_global_context* caml_make_empty_context(void)
}
#endif // #ifdef HAS_MULTICONTEXT
-extern value caml_start_program_r (CAML_R);
+/* Only one of these is defined in the assembly part: */
+extern value caml_start_program_r (CAML_R); // multicontext version
+extern value caml_start_program (void); // non-multicontext version
+
extern void caml_init_ieee_floats (void);
extern void caml_init_signals (void);
extern void caml_debugger_init_r(CAML_R);
@@ -256,7 +259,11 @@ caml_global_context* caml_main_rr(char **argv)
}
else{
//fprintf(stderr, "caml_main_rr: right after the setjmp call [%p]\n", *((void**)(ctx->where_to_longjmp)));
+#ifdef SUPPORTS_MULTICONTEXT
res = caml_start_program_r(ctx);
+#else
+ res = caml_start_program();
+#endif // #ifdef SUPPORTS_MULTICONTEXT
if (Is_exception_result(res))
caml_fatal_uncaught_exception_r(ctx, Extract_exception(res));
//fprintf(stderr, "caml_main_rr: exiting normally\n");
View
@@ -1 +1 @@
-#!/home/luca/usr-patched-ocaml/bin/ocamlrun
+#!/home/luca/usr-patched-ocaml//bin/ocamlrun
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
Binary file not shown.
View
@@ -42,7 +42,6 @@
static opcode_t callback_code[] = { ACC, 0, APPLY, 0, POP, 1, STOP };
#endif
-
#ifdef THREADED_CODE
static void thread_callback_r(CAML_R)
@@ -148,17 +147,29 @@ CAMLexport value caml_callbackN_exn_r(CAML_R, value closure, int narg, value arg
/* Pass as many arguments as possible */
switch (narg - i) {
case 1:
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
res = caml_callback_exn_r(ctx, res, args[i]);
+#else
+ res = caml_callback_exn(res, args[i]);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) CAMLreturn (res);
i += 1;
break;
case 2:
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
res = caml_callback2_exn_r(ctx, res, args[i], args[i + 1]);
+#else
+ res = caml_callback2_exn(res, args[i], args[i + 1]);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) CAMLreturn (res);
i += 2;
break;
default:
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
res = caml_callback3_exn_r(ctx, res, args[i], args[i + 1], args[i + 2]);
+#else
+ res = caml_callback3_exn(res, args[i], args[i + 1], args[i + 2]);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) CAMLreturn (res);
i += 3;
break;
@@ -173,22 +184,34 @@ CAMLexport value caml_callbackN_exn_r(CAML_R, value closure, int narg, value arg
CAMLexport value caml_callback_r (CAML_R, value closure, value arg)
{
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
value res = caml_callback_exn_r(ctx, closure, arg);
+#else
+ value res = caml_callback_exn(closure, arg);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) caml_raise_r(ctx, Extract_exception(res));
return res;
}
CAMLexport value caml_callback2_r (CAML_R, value closure, value arg1, value arg2)
{
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
value res = caml_callback2_exn_r(ctx, closure, arg1, arg2);
+#else
+ value res = caml_callback2_exn(closure, arg1, arg2);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) caml_raise_r(ctx, Extract_exception(res));
return res;
}
CAMLexport value caml_callback3_r (CAML_R, value closure, value arg1, value arg2,
value arg3)
{
+#if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
value res = caml_callback3_exn_r(ctx, closure, arg1, arg2, arg3);
+#else
+ value res = caml_callback3_exn(closure, arg1, arg2, arg3);
+#endif // #if !defined(NATIVE_CODE) || defined(SUPPORTS_MULTICONTEXT)
if (Is_exception_result(res)) caml_raise_r(ctx, Extract_exception(res));
return res;
}
View
@@ -28,17 +28,33 @@
extern "C" {
#endif
-CAMLextern value caml_callback (dont_use, value closure, value arg);
-CAMLextern value caml_callback2 (dont_use, value closure, value arg1, value arg2);
-CAMLextern value caml_callback3 (dont_use, value closure, value arg1, value arg2,
+/* CAMLextern value caml_callback (dont_use, value closure, value arg); */
+/* CAMLextern value caml_callback2 (dont_use, value closure, value arg1, value arg2); */
+/* CAMLextern value caml_callback3 (dont_use, value closure, value arg1, value arg2, */
+/* value arg3); */
+/* CAMLextern value caml_callbackN (dont_use, value closure, int narg, value args[]); */
+
+#if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
+CAMLextern value caml_callback (value closure, value arg);
+CAMLextern value caml_callback2 (value closure, value arg1, value arg2);
+CAMLextern value caml_callback3 (value closure, value arg1, value arg2,
value arg3);
-CAMLextern value caml_callbackN (dont_use, value closure, int narg, value args[]);
-
-CAMLextern value caml_callback_exn (dont_use, value closure, value arg);
-CAMLextern value caml_callback2_exn (dont_use, value closure, value arg1, value arg2);
-CAMLextern value caml_callback3_exn (dont_use, value closure,
+CAMLextern value caml_callbackN (value closure, int narg, value args[]);
+#endif // #if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
+
+/* CAMLextern value caml_callback_exn (dont_use, value closure, value arg); */
+/* CAMLextern value caml_callback2_exn (dont_use, value closure, value arg1, value arg2); */
+/* CAMLextern value caml_callback3_exn (dont_use, value closure, */
+/* value arg1, value arg2, value arg3); */
+/* CAMLextern value caml_callbackN_exn (dont_use, value closure, int narg, value args[]); */
+
+#if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
+CAMLextern value caml_callback_exn (value closure, value arg);
+CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2);
+CAMLextern value caml_callback3_exn (value closure,
value arg1, value arg2, value arg3);
-CAMLextern value caml_callbackN_exn (dont_use, value closure, int narg, value args[]);
+CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]);
+#endif // #if defined(NATIVE_CODE) && !defined(SUPPORTS_MULTICONTEXT)
CAMLextern value caml_callback_r (CAML_R, value closure, value arg);
CAMLextern value caml_callback2_r (CAML_R, value closure, value arg1, value arg2);
Oops, something went wrong.

0 comments on commit 170eefa

Please sign in to comment.