diff options
Diffstat (limited to 'ocaml-binary-annot/byterun/fix_code.c')
| -rw-r--r-- | ocaml-binary-annot/byterun/fix_code.c | 162 |
1 files changed, 162 insertions, 0 deletions
diff --git a/ocaml-binary-annot/byterun/fix_code.c b/ocaml-binary-annot/byterun/fix_code.c new file mode 100644 index 0000000000..b252efd587 --- /dev/null +++ b/ocaml-binary-annot/byterun/fix_code.c @@ -0,0 +1,162 @@ +/***********************************************************************/ +/* */ +/* 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$ */ + +/* Handling of blocks of bytecode (endianness switch, threading). */ + +#include "config.h" + +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +#include "debugger.h" +#include "fix_code.h" +#include "instruct.h" +#include "md5.h" +#include "memory.h" +#include "misc.h" +#include "mlvalues.h" +#include "reverse.h" + +code_t caml_start_code; +asize_t caml_code_size; +unsigned char * caml_saved_code; +unsigned char caml_code_md5[16]; + +/* Read the main bytecode block from a file */ + +void caml_load_code(int fd, asize_t len) +{ + int i; + struct MD5Context ctx; + + caml_code_size = len; + caml_start_code = (code_t) caml_stat_alloc(caml_code_size); + if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size) + caml_fatal_error("Fatal error: truncated bytecode file.\n"); + caml_MD5Init(&ctx); + caml_MD5Update(&ctx, (unsigned char *) caml_start_code, caml_code_size); + caml_MD5Final(caml_code_md5, &ctx); +#ifdef ARCH_BIG_ENDIAN + caml_fixup_endianness(caml_start_code, caml_code_size); +#endif + if (caml_debugger_in_use) { + len /= sizeof(opcode_t); + caml_saved_code = (unsigned char *) caml_stat_alloc(len); + for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i]; + } +#ifdef THREADED_CODE + /* Better to thread now than at the beginning of [caml_interprete], + since the debugger interface needs to perform SET_EVENT requests + on the code. */ + caml_thread_code(caml_start_code, caml_code_size); +#endif +} + +/* This code is needed only if the processor is big endian */ + +#ifdef ARCH_BIG_ENDIAN + +void caml_fixup_endianness(code_t code, asize_t len) +{ + code_t p; + len /= sizeof(opcode_t); + for (p = code; p < code + len; p++) { + Reverse_32(p, p); + } +} + +#endif + +/* This code is needed only if we're using threaded code */ + +#ifdef THREADED_CODE + +char ** caml_instr_table; +char * caml_instr_base; + +void caml_thread_code (code_t code, asize_t len) +{ + code_t p; + int l [STOP + 1]; + int i; + + for (i = 0; i <= STOP; i++) { + l [i] = 0; + } + /* Instructions with one operand */ + l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] = + l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] = + l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] = + l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] = + l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] = + l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] = + l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] = + l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] = + l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] = + l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] = + l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1; + + /* Instructions with two operands */ + l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] = + l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] = + l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] = + l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2; + len /= sizeof(opcode_t); + for (p = code; p < code + len; /*nothing*/) { + opcode_t instr = *p; + if (instr < 0 || instr > STOP){ + /* FIXME -- should Assert(false) ? + caml_fatal_error_arg ("Fatal error in fix_code: bad opcode (%lx)\n", + (char *)(long)instr); + */ + instr = STOP; + } + *p++ = (opcode_t)(caml_instr_table[instr] - caml_instr_base); + if (instr == SWITCH) { + uint32 sizes = *p++; + uint32 const_size = sizes & 0xFFFF; + uint32 block_size = sizes >> 16; + p += const_size + block_size; + } else if (instr == CLOSUREREC) { + uint32 nfuncs = *p++; + p++; /* skip nvars */ + p += nfuncs; + } else { + p += l[instr]; + } + } + Assert(p == code + len); +} + +#endif /* THREADED_CODE */ + +void caml_set_instruction(code_t pos, opcode_t instr) +{ +#ifdef THREADED_CODE + *pos = (opcode_t)(caml_instr_table[instr] - caml_instr_base); +#else + *pos = instr; +#endif +} + +int caml_is_instruction(opcode_t instr1, opcode_t instr2) +{ +#ifdef THREADED_CODE + return instr1 == (opcode_t)(caml_instr_table[instr2] - caml_instr_base); +#else + return instr1 == instr2; +#endif +} |