1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . D I R E C T _ I O --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This is the generic template for Direct_IO, i.e. the code that gets
35 -- duplicated. We absolutely minimize this code by either calling routines
36 -- in System.File_IO (for common file functions), or in System.Direct_IO
37 -- (for specialized Direct_IO functions)
39 with Interfaces.C_Streams; use Interfaces.C_Streams;
40 with System; use System;
41 with System.File_Control_Block;
43 with System.Direct_IO;
44 with System.Storage_Elements;
45 with Unchecked_Conversion;
47 use type System.Direct_IO.Count;
49 package body Ada.Direct_IO is
51 Zeroes : constant System.Storage_Elements.Storage_Array :=
52 (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
53 -- Buffer used to fill out partial records.
55 package FCB renames System.File_Control_Block;
56 package FIO renames System.File_IO;
57 package DIO renames System.Direct_IO;
59 SU : constant := System.Storage_Unit;
61 subtype AP is FCB.AFCB_Ptr;
62 subtype FP is DIO.File_Type;
63 subtype DPCount is DIO.Positive_Count;
65 function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
66 function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
72 procedure Close (File : in out File_Type) is
74 FIO.Close (AP (File));
82 (File : in out File_Type;
83 Mode : in File_Mode := Inout_File;
84 Name : in String := "";
85 Form : in String := "")
88 DIO.Create (FP (File), To_FCB (Mode), Name, Form);
96 procedure Delete (File : in out File_Type) is
98 FIO.Delete (AP (File));
105 function End_Of_File (File : in File_Type) return Boolean is
107 return DIO.End_Of_File (FP (File));
114 function Form (File : in File_Type) return String is
116 return FIO.Form (AP (File));
123 function Index (File : in File_Type) return Positive_Count is
125 return Positive_Count (DIO.Index (FP (File)));
132 function Is_Open (File : in File_Type) return Boolean is
134 return FIO.Is_Open (AP (File));
141 function Mode (File : in File_Type) return File_Mode is
143 return To_DIO (FIO.Mode (AP (File)));
150 function Name (File : in File_Type) return String is
152 return FIO.Name (AP (File));
160 (File : in out File_Type;
163 Form : in String := "")
166 DIO.Open (FP (File), To_FCB (Mode), Name, Form);
175 (File : in File_Type;
176 Item : out Element_Type;
177 From : in Positive_Count)
180 -- For a non-constrained variant record type, we read into an
181 -- intermediate buffer, since we may have the case of discriminated
182 -- records where a discriminant check is required, and we may need
183 -- to assign only part of the record buffer originally written
185 if not Element_Type'Constrained then
190 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From));
194 -- In the normal case, we can read straight into the buffer
197 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From));
201 procedure Read (File : in File_Type; Item : out Element_Type) is
203 -- Same processing for unconstrained case as above
205 if not Element_Type'Constrained then
210 DIO.Read (FP (File), Buf'Address, Bytes);
215 DIO.Read (FP (File), Item'Address, Bytes);
223 procedure Reset (File : in out File_Type; Mode : in File_Mode) is
225 DIO.Reset (FP (File), To_FCB (Mode));
228 procedure Reset (File : in out File_Type) is
230 DIO.Reset (FP (File));
237 procedure Set_Index (File : in File_Type; To : in Positive_Count) is
239 DIO.Set_Index (FP (File), DPCount (To));
246 function Size (File : in File_Type) return Count is
248 return Count (DIO.Size (FP (File)));
256 (File : in File_Type;
257 Item : in Element_Type;
258 To : in Positive_Count)
261 DIO.Set_Index (FP (File), DPCount (To));
262 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
265 procedure Write (File : in File_Type; Item : in Element_Type) is
267 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);