Working Xen bytecode microkernel (via the .bcxen target)

For some reason, ocamlc -output-obj doesnt entirely respect -nostdlib and so references to -ltermcap sneak into the default primitives. Therefore, ocamlclean is required or else undefined primitives result.
avsm · Apr 19, 2012 · 527bc83 · 527bc83
1 parent 492afe1
commit 527bc83
Show file tree

Hide file tree

Showing 14 changed files with 411 additions and 24 deletions.
diff --git a/NOTES.md b/NOTES.md
@@ -32,6 +32,11 @@ For the UNIX targets, there are 3 targets (by the filename extension):
 * `.bcbin`: bytecode as an embedded callback
 * `.bcxbin`: bytecode with deadcode-elimination via ocamlclean [1]
 
+For Xen, there is a bytecode (that requires ocamlclean) and native code:
+
+* `.xen`: native code microkernel
+* `.bcxen`: bytecode microkernel with deadcode-elimination via ocamlclean [1]
+
 Note that ocamlclean can be quite slow (minutes) for larger applications,
 hence it isnt done by default for the bytecode target.
 

diff --git a/assemble.sh b/assemble.sh
@@ -23,7 +23,7 @@ function assemble_xen {
     echo Assembling: Xen
     OBJ=${BUILDDIR}/xen
     mkdir -p ${OBJ}/lib ${OBJ}/syntax
-    for i in dietlibc/libdiet.a libm/libm.a ocaml/libocaml.a ocaml/libocamlbc.a kernel/libxen.a kernel/libxencaml.a kernel/x86_64.o; do
+    for i in dietlibc/libdiet.a libm/libm.a ocaml/libocaml.a ocaml/libocamlbc.a kernel/libxen.a kernel/libxencaml.a kernel/longjmp.o kernel/x86_64.o; do
       cp ${ROOT}/lib/_build/xen/os/runtime_xen/$i ${OBJ}/lib/
     done
     cp ${ROOT}/lib/os/runtime_xen/kernel/mirage-x86_64.lds ${OBJ}/lib/

diff --git a/lib/os/runtime_xen/all.itarget b/lib/os/runtime_xen/all.itarget
@@ -4,4 +4,5 @@ kernel/libxen.a
 kernel/libxencaml.a
 ocaml/libocaml.a
 ocaml/libocamlbc.a
+kernel/longjmp.o
 kernel/x86_64.o
diff --git a/lib/os/runtime_xen/kernel/longjmp.S b/lib/os/runtime_xen/kernel/longjmp.S
@@ -0,0 +1,23 @@
+#include <setjmp.h>
+
+.text
+.global __longjmp
+.type __longjmp,@function
+__longjmp:
+	mov	$1,%eax
+	/* Restore the return address now.  */
+	movq	 (JB_PC*8)(%rdi),%rdx
+	/* Restore registers. */
+	movq	(JB_RBX*8)(%rdi),%rbx
+	movq	(JB_RBP*8)(%rdi),%rbp
+	movq	(JB_R12*8)(%rdi),%r12
+	movq	(JB_R13*8)(%rdi),%r13
+	movq	(JB_R14*8)(%rdi),%r14
+	movq	(JB_R15*8)(%rdi),%r15
+	movq	(JB_RSP*8)(%rdi),%rsp
+	/* never return 0 */
+	test	%esi,%esi
+	cmovne	%esi,%eax
+	/* Jump to saved PC.  */
+	jmp	*%rdx
+.size __longjmp,.-__longjmp;
diff --git a/lib/os/runtime_xen/ocaml/backtrace_bc.c b/lib/os/runtime_xen/ocaml/backtrace_bc.c
@@ -125,6 +125,9 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp)
 #define O_BINARY 0
 #endif
 
+#ifdef SYS_xen
+static value read_debug_info(void) { return Val_false; }
+#else
 static value read_debug_info(void)
 {
   CAMLparam0();
@@ -165,6 +168,7 @@ static value read_debug_info(void)
   caml_close_channel(chan);
   CAMLreturn(events);
 }
+#endif
 
 /* Search the event for the given PC.  Return Val_false if not found. */
 
@@ -263,6 +267,7 @@ CAMLexport void caml_print_exception_backtrace(void)
   struct loc_info li;
 
   events = read_debug_info();
+
   if (events == Val_false) {
     fprintf(stderr,
             "(Program not linked with -g, cannot print stack backtrace)\n");

diff --git a/lib/os/runtime_xen/ocaml/dynlink.c b/lib/os/runtime_xen/ocaml/dynlink.c
@@ -60,10 +60,12 @@ static c_primitive lookup_primitive(char * name)
     if (strcmp(name, caml_names_of_builtin_cprim[i]) == 0)
       return caml_builtin_cprim[i];
   }
