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-- 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
32with System.File_IO;
33with Ada.Unchecked_Deallocation;
34
35package 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
165end System.Sequential_IO;
166