1--
2--  File Name:         TranscriptPkg.vhd
3--  Design Unit Name:  TranscriptPkg
4--  Revision:          STANDARD VERSION
5--
6--  Maintainer:        Jim Lewis      email:  jim@synthworks.com
7--  Contributor(s):
8--     Jim Lewis      jim@synthworks.com
9--
10--
11--  Description:
12--        Define file identifier TranscriptFile
13--        provide subprograms to open, close, and print to it.
14--
15--
16--  Developed for:
17--        SynthWorks Design Inc.
18--        VHDL Training Classes
19--        11898 SW 128th Ave.  Tigard, Or  97223
20--        http://www.SynthWorks.com
21--
22--  Revision History:
23--    Date       Version    Description
24--    01/2015:   2015.01    Initial revision
25--    01/2016:   2016.01    TranscriptOpen function now calls procedure of same name
26--    11/2016:   2016.l1    Added procedure BlankLine
27--
28--
29--  Copyright (c) 2015-2016 by SynthWorks Design Inc.  All rights reserved.
30--
31--  Verbatim copies of this source file may be used and
32--  distributed without restriction.
33--
34--  This source file is free software; you can redistribute it
35--  and/or modify it under the terms of the ARTISTIC License
36--  as published by The Perl Foundation; either version 2.0 of
37--  the License, or (at your option) any later version.
38--
39--  This source is distributed in the hope that it will be
40--  useful, but WITHOUT ANY WARRANTY; without even the implied
41--  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
42--  PURPOSE. See the Artistic License for details.
43--
44--  You should have received a copy of the license with this source.
45--  If not download it from,
46--     http://www.perlfoundation.org/artistic_license_2_0
47--
48
49use std.textio.all ;
50package TranscriptPkg is
51
52  -- File Identifier to facilitate usage of one transcript file
53  file             TranscriptFile : text ;
54
55  -- Cause compile errors if READ_MODE is passed to TranscriptOpen
56  subtype WRITE_APPEND_OPEN_KIND is FILE_OPEN_KIND range WRITE_MODE to APPEND_MODE ;
57
58  -- Open and close TranscriptFile.  Function allows declarative opens
59  procedure        TranscriptOpen (Status: out FILE_OPEN_STATUS; ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) ;
60  procedure        TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) ;
61  impure function  TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS ;
62
63  procedure        TranscriptClose ;
64  impure function  IsTranscriptOpen return boolean ;
65  alias            IsTranscriptEnabled is IsTranscriptOpen [return boolean] ;
66
67  -- Mirroring.  When using TranscriptPkw WriteLine and Print, uses both TranscriptFile and OUTPUT
68  procedure        SetTranscriptMirror (A : boolean := TRUE) ;
69  impure function  IsTranscriptMirrored return boolean ;
70  alias            GetTranscriptMirror is IsTranscriptMirrored [return boolean] ;
71
72  -- Write to TranscriptFile when open.  Write to OUTPUT when not open or IsTranscriptMirrored
73  procedure        WriteLine(buf : inout line)  ;
74  procedure        Print(s : string) ;
75
76  -- Create "count" number of blank lines
77  procedure BlankLine (count : integer := 1) ;
78
79end TranscriptPkg ;
80
81--- ///////////////////////////////////////////////////////////////////////////
82--- ///////////////////////////////////////////////////////////////////////////
83--- ///////////////////////////////////////////////////////////////////////////
84
85package body TranscriptPkg is
86  ------------------------------------------------------------
87  type LocalBooleanPType is protected
88    procedure Set (A : boolean) ;
89    impure function get return boolean ;
90  end protected LocalBooleanPType ;
91  type LocalBooleanPType is protected body
92    variable GlobalVar : boolean := FALSE ;
93    procedure Set (A : boolean) is
94    begin
95       GlobalVar := A ;
96    end procedure Set ;
97    impure function get return boolean is
98    begin
99      return GlobalVar ;
100    end function get ;
101  end protected body LocalBooleanPType ;
102
103  ------------------------------------------------------------
104  shared variable TranscriptEnable : LocalBooleanPType ;
105  shared variable TranscriptMirror : LocalBooleanPType ;
106
107  ------------------------------------------------------------
108  procedure TranscriptOpen (Status: out FILE_OPEN_STATUS; ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) is
109  ------------------------------------------------------------
110  begin
111    file_open(Status, TranscriptFile, ExternalName, OpenKind) ;
112    if Status = OPEN_OK then
113      TranscriptEnable.Set(TRUE) ;
114    end if ;
115  end procedure TranscriptOpen ;
116
117  ------------------------------------------------------------
118  procedure TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) is
119  ------------------------------------------------------------
120    variable Status : FILE_OPEN_STATUS ;
121  begin
122    TranscriptOpen(Status, ExternalName, OpenKind) ;
123    if Status /= OPEN_OK then
124      report "TranscriptPkg.TranscriptOpen file: " &
125             ExternalName & " status is: " & to_string(status) & " and is not OPEN_OK" severity FAILURE ;
126    end if ;
127  end procedure TranscriptOpen ;
128
129  ------------------------------------------------------------
130  impure function  TranscriptOpen (ExternalName: STRING; OpenKind: WRITE_APPEND_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is
131  ------------------------------------------------------------
132    variable Status : FILE_OPEN_STATUS ;
133  begin
134    TranscriptOpen(Status, ExternalName, OpenKind) ;
135    return Status ;
136  end function TranscriptOpen ;
137
138  ------------------------------------------------------------
139  procedure TranscriptClose is
140  ------------------------------------------------------------
141  begin
142    if TranscriptEnable.Get then
143      file_close(TranscriptFile) ;
144    end if ;
145    TranscriptEnable.Set(FALSE) ;
146  end procedure TranscriptClose ;
147
148  ------------------------------------------------------------
149  impure function IsTranscriptOpen return boolean is
150  ------------------------------------------------------------
151  begin
152    return TranscriptEnable.Get ;
153  end function IsTranscriptOpen ;
154
155  ------------------------------------------------------------
156  procedure SetTranscriptMirror (A : boolean := TRUE) is
157  ------------------------------------------------------------
158  begin
159      TranscriptMirror.Set(A) ;
160  end procedure SetTranscriptMirror ;
161
162  ------------------------------------------------------------
163  impure function IsTranscriptMirrored return boolean is
164  ------------------------------------------------------------
165  begin
166    return TranscriptMirror.Get ;
167  end function IsTranscriptMirrored ;
168
169  ------------------------------------------------------------
170  procedure WriteLine(buf : inout line) is
171  ------------------------------------------------------------
172  begin
173    if not TranscriptEnable.Get then
174      WriteLine(OUTPUT, buf) ;
175    elsif TranscriptMirror.Get then
176      TEE(TranscriptFile, buf) ;
177    else
178      WriteLine(TranscriptFile, buf) ;
179    end if ;
180  end procedure WriteLine ;
181
182  ------------------------------------------------------------
183  procedure Print(s : string) is
184  ------------------------------------------------------------
185    variable buf : line ;
186  begin
187    write(buf, s) ;
188    WriteLine(buf) ;
189  end procedure Print ;
190
191  ------------------------------------------------------------
192  procedure BlankLine (count : integer := 1) is
193  ------------------------------------------------------------
194  begin
195    for i in 1 to count loop
196      print("") ;
197    end loop ;
198  end procedure Blankline ;
199
200end package body TranscriptPkg ;