<commit_before>/**************************************************************************/
/*                                                                        */
/*                                 OCaml                                  */
/*                                                                        */
/*             <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 GNU Lesser General Public License version 2.1, with the          */
/*   special exception on linking described in the file LICENSE.          */
/*                                                                        */
/**************************************************************************/

#define CAML_INTERNALS

#include <string.h>
#include <stdlib.h>
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"

#if defined(LACKS_SANE_NAN) && !defined(isnan)
#define isnan _isnan
#endif

/* Structural comparison on trees. */

struct compare_item { value * v1, * v2; mlsize_t count; };

#define COMPARE_STACK_INIT_SIZE 8
#define COMPARE_STACK_MIN_ALLOC_SIZE 32
#define COMPARE_STACK_MAX_SIZE (1024*1024)
CAMLexport int caml_compare_unordered;

struct compare_stack {
  struct compare_item init_stack[COMPARE_STACK_INIT_SIZE];
  struct compare_item* stack;
  struct compare_item* limit;
};

/* Free the compare stack if needed */
static void compare_free_stack(struct compare_stack* stk)
{
  if (stk->stack != stk->init_stack) {
    caml_stat_free(stk->stack);
    stk->stack = NULL;
  }
}

/* Same, then raise Out_of_memory */
CAMLnoreturn_start
static void compare_stack_overflow(struct compare_stack* stk)
CAMLnoreturn_end;

static void compare_stack_overflow(struct compare_stack* stk)
{
  caml_gc_message (0x04, "Stack overflow in structural comparison\n");
  compare_free_stack(stk);
  caml_raise_out_of_memory();
}

/* Grow the compare stack */
static struct compare_item * compare_resize_stack(struct compare_stack* stk,
                                                  struct compare_item * sp)
{
  asize_t newsize;
  asize_t sp_offset = sp - stk->stack;
  struct compare_item * newstack;

  if (stk->stack == stk->init_stack) {
    newsize = COMPARE_STACK_MIN_ALLOC_SIZE;
    newstack = caml_stat_alloc_noexc(sizeof(struct compare_item) * newsize);
    if (newstack == NULL) compare_stack_overflow(stk);
    memcpy(newstack, stk->init_stack,
           sizeof(struct compare_item) * COMPARE_STACK_INIT_SIZE);
  } else {
    newsize = 2 * (stk->limit - stk->stack);
    if (newsize >= COMPARE_STACK_MAX_SIZE) compare_stack_overflow(stk);
    newstack = caml_stat_resize_noexc(stk->stack,
                                      sizeof(struct compare_item) * newsize);
    if (newstack == NULL) compare_stack_overflow(stk);
  }
  stk->stack = newstack;
  stk->limit = newstack + newsize;
  return newstack + sp_offset;
}


static intnat do_compare_val(struct compare_stack* stk,
                             value v1, value v2, int total);

static intnat compare_val(value v1, value v2, int total)
{
  struct compare_stack stk;
  intnat res;
  stk.stack = stk.init_stack;
  stk.limit = stk.stack + COMPARE_STACK_INIT_SIZE;
  res = do_compare_val(&stk, v1, v2, total);
  compare_free_stack(&stk);
  return res;
}

/* Structural comparison */


#define LESS -1
#define EQUAL 0
#define GREATER 1
#define UNORDERED ((intnat)1 << (8 * sizeof(value) - 1))

/* The return value of compare_val is as follows:
      > 0                 v1 is greater than v2
      0                   v1 is equal to v2
      < 0 and > UNORDERED v1 is less than v2
      UNORDERED           v1 and v2 cannot be compared */

