----------------------------------------------------------------------------- -- -- Onions Network Streams Library -- -- O N I O N S . B U C K E T S -- -- B o d y -- -- Copyright (C) 1997-1998 Regents of the University of California -- -- Onions is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation, with or without the single exception listed below; -- either version 2, or (at your option) any later version. Onions is -- distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -- without even the implied warranty of MERCHANTABILITY or FITNESS FOR A -- PARTICULAR PURPOSE. See the GNU General Public License for more details. -- You should have received a copy of the GNU General Public License -- distributed with Onions; see the file COPYING. If not, write to the -- Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- As a special exception, if other files instantiate generics from this -- library, or you link this library with other files to produce an -- executable, this library does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU General Public License. -- -- Created in 1997 by Roy T. Fielding ----------------------------------------------------------------------------- -- -- The Onions Buckets ADT defines objects and operations for manipulating -- raw data in the form of Iovec structures (a system address and length). -- The primary advantage of using Buckets instead of Strings or -- Storage_Arrays or Stream_Element_Arrays or C.char_arrays is that we can -- control their memory structure without worrying about the dope vector, -- avoid unnecessary copies, and perform more efficient moves to other data -- structures. -- -- We could make this even more efficient by adding two more components to -- the existing Bucket_Rec, namely -- -- Real_Base : Address as allocated by C_malloc -- Real_Len : Storage_Count that was actually allocated -- -- This would allow us to point the Iovec at any subset of the real array -- without copying the data and/or reallocating the array. -- with Ada.Characters.Latin_1; with Ada.Streams; use Ada.Streams; with System.Storage_Elements; use System.Storage_Elements; with Interfaces.C.Strings; with Unchecked_Conversion; with Unchecked_Deallocation; with Onions.Thin; use Onions.Thin; package body Onions.Buckets is use System; use Bucket_Queues; -- Allocate storage for a Bucket of a given size. -- function Allocate (Size : in Storage_Count) return Bucket is Newbie : Bucket; begin Newbie := new Bucket_Rec'(Iov_Base => C_malloc (Size), Iov_Len => Size); if Newbie.Iov_Base = Null_Address then raise Storage_Error; end if; return Newbie; end Allocate; -- Free the storage associated with a Bucket. -- procedure Dispose is new Unchecked_Deallocation (Bucket_Rec, Bucket); procedure Free (Bucko : in out Bucket) is begin if Bucko /= null then if Bucko.Iov_Base /= Null_Address then C_free (Bucko.Iov_Base); end if; Dispose (Bucko); end if; end Free; procedure Free (Blist : in out Bucket_List) is Bucko : Bucket; begin while not IsEmpty (Blist) loop Extract (Blist, Bucko); Free (Bucko); end loop; end Free; -- Split a Bucket into two Buckets, Front and Back, discarding anything -- in the gaps around the two offsets (a common thing for filters). -- -- If we were doing memory management of buckets, we could just -- do a view conversion on the existing array and keep track of -- the number of buckets pointing to a single memory allocation, -- and garbage collect after all the buckets are Free. For now, -- we'll just copy the back half into a new bucket and truncate -- the front half. Yuck. -- procedure Split (Bucko : in out Bucket; Front : out Bucket; Back : out Bucket; Fbeg : in Storage_Offset; Flen : in Storage_Count; Bbeg : in Storage_Offset; Blen : in Storage_Count) is begin if Bbeg <= 0 then Front := null; Back := Bucko; elsif Bbeg >= Bucko.Iov_Len then Front := Bucko; Back := null; else Back := New_Bucket ((Bucko.Iov_Base + Bbeg), Blen); Front := Bucko; if Fbeg > 0 and Flen > 0 then Front.Iov_Base := C_memmove (Front.Iov_Base, (Front.Iov_Base + Fbeg), Flen); end if; Front.Iov_Len := Flen; Front.Iov_Base := C_realloc (Front.Iov_Base, Front.Iov_Len); Bucko := null; if Front.Iov_Base = Null_Address then raise Storage_Error; end if; end if; end Split; procedure Split (Bucko : in out Bucket; Front : out Bucket; Back : out Bucket; Fbeg : in Address; Flen : in Storage_Count; Bbeg : in Address; Blen : in Storage_Count) is begin Split (Bucko, Front, Back, Fbeg - Bucko.Iov_Base, Flen, Bbeg - Bucko.Iov_Base, Blen); end Split; -- Truncate a Bucket beyond a given length -- procedure Truncate (Bucko : in out Bucket; Len : in Storage_Count) is begin if Bucko.Iov_Len > Len then Bucko.Iov_Len := Len; Bucko.Iov_Base := C_realloc (Bucko.Iov_Base, Bucko.Iov_Len); end if; end Truncate; -- To_Iovec sets an Iovec structure to point to a bucket's contents. -- procedure To_Iovec (Bucko : in Bucket; Vec : in Iovec_Access) is begin Vec.Iov_Base := Bucko.Iov_Base; Vec.Iov_Len := Bucko.Iov_Len; end To_Iovec; -- Address_Of returns the System.Address of the bucket's contents. -- function Address_Of (Bucko : Bucket) return System.Address is begin return Bucko.Iov_Base; end Address_Of; -- Utility functions for looking at a bucket character -- type Cp is access all Character; function Addr_To_Char_Ptr is new Unchecked_Conversion (Address, Cp); function chars_ptr_To_Address is new Unchecked_Conversion (C.Strings.chars_ptr, Address); function Val (Addr : Address) return Character is begin return Addr_To_Char_Ptr (Addr).all; end Val; procedure Set (Addr : Address; Char : Character) is Pip : Cp; begin Pip := Addr_To_Char_Ptr (Addr); Pip.all := Char; end Set; -- To_Ada allocates a new string containing the data in a bucket -- function To_Ada (Bucko : in Bucket) return String is subtype Tmp_Array is String (1 .. Positive (Bucko.Iov_Len)); type Tmp_Array_Ptr is access Tmp_Array; function Bucket_to_Tmp_Array_Ptr is new Unchecked_Conversion (Address, Tmp_Array_Ptr); begin return Bucket_to_Tmp_Array_Ptr (Bucko.Iov_Base).all; end To_Ada; function To_Ada (Bucko : in Bucket) return Wide_String is subtype Tmp_Array is Wide_String (1 .. Positive (Bucko.Iov_Len) / 2); type Tmp_Array_Ptr is access Tmp_Array; function Bucket_to_Tmp_Array_Ptr is new Unchecked_Conversion (Address, Tmp_Array_Ptr); begin return Bucket_to_Tmp_Array_Ptr (Bucko.Iov_Base).all; end To_Ada; function To_Ada (Bucko : in Bucket) return C.char_array is subtype Tmp_Array is C.char_array (0 .. C.size_t (Bucko.Iov_Len - 1)); type Tmp_Array_Ptr is access Tmp_Array; function Bucket_to_Tmp_Array_Ptr is new Unchecked_Conversion (Address, Tmp_Array_Ptr); begin return Bucket_to_Tmp_Array_Ptr (Bucko.Iov_Base).all; end To_Ada; function To_Ada (Bucko : in Bucket) return C.Strings.chars_ptr is begin return C.Strings.New_String (To_Ada (Bucko)); end To_Ada; function To_Ada (Bucko : in Bucket) return Storage_Array is subtype Tmp_Array is Storage_Array (1 .. Bucko.Iov_Len); type Tmp_Array_Ptr is access Tmp_Array; function Bucket_to_Tmp_Array_Ptr is new Unchecked_Conversion (Address, Tmp_Array_Ptr); begin return Bucket_to_Tmp_Array_Ptr (Bucko.Iov_Base).all; end To_Ada; function To_Ada (Bucko : in Bucket) return Stream_Element_Array is subtype Tmp_Array is Stream_Element_Array (1 .. Stream_Element_Offset (Bucko.Iov_Len)); type Tmp_Array_Ptr is access Tmp_Array; function Bucket_to_Tmp_Array_Ptr is new Unchecked_Conversion (Address, Tmp_Array_Ptr); begin return Bucket_to_Tmp_Array_Ptr (Bucko.Iov_Base).all; end To_Ada; -- New_Bucket allocates a new bucket containing a copy of an array. -- function New_Bucket (S : in String) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := S'Length; begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in Wide_String) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := S'Length * 2; begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in C.char_array) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := S'Length; begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in Storage_Array) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := S'Length; begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in Stream_Element_Array) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := S'Length; begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in Stream_Element_Array; Last : in Stream_Element_Offset) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := Storage_Count (Last); begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, S (S'First)'Address, Blen); return Bucko; end New_Bucket; function New_Bucket (S : in C.Strings.chars_ptr; Len : in C.size_t) return Bucket is Dummy : Address; Bucko : Bucket; Blen : Storage_Count := Storage_Count (Len); begin Bucko := Allocate (Blen); Dummy := C_memcpy (Bucko.Iov_Base, chars_ptr_To_Address (S), Blen); return Bucko; end New_Bucket; function New_Bucket (S : in Address; Len : in Storage_Count) return Bucket is Dummy : Address; Bucko : Bucket; begin Bucko := Allocate (Len); Dummy := C_memcpy (Bucko.Iov_Base, S, Len); return Bucko; end New_Bucket; function New_Bucket (S : in Character) return Bucket is Bucko : Bucket; begin Bucko := Allocate (1); Addr_to_Char_Ptr (Bucko.Iov_Base).all := S; return Bucko; end New_Bucket; -- Dump_Into dumps the contents of a bucket list into an array -- until the array is full or the buckets are empty. Last is -- the array position of the last byte filled. Assumes the -- bucket list is non-empty and that Last < Item'Last on entry. -- Note that Item may already contain preprocessed data. -- procedure Dump_Into (BL : in out Bucket_List; Item : in out Stream_Element_Array; Last : in out Stream_Element_Offset) is Dummy : Address; Bucko : Bucket; Avail : Storage_Count; begin loop Extract (BL, Bucko); Avail := Storage_Count (Item'Last - Last); if Avail > Bucko.Iov_Len then Avail := Bucko.Iov_Len; end if; Dummy := C_memcpy (Bucko.Iov_Base, Item (Last + 1)'Address, Avail); Last := Last + Stream_Element_Offset (Avail); if Avail /= Bucko.Iov_Len then BL := Add_Before (BL, New_Bucket ((Bucko.Iov_Base + Avail), (Bucko.Iov_Len - Avail))); end if; Free (Bucko); exit when Last = Item'Last or else IsEmpty (BL); end loop; end Dump_Into; -- Dump_Line dumps the contents of one bucket list (Foil) into -- another list (Toil) until an End-of-Line character sequence -- (CRLF, bare LF, or bare CR) is found (Done = True) or we run -- out of bucket contents. The End-of-Line character sequence is -- translated to LF. Assumes Foil is non-empty on entry. -- Note that Toil may contain previously processed data. -- procedure Dump_Line (Foil : in out Bucket_List; Toil : in out Bucket_List; Done : out Boolean) is End_of_Toil : Bucket_List; Bucko : Bucket; Tempo : Bucket; Where : Address; Next_Line : Address; CR : constant C.Int := 13; LF : constant C.Int := 10; begin Done := False; End_of_Toil := End_of_List (Toil); loop Extract (Foil, Bucko); -- First check for LF, possibly preceded by a CR -- Where := C_memchr (Bucko.Iov_Base, LF, Bucko.Iov_Len); if Where /= Null_Address then Next_Line := Where + 1; if Where > Bucko.Iov_Base then if Val (Where - 1) = Ada.Characters.Latin_1.CR then Where := Where - 1; Set (Where, Ada.Characters.Latin_1.LF); end if; end if; exit; end if; -- Since we didn't find a LF, check for a bare CR -- Where := C_memchr (Bucko.Iov_Base, CR, Bucko.Iov_Len); if Where = Null_Address then -- did not find an end-of-line in this bucket End_of_Toil := Add_After (End_of_Toil, Bucko); if IsEmpty (Foil) then return; end if; elsif Where = (Bucko.Iov_Base + (Bucko.Iov_Len - 1)) then -- found CR as last character, peek at next bucket for LF -- since we can't risk a CRLF split across buckets -- if Bucko.Iov_Len = 1 and then IsEmpty (Foil) then Foil := Add_Before (Foil, Bucko); return; end if; if IsEmpty (Foil) then Bucko.Iov_Len := Bucko.Iov_Len - 1; Foil := Add_Before (Foil, New_Bucket (Ada.Characters.Latin_1.CR)); else Done := True; Set (Where, Ada.Characters.Latin_1.LF); Tempo := Head (Foil); if Val (Tempo.Iov_Base) = Ada.Characters.Latin_1.LF then Tempo.Iov_Len := Tempo.Iov_Len - 1; Where := C_memmove (Tempo.Iov_Base, (Tempo.Iov_Base + 1), Tempo.Iov_Len); end if; end if; End_of_Toil := Add_After (End_of_Toil, Bucko); return; else Next_Line := Where + 1; exit; end if; end loop; Done := True; if Next_Line >= (Bucko.Iov_Base + Bucko.Iov_Len) then Bucko.Iov_Len := (Where - Bucko.Iov_Base) + 1; End_of_Toil := Add_After (End_of_Toil, Bucko); else Foil := Add_Before (Foil, New_Bucket (Next_Line, (Bucko.Iov_Base + Bucko.Iov_Len) - Next_Line)); Bucko.Iov_Len := (Where - Bucko.Iov_Base) + 1; Bucko.Iov_Base := C_realloc (Bucko.Iov_Base, Bucko.Iov_Len); if Bucko.Iov_Base = Null_Address then raise Storage_Error; end if; End_of_Toil := Add_After (End_of_Toil, Bucko); end if; end Dump_Line; -- Chop the last character from a bucket or list of buckets. -- Normally used to remove the LF from a complete line. -- procedure Chop (Blist : Bucket_List) is Pos : Bucket_List; begin Pos := End_of_List (Blist); while Pos /= null and then Pos.Data.Iov_Len = 0 loop Pos := Pos.Prev; Free (Pos.Next); end loop; if Pos /= null then Pos.Data.Iov_Len := Pos.Data.Iov_Len - 1; end if; end Chop; procedure Chop (Bucko : Bucket) is begin if Bucko.Iov_Len > 0 then Bucko.Iov_Len := Bucko.Iov_Len - 1; end if; end Chop; -- Combine all buckets in a bucket list into a single bucket or string. -- procedure Combine (Blist : in out Bucket_List; Combo : out Bucket) is Pos : Bucket_List; Bucko : Bucket; Len : Storage_Count; Base : Address; Dummy : Address; begin if Blist = null then Combo := null; elsif Blist.Next = null then Extract (Blist, Combo); else Len := 0; Pos := Blist; while Pos /= null loop Len := Len + Pos.Data.Iov_Len; Pos := Pos.Next; end loop; if Len > 0 then Combo := Allocate (Len); Base := Combo.Iov_Base; loop Extract (Blist, Bucko); if Bucko.Iov_Len > 0 then Dummy := C_memcpy (Base, Bucko.Iov_Base, Bucko.Iov_Len); Base := Base + Bucko.Iov_Len; end if; Free (Bucko); exit when Blist = null; end loop; else Extract (Blist, Combo); Free (Blist); end if; end if; end Combine; procedure Combine (Blist : in out Bucket_List; Combo : out String_Access) is Pos : Bucket_List; Bucko : Bucket; Len : Storage_Count; Dummy : Address; begin if Blist = null then Combo := null; else Len := 0; Pos := Blist; while Pos /= null loop Len := Len + Pos.Data.Iov_Len; Pos := Pos.Next; end loop; Combo := new String (1 .. Positive (Len)); if Len > 0 then Len := 1; loop Extract (Blist, Bucko); if Bucko.Iov_Len > 0 then Dummy := C_memcpy (Combo (Positive (Len))'Address, Bucko.Iov_Base, Bucko.Iov_Len); Len := Len + Bucko.Iov_Len; end if; Free (Bucko); exit when Blist = null; end loop; else Free (Blist); end if; end if; end Combine; -- Trim a list of buckets into two lists beyond a number of bytes. -- Do not worry about retaining the data beyond those bytes. -- procedure Trim (Bytes : in Storage_Count; Front : in Bucket_List; Back : out Bucket_List) is Pos : Bucket_List; Remaining : Storage_Offset := Bytes; begin Pos := Front; while Pos /= null loop if Remaining > Pos.Data.Iov_Len then Remaining := Remaining - Pos.Data.Iov_Len; Pos := Pos.Next; else Pos.Data.Iov_Len := Remaining; Back := Pos.Next; Pos.Next := null; if Back /= null then Back.Prev := null; end if; return; end if; end loop; Back := null; end Trim; -- Get_Size determines the number of buckets, and total bytes within -- those buckets, from a bucket list. -- procedure Get_Size (Blist : in Bucket_List; Bucks : out Natural; Bytes : out Storage_Count) is Pos : Bucket_List := Blist; begin Bucks := 0; Bytes := 0; while Pos /= null loop Bucks := Bucks + 1; Bytes := Bytes + Pos.Data.Iov_Len; Pos := Pos.Next; end loop; end Get_Size; end Onions.Buckets;