File : s-textio-memory.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . T E X T _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2008-2011, 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 -- Write console output in a memory buffer
33
34 package body System.Text_IO is
35
36 -- In memory output emulation
37
38 -- Export symbols so that gdb can easily find them.
39
40 Output : String (1 .. 2048);
41 pragma Export (C, Output, "textio_output");
42
43 Output_Len : Natural := 0;
44 pragma Export (C, Output_Len, "textio_output_len");
45
46 ---------
47 -- Get --
48 ---------
49
50 function Get return Character is
51 begin
52 -- Will never be called
53
54 raise Program_Error;
55 return ASCII.NUL;
56 end Get;
57
58 ----------------
59 -- Initialize --
60 ----------------
61
62 procedure Initialize is
63 begin
64 Output_Len := 0;
65 Initialized := True;
66 end Initialize;
67
68 -----------------
69 -- Is_Rx_Ready --
70 -----------------
71
72 function Is_Rx_Ready return Boolean is
73 begin
74 return False;
75 end Is_Rx_Ready;
76
77 -----------------
78 -- Is_Tx_Ready --
79 -----------------
80
81 function Is_Tx_Ready return Boolean is
82 begin
83 return True;
84 end Is_Tx_Ready;
85
86 ---------
87 -- Put --
88 ---------
89
90 procedure Put (C : Character) is
91 begin
92 Output_Len := Output_Len + 1;
93 if Output_Len <= Output'Last then
94 Output (Output_Len) := C;
95 end if;
96 end Put;
97
98 ----------------------------
99 -- Use_Cr_Lf_For_New_Line --
100 ----------------------------
101
102 function Use_Cr_Lf_For_New_Line return Boolean is
103 begin
104 return False;
105 end Use_Cr_Lf_For_New_Line;
106
107 end System.Text_IO;