File : s-sequio.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . S E Q U E N T I A L _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2009, 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 -- --
19 -- --
20 -- --
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 with System.File_IO;
33 with Ada.Unchecked_Deallocation;
34
35 package body System.Sequential_IO is
36
37 subtype AP is FCB.AFCB_Ptr;
38
39 package FIO renames System.File_IO;
40
41 -------------------
42 -- AFCB_Allocate --
43 -------------------
44
45 function AFCB_Allocate
46 (Control_Block : Sequential_AFCB) return FCB.AFCB_Ptr
47 is
48 pragma Warnings (Off, Control_Block);
49
50 begin
51 return new Sequential_AFCB;
52 end AFCB_Allocate;
53
54 ----------------
55 -- AFCB_Close --
56 ----------------
57
58 -- No special processing required for Sequential_IO close
59
60 procedure AFCB_Close (File : not null access Sequential_AFCB) is
61 pragma Warnings (Off, File);
62
63 begin
64 null;
65 end AFCB_Close;
66
67 ---------------
68 -- AFCB_Free --
69 ---------------
70
71 procedure AFCB_Free (File : not null access Sequential_AFCB) is
72
73 type FCB_Ptr is access all Sequential_AFCB;
74
75 FT : FCB_Ptr := FCB_Ptr (File);
76
77 procedure Free is new
78 Ada.Unchecked_Deallocation (Sequential_AFCB, FCB_Ptr);
79
80 begin
81 Free (FT);
82 end AFCB_Free;
83
84 ------------
85 -- Create --
86 ------------
87
88 procedure Create
89 (File : in out File_Type;
90 Mode : FCB.File_Mode := FCB.Out_File;
91 Name : String := "";
92 Form : String := "")
93 is
94 Dummy_File_Control_Block : Sequential_AFCB;
95 pragma Warnings (Off, Dummy_File_Control_Block);
96 -- Yes, we know this is never assigned a value, only the tag
97 -- is used for dispatching purposes, so that's expected.
98
99 begin
100 FIO.Open (File_Ptr => AP (File),
101 Dummy_FCB => Dummy_File_Control_Block,
102 Mode => Mode,
103 Name => Name,
104 Form => Form,
105 Amethod => 'Q',
106 Creat => True,
107 Text => False);
108 end Create;
109
110 ----------
111 -- Open --
112 ----------
113
114 procedure Open
115 (File : in out File_Type;
116 Mode : FCB.File_Mode;
117 Name : String;
118 Form : String := "")
119 is
120 Dummy_File_Control_Block : Sequential_AFCB;
121 pragma Warnings (Off, Dummy_File_Control_Block);
122 -- Yes, we know this is never assigned a value, only the tag
123 -- is used for dispatching purposes, so that's expected.
124
125 begin
126 FIO.Open (File_Ptr => AP (File),
127 Dummy_FCB => Dummy_File_Control_Block,
128 Mode => Mode,
129 Name => Name,
130 Form => Form,
131 Amethod => 'Q',
132 Creat => False,
133 Text => False);
134 end Open;
135
136 ----------
137 -- Read --
138 ----------
139
140 -- Not used, since Sequential_IO files are not used as streams
141
142 procedure Read
143 (File : in out Sequential_AFCB;
144 Item : out Ada.Streams.Stream_Element_Array;
145 Last : out Ada.Streams.Stream_Element_Offset)
146 is
147 begin
148 raise Program_Error;
149 end Read;
150
151 -----------
152 -- Write --
153 -----------
154
155 -- Not used, since Sequential_IO files are not used as streams
156
157 procedure Write
158 (File : in out Sequential_AFCB;
159 Item : Ada.Streams.Stream_Element_Array)
160 is
161 begin
162 raise Program_Error;
163 end Write;
164
165 end System.Sequential_IO;