1-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*- 2-- vim: tabstop=2:shiftwidth=2:noexpandtab 3-- kate: tab-width 2; replace-tabs off; indent-width 2; 4-- ============================================================================= 5-- Authors: Patrick Lehmann 6-- 7-- Package: File I/O-related Functions. 8-- 9-- Description: 10-- ------------------------------------- 11-- .. TODO:: No documentation available. 12-- 13-- License: 14-- ============================================================================= 15-- Copyright 2007-2016 Technische Universitaet Dresden - Germany, 16-- Chair of VLSI-Design, Diagnostics and Architecture 17-- 18-- Licensed under the Apache License, Version 2.0 (the "License"); 19-- you may not use this file except in compliance with the License. 20-- You may obtain a copy of the License at 21-- 22-- http://www.apache.org/licenses/LICENSE-2.0 23-- 24-- Unless required by applicable law or agreed to in writing, software 25-- distributed under the License is distributed on an "AS IS" BASIS, 26-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 27-- See the License for the specific language governing permissions and 28-- limitations under the License. 29-- ============================================================================= 30 31use STD.TextIO.all; 32 33library PoC; 34use PoC.my_project.all; 35use PoC.utils.all; 36use PoC.strings.all; 37use PoC.ProtectedTypes.all; 38 39 40package FileIO is 41 subtype T_LOGFILE_OPEN_KIND is FILE_OPEN_KIND range WRITE_MODE to APPEND_MODE; 42 43 -- Constant declarations 44 constant C_LINEBREAK : string; 45 46 -- =========================================================================== 47 type T_LOGFILE is protected 48 procedure OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE); 49 impure function OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS; 50 procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE); 51 impure function IsOpen return boolean; 52 procedure CloseFile; 53 54 procedure Print(str : string); 55 procedure PrintLine(str : string := ""); 56 procedure Flush; 57 -- procedure WriteLine(LineBuffer : inout LINE); 58 end protected; 59 60 -- =========================================================================== 61 type T_FILE is protected 62 procedure OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE); 63 impure function OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS; 64 procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE); 65 impure function IsOpen return boolean; 66 procedure CloseFile; 67 68 procedure Print(str : string); 69 procedure PrintLine(str : string := ""); 70 procedure Flush; 71 -- procedure WriteLine(LineBuffer : inout LINE); 72 end protected; 73 74 type T_STDOUT is protected 75 procedure Print(str : string); 76 procedure PrintLine(str : string := ""); 77 procedure Flush; 78 end protected; 79end package; 80 81 82package body FileIO is 83 constant C_LINEBREAK : string := ite(str_equal(MY_OPERATING_SYSTEM, "WINDOWS"), (CR & LF), (1 => LF)); 84 85 -- =========================================================================== 86 file Global_LogFile : TEXT; 87 -- shared variable LogFile_IsOpen : P_BOOLEAN; 88 -- shared variable LogFile : T_LOGFILE; 89 -- shared variable StdOut : T_STDOUT; 90 -- shared variable LogFile_IsMirrored : P_BOOLEAN; 91 92 -- =========================================================================== 93 type T_LOGFILE is protected body 94 variable LineBuffer : LINE; 95 variable Local_IsOpen : boolean; 96 variable Local_FileName : string(1 to 256); 97 98 procedure OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) is 99 variable Status : FILE_OPEN_STATUS; 100 begin 101 OpenFile(Status, FileName, OpenKind); 102 end procedure; 103 104 impure function OpenFile(FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is 105 variable Status : FILE_OPEN_STATUS; 106 begin 107 OpenFile(Status, FileName, OpenKind); 108 return Status; 109 end function; 110 111 procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : T_LOGFILE_OPEN_KIND := WRITE_MODE) is 112 variable Status_i : FILE_OPEN_STATUS; 113 begin 114 if not Local_IsOpen then 115 file_open(Status_i, Global_LogFile, FileName, OpenKind); 116 Local_IsOpen := Status_i = OPEN_OK; 117 Local_FileName := resize(FileName, Local_FileName'length); 118 Status := Status_i; 119 else 120 report "Global log file '" & str_trim(Local_FileName) & "' is already open." severity ERROR; 121 end if; 122 end procedure; 123 124 impure function IsOpen return boolean is 125 begin 126 return Local_IsOpen; 127 end function; 128 129 procedure CloseFile is 130 begin 131 if Local_IsOpen then 132 file_close(Global_LogFile); 133 Local_IsOpen := FALSE; 134 end if; 135 end procedure; 136 137 procedure WriteLine(LineBuffer : inout LINE) is 138 begin 139 if not Local_IsOpen then 140 writeline(OUTPUT, LineBuffer); 141 -- elsif (LogFile_IsMirrored.Get = TRUE) then 142 -- tee(Global_LogFile, LineBuffer); 143 else 144 writeline(Global_LogFile, LineBuffer); 145 end if ; 146 end procedure; 147 148 procedure Print(str : string) is 149 begin 150 write(LineBuffer, str); 151 end procedure; 152 153 procedure PrintLine(str : string := "") is 154 begin 155 write(LineBuffer, str); 156 WriteLine(LineBuffer); 157 end procedure; 158 159 procedure Flush is 160 begin 161 WriteLine(LineBuffer); 162 end procedure; 163 end protected body; 164 165 type T_FILE is protected body 166 file LocalFile : TEXT; 167 variable LineBuffer : LINE; 168 variable Local_IsOpen : boolean; 169 variable Local_FileName : string(1 to 256); 170 171 procedure OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) is 172 variable Status : FILE_OPEN_STATUS; 173 begin 174 OpenFile(Status, FileName, OpenKind); 175 end procedure; 176 177 impure function OpenFile(FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) return FILE_OPEN_STATUS is 178 variable Status : FILE_OPEN_STATUS; 179 begin 180 OpenFile(Status, FileName, OpenKind); 181 return Status; 182 end function; 183 184 impure function IsOpen return boolean is 185 begin 186 return Local_IsOpen; 187 end function; 188 189 procedure OpenFile(Status : out FILE_OPEN_STATUS; FileName : string; OpenKind : FILE_OPEN_KIND := WRITE_MODE) is 190 variable Status_i : FILE_OPEN_STATUS; 191 begin 192 if not Local_IsOpen then 193 file_open(Status_i, LocalFile, FileName, OpenKind); 194 Local_IsOpen := Status_i = OPEN_OK; 195 Local_FileName := resize(FileName, Local_FileName'length); 196 Status := Status_i; 197 else 198 report "File '" & str_trim(Local_FileName) & "' is already open." severity ERROR; 199 end if; 200 end procedure; 201 202 procedure CloseFile is 203 begin 204 if Local_IsOpen then 205 file_close(LocalFile); 206 Local_IsOpen := FALSE; 207 end if; 208 end procedure; 209 210 procedure WriteLine(LineBuffer : inout LINE) is 211 begin 212 if not Local_IsOpen then 213 report "File is not open." severity ERROR; 214 else 215 writeline(LocalFile, LineBuffer); 216 end if ; 217 end procedure; 218 219 procedure Print(str : string) is 220 begin 221 write(LineBuffer, str); 222 end procedure; 223 224 procedure PrintLine(str : string := "") is 225 begin 226 write(LineBuffer, str); 227 WriteLine(LineBuffer); 228 end procedure; 229 230 procedure Flush is 231 begin 232 WriteLine(LineBuffer); 233 end procedure; 234 end protected body; 235 236 type T_STDOUT is protected body 237 variable LineBuffer : LINE; 238 239 procedure Print(str : string) is 240 begin 241 write(LineBuffer, str); 242 end procedure; 243 244 procedure PrintLine(str : string := "") is 245 begin 246 write(LineBuffer, str); 247 writeline(OUTPUT, LineBuffer); 248 end procedure; 249 250 procedure Flush is 251 begin 252 writeline(OUTPUT, LineBuffer); 253 end procedure; 254 end protected body; 255end package body; 256