1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
with Ada.Text_IO; use Ada.Text_IO;
with Input;
package body Screen_Output is
----------------
-- Local Data --
----------------
Debug_On : constant Boolean := False;
-- When set, debugging information messages are output on the screen.
---------
-- Msg --
---------
procedure Msg
(S1 : String;
S2 : String := "";
End_Line : Boolean := True)
is
begin
Put (S1);
Put (S2);
if End_Line then
New_Line;
end if;
end Msg;
---------------
-- Debug_Msg --
---------------
procedure Debug_Msg (S : String) is
begin
if not Debug_On then
return;
end if;
Put ("DEBUG: ");
Put (S);
New_Line;
end Debug_Msg;
---------------
-- Error_Msg --
---------------
procedure Error_Msg (S1 : String; S2 : String := ""; S3 : String := "") is
begin
Put ("sdc error at line");
Put (Natural'Image (Input.Line_Number) & ": ");
Put (S1);
Put (S2);
Put (S3);
New_Line;
end Error_Msg;
------------------
-- Syntax_Error --
------------------
procedure Syntax_Error (S : String; Error_Pos : Natural := 0) is
Pos : Natural := Error_Pos;
begin
if Pos = 0 then
Pos := Input.Column_Number;
end if;
Put ("sdc:");
Put_Line (Input.Current_Line);
Put ("sdc:");
for I in 1 .. Pos - 1 loop
Put ("-");
end loop;
Put_Line ("!");
Put ("sdc input error at line");
Put (Natural'Image (Input.Line_Number) & ": " & S);
New_Line;
end Syntax_Error;
-----------
-- Pause --
-----------
procedure Pause is
begin
Put ("Press a key to continue...");
Skip_Line;
end Pause;
end Screen_Output;
|
