Merge: trivial stuff

Makefile

@@ -420,6 +420,7 @@ utils/config.ml: utils/config.mlp config/Makefile
 	    -e 's|%%ARCH%%|$(ARCH)|' \
 	    -e 's|%%MODEL%%|$(MODEL)|' \
 	    -e 's|%%SYSTEM%%|$(SYSTEM)|' \
+	    -e 's|%%MULTICONTEXT%%|$(MULTICONTEXT)|' \
 	    -e 's|%%EXT_OBJ%%|.o|' \
 	    -e 's|%%EXT_ASM%%|.s|' \
 	    -e 's|%%EXT_LIB%%|.a|' \

asmcomp/power/arch.ml

@@ -14,7 +14,7 @@
 
 (* Specific operations for the PowerPC processor *)
 
-open Misc
+(* open Misc *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)
 open Format
 
 (* Machine-specific command-line options *)

asmcomp/power/emit.mlp

@@ -16,7 +16,7 @@
 
 module StringSet = Set.Make(struct type t = string let compare = compare end)
 
-open Location
+(* open Location *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)
 open Misc
 open Cmm
 open Arch
@@ -328,7 +328,7 @@ let instr_size = function
   | Lop(Imove | Ispill | Ireload) -> 1
   | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2
   | Lop(Iconst_float s) -> 2
-  | Lop(Iconst_symbol s) -> 2
+  | Lop(Iconst_symbol (s, _)) -> 2
   | Lop(Icall_ind) -> 2
   | Lop(Icall_imm s) -> 1
   | Lop(Itailcall_ind) -> 5
