diff options
| -rw-r--r-- | Makefile.in | 2 | ||||
| -rw-r--r-- | dist/gcc/Makefile.in | 6 | ||||
| -rw-r--r-- | libraries/Makefile.inc | 75 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 6 | ||||
| -rw-r--r-- | src/grt/grt-options.adb | 10 | ||||
| -rw-r--r-- | src/grt/grt-processes.adb | 7 | ||||
| -rw-r--r-- | src/grt/grt-sdf.adb | 41 | ||||
| -rw-r--r-- | src/grt/grt-strings.adb | 41 | ||||
| -rw-r--r-- | src/grt/grt-strings.ads | 36 | ||||
| -rw-r--r-- | src/grt/grt-values.adb | 22 | ||||
| -rw-r--r-- | src/grt/grt-values.ads | 6 | ||||
| -rw-r--r-- | src/grt/grt-vpi.adb | 114 | ||||
| -rwxr-xr-x | testsuite/gna/bug028/testsuite.sh | 2 |
13 files changed, 241 insertions, 127 deletions
diff --git a/Makefile.in b/Makefile.in index a0e991078..546d7992f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -337,6 +337,8 @@ install.vhdllib: install.dirs $(MKDIR) -p $(DESTDIR)$(VHDL_LIB_DIR)/vendors $(INSTALL_DATA) -p \ $(LIBSRC_DIR)/vendors/* $(DESTDIR)$(VHDL_LIB_DIR)/vendors/ + $(INSTALL_PROGRAM) -p \ + $(LIBSRC_DIR)/vendors/*.sh $(DESTDIR)$(VHDL_LIB_DIR)/vendors/ ####################### clean ############################################ diff --git a/dist/gcc/Makefile.in b/dist/gcc/Makefile.in index d700cc919..a19725560 100644 --- a/dist/gcc/Makefile.in +++ b/dist/gcc/Makefile.in @@ -223,5 +223,7 @@ install-ghdllib: $(DESTDIR)$(VHDL_LIB_DIR)/v08/std/std_standard.o # Install vendors scripts. $(MKDIR) -p $(DESTDIR)$(VHDL_LIB_DIR)/vendors - $(INSTALL_DATA) -p \ - $(LIBSRC_DIR)/vendors/* $(DESTDIR)$(VHDL_LIB_DIR)/vendors/ + $(INSTALL_DATA) -p \ + $(LIBSRC_DIR)/vendors/* $(DESTDIR)$(VHDL_LIB_DIR)/vendors/ + $(INSTALL_PROGRAM) -p \ + $(LIBSRC_DIR)/vendors/*.sh $(DESTDIR)$(VHDL_LIB_DIR)/vendors/ diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index 4ce876c9a..7308fa8e5 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -28,12 +28,12 @@ vhdl.libs.all: vhdl.libs.v87 vhdl.libs.v93 vhdl.libs.v08 vhdl.libs.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93 vhdl.libs.v87: std.v87 ieee.v87 synopsys.v87 -vhdl.libs.v08: std.v08 ieee.v08 +vhdl.libs.v08: std.v08 ieee.v08 synopsys.v08 VHDLLIB_SUBDIRS= src/std src/ieee src/vital95 src/vital2000 src/synopsys src/mentor src/ieee2008 \ v87/std v87/ieee v87/synopsys \ v93/std v93/ieee v93/mentor v93/synopsys \ - v08/std v08/ieee v08/std \ + v08/std v08/ieee v08/synopsys \ STD_SRCS := std/textio.vhdl std/textio_body.vhdl IEEE_SRCS := ieee/std_logic_1164.vhdl ieee/std_logic_1164_body.vhdl \ @@ -47,33 +47,34 @@ VITAL2000_BSRCS := vital2000/timing_p.vhdl vital2000/timing_b.vhdl \ vital2000/prmtvs_p.vhdl vital2000/prmtvs_b.vhdl \ vital2000/memory_p.vhdl vital2000/memory_b.vhdl SYNOPSYS_BSRCS := synopsys/std_logic_arith.vhdl \ - synopsys/std_logic_textio.vhdl synopsys/std_logic_unsigned.vhdl \ - synopsys/std_logic_signed.vhdl \ - synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl + synopsys/std_logic_unsigned.vhdl \ + synopsys/std_logic_signed.vhdl +SYNOPSYS8793_BSRCS := synopsys/std_logic_textio.vhdl synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl MENTOR_BSRCS := mentor/std_logic_arith.vhdl mentor/std_logic_arith_body.vhdl IEEE08_BSRCS := \ -ieee2008/std_logic_1164.vhdl ieee2008/std_logic_1164-body.vhdl \ -ieee2008/std_logic_textio.vhdl \ -ieee2008/math_real.vhdl ieee2008/math_real-body.vhdl \ -ieee2008/math_complex.vhdl ieee2008/math_complex-body.vhdl \ -ieee2008/numeric_bit.vhdl ieee2008/numeric_bit-body.vhdl \ -ieee2008/numeric_bit_unsigned.vhdl ieee2008/numeric_bit_unsigned-body.vhdl \ -ieee2008/numeric_std.vhdl ieee2008/numeric_std-body.vhdl \ -ieee2008/numeric_std_unsigned.vhdl ieee2008/numeric_std_unsigned-body.vhdl \ -ieee2008/fixed_float_types.vhdl \ -ieee2008/fixed_generic_pkg.vhdl ieee2008/fixed_generic_pkg-body.vhdl \ -ieee2008/fixed_pkg.vhdl \ -ieee2008/float_generic_pkg.vhdl ieee2008/float_generic_pkg-body.vhdl \ -ieee2008/float_pkg.vhdl \ -ieee2008/ieee_bit_context.vhdl ieee2008/ieee_std_context.vhdl + ieee2008/std_logic_1164.vhdl ieee2008/std_logic_1164-body.vhdl \ + ieee2008/std_logic_textio.vhdl \ + ieee2008/math_real.vhdl ieee2008/math_real-body.vhdl \ + ieee2008/math_complex.vhdl ieee2008/math_complex-body.vhdl \ + ieee2008/numeric_bit.vhdl ieee2008/numeric_bit-body.vhdl \ + ieee2008/numeric_bit_unsigned.vhdl ieee2008/numeric_bit_unsigned-body.vhdl \ + ieee2008/numeric_std.vhdl ieee2008/numeric_std-body.vhdl \ + ieee2008/numeric_std_unsigned.vhdl ieee2008/numeric_std_unsigned-body.vhdl \ + ieee2008/fixed_float_types.vhdl \ + ieee2008/fixed_generic_pkg.vhdl ieee2008/fixed_generic_pkg-body.vhdl \ + ieee2008/fixed_pkg.vhdl \ + ieee2008/float_generic_pkg.vhdl ieee2008/float_generic_pkg-body.vhdl \ + ieee2008/float_pkg.vhdl \ + ieee2008/ieee_bit_context.vhdl ieee2008/ieee_std_context.vhdl STD87_BSRCS := $(STD_SRCS:.vhdl=.v87) STD93_BSRCS := $(STD_SRCS:.vhdl=.v93) STD08_BSRCS := $(STD_SRCS:.vhdl=.v08) std/env.vhdl std/env_body.vhdl IEEE87_BSRCS := $(IEEE_SRCS:.vhdl=.v87) IEEE93_BSRCS := $(IEEE_SRCS:.vhdl=.v93) $(MATH_SRCS) -SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS) -SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS) +SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS) $(SYNOPSYS8793_BSRCS) +SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS) $(SYNOPSYS8793_BSRCS) +SYNOPSYS08_BSRCS := $(SYNOPSYS_BSRCS) MENTOR93_BSRCS := $(MENTOR_BSRCS) .PREFIXES: .vhdl .v93 .v87 .v08 @@ -100,6 +101,7 @@ MENTOR93_DIR:=$(LIB93_DIR)/mentor LIB08_DIR:=$(LIBDST_DIR)/v08 STD08_DIR:=$(LIB08_DIR)/std IEEE08_DIR:=$(LIB08_DIR)/ieee +SYN08_DIR:=$(LIB08_DIR)/synopsys ANALYZE87:=$(ANALYZE) --std=87 ANALYZE93:=$(ANALYZE) --std=93 @@ -112,7 +114,9 @@ STD08_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(STD08_BSRCS)) IEEE93_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(IEEE93_BSRCS)) IEEE87_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(IEEE87_BSRCS)) IEEE08_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(IEEE08_BSRCS)) -SYNOPSYS_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(SYNOPSYS_BSRCS)) +SYNOPSYS87_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(SYNOPSYS87_BSRCS)) +SYNOPSYS93_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(SYNOPSYS93_BSRCS)) +SYNOPSYS08_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(SYNOPSYS08_BSRCS)) MENTOR93_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(MENTOR93_BSRCS)) VITAL95_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(VITAL95_BSRCS)) VITAL2000_SRCS=$(addprefix $(LIBDST_DIR)/src/,$(VITAL2000_BSRCS)) @@ -156,7 +160,7 @@ ieee.v87: $(ANALYZE_DEP) $(LIB87_DIR) $(IEEE87_SRCS) $(VITAL95_SRCS) std.v87 for $(LIBDST_DIR)/src/synopsys/%.vhdl: $(LIBSRC_DIR)/synopsys/%.vhdl $(LIBDST_DIR)/src/synopsys $(CP) $< $@ -synopsys.v87: $(ANALYZE_DEP) $(LIB87_DIR) $(SYNOPSYS_SRCS) ieee.v87 force +synopsys.v87: $(ANALYZE_DEP) $(LIB87_DIR) $(SYNOPSYS87_SRCS) ieee.v87 force $(RM) -rf $(SYN87_DIR) mkdir $(SYN87_DIR) cd $(SYN87_DIR); \ @@ -210,7 +214,7 @@ ieee.v93: $(ANALYZE_DEP) $(LIB93_DIR) $(IEEE93_SRCS) $(VITAL2000_SRCS) std.v93 f echo $$cmd; eval $$cmd || exit 1; \ done -synopsys.v93: $(ANALYZE_DEP) $(LIB93_DIR) $(SYNOPSYS_SRCS) ieee.v93 force +synopsys.v93: $(ANALYZE_DEP) $(LIB93_DIR) $(SYNOPSYS93_SRCS) ieee.v93 force $(RM) -rf $(SYN93_DIR) mkdir $(SYN93_DIR) cd $(SYN93_DIR); \ @@ -271,13 +275,34 @@ $(LIBDST_DIR)/src/ieee2008/%.vhdl: $(LIBSRC_DIR)/ieee2008/%.vhdl $(LIBDST_DIR)/s $(CP) $< $@ ANALYZE_IEEE08=$(ANALYZE08) -P../std --work=ieee +ANALYZE_VITAL08=$(ANALYZE08) -P../std --work=ieee -frelaxed-rules ieee.v08: $(ANALYZE_DEP) $(LIB08_DIR) $(IEEE08_SRCS) std.v08 force $(RM) -rf $(IEEE08_DIR) mkdir $(IEEE08_DIR) -# FIXME: add VITAL2000 ? cd $(IEEE08_DIR); \ for i in $(IEEE08_BSRCS); do \ cmd="$(ANALYZE_IEEE08) ../../src/$$i"; \ echo $$cmd; eval $$cmd || exit 1; \ + done; \ + for i in $(VITAL2000_BSRCS); do \ + cmd="$(ANALYZE_VITAL08) ../../src/$$i"; \ + echo $$cmd; eval $$cmd || exit 1; \ + done + +synopsys.v08: $(ANALYZE_DEP) $(LIB08_DIR) $(SYNOPSYS08_SRCS) ieee.v08 force + $(RM) -rf $(SYN08_DIR) + mkdir $(SYN08_DIR) + cd $(SYN08_DIR); \ + $(CP) ../ieee/ieee-obj08.cf .; \ + test x$(VHDLLIBS_COPY_OBJS) = "xno" || \ + for i in $(IEEE_SRCS) $(MATH_SRCS) $(VITAL2000_SRCS); do \ + b=`basename $$i .vhdl`; \ + if [ -f ../ieee/$$b.o ]; then \ + $(LN) ../ieee/$$b.o $$b.o || exit 1; \ + fi; \ + done; \ + for i in $(SYNOPSYS08_BSRCS); do \ + cmd="$(ANALYZE_IEEE08) ../../src/$$i"; \ + echo $$cmd; eval $$cmd || exit 1; \ done diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index a28c44bee..fbffb5f1d 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -442,11 +442,7 @@ package body Ghdllocal is when Lib_Standard => Add_Library_Path ("ieee"); when Lib_Synopsys => - if Vhdl_Std >= Vhdl_08 then - Warning ("--ieee=synopsys is ignored for --std=08"); - else - Add_Library_Path ("synopsys"); - end if; + Add_Library_Path ("synopsys"); when Lib_Mentor => if Vhdl_Std >= Vhdl_08 then Warning ("--ieee=mentor is ignored for --std=08"); diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 3c4acb215..81fa962f0 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -23,6 +23,7 @@ -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. with Interfaces; use Interfaces; +with Grt.Strings; use Grt.Strings; with Grt.Errors; use Grt.Errors; with Grt.Astdio; with Grt.Hooks; @@ -210,15 +211,6 @@ package body Grt.Options is end loop; end Extract_Integer; - function To_Lower (C : Character) return Character is - begin - if C in 'A' .. 'Z' then - return Character'Val (Character'Pos (C) + 32); - else - return C; - end if; - end To_Lower; - procedure Decode_Option (Option : String; Status : out Decode_Option_Status) is diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb index 91e56b6ca..67b7a88a5 100644 --- a/src/grt/grt-processes.adb +++ b/src/grt/grt-processes.adb @@ -842,6 +842,13 @@ package body Grt.Processes is -- of step f of the simulation cycle, below. Next_Time := Compute_Next_Time; if Next_Time /= 0 then + if Has_Callbacks (Hooks.Cb_Last_Known_Delta) then + Call_Callbacks (Hooks.Cb_Last_Known_Delta); + Flush_Active_Chain; + Next_Time := Compute_Next_Time; + end if; + end if; + if Next_Time /= 0 then Update_Active_Chain; end if; diff --git a/src/grt/grt-sdf.adb b/src/grt/grt-sdf.adb index 75dfefe4d..1cb04e5e1 100644 --- a/src/grt/grt-sdf.adb +++ b/src/grt/grt-sdf.adb @@ -1,5 +1,5 @@ -- GHDL Run Time (GRT) - SDF parser. --- Copyright (C) 2002 - 2014 Tristan Gingold +-- Copyright (C) 2002 - 2016 Tristan Gingold -- -- GHDL 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 @@ -22,17 +22,16 @@ -- covered by the GNU General Public License. This exception does not -- however invalidate any other reasons why the executable file might be -- covered by the GNU Public License. -with System.Storage_Elements; -- Work around GNAT bug. -pragma Unreferenced (System.Storage_Elements); + with Grt.Stdio; use Grt.Stdio; with Grt.C; use Grt.C; +with Grt.Strings; use Grt.Strings; with Grt.Errors; use Grt.Errors; -with Ada.Characters.Latin_1; with Ada.Unchecked_Deallocation; with Grt.Vital_Annotate; package body Grt.Sdf is - EOT : constant Character := Character'Val (4); + use ASCII; type Sdf_Token_Type is ( @@ -71,10 +70,10 @@ package body Grt.Sdf is function Open_Sdf (Filename : String) return Boolean is N_Filename : String (1 .. Filename'Length + 1); - Mode : constant String := "rt" & NUL; + Mode : constant String := "rt" & ASCII.NUL; begin N_Filename (1 .. Filename'Length) := Filename; - N_Filename (N_Filename'Last) := NUL; + N_Filename (N_Filename'Last) := ASCII.NUL; Sdf_Stream := fopen (N_Filename'Address, Mode'Address); if Sdf_Stream = NULL_Stream then Error_C ("cannot open SDF file '"); @@ -212,7 +211,7 @@ package body Grt.Sdf is -- Continue to read. Read_Append; Pos := Pos - 1; - when NUL .. Character'Val (3) + when ASCII.NUL .. Character'Val (3) | Character'Val (5) .. Character'Val (31) | Character'Val (127) .. Character'Val (255) => Error_Bad_Character; @@ -295,9 +294,7 @@ package body Grt.Sdf is Pos := 1; end Refill_Buf; - procedure Skip_Spaces - is - use Ada.Characters.Latin_1; + procedure Skip_Spaces is begin -- Fast blanks skipping. while Buf (Pos) = ' ' loop @@ -359,9 +356,7 @@ package body Grt.Sdf is end loop; end Skip_Spaces; - function Get_Token return Sdf_Token_Type - is - use Ada.Characters.Latin_1; + function Get_Token return Sdf_Token_Type is begin Skip_Spaces; @@ -410,9 +405,7 @@ package body Grt.Sdf is end case; end Get_Token; - function Is_White_Space (C : Character) return Boolean - is - use Ada.Characters.Latin_1; + function Is_White_Space (C : Character) return Boolean is begin case C is when ' ' @@ -425,9 +418,7 @@ package body Grt.Sdf is end case; end Is_White_Space; - function Get_Edge_Token return Edge_Type - is - use Ada.Characters.Latin_1; + function Get_Edge_Token return Edge_Type is begin Skip_Spaces; @@ -664,16 +655,6 @@ package body Grt.Sdf is return True; end Expect_Rexpr_Cp_Op_Ident; - function To_Lower (C : Character) return Character is - begin - if C >= 'A' and C <= 'Z' then - return Character'Val (Character'Pos (C) - - Character'Pos ('A') + Character'Pos ('a')); - else - return C; - end if; - end To_Lower; - function Parse_Port_Path1 (Tok : Sdf_Token_Type) return Boolean is Port_Spec : Port_Spec_Type diff --git a/src/grt/grt-strings.adb b/src/grt/grt-strings.adb new file mode 100644 index 000000000..38e2c6b4e --- /dev/null +++ b/src/grt/grt-strings.adb @@ -0,0 +1,41 @@ +-- GHDL Run Time (GRT) - Misc subprograms for characters and strings +-- Copyright (C) 2016 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +package body Grt.Strings is + function Is_Whitespace (C : in Character) return Boolean is + use ASCII; + begin + return C = ' ' or C = NBSP or C = HT; + end Is_Whitespace; + + function To_Lower (C : Character) return Character is + begin + if C in 'A' .. 'Z' then + return Character'Val (Character'Pos (C) + 32); + else + return C; + end if; + end To_Lower; +end Grt.Strings; diff --git a/src/grt/grt-strings.ads b/src/grt/grt-strings.ads new file mode 100644 index 000000000..d11c799f0 --- /dev/null +++ b/src/grt/grt-strings.ads @@ -0,0 +1,36 @@ +-- GHDL Run Time (GRT) - Misc subprograms for characters and strings +-- Copyright (C) 2016 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +package Grt.Strings is + pragma Pure; + + NBSP : constant Character := Character'Val (160); + + -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) + function Is_Whitespace (C : in Character) return Boolean; + + -- Convert C to lowercase. + function To_Lower (C : Character) return Character; +end Grt.Strings; diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb index e87182791..e64e7b943 100644 --- a/src/grt/grt-values.adb +++ b/src/grt/grt-values.adb @@ -1,5 +1,5 @@ -- GHDL Run Time (GRT) - 'value subprograms. --- Copyright (C) 2002 - 2014 Tristan Gingold +-- Copyright (C) 2002 - 2016 Tristan Gingold -- -- GHDL 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 @@ -24,18 +24,13 @@ -- covered by the GNU Public License. with Grt.Errors; use Grt.Errors; with Grt.Rtis_Utils; +with Grt.Strings; use Grt.Strings; package body Grt.Values is NBSP : constant Character := Character'Val (160); HT : constant Character := Character'Val (9); - -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) - function Is_Whitespace (C : in Character) return Boolean is - begin - return C = ' ' or C = NBSP or C = HT; - end Is_Whitespace; - -- Increase POS to skip leading whitespace characters, decrease LEN to -- skip trailing whitespaces in string S. procedure Remove_Whitespaces (S : Std_String_Basep; @@ -58,17 +53,6 @@ package body Grt.Values is end if; end Remove_Whitespaces; - -- Convert C to lowercase. - function To_LC (C : in Character) return Character is - begin - if C in 'A' .. 'Z' then - return Character'Val - (Character'Pos (C) + Character'Pos ('a') - Character'Pos ('A')); - else - return C; - end if; - end To_LC; - -- Return TRUE iff user string S (POS .. LEN - 1) is equal to REF. -- Comparaison is case insensitive, but REF must be lowercase (REF is -- supposed to come from an RTI). @@ -90,7 +74,7 @@ package body Grt.Values is end if; C_S := S (Pos + P); if not Is_Char then - C_S := To_LC (C_S); + C_S := To_Lower (C_S); end if; if C_S /= C_Ref or else C_Ref = ASCII.NUL then return False; diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads index 5f1e5169d..ee76109d5 100644 --- a/src/grt/grt-values.ads +++ b/src/grt/grt-values.ads @@ -26,12 +26,6 @@ with Grt.Types; use Grt.Types; with Grt.Rtis; use Grt.Rtis; package Grt.Values is - -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) - function Is_Whitespace (C : in Character) return Boolean; - - -- Convert C to lowercase. - function To_LC (C : in Character) return Character; - -- Extract position of numeric literal and unit in string STR. -- Set IS_REAL if the unit is a real number (presence of '.'). -- Set UNIT_POS to the position of the first character of the unit name. diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 90c75ef93..d7a62330f 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -45,6 +45,7 @@ with Grt.Stdio; use Grt.Stdio; with Grt.C; use Grt.C; with Grt.Signals; use Grt.Signals; with Grt.Astdio; use Grt.Astdio; +with Grt.Strings; use Grt.Strings; with Grt.Hooks; use Grt.Hooks; with Grt.Options; with Grt.Vcd; use Grt.Vcd; @@ -131,13 +132,6 @@ package body Grt.Vpi is -- Clear error status. procedure Reset_Error; - procedure Vpi_Trace (Msg : String) is - begin - if Flag_Trace then - Put_Line (Trace_File, Msg); - end if; - end Vpi_Trace; - procedure Trace_Start (Msg : String) is begin for I in 1 .. Trace_Indent loop @@ -213,11 +207,53 @@ package body Grt.Vpi is when vpiRightRange => Trace ("vpiRightRange"); + when vpiStop => + Trace ("vpiStop"); + when vpiFinish => + Trace ("vpiFinish"); + when vpiReset => + Trace ("vpiReset"); + when others => Trace (V); end case; end Trace_Property; + procedure Trace_Format (F : Integer) is + begin + case F is + when vpiBinStrVal => + Trace ("BinStr"); + when vpiOctStrVal => + Trace ("OctStr"); + when vpiDecStrVal => + Trace ("DecStr"); + when vpiHexStrVal => + Trace ("HexStr"); + when vpiScalarVal => + Trace ("Scalar"); + when vpiIntVal => + Trace ("Int"); + when vpiRealVal => + Trace ("Real"); + when vpiStringVal => + Trace ("String"); + when vpiVectorVal => + Trace ("Vector"); + when vpiStrengthVal => + Trace ("Strength"); + when vpiTimeVal => + Trace ("Time"); + when vpiObjTypeVal => + Trace ("ObjType"); + when vpiSuppressVal => + Trace ("Suppress"); + + when others => + Trace (F); + end case; + end Trace_Format; + procedure Trace_Time_Tag (V : Integer) is begin case V is @@ -796,7 +832,7 @@ package body Grt.Vpi is Trace_Start ("vpi_get_value ("); Trace (Expr); Trace (", {format="); - Trace (Value.Format); + Trace_Format (Value.Format); Trace ("}) = "); end if; @@ -1130,7 +1166,21 @@ package body Grt.Vpi is Res : Integer; pragma Unreferenced (Res); begin + if Flag_Trace then + Trace_Start ("vpi call callback "); + Trace_Cb_Reason (Hand.Cb.Reason); + Trace (" "); + Trace (Hand); + Trace_Newline; + Trace_Indent := Trace_Indent + 1; + end if; Res := Hand.Cb.Cb_Rtn (Hand.Cb'Access); + if Flag_Trace then + Trace_Indent := Trace_Indent - 1; + Trace_Start ("vpi end callback "); + Trace (Hand); + Trace_Newline; + end if; end Execute_Callback; procedure Execute_Callback_List (List : Callback_List) @@ -1157,25 +1207,12 @@ package body Grt.Vpi is function To_vpiHandle is new Ada.Unchecked_Conversion (System.Address, vpiHandle); + -- Wrapper procedure Call_Callback (Arg : System.Address) is Hand : constant vpiHandle := To_vpiHandle (Arg); begin - if Flag_Trace then - Trace_Start ("vpi call callback "); - Trace_Cb_Reason (Hand.Cb.Reason); - Trace (" "); - Trace (Hand); - Trace_Newline; - Trace_Indent := Trace_Indent + 1; - end if; Execute_Callback (Hand); - if Flag_Trace then - Trace_Indent := Trace_Indent - 1; - Trace_Start ("vpi end callback "); - Trace (Hand); - Trace_Newline; - end if; end Call_Callback; procedure Call_Valuechange_Callback (Arg : System.Address) @@ -1290,7 +1327,10 @@ package body Grt.Vpi is -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p) function vpi_get_vlog_info (info : p_vpi_vlog_info) return integer is begin - Vpi_Trace ("vpi_get_vlog_info"); + if Flag_Trace then + Trace_Start ("vpi_get_vlog_info"); + Trace_Newline; + end if; info.all := (Argc => 0, Argv => Null_Address, @@ -1306,6 +1346,11 @@ package body Grt.Vpi is pragma Unreferenced (aRef); pragma Unreferenced (aIndex); begin + if Flag_Trace then + Trace_Start ("vpi_handle_by_index UNIMPLEMENTED!"); + Trace_Newline; + end if; + return null; end vpi_handle_by_index; @@ -1323,7 +1368,7 @@ package body Grt.Vpi is -- NUL not allowed in L. return False; end if; - if L (I) /= R (I - L'First + 1) then + if To_Lower (L (I)) /= R (I - L'First + 1) then return False; end if; end loop; @@ -1353,7 +1398,7 @@ package body Grt.Vpi is exit when Err /= AvhpiErrorOk; El_Name := Avhpi_Get_Base_Name (Res); - exit when Strcmp (Name , El_Name); + exit when Strcmp (Name, El_Name); end loop; end Find_By_Name; @@ -1474,7 +1519,10 @@ package body Grt.Vpi is is pragma Unreferenced (aSs); begin - Vpi_Trace ("vpi_register_systf"); + if Flag_Trace then + Trace_Start ("vpi_register_systf"); + Trace_Newline; + end if; end vpi_register_systf; -- int vpi_remove_cb(vpiHandle ref) @@ -1561,11 +1609,17 @@ package body Grt.Vpi is return Err_Status; end vpi_chk_error; - function vpi_control (Op : Integer; Status : Integer) return Integer - is - pragma Unreferenced (Status); + function vpi_control (Op : Integer; Status : Integer) return Integer is begin - Vpi_Trace ("vpi_control"); + if Flag_Trace then + Trace_Start ("vpi_control ("); + Trace_Property (Op); + Trace (", "); + Trace (Status); + Trace (")"); + Trace_Newline; + end if; + case Op is when vpiFinish | vpiStop => diff --git a/testsuite/gna/bug028/testsuite.sh b/testsuite/gna/bug028/testsuite.sh index 2567fba26..6eb89c3d0 100755 --- a/testsuite/gna/bug028/testsuite.sh +++ b/testsuite/gna/bug028/testsuite.sh @@ -3,7 +3,7 @@ . ../../testenv.sh GHDL_STD_FLAGS=--std=08 -GHDL_FLAGS=--ieee=synopsys +GHDL_FLAGS=--ieee=mentor analyze simple.vhdl 2>&1 | grep ignored clean |