+#ifndef SYS_xen
   for (i = 0; i < shared_libs.size; i++) {
     res = caml_dlsym(shared_libs.contents[i], name);
     if (res != NULL) return (c_primitive) res;
   }
+#endif
   return NULL;
 }
 
@@ -72,6 +74,7 @@ static c_primitive lookup_primitive(char * name)
 
 #define LD_CONF_NAME "ld.conf"
 
+#ifndef SYS_xen
 static char * parse_ld_conf(void)
 {
   char * stdlib, * ldconfname, * config, * p, * q;
@@ -177,6 +180,8 @@ void caml_build_primitive_table(char * lib_path,
   caml_ext_table_free(&caml_shared_libs_path, 0);
 }
 
+#endif /* SYS_xen */
+
 /* Build the table of primitives as a copy of the builtin primitive table.
    Used for executables generated by ocamlc -output-obj. */
 
@@ -191,7 +196,7 @@ void caml_build_primitive_table_builtin(void)
 #endif /* NATIVE_CODE */
 
 /** dlopen interface for the bytecode linker **/
-
+#ifndef SYS_xen
 #define Handle_val(v) (*((void **) (v)))
 
 CAMLprim value caml_dynlink_open_lib(value mode, value filename)
@@ -265,3 +270,4 @@ value caml_dynlink_get_current_libs(value unit)
 }
 
 #endif /* NATIVE_CODE */
+#endif
diff --git a/lib/os/runtime_xen/ocaml/fail_bc.c b/lib/os/runtime_xen/ocaml/fail_bc.c
@@ -0,0 +1,170 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1996 Institut National de Recherche en Informatique et   */
+/*  en Automatique.  All rights reserved.  This file is distributed    */
+/*  under the terms of the GNU Library General Public License, with    */
+/*  the special exception on linking described in file ../LICENSE.     */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+/* Raising exceptions from C. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "alloc.h"
+#include "fail.h"
+#include "io.h"
+#include "gc.h"
+#include "memory.h"
+#include "misc.h"
+#include "mlvalues.h"
+#include "printexc.h"
+#include "signals.h"
+#include "stacks.h"
+
+CAMLexport struct longjmp_buffer * caml_external_raise = NULL;
+value caml_exn_bucket;
+
+CAMLexport void caml_raise(value v)
+{
+  Unlock_exn();
+  caml_exn_bucket = v;
+  if (caml_external_raise == NULL) caml_fatal_uncaught_exception(v);
+  siglongjmp(caml_external_raise->buf, 1);
+}
+
+CAMLexport void caml_raise_constant(value tag)
+{
+  CAMLparam1 (tag);
+  CAMLlocal1 (bucket);
+
+  bucket = caml_alloc_small (1, 0);
+  Field(bucket, 0) = tag;
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
+CAMLexport void caml_raise_with_arg(value tag, value arg)
+{
+  CAMLparam2 (tag, arg);
+  CAMLlocal1 (bucket);
+
+  bucket = caml_alloc_small (2, 0);
+  Field(bucket, 0) = tag;
+  Field(bucket, 1) = arg;
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
+CAMLexport void caml_raise_with_args(value tag, int nargs, value args[])
+{
+  CAMLparam1 (tag);
+  CAMLxparamN (args, nargs);
+  value bucket;
+  int i;
+
+  Assert(1 + nargs <= Max_young_wosize);
+  bucket = caml_alloc_small (1 + nargs, 0);
+  Field(bucket, 0) = tag;
+  for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
+CAMLexport void caml_raise_with_string(value tag, char const *msg)
+{
+  CAMLparam1 (tag);
+  CAMLlocal1 (vmsg);
+
+  vmsg = caml_copy_string(msg);
+  caml_raise_with_arg(tag, vmsg);
+  CAMLnoreturn;
+}
+
+/* PR#5115: Failure and Invalid_argument can be triggered by
+   input_value while reading the initial value of [caml_global_data]. */
+
+CAMLexport void caml_failwith (char const *msg)
+{
+  if (caml_global_data == 0) {
+    fprintf(stderr, "Fatal error: exception Failure(\"%s\")\n", msg);
+    exit(2);
+  }
+  caml_raise_with_string(Field(caml_global_data, FAILURE_EXN), msg);
+}
+
+CAMLexport void caml_invalid_argument (char const *msg)
+{
+  if (caml_global_data == 0) {
+    fprintf(stderr, "Fatal error: exception Invalid_argument(\"%s\")\n", msg);
+    exit(2);
+  }
+  caml_raise_with_string(Field(caml_global_data, INVALID_EXN), msg);
+}
+
+CAMLexport void caml_array_bound_error(void)
+{
+  caml_invalid_argument("index out of bounds");
+}
+
+/* Problem: we can't use [caml_raise_constant], because it allocates and
+   we're out of memory... Here, we allocate statically the exn bucket
+   for [Out_of_memory]. */
+
+static struct {
+  header_t hdr;
+  value exn;
+} out_of_memory_bucket = { 0, 0 };
+
+CAMLexport void caml_raise_out_of_memory(void)
+{
+  if (out_of_memory_bucket.exn == 0)
+    caml_fatal_error
+      ("Fatal error: out of memory while raising Out_of_memory\n");
+  caml_raise((value) &(out_of_memory_bucket.exn));
+}
+
+CAMLexport void caml_raise_stack_overflow(void)
+{
+  caml_raise_constant(Field(caml_global_data, STACK_OVERFLOW_EXN));
+}
+
+CAMLexport void caml_raise_sys_error(value msg)
+{
+  caml_raise_with_arg(Field(caml_global_data, SYS_ERROR_EXN), msg);
+}
+
+CAMLexport void caml_raise_end_of_file(void)
+{
+  caml_raise_constant(Field(caml_global_data, END_OF_FILE_EXN));
+}
+
+CAMLexport void caml_raise_zero_divide(void)
+{
+  caml_raise_constant(Field(caml_global_data, ZERO_DIVIDE_EXN));
+}
+
+CAMLexport void caml_raise_not_found(void)
+{
+  caml_raise_constant(Field(caml_global_data, NOT_FOUND_EXN));
+}
+
+CAMLexport void caml_raise_sys_blocked_io(void)
+{
+  caml_raise_constant(Field(caml_global_data, SYS_BLOCKED_IO));
+}
+
+/* Initialization of statically-allocated exception buckets */
+
+void caml_init_exceptions(void)
+{
+  out_of_memory_bucket.hdr = Make_header(1, 0, Caml_white);
+  out_of_memory_bucket.exn = Field(caml_global_data, OUT_OF_MEMORY_EXN);
+  caml_register_global_root(&out_of_memory_bucket.exn);
+}
diff --git a/lib/os/runtime_xen/ocaml/interp.c b/lib/os/runtime_xen/ocaml/interp.c
@@ -11,7 +11,7 @@
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: interp.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
 
 /* The bytecode interpreter */
 #include <stdio.h>

