home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / a-sequio.adb < prev    next >
Text File  |  1996-09-28  |  6KB  |  207 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                    A D A . S E Q U E N T I A L _ I O                     --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.11 $                             --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  This is the generic template for Sequential_IO, i.e. the code that gets
  27. --  duplicated. We absolutely minimize this code by either calling routines
  28. --  in System.File_IO (for common file functions), or in System.Sequential_IO
  29. --  (for specialized Sequential_IO functions)
  30.  
  31. with Interfaces.C_Streams; use Interfaces.C_Streams;
  32. with System;
  33. with System.File_Control_Block;
  34. with System.File_IO;
  35. with Unchecked_Conversion;
  36.  
  37. package body Ada.Sequential_IO is
  38.  
  39.    package FIO renames System.File_IO;
  40.    package FCB renames System.File_Control_Block;
  41.    package SIO renames System.Sequential_IO;
  42.  
  43.    SU : constant := System.Storage_Unit;
  44.  
  45.    subtype AP is FCB.AFCB_Ptr;
  46.    subtype FP is SIO.File_Type;
  47.  
  48.    function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
  49.    function To_SIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
  50.  
  51.    -----------
  52.    -- Close --
  53.    -----------
  54.  
  55.    procedure Close (File : in out File_Type) is
  56.    begin
  57.       FIO.Close (AP (File));
  58.    end Close;
  59.  
  60.    ------------
  61.    -- Create --
  62.    ------------
  63.  
  64.    procedure Create
  65.      (File : in out File_Type;
  66.       Mode : in File_Mode := Out_File;
  67.       Name : in String := "";
  68.       Form : in String := "")
  69.    is
  70.    begin
  71.       SIO.Create (FP (File), To_FCB (Mode), Name, Form);
  72.    end Create;
  73.  
  74.    ------------
  75.    -- Delete --
  76.    ------------
  77.  
  78.    procedure Delete (File : in out File_Type) is
  79.    begin
  80.       FIO.Delete (AP (File));
  81.    end Delete;
  82.  
  83.    -----------------
  84.    -- End_Of_File --
  85.    -----------------
  86.  
  87.    function End_Of_File (File : in File_Type) return Boolean is
  88.    begin
  89.       return FIO.End_Of_File (AP (File));
  90.    end End_Of_File;
  91.  
  92.    ----------
  93.    -- Form --
  94.    ----------
  95.  
  96.    function Form (File : in File_Type) return String is
  97.    begin
  98.       return FIO.Form (AP (File));
  99.    end Form;
  100.  
  101.    -------------
  102.    -- Is_Open --
  103.    -------------
  104.  
  105.    function Is_Open (File : in File_Type) return Boolean is
  106.    begin
  107.       return FIO.Is_Open (AP (File));
  108.    end Is_Open;
  109.  
  110.    ----------
  111.    -- Mode --
  112.    ----------
  113.  
  114.    function Mode (File : in File_Type) return File_Mode is
  115.    begin
  116.       return To_SIO (FIO.Mode (AP (File)));
  117.    end Mode;
  118.  
  119.    ----------
  120.    -- Name --
  121.    ----------
  122.  
  123.    function Name (File : in File_Type) return String is
  124.    begin
  125.       return FIO.Name (AP (File));
  126.    end Name;
  127.  
  128.    ----------
  129.    -- Open --
  130.    ----------
  131.  
  132.    procedure Open
  133.      (File : in out File_Type;
  134.       Mode : in File_Mode;
  135.       Name : in String;
  136.       Form : in String := "")
  137.    is
  138.    begin
  139.       SIO.Open (FP (File), To_FCB (Mode), Name, Form);
  140.    end Open;
  141.  
  142.    ----------
  143.    -- Read --
  144.    ----------
  145.  
  146.    procedure Read (File : in File_Type; Item : out Element_Type) is
  147.       Siz  : constant size_t := (Item'Size + SU - 1) / SU;
  148.       Rsiz : size_t;
  149.  
  150.    begin
  151.       FIO.Check_Read_Status (AP (File));
  152.  
  153.       --  For non-definite type, read size
  154.  
  155.       if not Element_Type'Definite then
  156.          FIO.Read_Buf
  157.            (AP (File), Rsiz'Address, size_t'Size / System.Storage_Unit);
  158.  
  159.          if Rsiz > Siz then
  160.             raise Program_Error;
  161.          end if;
  162.  
  163.          FIO.Read_Buf (AP (File), Item'Address, Rsiz);
  164.  
  165.       --  For definite type, use type'Size as size
  166.  
  167.       else
  168.          FIO.Read_Buf (AP (File), Item'Address, Siz);
  169.       end if;
  170.    end Read;
  171.  
  172.    -----------
  173.    -- Reset --
  174.    -----------
  175.  
  176.    procedure Reset (File : in out File_Type; Mode : in File_Mode) is
  177.    begin
  178.       FIO.Reset (AP (File), To_FCB (Mode));
  179.    end Reset;
  180.  
  181.    procedure Reset (File : in out File_Type) is
  182.    begin
  183.       FIO.Reset (AP (File));
  184.    end Reset;
  185.  
  186.    -----------
  187.    -- Write --
  188.    -----------
  189.  
  190.    procedure Write (File : in File_Type; Item : in Element_Type) is
  191.       Siz : constant size_t := (Item'Size + SU - 1) / SU;
  192.  
  193.    begin
  194.       FIO.Check_Write_Status (AP (File));
  195.  
  196.       --  For non-definite types, write out the size
  197.  
  198.       if not Element_Type'Definite then
  199.          FIO.Write_Buf
  200.            (AP (File), Siz'Address, size_t'Size / System.Storage_Unit);
  201.       end if;
  202.  
  203.       FIO.Write_Buf (AP (File), Item'Address, Siz);
  204.    end Write;
  205.  
  206. end Ada.Sequential_IO;
  207.