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-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 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