helm/DEVEL/pxp/netstring/netbuffer.ml

   1 (* $Id$
   2  * ----------------------------------------------------------------------
   3  *
   4  *)
   5
   6 type t =
   7     { mutable buffer : string;
   8       mutable length : int;
   9     }
  10
  11 (* To help the garbage collector:
  12  * The 'buffer' has a minimum length of 31 bytes. This minimum can still
  13  * be stored in the minor heap.
  14  * The 'buffer' has a length which is always near a multiple of two. This
  15  * limits the number of different bucket sizes, and simplifies reallocation
  16  * of freed memory.
  17  *)
  18
  19 (* Optimal string length:
  20  * Every string takes: 1 word for the header, enough words for the
  21  * contents + 1 Null byte (for C compatibility).
  22  * If the buffer grows, it is best to use a new string length such
  23  * that the number of words is exactly twice as large as for the previous
  24  * string.
  25  * n:              length of the previous string in bytes
  26  * w:              storage size of the previous string in words
  27  * n':             length of the new string in bytes
  28  * w' = 2*w:       storage size of the new string in words
  29  *
  30  * w = (n+1) / word_length + 1
  31  *            [it is assumed that (n+1) is always a multiple of word_length]
  32  *
  33  * n' = (2*w - 1) * word_length - 1
  34  *
  35  * n' = [2 * ( [n+1] / word_length + 1) - 1] * word_length - 1
  36  *    = ...
  37  *    = (2*n + 2) + word_length - 1
  38  *    = 2 * n + word_length + 1
  39  *
  40  * n'+1 is again a multiple of word_length:
  41  * n'+1 = 2*n + 2 + word_length
  42  *      = 2*(n+1) + word_length
  43  *      = a multiple of word_length because n+1 is a multiple of word_length
  44  *)
  45
  46 let word_length = Sys.word_size / 8       (* in bytes *)
  47
  48 let create n =
  49   { buffer = String.create (max n 31); length = 0; }
  50
  51 let contents b =
  52   String.sub b.buffer 0 b.length
  53
  54 let sub b ~pos:k ~len:n =
  55   if k+n > b.length then
  56     raise (Invalid_argument "Netbuffer.sub");
  57   String.sub b.buffer k n
  58
  59 let unsafe_buffer b =
  60   b.buffer
  61
  62 let length b =
  63   b.length
  64
  65 let add_string b s =
  66   let l = String.length s in
  67   if l + b.length > String.length b.buffer then begin
  68     let l' = l + b.length in
  69     let rec new_size s =
  70       if s >= l' then s else new_size(2*s + word_length + 1)
  71     in
  72     let buffer' = String.create (new_size (String.length b.buffer)) in
  73     String.blit b.buffer 0 buffer' 0 b.length;
  74     b.buffer <- buffer'
  75   end;
  76   String.blit s 0 b.buffer b.length l;
  77   b.length <- b.length + l
  78
  79 let add_sub_string b s ~pos:k ~len:l =
  80   if l + b.length > String.length b.buffer then begin
  81     let l' = l + b.length in
  82     let rec new_size s =
  83       if s >= l' then s else new_size(2*s + word_length + 1)
  84     in
  85     let buffer' = String.create (new_size (String.length b.buffer)) in
  86     String.blit b.buffer 0 buffer' 0 b.length;
  87     b.buffer <- buffer'
  88   end;
  89   String.blit s k b.buffer b.length l;
  90   b.length <- b.length + l
  91
  92 let delete b ~pos:k ~len:l =
  93   (* deletes l bytes at position k in b *)
  94   let n = String.length b.buffer in
  95   if k+l <> n & k <> n then
  96     String.blit b.buffer (k+l) b.buffer k (n-l-k);
  97   b.length <- b.length - l;
  98   ()
  99
 100 let try_shrinking b =
 101   (* If the buffer size decreases drastically, reallocate the buffer *)
 102   if b.length < (String.length b.buffer / 2) then begin
 103     let rec new_size s =
 104       if s >= b.length then s else new_size(2*s + word_length + 1)
 105     in
 106     let buffer' = String.create (new_size 31) in
 107     String.blit b.buffer 0 buffer' 0 b.length;
 108     b.buffer <- buffer'
 109   end
 110
 111 let clear b =
 112   delete b 0 (b.length)
 113
 114 let index_from b k c =
 115   if k > b.length then
 116     raise (Invalid_argument "Netbuffer.index_from");
 117   let p = String.index_from b.buffer k c in
 118   if p >= b.length then raise Not_found;
 119   p
 120
 121 let print_buffer b =
 122   Format.printf
 123     "<NETBUFFER: %d/%d>"
 124     b.length
 125     (String.length b.buffer)
 126 ;;
 127
 128 (* ======================================================================
 129  * History:
 130  *
 131  * $Log$
 132  * Revision 1.1  2000/11/17 09:57:27  lpadovan
 133  * Initial revision
 134  *
 135  * Revision 1.3  2000/06/25 22:34:43  gerd
 136  *      Added labels to arguments.
 137  *
 138  * Revision 1.2  2000/06/24 20:20:33  gerd
 139  *      Added the toploop printer.
 140  *
 141  * Revision 1.1  2000/04/15 13:07:48  gerd
 142  *      Initial revision.
 143  *
 144  *
 145  *)