<commit_before>(* Utility program which copies between two block devices, using vhd BATs and efficient zero-scanning
   for performance. *)

open Pervasiveext
open Stringext
open Listext

let ( +* ) = Int64.add
let ( -* ) = Int64.sub
let ( ** ) = Int64.mul

let kib = 1024L
let mib = kib ** kib

let blocksize = 10L ** mib

exception ShortWrite of int (* offset *) * int (* expected *) * int (* actual *)

(* Consider a tunable quantum of non-zero'ness such that if we encounter
   a non-zero, we know we're going to incur the penalty of a seek/write
   and we may as well write a sizeable chunk at a time. *)
let roundup x = 
	let quantum = 16384 in
	((x + quantum + quantum - 1) / quantum) * quantum

(** Represents a substring without making a copy *)
type substring = {
	buf: string;
	offset: int;
	len: int;
}

(** The copying routine has inputs and outputs which both look like a 
    Unix file-descriptor *)
module type IO = sig
	type t
	val op: t -> int64 -> substring -> unit
end
	
(* [fold_over_blocks (s, len) skip f initial] applies contiguous (start, length) pairs to 
   [f] starting at [s] up to maximum length [len] where each pair is as large as possible
   up to [skip]. *)
let fold_over_blocks (s, len) skip f initial = 
	let rec inner offset acc = 
		if offset = s +* len then acc
		else
			let len' = min skip (s +* len -* offset) in
			inner (offset +* len') (f acc (offset, len')) in
	inner s initial

(** Represents a "block allocation table" *)
module Bat = ExtentlistSet.ExtentlistSet(Int64)

(** As we copy we accumulate some simple performance stats *)
type stats = {
	writes: int;  (* total number of writes *)
	bytes: int64; (* total bytes written *)
}

(** Perform the data duplication ("DD") *)
module DD(Input : IO)(Output : IO) = struct
	(** [copy progress_cb bat sparse src dst size] copies blocks of data from [src] to [dst]
	    where [bat] represents the allocated / dirty blocks in [src];
	    where if sparse is None it means don't scan for and skip over blocks of zeroes in [src]
	    where if sparse is (Some c) it means do scan for and skip over blocks of 'c' in [src]
	    while calling [progress_cb] frequently to report the fraction complete
	*)
	let copy progress_cb bat sparse (src: Input.t) (dst: Output.t) size = 
		let buf = String.create (Int64.to_int blocksize) in
		let do_block stats (offset, this_chunk) : stats =
			progress_cb ((Int64.to_float offset) /. (Int64.to_float size));   
			Input.op src offset { buf = buf; offset = 0; len = Int64.to_int this_chunk };
			let write_extent stats (s, e) = 
				Output.op dst (offset +* (Int64.of_int s)) { buf = buf; offset = s; len = e };
				{ stats with writes = stats.writes + 1; bytes = stats.bytes +* (Int64.of_int e) }
			in
			begin match sparse with
			| Some zero -> Zerocheck.fold_over_nonzeros buf (Int64.to_int this_chunk) roundup write_extent stats
			| None -> write_extent stats (0, Int64.to_int this_chunk)
			end in
		(* For each entry from the BAT, copy it as a sequence of sub-blocks *)
		Bat.fold_left (fun stats b -> fold_over_blocks b blocksize do_block stats) { writes = 0; bytes = 0L } bat
end

(* Helper function to always return a block of zeroes, like /dev/null *)
module Zero_reader = struct
	type t = unit
	let op _ _ { buf = buf; offset = offset; len = len } = 
		for i = 0 to len - 1 do
			buf.[offset + i] <- '\000'
		done
end

let blit src srcoff dst dstoff len = 
	(* Printf.printf "[%s](%d) -> [%s](%d) %d\n" "?" srcoff "?" dstoff len; *)
	String.blit src srcoff dst dstoff len

module String_reader = struct
	type t = string
	let op str stream_offset { buf = buf; offset = offset; len = len } = 
		blit str (Int64.to_int stream_offset) buf offset len
end
module String_writer = struct
	type t = string
	let op str stream_offset { buf = buf; offset = offset; len = len } = 
		blit buf offset str (Int64.to_int stream_offset) len
end
<commit_msg>CA-43021: More refactorings of the sparse_dd binary.<commit_after>(* Utility program which copies between two block devices, using vhd BATs and efficient zero-scanning
   for performance. *)

