add netencoding.html

httpev.ml

@@ -184,7 +184,7 @@ let get_content_length headers =
   | Some s -> try Some (int_of_string s) with _ -> failed Header (sprintf "content-length %S" s)
 
 let decode_args s =
-  try Web.Url.dest_url_encoded_parameters s with exn -> Exn.fail ~exn "decode_args : %S" s
+  try Ocamlnet_lite.Netencoding.Url.dest_url_encoded_parameters s with exn -> Exn.fail ~exn "decode_args : %S" s
 
 let acceptable_encoding headers =
   let split s c = List.map (String.strip ~chars:" \t\r\n") @@ Stre.nsplitc s c in

ocamlnet_lite/netaux.ml

@@ -0,0 +1,53 @@
+module ArrayAux = struct
+  let int_blit_ref =
+    ref 
+      (fun (src:int array) srcpos dest destpos len ->
+	 (* A specialised version of Array.blit for int arrays.
+	  * Faster than the polymorphic Array.blit for
+	  * various reasons.
+	  *)
+	 if (len < 0 || srcpos < 0 || 
+	     srcpos+len > Array.length src ||
+	     destpos < 0 ||
+	     destpos+len > Array.length dest) then
+	   invalid_arg "Netaux.ArrayAux.int_blit";
+	 if src != dest || destpos <= srcpos then (
+	   for i = 0 to len-1 do
+	     Array.unsafe_set 
+	       dest 
+	       (destpos+i) 
+	       (Array.unsafe_get src (srcpos+i))
+	   done
+	 ) else (
+	   for i = len-1 downto 0 do
+	     Array.unsafe_set 
+	       dest 
+	       (destpos+i) 
+	       (Array.unsafe_get src (srcpos+i))
+	   done
+	 )
+      )
+
+  let int_blit src srcpos dest destpos len = 
+    !int_blit_ref src srcpos dest destpos len
+
+  let int_series_ref =
+    ref
+      (fun src srcpos dst dstpos len n ->
+	 if (len < 0 || srcpos < 0 || dstpos < 0 ||
+	     srcpos+len > Array.length src ||
+	     dstpos+len > Array.length dst)
+	 then
+	   invalid_arg "Netaux.ArrayAux.int_series";
+
+	 let s = ref n in
+	 for i = 0 to len-1 do
+	   Array.unsafe_set dst (dstpos+i) !s;
+	   s := !s + Array.unsafe_get src (srcpos+i)
+	 done
+      )
+
+  let int_series src srcpos dst dstpos len n =
+    !int_series_ref src srcpos dst dstpos len n
+
+end

ocamlnet_lite/netaux.mli

