1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . D I R E C T _ I O -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 10-- -- 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 3, 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is the generic template for Direct_IO, i.e. the code that gets 33-- duplicated. We absolutely minimize this code by either calling routines 34-- in System.File_IO (for common file functions), or in System.Direct_IO 35-- (for specialized Direct_IO functions) 36 37with Interfaces.C_Streams; use Interfaces.C_Streams; 38with System; use System; 39with System.CRTL; 40with System.File_Control_Block; 41with System.File_IO; 42with System.Storage_Elements; 43with Ada.Unchecked_Conversion; 44 45package body Ada.Direct_IO is 46 47 Zeroes : constant System.Storage_Elements.Storage_Array := 48 (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0); 49 -- Buffer used to fill out partial records 50 51 package FCB renames System.File_Control_Block; 52 package FIO renames System.File_IO; 53 package DIO renames System.Direct_IO; 54 55 SU : constant := System.Storage_Unit; 56 57 subtype AP is FCB.AFCB_Ptr; 58 subtype FP is DIO.File_Type; 59 subtype DPCount is DIO.Positive_Count; 60 61 function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode); 62 function To_DIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode); 63 64 use type System.CRTL.size_t; 65 66 ----------- 67 -- Close -- 68 ----------- 69 70 procedure Close (File : in out File_Type) is 71 begin 72 FIO.Close (AP (File)'Unrestricted_Access); 73 end Close; 74 75 ------------ 76 -- Create -- 77 ------------ 78 79 procedure Create 80 (File : in out File_Type; 81 Mode : File_Mode := Inout_File; 82 Name : String := ""; 83 Form : String := "") 84 is 85 begin 86 DIO.Create (FP (File), To_FCB (Mode), Name, Form); 87 File.Bytes := Bytes; 88 end Create; 89 90 ------------ 91 -- Delete -- 92 ------------ 93 94 procedure Delete (File : in out File_Type) is 95 begin 96 FIO.Delete (AP (File)'Unrestricted_Access); 97 end Delete; 98 99 ----------------- 100 -- End_Of_File -- 101 ----------------- 102 103 function End_Of_File (File : File_Type) return Boolean is 104 begin 105 return DIO.End_Of_File (FP (File)); 106 end End_Of_File; 107 108 ----------- 109 -- Flush -- 110 ----------- 111 112 procedure Flush (File : File_Type) is 113 begin 114 FIO.Flush (AP (File)); 115 end Flush; 116 117 ---------- 118 -- Form -- 119 ---------- 120 121 function Form (File : File_Type) return String is 122 begin 123 return FIO.Form (AP (File)); 124 end Form; 125 126 ----------- 127 -- Index -- 128 ----------- 129 130 function Index (File : File_Type) return Positive_Count is 131 begin 132 return Positive_Count (DIO.Index (FP (File))); 133 end Index; 134 135 ------------- 136 -- Is_Open -- 137 ------------- 138 139 function Is_Open (File : File_Type) return Boolean is 140 begin 141 return FIO.Is_Open (AP (File)); 142 end Is_Open; 143 144 ---------- 145 -- Mode -- 146 ---------- 147 148 function Mode (File : File_Type) return File_Mode is 149 begin 150 return To_DIO (FIO.Mode (AP (File))); 151 end Mode; 152 153 ---------- 154 -- Name -- 155 ---------- 156 157 function Name (File : File_Type) return String is 158 begin 159 return FIO.Name (AP (File)); 160 end Name; 161 162 ---------- 163 -- Open -- 164 ---------- 165 166 procedure Open 167 (File : in out File_Type; 168 Mode : File_Mode; 169 Name : String; 170 Form : String := "") 171 is 172 begin 173 DIO.Open (FP (File), To_FCB (Mode), Name, Form); 174 File.Bytes := Bytes; 175 end Open; 176 177 ---------- 178 -- Read -- 179 ---------- 180 181 procedure Read 182 (File : File_Type; 183 Item : out Element_Type; 184 From : Positive_Count) 185 is 186 begin 187 -- For a non-constrained variant record type, we read into an 188 -- intermediate buffer, since we may have the case of discriminated 189 -- records where a discriminant check is required, and we may need 190 -- to assign only part of the record buffer originally written. 191 192 -- Note: we have to turn warnings on/off because this use of 193 -- the Constrained attribute is an obsolescent feature. 194 195 pragma Warnings (Off); 196 if not Element_Type'Constrained then 197 pragma Warnings (On); 198 199 declare 200 Buf : Element_Type; 201 202 begin 203 DIO.Read (FP (File), Buf'Address, Bytes, DPCount (From)); 204 Item := Buf; 205 end; 206 207 -- In the normal case, we can read straight into the buffer 208 209 else 210 DIO.Read (FP (File), Item'Address, Bytes, DPCount (From)); 211 end if; 212 end Read; 213 214 procedure Read (File : File_Type; Item : out Element_Type) is 215 begin 216 -- Same processing for unconstrained case as above 217 218 -- Note: we have to turn warnings on/off because this use of 219 -- the Constrained attribute is an obsolescent feature. 220 221 pragma Warnings (Off); 222 if not Element_Type'Constrained then 223 pragma Warnings (On); 224 225 declare 226 Buf : Element_Type; 227 228 begin 229 DIO.Read (FP (File), Buf'Address, Bytes); 230 Item := Buf; 231 end; 232 233 else 234 DIO.Read (FP (File), Item'Address, Bytes); 235 end if; 236 end Read; 237 238 ----------- 239 -- Reset -- 240 ----------- 241 242 procedure Reset (File : in out File_Type; Mode : File_Mode) is 243 begin 244 DIO.Reset (FP (File), To_FCB (Mode)); 245 end Reset; 246 247 procedure Reset (File : in out File_Type) is 248 begin 249 DIO.Reset (FP (File)); 250 end Reset; 251 252 --------------- 253 -- Set_Index -- 254 --------------- 255 256 procedure Set_Index (File : File_Type; To : Positive_Count) is 257 begin 258 DIO.Set_Index (FP (File), DPCount (To)); 259 end Set_Index; 260 261 ---------- 262 -- Size -- 263 ---------- 264 265 function Size (File : File_Type) return Count is 266 begin 267 return Count (DIO.Size (FP (File))); 268 end Size; 269 270 ----------- 271 -- Write -- 272 ----------- 273 274 procedure Write 275 (File : File_Type; 276 Item : Element_Type; 277 To : Positive_Count) 278 is 279 begin 280 DIO.Set_Index (FP (File), DPCount (To)); 281 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes); 282 end Write; 283 284 procedure Write (File : File_Type; Item : Element_Type) is 285 begin 286 DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes); 287 end Write; 288 289end Ada.Direct_IO; 290