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
|
-- Error handling for synthesis.
-- Copyright (C) 2017 Tristan Gingold
--
-- This file is part of GHDL.
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
-- MA 02110-1301, USA.
package body Netlists.Errors is
function "+" (N : Instance) return Earg_Type is
begin
return Make_Earg_Synth_Instance (Uns32 (N));
end "+";
function "+" (N : Net) return Earg_Type is
begin
return Make_Earg_Synth_Net (Uns32 (N));
end "+";
function "+" (N : Sname) return Earg_Type is
begin
return Make_Earg_Synth_Name (Uns32 (N));
end "+";
procedure Output_Name_1 (N : Sname)
is
Prefix : Sname;
begin
-- Do not crash on No_Name.
if N = No_Sname then
Output_Message ("*nil*");
return;
end if;
Prefix := Get_Sname_Prefix (N);
if Prefix /= No_Sname then
Output_Name_1 (Prefix);
Output_Message (".");
end if;
case Get_Sname_Kind (N) is
when Sname_User =>
Output_Identifier (Get_Sname_Suffix (N));
when Sname_Artificial =>
Output_Identifier (Get_Sname_Suffix (N));
when Sname_Version =>
Output_Message ("n");
Output_Uns32 (Get_Sname_Version (N));
end case;
end Output_Name_1;
procedure Output_Name (N : Sname) is
begin
Output_Message ("""");
Output_Name_1 (N);
Output_Message ("""");
end Output_Name;
procedure Synth_Instance_Handler
(Format : Character; Err : Error_Record; Val : Uns32)
is
pragma Unreferenced (Err);
Inst : constant Instance := Instance (Val);
begin
case Format is
when 'n' =>
Output_Name (Get_Instance_Name (Inst));
when 'i' =>
Output_Message ("i");
Output_Uns32 (Uns32 (Inst));
when others =>
raise Internal_Error;
end case;
end Synth_Instance_Handler;
procedure Synth_Net_Handler
(Format : Character; Err : Error_Record; Val : Uns32)
is
pragma Unreferenced (Err);
N : constant Net := Net (Val);
begin
case Format is
when 'n' =>
declare
Inst : constant Instance := Get_Net_Parent (N);
Idx : constant Port_Idx := Get_Port_Idx (N);
Name : Sname;
begin
if Is_Self_Instance (Inst) then
Name := Get_Input_Desc (Get_Module (Inst), Idx).Name;
else
Name := Get_Output_Desc (Get_Module (Inst), Idx).Name;
end if;
Output_Name (Name);
end;
when others =>
raise Internal_Error;
end case;
end Synth_Net_Handler;
procedure Synth_Name_Handler
(Format : Character; Err : Error_Record; Val : Uns32)
is
pragma Unreferenced (Err);
N : constant Sname := Sname (Val);
begin
if Format = 'n' then
Output_Name (N);
else
raise Internal_Error;
end if;
end Synth_Name_Handler;
procedure Initialize is
begin
Register_Earg_Handler
(Earg_Synth_Instance, Synth_Instance_Handler'Access);
Register_Earg_Handler
(Earg_Synth_Net, Synth_Net_Handler'Access);
Register_Earg_Handler
(Earg_Synth_Name, Synth_Name_Handler'Access);
end Initialize;
end Netlists.Errors;
|
