aboutsummaryrefslogtreecommitdiffstats
path: root/src/synth/netlists-errors.adb
blob: 7d3bbd93c4f27ef7b77ce3fa6e16d0cbd4458356 (plain)
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
--  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, see <gnu.org/licenses>.

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;