<commit_before>(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            <NAME>, <NAME>, 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 Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* Disassembler for executable and .cmo object files *)

open Obj
open Printf
open Config
open Asttypes
open Lambda
open Emitcode
open Opcodes
open Instruct
open Opnames

(* Read signed and unsigned integers *)

let inputu ic =
  let b1 = input_byte ic in
  let b2 = input_byte ic in
  let b3 = input_byte ic in
  let b4 = input_byte ic in
  (b4 lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1

let inputs ic =
  let b1 = input_byte ic in
  let b2 = input_byte ic in
  let b3 = input_byte ic in
  let b4 = input_byte ic in
  let b4' = if b4 >= 128 then b4-256 else b4 in
  (b4' lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1

(* Global variables *)

type global_table_entry =
    Empty
  | Global of Ident.t
  | Constant of Obj.t

let start = ref 0                              (* Position of beg. of code *)
let reloc = ref ([] : (reloc_info * int) list) (* Relocation table *)
let globals = ref ([||] : global_table_entry array) (* Global map *)
let primitives = ref ([||] : string array)     (* Table of primitives *)
let objfile = ref false                        (* true if dumping a .cmo *)

(* Events (indexed by PC) *)

let event_table = (Hashtbl.create 253 : (int, debug_event) Hashtbl.t)

let relocate_event orig ev =
  ev.ev_pos <- orig + ev.ev_pos;
  match ev.ev_repr with
    Event_parent repr -> repr := ev.ev_pos
  | _                 -> ()

let record_events orig evl =
  List.iter 
    (fun ev ->
      relocate_event orig ev;
      Hashtbl.add event_table ev.ev_pos ev)
    evl

(* Print a structured constant *)

let print_float f =
  if String.contains f '.'
  then printf "%s" f
  else printf "%s." f
;;

let rec print_struct_const = function
    Const_base(Const_int i) -> printf "%d" i
  | Const_base(Const_float f) -> print_float f
  | Const_base(Const_string s) -> printf "%S" s
  | Const_base(Const_char c) -> printf "%C" c
  | Const_base(Const_int32 i) -> printf "%ldl" i
  | Const_base(Const_nativeint i) -> printf "%ndn" i
  | Const_base(Const_int64 i) -> printf "%LdL" i
  | Const_pointer n -> printf "%da" n
  | Const_block(tag, args) ->
      printf "<%d>" tag;
      begin match args with
        [] -> ()
      | [a1] ->
          printf "("; print_struct_const a1; printf ")"
      | a1::al ->
          printf "("; print_struct_const a1;
          List.iter (fun a -> printf ", "; print_struct_const a) al;
          printf ")"
      end
  | Const_float_array a ->
      printf "[|";
      List.iter (fun f -> print_float f; printf "; ") a;
      printf "|]"

(* Print an obj *)

let rec print_obj x =
  if Obj.is_block x then begin
    match Obj.tag x with
      252 ->                            (* string *)
        printf "%S" (Obj.magic x : string)
    | 253 ->                            (* float *)
        printf "%.12g" (Obj.magic x : float)
    | 254 ->                            (* float array *)
        let a = (Obj.magic x : float array) in
        printf "[|";
        for i = 0 to Array.length a - 1 do
          if i > 0 then printf ", ";
          printf "%.12g" a.(i)
        done;
        printf "|]"
    | _ ->
        printf "<%d>" (Obj.tag x);
        begin match Obj.size x with
          0 -> ()
        | 1 ->
            printf "("; print_obj (Obj.field x 0); printf ")"
        | n ->
            printf "("; print_obj (Obj.field x 0);
            for i = 1 to n - 1 do
              printf ", "; print_obj (Obj.field x i)
            done;
            printf ")"
        end
  end else
    printf "%d" (Obj.magic x : int)

(* Current position in input file *)

let currpos ic =
  pos_in ic - !start

(* Access in the relocation table *)

let rec rassoc key = function
    [] -> raise Not_found
  | (a,b) :: l -> if b = key then a else rassoc key l

let find_reloc ic =
  rassoc (pos_in ic - !start) !reloc

(* Symbolic printing of global names, etc *)

let print_getglobal_name ic =
  if !objfile then begin
    begin try
      match find_reloc ic with
          Reloc_getglobal id -> print_string (Ident.name id)<commit_msg>MAJ numeros de tags dans print_obj<commit_after>(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            <NAME>, <NAME>, 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 Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* Disassembler for executable and .cmo object files *)

open Obj
open Printf
open Config
open Asttypes
open Lambda
open Emitcode
open Opcodes
open Instruct
open Opnames

(* Read signed and unsigned integers *)

let inputu ic =
  let b1 = input_byte ic in
  let b2 = input_byte ic in
  let b3 = input_byte ic in
  let b4 = input_byte ic in
  (b4 lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1

let inputs ic =
  let b1 = input_byte ic in
  let b2 = input_byte ic in
  let b3 = input_byte ic in
  let b4 = input_byte ic in
  let b4' = if b4 >= 128 then b4-256 else b4 in
  (b4' lsl 24) + (b3 lsl 16) + (b2 lsl 8) + b1

(* Global variables *)

type global_table_entry =
    Empty
  | Global of Ident.t
  | Constant of Obj.t

let start = ref 0                              (* Position of beg. of code *)
let reloc = ref ([] : (reloc_info * int) list) (* Relocation table *)
let globals = ref ([||] : global_table_entry array) (* Global map *)
let primitives = ref ([||] : string array)     (* Table of primitives *)
let objfile = ref false                        (* true if dumping a .cmo *)

(* Events (indexed by PC) *)

let event_table = (Hashtbl.create 253 : (int, debug_event) Hashtbl.t)

let relocate_event orig ev =
  ev.ev_pos <- orig + ev.ev_pos;
  match ev.ev_repr with
    Event_parent repr -> repr := ev.ev_pos
  | _                 -> ()

let record_events orig evl =
  List.iter 
    (fun ev ->
      relocate_event orig ev;
      Hashtbl.add event_table ev.ev_pos ev)
    evl

(* Print a structured constant *)

let print_float f =
  if String.contains f '.'
  then printf "%s" f
  else printf "%s." f
;;

let rec print_struct_const = function
    Const_base(Const_int i) -> printf "%d" i
  | Const_base(Const_float f) -> print_float f
  | Const_base(Const_string s) -> printf "%S" s
  | Const_base(Const_char c) -> printf "%C" c
  | Const_base(Const_int32 i) -> printf "%ldl" i
  | Const_base(Const_nativeint i) -> printf "%ndn" i
  | Const_base(Const_int64 i) -> printf "%LdL" i
  | Const_pointer n -> printf "%da" n
  | Const_block(tag, args) ->
      printf "<%d>" tag;
      begin match args with
        [] -> ()
      | [a1] ->
          printf "("; print_struct_const a1; printf ")"
      | a1::al ->
          printf "("; print_struct_const a1;
          List.iter (fun a -> printf ", "; print_struct_const a) al;
          printf ")"
      end
  | Const_float_array a ->
      printf "[|";
      List.iter (fun f -> print_float f; printf "; ") a;
      printf "|]"

(* Print an obj *)

let rec print_obj x =
  if Obj.is_block x then begin
    let tag = Obj.tag x in
    if tag = Obj.string_tag then
        printf "%S" (Obj.magic x : string)
    else if tag = Obj.double_tag then
        printf "%.12g" (Obj.magic x : float)
    else if tag = Obj.double_array_tag then begin
        let a = (Obj.magic x : float array) in
        printf "[|";
        for i = 0 to Array.length a - 1 do
          if i > 0 then printf ", ";
          printf "%.12g" a.(i)
        done;
        printf "|]"
    end else if tag < Obj.no_scan_tag then begin
        printf "<%d>" (Obj.tag x);
        match Obj.size x with
          0 -> ()
        | 1 ->
            printf "("; print_obj (Obj.field x 0); printf ")"
        | n ->
            printf "("; print_obj (Obj.field x 0);
            for i = 1 to n - 1 do
              printf ", "; print_obj (Obj.field x i)
            done;
            printf ")"
    end else
        printf "<tag %d>" tag
  end else
    printf "%d" (Obj.magic x : int)

(* Current position in input file *)

let currpos ic =
  pos_in ic - !start

(* Access in the relocation table *)

let rec rassoc key = function
    [] -> raise Not_found
  | (a,b) :: l -> if b = key then a else rassoc key l

let find_reloc ic =
  rassoc (pos_in ic - !start) !reloc

(* Symbolic printing of global names, etc *)

let print_getglobal_name ic =
  if !objfile then begin
    begin try
      match find_reloc ic with
          Reloc_getglobal id -> print_string (Ident.name id)
{'fraction_non_alphanumeric': 0.1387277248238707, 'fraction_numerical': 0.014815582262743474, 'mean_word_length': 1.7898843930635837, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 68, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 21, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2047893', 'n_tokens_mistral': 3074, 'n_tokens_neox': 2944, 'n_words': 1030}