Permalink
Browse files

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.
  • Loading branch information...
avsm committed Apr 19, 2012
1 parent 492afe1 commit 527bc83e40c0f2bf53c1cb68f90db4708e58c2d8
View
@@ -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.
View
@@ -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/
@@ -4,4 +4,5 @@ kernel/libxen.a
kernel/libxencaml.a
ocaml/libocaml.a
ocaml/libocamlbc.a
+kernel/longjmp.o
kernel/x86_64.o
@@ -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;
@@ -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");
@@ -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
@@ -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);
+}
@@ -11,7 +11,7 @@
/* */
/***********************************************************************/
-/* $Id: interp.c 9547 2010-01-22 12:48:24Z doligez $ */
+/* $Id$ */
/* The bytecode interpreter */
#include <stdio.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
@@ -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
Oops, something went wrong.

0 comments on commit 527bc83

Please sign in to comment.