1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135 | -----------------------------------------------------------------------
-- util-streams-raw -- Raw streams for Windows based systems
-- Copyright (C) 2011, 2019 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;
with System;
package body Util.Streams.Raw is
use System;
use Util.Systems.Os;
use type Util.Systems.Os.HANDLE;
-- -----------------------
-- Initialize the raw stream to read and write on the given file descriptor.
-- -----------------------
procedure Initialize (Stream : in out Raw_Stream;
File : in File_Type) is
begin
if Stream.File /= NO_FILE then
raise Ada.IO_Exceptions.Status_Error;
end if;
Stream.File := File;
end Initialize;
-- -----------------------
-- Get the file descriptor associated with the stream.
-- -----------------------
function Get_File (Stream : in Raw_Stream) return Util.Systems.Os.File_Type is
begin
return Stream.File;
end Get_File;
-- -----------------------
-- Set the file descriptor to be used by the stream.
-- -----------------------
procedure Set_File (Stream : in out Raw_Stream;
File : in Util.Systems.Os.File_Type) is
begin
Stream.File := File;
end Set_File;
-- -----------------------
-- Close the stream.
-- -----------------------
overriding
procedure Close (Stream : in out Raw_Stream) is
Error : Integer;
begin
if Stream.File /= NO_FILE then
if Close_Handle (Stream.File) = 0 then
Error := Get_Last_Error;
if Error /= ERROR_BROKEN_PIPE then
raise Ada.IO_Exceptions.Device_Error with "IO error: " & Integer'Image (Error);
end if;
end if;
Stream.File := NO_FILE;
end if;
end Close;
-- -----------------------
-- Write the buffer array to the output stream.
-- -----------------------
procedure Write (Stream : in out Raw_Stream;
Buffer : in Ada.Streams.Stream_Element_Array) is
Res : aliased DWORD := 0;
Status : BOOL;
begin
Status := Write_File (Stream.File, Buffer'Address, Buffer'Length,
Res'Unchecked_Access, System.Null_Address);
if Status = 0 then
raise Ada.IO_Exceptions.Device_Error;
end if;
end Write;
-- -----------------------
-- Read into the buffer as many bytes as possible and return in
-- <b>last</b> the position of the last byte read.
-- -----------------------
procedure Read (Stream : in out Raw_Stream;
Into : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset) is
Res : aliased DWORD := 0;
Status : BOOL;
Error : Integer;
begin
Status := Read_File (Stream.File, Into'Address, Into'Length,
Res'Unchecked_Access, System.Null_Address);
if Status = 0 then
Error := Get_Last_Error;
if Error /= ERROR_BROKEN_PIPE then
raise Ada.IO_Exceptions.Device_Error with "IO error: " & Integer'Image (Error);
end if;
end if;
Last := Into'First + Ada.Streams.Stream_Element_Offset (Res) - 1;
end Read;
-- -----------------------
-- Reposition the read/write file offset.
-- -----------------------
procedure Seek (Stream : in out Raw_Stream;
Pos : in Util.Systems.Types.off_t;
Mode : in Util.Systems.Types.Seek_Mode) is
Res : Util.Systems.Types.off_t;
begin
Res := Sys_Lseek (Stream.File, Pos, Mode);
if Res < 0 then
raise Ada.IO_Exceptions.Device_Error;
end if;
end Seek;
-- -----------------------
-- Flush the stream and release the buffer.
-- -----------------------
procedure Finalize (Object : in out Raw_Stream) is
begin
Close (Object);
end Finalize;
end Util.Streams.Raw;
|