static intnat do_compare_val(struct compare_stack* stk,
                             value v1, value v2, int total)
{
  struct compare_item * sp;
  tag_t t1, t2;

  sp = stk->stack;
  while (1) {
    if (v1 == v2 && total) goto next_item;
    if (Is_long(v1)) {
      if (v1 == v2) goto next_item;
      if (Is_long(v2))
        return Long_val(v1) - Long_val(v2);
      /* Subtraction above cannot overflow and cannot result in UNORDERED */
      if (Is_in_value_area(v2)) {
        switch (Tag_val(v2)) {
        case Forward_tag:
          v2 = Forward_val(v2);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
          if (compare == NULL) break;  /* for backward compatibility */
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: /*fallthrough*/;
        }
      }
      return LESS;                /* v1 long < v2 block */
    }
    if (Is_long(v2)) {
      if (Is_in_value_area(v1)) {
        switch (Tag_val(v1)) {
        case Forward_tag:
          v1 = Forward_val(v1);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
          if (compare == NULL) break;  /* for backward compatibility */
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: /*fallthrough*/;
        }
      }
      return GREATER;            /* v1 block > v2 long */
    }
    /* If one of the objects is outside the heap (but is not an atom),
       use address comparison. Since both addresses are 2-aligned,
       shift lsb off to avoid overflow in subtraction. */
    if (! Is_in_value_area(v1) || ! Is_in_value_area(v2)) {
      if (v1 == v2) goto next_item;
      return (v1 >> 1) - (v2 >> 1);
      /* Subtraction above cannot result in UNORDERED */
    }
    t1 = Tag_val(v1);
    t2 = Tag_val(v2);
    if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
    if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }<commit_msg>Avoid page table lookup in Pervasives.compare with no-naked-pointers<commit_after>/**************************************************************************/
/*                                                                        */
/*                                 OCaml                                  */
/*                                                                        */
/*             <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 GNU Lesser General Public License version 2.1, with the          */
/*   special exception on linking described in the file LICENSE.          */
/*                                                                        */
/**************************************************************************/

#define CAML_INTERNALS

#include <string.h>
#include <stdlib.h>
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"

#if defined(LACKS_SANE_NAN) && !defined(isnan)
#define isnan _isnan
#endif

/* Structural comparison on trees. */

struct compare_item { value * v1, * v2; mlsize_t count; };

#define COMPARE_STACK_INIT_SIZE 8
#define COMPARE_STACK_MIN_ALLOC_SIZE 32
#define COMPARE_STACK_MAX_SIZE (1024*1024)
CAMLexport int caml_compare_unordered;

struct compare_stack {
  struct compare_item init_stack[COMPARE_STACK_INIT_SIZE];
  struct compare_item* stack;
  struct compare_item* limit;
};

/* Free the compare stack if needed */
static void compare_free_stack(struct compare_stack* stk)
{
  if (stk->stack != stk->init_stack) {
    caml_stat_free(stk->stack);
    stk->stack = NULL;
  }
}

/* Same, then raise Out_of_memory */
CAMLnoreturn_start
static void compare_stack_overflow(struct compare_stack* stk)
CAMLnoreturn_end;

static void compare_stack_overflow(struct compare_stack* stk)
{
  caml_gc_message (0x04, "Stack overflow in structural comparison\n");
  compare_free_stack(stk);
  caml_raise_out_of_memory();
}

/* Grow the compare stack */
static struct compare_item * compare_resize_stack(struct compare_stack* stk,
                                                  struct compare_item * sp)
{
  asize_t newsize;
  asize_t sp_offset = sp - stk->stack;
  struct compare_item * newstack;

  if (stk->stack == stk->init_stack) {
    newsize = COMPARE_STACK_MIN_ALLOC_SIZE;
    newstack = caml_stat_alloc_noexc(sizeof(struct compare_item) * newsize);
    if (newstack == NULL) compare_stack_overflow(stk);
    memcpy(newstack, stk->init_stack,
           sizeof(struct compare_item) * COMPARE_STACK_INIT_SIZE);
  } else {
    newsize = 2 * (stk->limit - stk->stack);
    if (newsize >= COMPARE_STACK_MAX_SIZE) compare_stack_overflow(stk);
    newstack = caml_stat_resize_noexc(stk->stack,
                                      sizeof(struct compare_item) * newsize);
    if (newstack == NULL) compare_stack_overflow(stk);
  }
  stk->stack = newstack;
  stk->limit = newstack + newsize;
  return newstack + sp_offset;
}


static intnat do_compare_val(struct compare_stack* stk,
                             value v1, value v2, int total);

static intnat compare_val(value v1, value v2, int total)
{
  struct compare_stack stk;
  intnat res;
  stk.stack = stk.init_stack;
  stk.limit = stk.stack + COMPARE_STACK_INIT_SIZE;
  res = do_compare_val(&stk, v1, v2, total);
  compare_free_stack(&stk);
  return res;
}

/* Structural comparison */


#define LESS -1
#define EQUAL 0
#define GREATER 1
#define UNORDERED ((intnat)1 << (8 * sizeof(value) - 1))

/* The return value of compare_val is as follows:
      > 0                 v1 is greater than v2
      0                   v1 is equal to v2
      < 0 and > UNORDERED v1 is less than v2
      UNORDERED           v1 and v2 cannot be compared */

static intnat do_compare_val(struct compare_stack* stk,
                             value v1, value v2, int total)
{
  struct compare_item * sp;
  tag_t t1, t2;

  sp = stk->stack;
  while (1) {
    if (v1 == v2 && total) goto next_item;
    if (Is_long(v1)) {
      if (v1 == v2) goto next_item;
      if (Is_long(v2))
        return Long_val(v1) - Long_val(v2);
      /* Subtraction above cannot overflow and cannot result in UNORDERED */
#ifndef NO_NAKED_POINTERS
      if (Is_in_value_area(v2)) {
#endif
        switch (Tag_val(v2)) {
        case Forward_tag:
          v2 = Forward_val(v2);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
          if (compare == NULL) break;  /* for backward compatibility */
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: /*fallthrough*/;
        }
#ifndef NO_NAKED_POINTERS
      }
#endif
      return LESS;                /* v1 long < v2 block */
    }
    if (Is_long(v2)) {
#ifndef NO_NAKED_POINTERS
      if (Is_in_value_area(v1)) {
#endif
        switch (Tag_val(v1)) {
        case Forward_tag:
          v1 = Forward_val(v1);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
          if (compare == NULL) break;  /* for backward compatibility */
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: /*fallthrough*/;
        }
#ifndef NO_NAKED_POINTERS
      }
#endif
      return GREATER;            /* v1 block > v2 long */
    }
#ifndef NO_NAKED_POINTERS
    /* If one of the objects is outside the heap (but is not an atom),
       use address comparison. Since both addresses are 2-aligned,
       shift lsb off to avoid overflow in subtraction. */
    if (! Is_in_value_area(v1) || ! Is_in_value_area(v2)) {
      if (v1 == v2) goto next_item;
      return (v1 >> 1) - (v2 >> 1);
      /* Subtraction above cannot result in UNORDERED */
    }
#endif
    t1 = Tag_val(v1);
    t2 = Tag_val(v2);
    if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
    if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
{'fraction_non_alphanumeric': 0.12146460785812567, 'fraction_numerical': 0.016052591346888856, 'mean_word_length': 2.0553479682391407, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 44, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1828198', 'n_tokens_mistral': 4120, 'n_tokens_neox': 3996, 'n_words': 1070}