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
|
-- 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 Synth_Instance_Handler
(Format : Character; Err : Error_Record; Val : Uns32)
is
pragma Unreferenced (Err);
Inst : constant Instance := Instance (Val);
begin
if Format = 'n' then
Output_Name_1 (Get_Instance_Name (Inst));
else
raise Internal_Error;
end if;
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
if Format = 'n' then
declare
Inst : constant Instance := Get_Net_Parent (N);
Idx : constant Port_Idx := Get_Port_Idx (N);
begin
if Is_Self_Instance (Inst) then
Output_Name_1 (Get_Input_Desc (Get_Module (Inst), Idx).Name);
else
Output_Name_1 (Get_Output_Desc (Get_Module (Inst), Idx).Name);
end if;
end;
else
raise Internal_Error;
end if;
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_1 (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;
|
