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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A D A . E X C E P T I O N S --
-- --
-- S p e c --
-- --
-- $Revision: 1.16 $ --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Streams;
with System.Standard_Library;
package Ada.Exceptions is
type Exception_Id is private;
Null_Id : constant Exception_Id;
type Exception_Occurrence is limited private;
type Exception_Occurrence_Access is access all Exception_Occurrence;
Null_Occurrence : constant Exception_Occurrence;
-- Note: we altered the order to simplify the processing for the intrinsic
-- routine Exception_Name, which needs to call the Exception_Occurrence
-- version of the routine here, and Rtsfind will find the first matching
-- occurrence when we have overloaded routines.
function Exception_Identity (X : Exception_Occurrence) return Exception_Id;
function Exception_Name (X : Exception_Occurrence) return String;
-- Same as Exception_Name (Exception_Identity (X))
function Exception_Name (X : Exception_Id) return String;
procedure Raise_Exception (E : in Exception_Id; Message : in String := "");
-- Note: it would be really nice to give a pragma No_Return for this
-- procedure, but it would be wrong, since Raise_Exception does return
-- if given the null exception. However we do special case the name in
-- the test in the compiler for issuing a warning for a missing return
-- after this call. Program_Error seems reasonable enough in such a case.
function Exception_Message (X : Exception_Occurrence) return String;
procedure Reraise_Occurrence (X : Exception_Occurrence);
function Exception_Information (X : Exception_Occurrence) return String;
procedure Save_Occurrence
(Target : out Exception_Occurrence;
Source : in Exception_Occurrence);
function Save_Occurrence
(Source : in Exception_Occurrence)
return Exception_Occurrence_Access;
private
package SSL renames System.Standard_Library;
type Exception_Id is access all SSL.Exception_Data;
Null_Id : constant Exception_Id := null;
subtype Nat is Natural range 0 .. SSL.Exception_Message_Buffer'Last;
-- ??? replace Nat by Natural when limited types with discriminants
-- are implemented properly
-- Exception_Occurrence is defined as a limited record so that when a
-- default instance is allocated, the default discriminant value is used
-- to determine the length (given that even the full view is limited, we
-- do not need to allocate the maximum length).
type Exception_Occurrence
(Max_Length : Nat := SSL.Exception_Msg_Max)
is limited record
Id : Exception_Id;
Msg_Length : Natural;
Msg : String (1 .. Max_Length);
end record;
procedure Set_Exception_Occurrence (Occ : Exception_Occurrence_Access);
pragma Export (C, Set_Exception_Occurrence, "__set_except_occ");
-- Procedure called directly by gigi to copy in the exception occurrence
-- the exception message kept in the task-Specific data.
-- Note: the whole issue of stream attributes and exception occurrences
-- is rather mixed up. We implement 'Read and 'Write as required in the
-- RM, with the addition that Read is allowed to truncate a long message
-- to the allowed 200 characters (just like Save_Occurrence).
procedure Exception_Occurrence_Read
(Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : out Exception_Occurrence);
procedure Exception_Occurrence_Write
(Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : in Exception_Occurrence);
for Exception_Occurrence'Read use Exception_Occurrence_Read;
for Exception_Occurrence'Write use Exception_Occurrence_Write;
-- We do not implement 'Input and 'Output for Exception_Occurrence,
-- since they are not required, and 'Input in particular is not easy
-- to implement (more properly is impossible), since there is no way
-- to write a 'Input function for a limited record that does not have
-- a serious storage leak problem.
-- Instead, analogous to how Save_Occurrence works, we implement a
-- special 'Input routine for Exception_Occurrence_Access that returns
-- a pointer to an Exception_Occurrence that can hold a message of any
-- length as originally written by Exception_Occurrence'Write.
function Exception_Occurrence_Access_Input
(Stream : access Ada.Streams.Root_Stream_Type'Class)
return Exception_Occurrence_Access;
for Exception_Occurrence_Access'Input use Exception_Occurrence_Access_Input;
-- Note: the following definition of Null_Occurrence is not legal Ada. In
-- fact, given the clear requirement to make Exception_Occurrence a limited
-- record (see above note), there is no way to complete Null_Occurrence in
-- a legal way. There is a special kludge in the compiler to permit this
-- particular bit of illegal Ada!
Null_Occurrence : constant Exception_Occurrence := (
Max_Length => 0,
Id => Null_Id,
Msg_Length => 0,
Msg => "");
function Exception_Name_Simple (X : Exception_Occurrence) return String;
-- Like Exception_Name, but returns the simple non-qualified name of
-- the exception. This is used to implement the Exception_Name function
-- in Current_Exceptions (the DEC compatible unit). It is called from
-- the compiler generated code (using Rtsfind, which does not respect
-- the private barrier, so we can place this function in the private
-- part where the compiler can find it, but the spec is unchanged.)
end Ada.Exceptions;
|
