File : a-textio-raven.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . T E X T _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2016, 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 -- Version for use with ravenscar run time. This version consider that IO
33 -- calls are blocking (which is true according to arm 9.5.1/18) and that
34 -- pragma Detect_Blocking is present. So calls to IO procedures from a
35 -- protected subprogram .
36
37 with System.Text_IO; use System.Text_IO;
38 with System.Task_Primitives.Operations;
39
40 with System.Tasking.Restricted.Stages;
41 pragma Unreferenced (System.Tasking.Restricted.Stages);
42 -- Be sure tasking is initialized so that Self can be called
43
44 package body Ada.Text_IO is
45
46 procedure Blocking_Operation;
47 -- Implement pragma Detect_Blocking: raise PE if currently executing in a
48 -- context where blocking operations are not allowed. According to ARM
49 -- 9.5.1/18, language defined input-output packages are potentially that
50 -- manipulate files are potentially blocking.
51
52 package STPO renames System.Task_Primitives.Operations;
53
54 ------------------------
55 -- Blocking_Operation --
56 ------------------------
57
58 procedure Blocking_Operation is
59 begin
60 if STPO.Self.Common.Protected_Action_Nesting > 0 then
61 raise Program_Error;
62 end if;
63 end Blocking_Operation;
64
65 ---------
66 -- Get --
67 ---------
68
69 procedure Get (C : out Character) is
70 begin
71 -- Detect blocking operation
72
73 Blocking_Operation;
74
75 while not Is_Rx_Ready loop
76 null;
77 end loop;
78
79 C := System.Text_IO.Get;
80 end Get;
81
82 --------------
83 -- New_Line --
84 --------------
85
86 procedure New_Line is
87 begin
88 if Use_Cr_Lf_For_New_Line then
89 Put (ASCII.CR);
90 end if;
91
92 Put (ASCII.LF);
93 end New_Line;
94
95 ---------
96 -- Put --
97 ---------
98
99 procedure Put (Item : Character) is
100 begin
101 -- Detect blocking operation
102
103 Blocking_Operation;
104
105 while not Is_Tx_Ready loop
106 null;
107 end loop;
108
109 System.Text_IO.Put (Item);
110 end Put;
111
112 procedure Put (Item : String) is
113 begin
114 for J in Item'Range loop
115 Put (Item (J));
116 end loop;
117 end Put;
118
119 --------------
120 -- Put_Line --
121 --------------
122
123 procedure Put_Line (Item : String) is
124 begin
125 Put (Item);
126 New_Line;
127 end Put_Line;
128
129 begin
130 if not Initialized then
131 Initialize;
132 end if;
133 end Ada.Text_IO;