l4/pkg/ocaml/contrib/byterun/fix_code.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: fix_code.c 6331 2004-05-26 11:10:52Z garrigue $ */
  15
  16 /* Handling of blocks of bytecode (endianness switch, threading). */
  17
  18 #include "config.h"
  19
  20 #ifdef HAS_UNISTD
  21 #include <unistd.h>
  22 #endif
  23
  24 #include "debugger.h"
  25 #include "fix_code.h"
  26 #include "instruct.h"
  27 #include "md5.h"
  28 #include "memory.h"
  29 #include "misc.h"
  30 #include "mlvalues.h"
  31 #include "reverse.h"
  32
  33 code_t caml_start_code;
  34 asize_t caml_code_size;
  35 unsigned char * caml_saved_code;
  36 unsigned char caml_code_md5[16];
  37
  38 /* Read the main bytecode block from a file */
  39
  40 void caml_load_code(int fd, asize_t len)
  41 {
  42   int i;
  43   struct MD5Context ctx;
  44
  45   caml_code_size = len;
  46   caml_start_code = (code_t) caml_stat_alloc(caml_code_size);
  47   if (read(fd, (char *) caml_start_code, caml_code_size) != caml_code_size)
  48     caml_fatal_error("Fatal error: truncated bytecode file.\n");
  49   caml_MD5Init(&ctx);
  50   caml_MD5Update(&ctx, (unsigned char *) caml_start_code, caml_code_size);
  51   caml_MD5Final(caml_code_md5, &ctx);
  52 #ifdef ARCH_BIG_ENDIAN
  53   caml_fixup_endianness(caml_start_code, caml_code_size);
  54 #endif
  55   if (caml_debugger_in_use) {
  56     len /= sizeof(opcode_t);
  57     caml_saved_code = (unsigned char *) caml_stat_alloc(len);
  58     for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i];
  59   }
  60 #ifdef THREADED_CODE
  61   /* Better to thread now than at the beginning of [caml_interprete],
  62      since the debugger interface needs to perform SET_EVENT requests
  63      on the code. */
  64   caml_thread_code(caml_start_code, caml_code_size);
  65 #endif
  66 }
  67
  68 /* This code is needed only if the processor is big endian */
  69
  70 #ifdef ARCH_BIG_ENDIAN
  71
  72 void caml_fixup_endianness(code_t code, asize_t len)
  73 {
  74   code_t p;
  75   len /= sizeof(opcode_t);
  76   for (p = code; p < code + len; p++) {
  77     Reverse_32(p, p);
  78   }
  79 }
  80
  81 #endif
  82
  83 /* This code is needed only if we're using threaded code */
  84
  85 #ifdef THREADED_CODE
  86
  87 char ** caml_instr_table;
  88 char * caml_instr_base;
  89
  90 void caml_thread_code (code_t code, asize_t len)
  91 {
  92   code_t p;
  93   int l [STOP + 1];
  94   int i;
  95
  96   for (i = 0; i <= STOP; i++) {
  97     l [i] = 0;
  98   }
  99   /* Instructions with one operand */
 100   l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] =
 101   l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] =
 102   l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] =
 103   l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] =
 104   l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] =
 105   l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] =
 106   l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] =
 107   l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] =
 108   l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] =
 109   l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] =
 110   l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1;
 111
 112   /* Instructions with two operands */
 113   l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] =
 114   l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] =
 115   l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] =
 116   l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2;
 117   len /= sizeof(opcode_t);
 118   for (p = code; p < code + len; /*nothing*/) {
 119     opcode_t instr = *p;
 120     if (instr < 0 || instr > STOP){
 121       /* FIXME -- should Assert(false) ?
 122       caml_fatal_error_arg ("Fatal error in fix_code: bad opcode (%lx)\n",
 123                             (char *)(long)instr);
 124       */
 125       instr = STOP;
 126     }
 127     *p++ = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
 128     if (instr == SWITCH) {
 129       uint32 sizes = *p++;
 130       uint32 const_size = sizes & 0xFFFF;
 131       uint32 block_size = sizes >> 16;
 132       p += const_size + block_size;
 133     } else if (instr == CLOSUREREC) {
 134       uint32 nfuncs = *p++;
 135       p++;                      /* skip nvars */
 136       p += nfuncs;
 137     } else {
 138       p += l[instr];
 139     }
 140   }
 141   Assert(p == code + len);
 142 }
 143
 144 #endif /* THREADED_CODE */
 145
 146 void caml_set_instruction(code_t pos, opcode_t instr)
 147 {
 148 #ifdef THREADED_CODE
 149   *pos = (opcode_t)(caml_instr_table[instr] - caml_instr_base);
 150 #else
 151   *pos = instr;
 152 #endif
 153 }
 154
 155 int caml_is_instruction(opcode_t instr1, opcode_t instr2)
 156 {
 157 #ifdef THREADED_CODE
 158   return instr1 == (opcode_t)(caml_instr_table[instr2] - caml_instr_base);
 159 #else
 160   return instr1 == instr2;
 161 #endif
 162 }