diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-10-06 08:46:30 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-10-06 08:46:30 +0200 |
commit | 00f8dd9107cef97100a409731e1d09903c98d24d (patch) | |
tree | 0c166a1d32836717afb1a8383c2b9dc978f01905 /src/synth/netlists-errors.adb | |
parent | d444e0db133898308795ffbf8081330e6a33ed4f (diff) | |
download | ghdl-00f8dd9107cef97100a409731e1d09903c98d24d.tar.gz ghdl-00f8dd9107cef97100a409731e1d09903c98d24d.tar.bz2 ghdl-00f8dd9107cef97100a409731e1d09903c98d24d.zip |
synth: add error messages for latches.
Diffstat (limited to 'src/synth/netlists-errors.adb')
-rw-r--r-- | src/synth/netlists-errors.adb | 121 |
1 files changed, 121 insertions, 0 deletions
diff --git a/src/synth/netlists-errors.adb b/src/synth/netlists-errors.adb new file mode 100644 index 000000000..880ae1418 --- /dev/null +++ b/src/synth/netlists-errors.adb @@ -0,0 +1,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_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; |