diff --git a/lib/os/runtime_xen/ocaml/jumptbl.h b/lib/os/runtime_xen/ocaml/jumptbl.h
@@ -0,0 +1,37 @@
+  &&lbl_ACC0, &&lbl_ACC1, &&lbl_ACC2, &&lbl_ACC3, &&lbl_ACC4, &&lbl_ACC5, &&lbl_ACC6, &&lbl_ACC7,
+  &&lbl_ACC, &&lbl_PUSH,
+  &&lbl_PUSHACC0, &&lbl_PUSHACC1, &&lbl_PUSHACC2, &&lbl_PUSHACC3,
+  &&lbl_PUSHACC4, &&lbl_PUSHACC5, &&lbl_PUSHACC6, &&lbl_PUSHACC7,
+  &&lbl_PUSHACC, &&lbl_POP, &&lbl_ASSIGN,
+  &&lbl_ENVACC1, &&lbl_ENVACC2, &&lbl_ENVACC3, &&lbl_ENVACC4, &&lbl_ENVACC,
+  &&lbl_PUSHENVACC1, &&lbl_PUSHENVACC2, &&lbl_PUSHENVACC3, &&lbl_PUSHENVACC4, &&lbl_PUSHENVACC,
+  &&lbl_PUSH_RETADDR, &&lbl_APPLY, &&lbl_APPLY1, &&lbl_APPLY2, &&lbl_APPLY3,
+  &&lbl_APPTERM, &&lbl_APPTERM1, &&lbl_APPTERM2, &&lbl_APPTERM3,
+  &&lbl_RETURN, &&lbl_RESTART, &&lbl_GRAB,
+  &&lbl_CLOSURE, &&lbl_CLOSUREREC,
+  &&lbl_OFFSETCLOSUREM2, &&lbl_OFFSETCLOSURE0, &&lbl_OFFSETCLOSURE2, &&lbl_OFFSETCLOSURE,
+  &&lbl_PUSHOFFSETCLOSUREM2, &&lbl_PUSHOFFSETCLOSURE0,
+  &&lbl_PUSHOFFSETCLOSURE2, &&lbl_PUSHOFFSETCLOSURE,
+  &&lbl_GETGLOBAL, &&lbl_PUSHGETGLOBAL, &&lbl_GETGLOBALFIELD, &&lbl_PUSHGETGLOBALFIELD, &&lbl_SETGLOBAL,
+  &&lbl_ATOM0, &&lbl_ATOM, &&lbl_PUSHATOM0, &&lbl_PUSHATOM,
+  &&lbl_MAKEBLOCK, &&lbl_MAKEBLOCK1, &&lbl_MAKEBLOCK2, &&lbl_MAKEBLOCK3, &&lbl_MAKEFLOATBLOCK,
+  &&lbl_GETFIELD0, &&lbl_GETFIELD1, &&lbl_GETFIELD2, &&lbl_GETFIELD3, &&lbl_GETFIELD, &&lbl_GETFLOATFIELD,
+  &&lbl_SETFIELD0, &&lbl_SETFIELD1, &&lbl_SETFIELD2, &&lbl_SETFIELD3, &&lbl_SETFIELD, &&lbl_SETFLOATFIELD,
+  &&lbl_VECTLENGTH, &&lbl_GETVECTITEM, &&lbl_SETVECTITEM,
+  &&lbl_GETSTRINGCHAR, &&lbl_SETSTRINGCHAR,
+  &&lbl_BRANCH, &&lbl_BRANCHIF, &&lbl_BRANCHIFNOT, &&lbl_SWITCH, &&lbl_BOOLNOT,
+  &&lbl_PUSHTRAP, &&lbl_POPTRAP, &&lbl_RAISE, &&lbl_CHECK_SIGNALS,
+  &&lbl_C_CALL1, &&lbl_C_CALL2, &&lbl_C_CALL3, &&lbl_C_CALL4, &&lbl_C_CALL5, &&lbl_C_CALLN,
+  &&lbl_CONST0, &&lbl_CONST1, &&lbl_CONST2, &&lbl_CONST3, &&lbl_CONSTINT,
+  &&lbl_PUSHCONST0, &&lbl_PUSHCONST1, &&lbl_PUSHCONST2, &&lbl_PUSHCONST3, &&lbl_PUSHCONSTINT,
+  &&lbl_NEGINT, &&lbl_ADDINT, &&lbl_SUBINT, &&lbl_MULINT, &&lbl_DIVINT, &&lbl_MODINT,
+  &&lbl_ANDINT, &&lbl_ORINT, &&lbl_XORINT, &&lbl_LSLINT, &&lbl_LSRINT, &&lbl_ASRINT,
+  &&lbl_EQ, &&lbl_NEQ, &&lbl_LTINT, &&lbl_LEINT, &&lbl_GTINT, &&lbl_GEINT,
+  &&lbl_OFFSETINT, &&lbl_OFFSETREF, &&lbl_ISINT,
+  &&lbl_GETMETHOD,
+  &&lbl_BEQ, &&lbl_BNEQ,  &&lbl_BLTINT, &&lbl_BLEINT, &&lbl_BGTINT, &&lbl_BGEINT,
+  &&lbl_ULTINT, &&lbl_UGEINT,
+  &&lbl_BULTINT, &&lbl_BUGEINT,
+  &&lbl_GETPUBMET, &&lbl_GETDYNMET,
+  &&lbl_STOP,
+  &&lbl_EVENT, &&lbl_BREAK
diff --git a/lib/os/runtime_xen/ocaml/libcamlrun.cclib b/lib/os/runtime_xen/ocaml/libcamlrun.cclib
@@ -0,0 +1,42 @@
+amd64.bc.o
+alloc.bc.o
+array.bc.o
+backtrace.bc.o
+callback.bc.o
+compact.bc.o
+compare.bc.o
+custom.bc.o
+debugger.bc.o
+dynlink.bc.o
+extern.bc.o
+fail.bc.o
+finalise.bc.o
+floats.bc.o
+freelist.bc.o
+gc_ctrl.bc.o
+globroots.bc.o
+hash.bc.o
+instrtrace.bc.o
+intern.bc.o
+ints.bc.o
+io.bc.o
+lexing.bc.o
+main.bc.o
+major_gc.bc.o
+md5.bc.o
+memory.bc.o
+meta.bc.o
+minor_gc.bc.o
+misc.bc.o
+natdynlink.bc.o
+obj.bc.o
+parsing.bc.o
+printexc.bc.o
+roots.bc.o
+signals.bc.o
+stacks.bc.o
+startup_bc.bc.o
+str.bc.o
+sys.bc.o
+terminfo.bc.o
+weak.bc.o