----------------------------------------------------------------------------- -- -- Onions Network Streams Library -- -- O N I O N S . I N S T R E A M S . F I L E -- -- 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 File Input Stream is a stream end that performs buffered reads -- on a filesystem descriptor. Open or Bind must be called before reading. -- -- I'd be interested to see a performance comparison of this package -- versus Ada.Text_IO input files. -- with Ada.Streams; use Ada.Streams; with System.Storage_Elements; with Interfaces.C.Strings; with Onions.Buckets; use Onions.Buckets; with Onions.Constants; use Onions.Constants; with Onions.Thin; use Onions.Thin; with Onions.OS; use Onions.OS; with Unchecked_Deallocation; package body Onions.Instreams.File is use Bucket_Queues; use type C.int; --------------------------------------------- -- Dispatching Stream Control Operations -- --------------------------------------------- procedure Dispose is new Unchecked_Deallocation (File_Input_Stream, File_Input_Stream_Ptr); -- Free the storage associated with a stream object. -- procedure Free (SP : in out File_Input_Stream_Ptr) is begin if SP /= null then if SP.Fd /= Failure then Close (SP.all); end if; Dispose (SP); end if; end Free; -- Bind an already open descriptor to the stream. -- function Bind (Stream : in File_Input_Stream_Ptr; Filedes : in Descriptor) return Input_Pipe is begin Stream.Fd := Filedes; Stream.Filename := C.Strings.New_String (C.int'Image (Filedes)); Stream.Byte_Count := 0; Stream.Timeout := 0; if Set_Non_Blocking (Stream.Fd) = Failure then Stream.System_Error := C_errno; else Stream.System_Error := 0; end if; return Input_Pipe (Stream); end Bind; -- Open the descriptor associated with a stream. If Name is "", the -- stream is associated with the already open STDIN descriptor, -- otherwise the named file is opened for reading. Raises Device_Error -- if it is unable to open a descriptor for the named file. -- function Open (Stream : in File_Input_Stream_Ptr; Name : in String := "") return Input_Pipe is begin if Stream.Fd /= Failure then Close (Stream.all); end if; if Name = "" then Stream.Fd := STDIN_FILENO; Stream.Filename := C.Strings.New_String ("stdin"); else Stream.Filename := C.Strings.New_String (Name); loop Stream.Fd := C_open (Stream.Filename, O_RDONLY or O_BINARY); if Stream.Fd = Failure then if C_errno /= EINTR then Stream.System_Error := C_errno; C.Strings.Free (Stream.Filename); Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to open file " & Name); end if; else exit; end if; end loop; end if; Stream.Byte_Count := 0; Stream.Timeout := 0; if Set_Non_Blocking (Stream.Fd) = Failure then Stream.System_Error := C_errno; else Stream.System_Error := 0; end if; return Input_Pipe (Stream); end Open; -- Close the descriptor associated with a stream. Note that this -- is different from a Close of an Input_Pipe in that it does not -- free the stream. I.e., the stream can be Open'd again. -- procedure Close (Stream : in out File_Input_Stream) is ItemList : Bucket_List; Status : C.int; begin if Stream.Fd /= Failure then if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, ItemList); Free (ItemList); end if; if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; if Stream.Fd /= STDIN_FILENO then loop Status := C_close (Stream.Fd); if Status < 0 then Stream.System_Error := C_errno; exit when Stream.System_Error /= EINTR; else Stream.System_Error := 0; exit; end if; end loop; end if; Stream.Fd := Failure; C.Strings.Free (Stream.Filename); end if; end Close; -- Abort_Stream should only be used if a stream is interrupted -- by the user, or an error occurs that makes the whole stream bad. -- It forces the stream closed without a flush. -- procedure Abort_Stream (Stream : in out File_Input_Stream) is begin Close (Stream); end Abort_Stream; -- Reset is like Close, but only resets the file and its buffers -- instead of closing the descriptor. -- procedure Reset (Stream : in out File_Input_Stream) is ItemList : Bucket_List; Dummy : off_t; begin if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; Stream.Byte_Count := 0; Stream.Timeout := 0; Stream.System_Error := 0; if Stream.Fd /= Failure and Stream.Fd /= STDIN_FILENO then Dummy := C_lseek (Stream.Fd, 0, SEEK_SET); end if; end Reset; -- Drain the stream by returning any processed data -- as if it were the end-of-stream. -- procedure Drain (Stream : in out File_Input_Stream; ItemList : out Bucket_List) is begin if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); else ItemList := null; end if; end Drain; -- Name returns a string containing the currently open file name. -- function Name (Stream : in File_Input_Stream) return String is use C.Strings; begin if Stream.Filename = Null_Ptr then return ""; else return Value (Stream.Filename); end if; end Name; ------------------------------------ -- Ada.Streams Dispatching Read -- ------------------------------------ -- Read obtains stream elements from Stream and places them into -- the components of Item until either each component is filled or -- no elements remain on the stream. Last is set to the index of -- the last component of Item that was filled. This interface is -- defined by Ada.Streams for abstract stream operations. We won't -- use it much because it forces a full data copy when filtering. -- procedure Read (Stream : in out File_Input_Stream; Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is ReadList : Bucket_List; begin Last := Item'First - 1; loop while Length (Stream.Processed) = 0 loop Process (Stream, False); end loop; Dequeue (Stream.Processed, ReadList); Dump_Into (ReadList, Item, Last); if not IsEmpty (ReadList) then Undequeue (Stream.Processed, ReadList); end if; exit when Last = Item'Last; end loop; exception when End_Error => if Last < Item'First then raise End_Error; end if; end Read; ---------------------------------- -- Data Processing Operations -- ---------------------------------- use System.Storage_Elements; -- Process does the real work of reading from the file and moves the -- the read data to the Processed read queue. The Unprocessed read -- queue is used as a temporary storage for our free memory list. -- As such, the Everything (end-of-stream indicator) boolean is ignored. -- Raises End_Error when end-of-file is encountered; -- Storage_Error if there is no memory available for the buffer; -- Timeout_Exceeded if we have to wait longer than Stream.Timeout; -- Device_Error if anything else goes fatally wrong. -- procedure Process (Stream : in out File_Input_Stream; Everything : Boolean) is Buffer_List : Bucket_List; Buffer_Num : Natural; Filled_List : Bucket_List; Filled_Amt : Storage_Offset; begin if Stream.Fd = Failure then Raise_Error (Status_Error'Identity, 0, "File stream must be opened before Read"); end if; -- Make sure we have an adequate read buffer -- Buffer_Num := Length (Stream.Unprocessed); if Buffer_Num < Stream.Minimum_Buckets_per_Read then begin while Buffer_Num < Stream.Maximum_Buckets_per_Read loop Enqueue (Stream.Unprocessed, Allocate (Stream.Bucket_Size)); Buffer_Num := Buffer_Num + 1; end loop; exception when Storage_Error => if Buffer_Num = 0 then Raise_Error (Storage_Error'Identity, Stream.System_Error, "Unable to allocate read buffer"); end if; end; end if; Dequeue (Stream.Unprocessed, Buffer_List); -- Read what we can from the file (previously set to non-blocking) -- begin Read_Vector (Stream.Fd, Stream.Timeout, Buffer_List, Buffer_Num, Filled_List, Filled_Amt); exception when Device_Error => Stream.System_Error := C_errno; Free (Buffer_List); Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to read file " & C.Strings.Value (Stream.Filename)); when others => Free (Buffer_List); raise; end; if Filled_Amt <= 0 then Enqueue (Stream.Unprocessed, Buffer_List); raise End_Error; else Stream.Byte_Count := Stream.Byte_Count + Filled_Amt; Enqueue (Stream.Processed, Filled_List); if not IsEmpty (Buffer_List) then Enqueue (Stream.Unprocessed, Buffer_List); end if; end if; end Process; -- Unprocess would be called by Pop if someone foolishly tried -- to pop off the File_Input_Stream. We don't allow that. -- procedure Unprocess (Stream : in out File_Input_Stream) is begin raise Use_Error; end Unprocess; end Onions.Instreams.File;