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
|
-- GHDL Run Time (GRT) - VCD .gz module.
-- Copyright (C) 2005 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.
with System.Storage_Elements; -- Work around GNAT bug.
pragma Unreferenced (System.Storage_Elements);
with Grt.Vcd; use Grt.Vcd;
with Grt.Errors; use Grt.Errors;
with Grt.Types; use Grt.Types;
with Grt.Astdio; use Grt.Astdio;
with Grt.Hooks; use Grt.Hooks;
with Grt.Zlib; use Grt.Zlib;
with Grt.C; use Grt.C;
package body Grt.Vcdz is
Stream : gzFile;
procedure My_Vcd_Put (Str : String)
is
R : int;
pragma Unreferenced (R);
begin
R := gzwrite (Stream, Str'Address, Str'Length);
end My_Vcd_Put;
procedure My_Vcd_Putc (C : Character)
is
R : int;
pragma Unreferenced (R);
begin
R := gzputc (Stream, Character'Pos (C));
end My_Vcd_Putc;
procedure My_Vcd_Close is
begin
gzclose (Stream);
Stream := NULL_gzFile;
end My_Vcd_Close;
-- VCD filename.
-- Return TRUE if OPT is an option for VCD.
function Vcdz_Option (Opt : String) return Boolean
is
F : constant Natural := Opt'First;
Vcd_Filename : String_Access := null;
Mode : constant String := "wb" & NUL;
begin
if Opt'Length < 7 or else Opt (F .. F + 6) /= "--vcdgz" then
return False;
end if;
if Opt'Length > 7 and then Opt (F + 7) = '=' then
if Vcd_Close /= null then
Error ("--vcdgz: file already set");
return True;
end if;
-- Add an extra NUL character.
Vcd_Filename := new String (1 .. Opt'Length - 8 + 1);
Vcd_Filename (1 .. Opt'Length - 8) := Opt (F + 8 .. Opt'Last);
Vcd_Filename (Vcd_Filename'Last) := NUL;
Stream := gzopen (Vcd_Filename.all'Address, Mode'Address);
if Stream = NULL_gzFile then
Error_C ("cannot open ");
Error_E (Vcd_Filename (Vcd_Filename'First
.. Vcd_Filename'Last - 1));
return True;
end if;
Vcd_Putc := My_Vcd_Putc'Access;
Vcd_Put := My_Vcd_Put'Access;
Vcd_Close := My_Vcd_Close'Access;
return True;
else
return False;
end if;
end Vcdz_Option;
procedure Vcdz_Help is
begin
Put_Line
(" --vcdgz=FILENAME dump signal values into a VCD gzip'ed file");
end Vcdz_Help;
Vcdz_Hooks : aliased constant Hooks_Type :=
(Option => Vcdz_Option'Access,
Help => Vcdz_Help'Access,
Init => Proc_Hook_Nil'Access,
Start => Proc_Hook_Nil'Access,
Finish => Proc_Hook_Nil'Access);
procedure Register is
begin
Register_Hooks (Vcdz_Hooks'Access);
end Register;
end Grt.Vcdz;
|