@@ -0,0 +1,31 @@
+(** Internal auxiliary functions 
+ *
+ * This is an internal module.
+ *)
+
+(* Auxiliary stuff *)
+
+module ArrayAux : sig
+  val int_blit : int array -> int -> int array -> int -> int -> unit
+    (** A specialisation of [Array.blit] for int arrays. 
+     * (Performance reasons.)
+     *)
+
+  val int_series : int array -> int -> int array -> int -> int -> int -> unit
+    (** [int_series src srcpos dst dstpos len n]:
+     * Computes for every [i], [0 <= i < len]:
+     * [dst.(dstpos+i) = n + SUM(j=0..(i-1): src.(srcpos+j)) ]
+     *
+     * It is expected that [src == dst] implies [srcpos >= dstpos].
+     *)
+
+    (**/**)
+
+  val int_blit_ref : 
+    (int array -> int -> int array -> int -> int -> unit) ref
+    (* Used by [Netaccel] to override the built-in implementation *)
+
+  val int_series_ref : 
+    (int array -> int -> int array -> int -> int -> int -> unit) ref
+    (* Used by [Netaccel] to override the built-in implementation *)
+end

ocamlnet_lite/netbuffer.ml

@@ -0,0 +1,88 @@
+type t = {
+  mutable buffer : Bytes.t;
+  mutable buffer_length : int; (* = String.length buffer *)
+  mutable length : int;
+  create_length : int;
+}
+
+(* To help the garbage collector:
+ * The 'buffer' has a minimum length of 31 bytes. This minimum can still
+ * be stored in the minor heap.
+ * The 'buffer' has a length which is always near a multiple of two. This
+ * limits the number of different bucket sizes, and simplifies reallocation
+ * of freed memory.
+ *)
+
+(* Optimal string length:
+ * Every string takes: 1 word for the header, enough words for the 
+ * contents + 1 Null byte (for C compatibility).
+ * If the buffer grows, it is best to use a new string length such
+ * that the number of words is exactly twice as large as for the previous
+ * string.
+ * n:              length of the previous string in bytes
+ * w:              storage size of the previous string in words
+ * n':             length of the new string in bytes
+ * w' = 2*w:       storage size of the new string in words
+ *
+ * w = (n+1) / word_length + 1
+ *            [it is assumed that (n+1) is always a multiple of word_length]
+ *
+ * n' = (2*w - 1) * word_length - 1
+ *
+ * n' = [2 * ( [n+1] / word_length + 1) - 1] * word_length - 1
+ *    = ...
+ *    = (2*n + 2) + word_length - 1
+ *    = 2 * n + word_length + 1
+ *
+ * n'+1 is again a multiple of word_length:
+ * n'+1 = 2*n + 2 + word_length
+ *      = 2*(n+1) + word_length
+ *      = a multiple of word_length because n+1 is a multiple of word_length
+ *)
+
+let word_length = Sys.word_size / 8 (* in bytes *)
+
+let create n =
+  let bl = max n 31 in
+  {
+    buffer = Bytes.create bl;
+    buffer_length = bl;
+    length = 0;
+    create_length = n;
+  }
+
+let contents b = Bytes.sub_string b.buffer 0 b.length
+let to_bytes b = Bytes.sub b.buffer 0 b.length
+
+let to_tstring_poly : type s. t -> s Netstring_tstring.tstring_kind -> s =
+ fun b kind ->
+  match kind with
+  | Netstring_tstring.String_kind -> contents b
+  | Netstring_tstring.Bytes_kind -> to_bytes b
+
+let alloc_space b n =
+  let rec new_size s =
+    if s >= n then s else new_size ((2 * s) + word_length + 1)
+  in
+  let size = min (new_size b.buffer_length) Sys.max_string_length in
+  if size < n then failwith "Netbuffer: string too large";
+  let buffer' = Bytes.create size in
+  Bytes.blit b.buffer 0 buffer' 0 b.length;
+  b.buffer <- buffer';
+  b.buffer_length <- size
+
+let ensure_space b n =
+  (* Ensure that there are n bytes space in b *)
+  if n > b.buffer_length then alloc_space b n
+
+let add_internal blit b s k l =
+  ensure_space b (l + b.length);
+  blit s k b.buffer b.length l;
+  b.length <- b.length + l
+
+let add_substring b s k l =
+  if k < 0 || l < 0 || k > String.length s - l then
+    invalid_arg "Netbuffer.add_substring";
+  add_internal Bytes.blit_string b s k l
+
+let add_string b s = add_substring b s 0 (String.length s)

ocamlnet_lite/netbuffer.mli

@@ -0,0 +1,19 @@
+(** A Netbuffer.t is a buffer that can grow and shrink dynamically. *)
+
+type t
+
+val create : int -> t
+    (** Creates a netbuffer which allocates initially this number of bytes. 
+     * The logical length is zero.
+     *)
+
+val to_tstring_poly : t -> 's Netstring_tstring.tstring_kind -> 's
+    (** Return the buffer in the format as selected by the arg *)
+
+(** {2 Appending strings} *)
+
+val add_string : t -> string -> unit
+    (** [add_string nb s]: Adds a copy of the string [s] to the logical end of
+     * the netbuffer [nb]. If necessary, [nb] grows.
+     *)
+