@@ -480,7 +480,7 @@ let rec emit_instr i dslot =
         float_literals := (s, lbl) :: !float_literals;
         `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
         `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n`
-    | Lop(Iconst_symbol s) ->
+    | Lop(Iconst_symbol (s,_)) ->
         `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
         `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
     | Lop(Icall_ind) ->

asmcomp/power/proc.ml

@@ -237,5 +237,5 @@ let assemble_file infile outfile =
   Ccomp.command (Config.asm ^ " -o " ^
                  Filename.quote outfile ^ " " ^ Filename.quote infile)
 
-open Clflags;;
-open Config;;
+(* open Clflags;; *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)
+(* open Config;; *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)

asmcomp/power/selection.ml

@@ -14,9 +14,9 @@
 
 (* Instruction selection for the Power PC processor *)
 
-open Misc
+(* open Misc *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)
 open Cmm
-open Reg
+(* open Reg *) (* removed because it was unused, and this is compiled with Error-enabled warnings *)
 open Arch
 open Mach
 
@@ -28,7 +28,7 @@ type addressing_expr =
   | Aadd of expression * expression
 
 let rec select_addr = function
-    Cconst_symbol s ->
+    Cconst_symbol (s, _) ->
       (Asymbol s, 0)
   | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n + m)

asmrun/signals_asm.c

@@ -22,6 +22,7 @@
 #define CAML_CONTEXT_SIGNALS
 #define CAML_CONTEXT_SIGNALS_ASM
 #define CAML_CONTEXT_FAIL
+#define CAML_CONTEXT_MEMORY
 
 #if defined(TARGET_amd64) && defined (SYS_linux)
 #define _GNU_SOURCE

byterun/array.c

@@ -19,6 +19,7 @@
 #define CAML_CONTEXT_ROOTS
 #define CAML_CONTEXT_MINOR_GC
 #define CAML_CONTEXT_MAJOR_GC
+#define CAML_CONTEXT_MEMORY
 
 #include <string.h>
 #include "alloc.h"

byterun/compact.c

@@ -18,6 +18,7 @@
 #define CAML_CONTEXT_FREELIST
 #define CAML_CONTEXT_COMPACT
 #define CAML_CONTEXT_MAJOR_GC
+#define CAML_CONTEXT_MEMORY
 
 #include <string.h>
 

byterun/compare.c

@@ -14,6 +14,7 @@
 /* $Id$ */
 
 #define CAML_CONTEXT_COMPARE
+#define CAML_CONTEXT_MEMORY
 
 #include <string.h>
 #include <stdlib.h>

byterun/context.c

@@ -51,10 +51,13 @@ static __thread caml_global_context *the_thread_local_caml_context = NULL;
 /* The one and only main context: */
 caml_global_context *the_main_context = NULL;
 
+#ifdef HAS_MULTICONTEXT
+/* In single-context mode, this is a trivial macro instead of a function. */
 caml_global_context *caml_get_thread_local_context(void)
 {
   return the_thread_local_caml_context;
 }
+#endif // #ifdef HAS_MULTICONTEXT
 
 void caml_set_thread_local_context(caml_global_context *new_caml_context)
 {

byterun/context.h

@@ -31,7 +31,7 @@
 #include "config.h"
 #include "mlvalues.h"
 #include "misc.h"
-#include "memory.h"
+//#include "memory.h"
 #include "extensible_buffer.h"
 
 #ifdef HAS_PTHREAD
@@ -224,8 +224,7 @@ typedef struct {
 } st_masterlock;
 
 
-// ??????
-typedef struct caml_thread_struct * caml_thread_t; /* from st_posix.h */
+typedef struct caml_thread_struct * caml_thread_t; /* from scheduler.c and st_posix.h */
 typedef pthread_t st_thread_id; /* from st_posix.h */
 // ??????
 
@@ -362,6 +361,11 @@ struct caml_global_context {
 #ifdef ARCH_SIXTYFOUR
   struct page_table caml_page_table;
 #else
+/* 32 bits: Represent page table as a 2-level array */
+#define Pagetable2_log 11
+#define Pagetable2_size (1 << Pagetable2_log)
+#define Pagetable1_log (Page_log + Pagetable2_log)
+#define Pagetable1_size (1 << (32 - Pagetable1_log))
   unsigned char * caml_page_table[Pagetable1_size];
   unsigned char caml_page_table_empty[Pagetable2_size]; /* = { 0, }; */
 #endif
@@ -759,10 +763,6 @@ extern void caml_pin_context_r(CAML_R);
 extern void caml_unpin_context_r(CAML_R);
 /* extern void (*caml_remove_last_pin_from_context_hook)(CAML_R); */
 
-/* Access a thread-local context pointer */
-extern caml_global_context *caml_get_thread_local_context(void);
-extern void caml_set_thread_local_context(caml_global_context *new_global_context);
-
 extern void (*caml_enter_blocking_section_hook)(void);
 extern void (*caml_leave_blocking_section_hook)(void);
 extern int (*caml_try_leave_blocking_section_hook)(void);
@@ -1333,4 +1333,25 @@ void caml_set_caml_can_split_r(CAML_R, int (*caml_can_split_r)(CAML_R));
 CAMLextern caml_global_context *the_main_context;
 
 extern int caml_debugging; // !!!!!!!!!!!!!!!!!!!!!!!
+
+/* Access a thread-local context pointer */
+#ifdef HAS_MULTICONTEXT
+extern caml_global_context *caml_get_thread_local_context(void);
+#else
+/* If we don't have multicontext we don't really need to call
+   caml_get_thread_local_context at runtime: we can just use a known
+   pointer instead of calling a trivial constant function. */
+#define caml_get_thread_local_context() \
+  (&the_one_and_only_context_struct)
+#endif // #ifdef HAS_MULTICONTEXT
+
+extern void caml_set_thread_local_context(caml_global_context *new_global_context);
+
+// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+// scratch
+#define CAMLFUNCTION1(TYPE, NAME, ARG1TYPE, ARG1NAME) \
+  TYPE NAME(ARG1TYPE ARG1NAME){ return NAME##_r(caml_get_thread_local_context(), ARG1NAME); } \
+  TYPE NAME##_r(CAML_R, ARG1TYPE, ARG1NAME)
+
+
 #endif

byterun/context_split.c

@@ -86,12 +86,18 @@ void caml_destroy_local_mailbox_r(CAML_R, struct caml_mailbox *mailbox){
 void caml_run_at_context_exit_functions_r(CAML_R){
   CAMLparam0();
   CAMLlocal1(run_at_context_exit_functions);
-  volatile value *run_at_context_exit_functions_pointer;
+  value *run_at_context_exit_functions_pointer;
   run_at_context_exit_functions_pointer = caml_named_value_r(ctx, "Context.run_at_context_exit_functions");
-  assert(run_at_context_exit_functions_pointer != NULL);
-  run_at_context_exit_functions = *run_at_context_exit_functions_pointer;
-  DUMP("Context.run_at_context_exit_functions is %p", (void*)(long)run_at_context_exit_functions);
-  caml_callback_exn_r(ctx, run_at_context_exit_functions, Val_unit);
+  /* Normally Context.run_at_context_exit_functions should have been
+     register at initialization time from OCaml in the Context module;
+     however run_at_context_exit_functions_pointer is allowed to be
+     NULL, if the standard library has been disabled.  In that case
+     we simply won't run cleanup functions. */
+  if(run_at_context_exit_functions_pointer != NULL){
+    run_at_context_exit_functions = *run_at_context_exit_functions_pointer;
+    DUMP("Context.run_at_context_exit_functions is %p", (void*)(long)run_at_context_exit_functions);
+    caml_callback_exn_r(ctx, run_at_context_exit_functions, Val_unit);
+  }
   CAMLreturn0;
 }
 

byterun/extensible_buffer.c

@@ -6,6 +6,8 @@
 #include "mlvalues.h"
 #include "context.h"
 #include "memory.h"
+#include "context.h"
+#include "mlvalues.h"
 #include "extensible_buffer.h"
 
 static void caml_reallocate_extensible_buffer(struct caml_extensible_buffer *b, size_t new_allocated_size){

byterun/extern.c

@@ -20,6 +20,7 @@
 #define CAML_CONTEXT_STARTUP
 #define CAML_CONTEXT_EXTERN
 #define CAML_CONTEXT_ROOTS
+#define CAML_CONTEXT_MEMORY
 
 #include <stdio.h>
 #include <string.h>
@@ -461,7 +462,7 @@ static void extern_rec_r(CAML_R, value v)
       if (serialize == NULL){
         //////
         //struct custom_operations *o = Custom_ops_val(v);
-        printf("About the object at %p, which is a %s custom\n", (void*)v, Custom_ops_val(v)->identifier); volatile int a = 1; a /= 0;
+        //printf("About the object at %p, which is a %s custom\n", (void*)v, Custom_ops_val(v)->identifier); volatile int a = 1; a /= 0;
         ///////////
         extern_invalid_argument_r(ctx, "output_value: abstract value (Custom)");
       }
@@ -527,11 +528,11 @@ static void extern_rec_r(CAML_R, value v)
       /* DUMP("probably crashing now"); */
       /* DUMP("tag is %i", (int)Tag_val(v)); */
       /* DUMP("size is %i", (int)Wosize_val(v)); */
-      volatile int a = 1; a /= 0;
+      //volatile int a = 1; a /= 0;
       //extern_rec_r(ctx, Val_int(0));
       /* fprintf(stderr, "ZZZZ [This is probably wrong: I'm marshalling an out-of-heap pointer as an int64]\n"); */
       /* writecode64_r(ctx, CODE_INT64, (v << 1) | 1); */
-      //extern_invalid_argument_r(ctx, "output_value: abstract value (outside heap) [FIXME: implement]");
+      extern_invalid_argument_r(ctx, "output_value: abstract value (outside heap) [FIXME: implement]");
     }
     else
       extern_invalid_argument_r(ctx, "output_value: abstract value (outside heap)");

byterun/finalise.c

@@ -16,6 +16,7 @@
 /* Handling of finalised values. */
 
 #define CAML_CONTEXT_FINALISE
+#define CAML_CONTEXT_MEMORY
 
 #include "callback.h"
 #include "fail.h"

byterun/fix_code.c

@@ -61,7 +61,7 @@ void caml_load_code_r(CAML_R, int fd, asize_t len)
   caml_init_code_fragments_r(ctx);
   /* Prepare the code for execution */
 #ifdef ARCH_BIG_ENDIAN
-  caml_fixup_endianness(caml_start_code, caml_code_size);
+  caml_fixup_endianness_r(ctx, caml_start_code, caml_code_size);
 #endif
   if (caml_debugger_in_use) {
     len /= sizeof(opcode_t);

byterun/freelist.c

@@ -15,6 +15,7 @@
 
 #define CAML_CONTEXT_FREELIST
 #define CAML_CONTEXT_MAJOR_GC
+#define CAML_CONTEXT_MEMORY
 
 #define FREELIST_DEBUG 0
 #if FREELIST_DEBUG

byterun/gc_ctrl.c

@@ -17,7 +17,9 @@
 #define CAML_CONTEXT_MINOR_GC
 #define CAML_CONTEXT_ROOTS
 #define CAML_CONTEXT_FREELIST
+#define CAML_MEMORY
 
+#include "memory.h"
 #include "alloc.h"
 #include "compact.h"
 #include "custom.h"
@@ -226,12 +228,12 @@ static value heap_stats_r (CAML_R, int returnstats)
   }
 }
 
-#ifdef DEBUG
+//#ifdef DEBUG
 void caml_heap_check_r (CAML_R)
 {
   heap_stats_r (ctx, 0);
 }
-#endif
+//#endif
 
 CAMLprim value caml_gc_stat_r(CAML_R)
 {

byterun/globroots.c

@@ -17,6 +17,7 @@
 
 #define CAML_CONTEXT_GLOBROOTS
 #define CAML_CONTEXT_MINOR_GC
+#define CAML_CONTEXT_MEMORY
 
 #include "memory.h"
 #include "misc.h"

byterun/hash.c

@@ -18,6 +18,8 @@
 /* The interface of this file is in "mlvalues.h" (for [caml_hash_variant])
    and in "hash.h" (for the other exported functions). */
 
+#define CAML_CONTEXT_MEMORY
+
 #include "mlvalues.h"
 #include "custom.h"
 #include "memory.h"

byterun/intern.c

@@ -348,7 +348,7 @@ static void intern_rec_r(CAML_R, value *dest)
         break;
 #else
         intern_cleanup_r(ctx);
-        caml_failwith("input_value: integer too large");
+        caml_failwith_r(ctx, "input_value: integer too large");
         break;
 #endif
       case CODE_SHARED8:
@@ -378,7 +378,7 @@ static void intern_rec_r(CAML_R, value *dest)
         goto read_block;
 #else
         intern_cleanup_r(ctx);
-        caml_failwith("input_value: data block too large");
+        caml_failwith_r(ctx, "input_value: data block too large");
         break;
 #endif
       case CODE_STRING8:

byterun/interp.c

@@ -25,6 +25,7 @@
 #define CAML_CONTEXT_MINOR_GC
 #define CAML_CONTEXT_BACKTRACE
 #define CAML_CONTEXT_FIX_CODE
+#define CAML_CONTEXT_MEMORY
 
 /* The bytecode interpreter */
 #include <stdio.h>

byterun/ints.c

@@ -808,6 +808,9 @@ CAMLprim value caml_nativeint_of_int_r(CAML_R, value v)
 CAMLprim value caml_nativeint_to_int(value v)
 { return Val_long(Nativeint_val(v)); }
 
+CAMLprim value caml_nativeint_to_int_r(CAML_R, value v)
+{ return Val_long(Nativeint_val(v)); }
+
 CAMLprim value caml_nativeint_of_float_r(CAML_R, value v)
 { return caml_copy_nativeint_r(ctx,(intnat)(Double_val(v))); }
 

byterun/major_gc.c

@@ -17,6 +17,7 @@
 #define CAML_CONTEXT_FREELIST
 #define CAML_CONTEXT_MAJOR_GC
 #define CAML_CONTEXT_GC_CTRL
+#define CAML_CONTEXT_MEMORY
 
 #include <stdio.h> // FIXME: remove after debugging
 #include <limits.h>

byterun/md5.c

@@ -14,6 +14,7 @@
 /* $Id$ */
 
 #define CAML_CONTEXT_ROOTS
+#define CAML_CONTEXT_MEMORY
 
 #include <stdio.h> // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 #include <string.h>
@@ -200,7 +201,7 @@ CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *md5_ctx)
     if (count < 8) {
         /* Two lots of padding:  Pad the first block to 64 bytes */
         memset(p, 0, count);
-        byteReverse(ctx->in, 16);
+        byteReverse(md5_ctx->in, 16);
         caml_MD5Transform(md5_ctx->buf, (uint32 *) md5_ctx->in);
 
         /* Now fill the next block with 56 bytes */
@@ -209,7 +210,7 @@ CAMLexport void caml_MD5Final(unsigned char *digest, struct MD5Context *md5_ctx)
         /* Pad block to 56 bytes */
         memset(p, 0, count - 8);
     }
-    byteReverse(ctx->in, 14);
+    byteReverse(md5_ctx->in, 14);
 
     /* Append length in bits and transform */
     ((uint32 *) md5_ctx->in)[14] = md5_ctx->bits[0];