Geek Gadgets 1/ADE-1.bin/ade-bin/lib/gcc-lib/m68k-amigaos/2.7.2.1/adainclude/a-sequio.adb

Text File | 1995-10-17 | 5.8 KB | 207 lines

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUNTIME COMPONENTS                          --
--                                                                          --
--                    A D A . S E Q U E N T I A L _ I O                     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.11 $                             --
--                                                                          --
--        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
--                                                                          --
-- The GNAT library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU Library General Public License as published by --
-- the Free Software  Foundation; either version 2, or (at your option) any --
-- later version.  The GNAT library 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 --
-- Library  General  Public  License for  more  details.  You  should  have --
-- received  a copy of the GNU  Library  General Public License  along with --
-- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
-- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
--                                                                          --
------------------------------------------------------------------------------

--  This is the generic template for Sequential_IO, i.e. the code that gets
--  duplicated. We absolutely minimize this code by either calling routines
--  in System.File_IO (for common file functions), or in System.Sequential_IO
--  (for specialized Sequential_IO functions)

with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.File_Control_Block;
with System.File_IO;
with Unchecked_Conversion;

package body Ada.Sequential_IO is

   package FIO renames System.File_IO;
   package FCB renames System.File_Control_Block;
   package SIO renames System.Sequential_IO;

   SU : constant := System.Storage_Unit;

   subtype AP is FCB.AFCB_Ptr;
   subtype FP is SIO.File_Type;

   function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
   function To_SIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);

   -----------
   -- Close --
   -----------

   procedure Close (File : in out File_Type) is
   begin
      FIO.Close (AP (File));
   end Close;

   ------------
   -- Create --
   ------------

   procedure Create
     (File : in out File_Type;
      Mode : in File_Mode := Out_File;
      Name : in String := "";
      Form : in String := "")
   is
   begin
      SIO.Create (FP (File), To_FCB (Mode), Name, Form);
   end Create;

   ------------
   -- Delete --
   ------------

   procedure Delete (File : in out File_Type) is
   begin
      FIO.Delete (AP (File));
   end Delete;

   -----------------
   -- End_Of_File --
   -----------------

   function End_Of_File (File : in File_Type) return Boolean is
   begin
      return FIO.End_Of_File (AP (File));
   end End_Of_File;

   ----------
   -- Form --
   ----------

   function Form (File : in File_Type) return String is
   begin
      return FIO.Form (AP (File));
   end Form;

   -------------
   -- Is_Open --
   -------------

   function Is_Open (File : in File_Type) return Boolean is
   begin
      return FIO.Is_Open (AP (File));
   end Is_Open;

   ----------
   -- Mode --
   ----------

   function Mode (File : in File_Type) return File_Mode is
   begin
      return To_SIO (FIO.Mode (AP (File)));
   end Mode;

   ----------
   -- Name --
   ----------

   function Name (File : in File_Type) return String is
   begin
      return FIO.Name (AP (File));
   end Name;

   ----------
   -- Open --
   ----------

   procedure Open
     (File : in out File_Type;
      Mode : in File_Mode;
      Name : in String;
      Form : in String := "")
   is
   begin
      SIO.Open (FP (File), To_FCB (Mode), Name, Form);
   end Open;

   ----------
   -- Read --
   ----------

   procedure Read (File : in File_Type; Item : out Element_Type) is
      Siz  : constant size_t := (Item'Size + SU - 1) / SU;
      Rsiz : size_t;

   begin
      FIO.Check_Read_Status (AP (File));

      --  For non-definite type, read size

      if not Element_Type'Definite then
         FIO.Read_Buf
           (AP (File), Rsiz'Address, size_t'Size / System.Storage_Unit);

         if Rsiz > Siz then
            raise Program_Error;
         end if;

         FIO.Read_Buf (AP (File), Item'Address, Rsiz);

      --  For definite type, use type'Size as size

      else
         FIO.Read_Buf (AP (File), Item'Address, Siz);
      end if;
   end Read;

   -----------
   -- Reset --
   -----------

   procedure Reset (File : in out File_Type; Mode : in File_Mode) is
   begin
      FIO.Reset (AP (File), To_FCB (Mode));
   end Reset;

   procedure Reset (File : in out File_Type) is
   begin
      FIO.Reset (AP (File));
   end Reset;

   -----------
   -- Write --
   -----------

   procedure Write (File : in File_Type; Item : in Element_Type) is
      Siz : constant size_t := (Item'Size + SU - 1) / SU;

   begin
      FIO.Check_Write_Status (AP (File));

      --  For non-definite types, write out the size

      if not Element_Type'Definite then
         FIO.Write_Buf
           (AP (File), Siz'Address, size_t'Size / System.Storage_Unit);
      end if;

      FIO.Write_Buf (AP (File), Item'Address, Siz);
   end Write;

end Ada.Sequential_IO;