open Pervasiveext
open Stringext
open Listext
open Zerocheck

let ( +* ) = Int64.add
let ( -* ) = Int64.sub
let ( ** ) = Int64.mul

let kib = 1024L
let mib = kib ** kib

let blocksize = 10L ** mib

exception ShortWrite of int (* offset *) * int (* expected *) * int (* actual *)

(* Consider a tunable quantum of non-zero'ness such that if we encounter
   a non-zero, we know we're going to incur the penalty of a seek/write
   and we may as well write a sizeable chunk at a time. *)
let roundup x = 
	let quantum = 16384 in
	((x + quantum + quantum - 1) / quantum) * quantum

(** The copying routine has inputs and outputs which both look like a 
    Unix file-descriptor *)
module type IO = sig
	type t
	val op: t -> int64 -> substring -> unit
end
	
(* [partition_into_blocks (s, len) skip f initial] applies contiguous (start, length) pairs to 
   [f] starting at [s] up to maximum length [len] where each pair is as large as possible
   up to [skip]. *)
let partition_into_blocks (s, len) skip f initial = 
	let rec inner offset acc = 
		if offset = s +* len then acc
		else
			let len' = min skip (s +* len -* offset) in
			inner (offset +* len') (f acc (offset, len')) in
	inner s initial

(** Represents a "block allocation table" *)
module Bat = ExtentlistSet.ExtentlistSet(Int64)

(** As we copy we accumulate some simple performance stats *)
type stats = {
	writes: int;  (* total number of writes *)
	bytes: int64; (* total bytes written *)
}

(** Perform the data duplication ("DD") *)
module DD(Input : IO)(Output : IO) = struct
	let fold bat sparse (src: Input.t) size f initial = 
		let buf = String.create (Int64.to_int blocksize) in
		let do_block acc (offset, this_chunk) =
			Input.op src offset { buf = buf; offset = 0; len = Int64.to_int this_chunk };
			begin match sparse with
			| Some zero -> fold_over_nonzeros buf (Int64.to_int this_chunk) roundup (f offset) acc
			| None -> f offset acc { buf = buf; offset = 0; len = Int64.to_int this_chunk }
			end in
		(* For each entry from the BAT, copy it as a sequence of sub-blocks *)
		Bat.fold_left (fun acc b -> partition_into_blocks b blocksize do_block acc) initial bat

	(** [copy progress_cb bat sparse src dst size] copies blocks of data from [src] to [dst]
	    where [bat] represents the allocated / dirty blocks in [src];
	    where if sparse is None it means don't scan for and skip over blocks of zeroes in [src]
	    where if sparse is (Some c) it means do scan for and skip over blocks of 'c' in [src]
	    while calling [progress_cb] frequently to report the fraction complete
	*)
	let copy progress_cb bat sparse src dst size =
		let total_work = Bat.fold_left (fun total (_, size) -> total +* size) 0L bat in 
		fold bat sparse src size
			(fun offset stats substr -> 
				Output.op dst (offset +* (Int64.of_int substr.offset)) substr;
				let stats' = { writes = stats.writes + 1; bytes = stats.bytes +* (Int64.of_int substr.len) } in
				progress_cb (Int64.to_float stats'.bytes /. (Int64.to_float total_work));
				stats')
			{ writes = 0; bytes = 0L }
end

(* Helper function to always return a block of zeroes, like /dev/null *)
module Zero_reader = struct
	type t = unit
	let op _ _ { buf = buf; offset = offset; len = len } = 
		for i = 0 to len - 1 do
			buf.[offset + i] <- '\000'
		done
end

let blit src srcoff dst dstoff len = 
	(* Printf.printf "[%s](%d) -> [%s](%d) %d\n" "?" srcoff "?" dstoff len; *)
	String.blit src srcoff dst dstoff len

module String_reader = struct
	type t = string
	let op str stream_offset { buf = buf; offset = offset; len = len } = 
		blit str (Int64.to_int stream_offset) buf offset len
end
module String_writer = struct
	type t = string
	let op str stream_offset { buf = buf; offset = offset; len = len } = 
		blit buf offset str (Int64.to_int stream_offset) len
end

{'fraction_non_alphanumeric': 0.10429369918699187, 'fraction_numerical': 0.014481707317073171, 'mean_word_length': 3.337741046831956, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4787976', 'n_tokens_mistral': 2757, 'n_tokens_neox': 2507, 'n_words': 1091}