summaryrefslogtreecommitdiffstats
path: root/ieee_proposed/rtl/standard_textio_additions_c.vhd
blob: 35ed5d0fc712759d866b724961ae805bc6a5a0b1 (plain)
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
------------------------------------------------------------------------------
-- "standard_textio_additions" package contains the additions to the built in
-- "standard.textio" package.
-- This package should be compiled into "ieee_proposed" and used as follows:
-- use ieee_proposed.standard_textio_additions.all;
-- Last Modified: $Date: 2007-03-13 14:25:58-04 $
-- RCS ID: $Id: standard_textio_additions_c.vhdl,v 1.5 2007-03-13 14:25:58-04 l435385 Exp $
--
--  Created for VHDL-200X par, David Bishop (dbishop@vhdl.org)
------------------------------------------------------------------------------
use std.textio.all;
package standard_textio_additions is

--  procedure DEALLOCATE (P : inout LINE);

  procedure FLUSH (file F : TEXT);

  function MINIMUM (L, R : SIDE) return SIDE;
  function MAXIMUM (L, R : SIDE) return SIDE;

  function TO_STRING (VALUE : SIDE) return STRING;

  function JUSTIFY (VALUE : STRING; JUSTIFIED : SIDE := right; FIELD : WIDTH := 0) return STRING;

  procedure SREAD (L    : inout LINE; VALUE : out STRING; STRLEN : out NATURAL);
  alias STRING_READ is SREAD [LINE, STRING, NATURAL];
  alias BREAD is READ [LINE, BIT_VECTOR, BOOLEAN];
  alias BREAD is READ [LINE, BIT_VECTOR];
  alias BINARY_READ is READ [LINE, BIT_VECTOR, BOOLEAN];
  alias BINARY_READ is READ [LINE, BIT_VECTOR];
  procedure OREAD (L    : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
  procedure OREAD (L    : inout LINE; VALUE : out BIT_VECTOR);
  alias OCTAL_READ is OREAD [LINE, BIT_VECTOR, BOOLEAN];
  alias OCTAL_READ is OREAD [LINE, BIT_VECTOR];
  procedure HREAD (L    : inout LINE; VALUE : out BIT_VECTOR; GOOD : out BOOLEAN);
  procedure HREAD (L    : inout LINE; VALUE : out BIT_VECTOR);
  alias HEX_READ is HREAD [LINE, BIT_VECTOR, BOOLEAN];
  alias HEX_READ is HREAD [LINE, BIT_VECTOR];
  procedure TEE (file F :     TEXT; L : inout LINE);
  procedure WRITE (L      : inout LINE; VALUE : in REAL;
                   FORMAT : in    STRING);
  alias SWRITE is WRITE [LINE, STRING, SIDE, WIDTH];
  alias STRING_WRITE is WRITE [LINE, STRING, SIDE, WIDTH];
  alias BWRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
  alias BINARY_WRITE is WRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
  procedure OWRITE (L         : inout LINE; VALUE : in BIT_VECTOR;
                    JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0);
  alias OCTAL_WRITE is OWRITE [LINE, BIT_VECTOR, SIDE, WIDTH];
  procedure HWRITE (L         : inout LINE; VALUE : in BIT_VECTOR;
                    JUSTIFIED : in    SIDE := right; FIELD : in WIDTH := 0);
  alias HEX_WRITE is HWRITE [LINE, BIT_VECTOR, SIDE, WIDTH];

end package standard_textio_additions;

library ieee_proposed;
use ieee_proposed.standard_additions.all;

package body standard_textio_additions is
-- pragma synthesis_off
  constant NUS  : STRING(2 to 1) := (others => ' ');     -- NULL array
  constant NBSP : CHARACTER      := CHARACTER'val(160);  -- space character

  -- Writes L to a file without modifying the contents of the line
  procedure TEE (file F : TEXT; L : inout LINE) is
  begin
    write (OUTPUT, L.all & LF);
    writeline(F, L);
  end procedure TEE;

  procedure FLUSH (file F: TEXT) is  -- Implicit
  begin
    file_close (F);
  end procedure FLUSH;

  -- Read and Write procedure for strings
  procedure SREAD (L      : inout LINE;
                   VALUE  : out   STRING;
                   STRLEN : out   natural) is
    variable ok     : BOOLEAN;
    variable c      : CHARACTER;
    -- Result is padded with space characters
    variable result : STRING (1 to VALUE'length) := (others => ' ');
  begin
    VALUE := result;
    loop                                -- skip white space
      read(L, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      STRLEN := 0;
      return;
    end if;
    result (1) := c;
    STRLEN     := 1;
    for i in 2 to VALUE'length loop
      read(L, c, ok);
      if (ok = false) or ((c = ' ') or (c = NBSP) or (c = HT)) then
        exit;
      else
        result (i) := c;
      end if;
      STRLEN := i;
    end loop;
    VALUE := result;
  end procedure SREAD;

  -- Hex Read and Write procedures for bit_vector.
  -- Procedure only visible internally.
  procedure Char2QuadBits (C           :     CHARACTER;
                           RESULT      : out BIT_VECTOR(3 downto 0);
                           GOOD        : out BOOLEAN;
                           ISSUE_ERROR : in  BOOLEAN) is
  begin
    case c is
      when '0'       => result := x"0"; good := true;
      when '1'       => result := x"1"; good := true;
      when '2'       => result := x"2"; good := true;
      when '3'       => result := x"3"; good := true;
      when '4'       => result := x"4"; good := true;
      when '5'       => result := x"5"; good := true;
      when '6'       => result := x"6"; good := true;
      when '7'       => result := x"7"; good := true;
      when '8'       => result := x"8"; good := true;
      when '9'       => result := x"9"; good := true;
      when 'A' | 'a' => result := x"A"; good := true;
      when 'B' | 'b' => result := x"B"; good := true;
      when 'C' | 'c' => result := x"C"; good := true;
      when 'D' | 'd' => result := x"D"; good := true;
      when 'E' | 'e' => result := x"E"; good := true;
      when 'F' | 'f' => result := x"F"; good := true;
      when others    =>
        assert not ISSUE_ERROR report
          "TEXTIO.HREAD Error: Read a '" & c &
          "', expected a Hex character (0-F)." severity error;
        GOOD := false;
    end case;
  end procedure Char2QuadBits;

  procedure HREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR;
                   GOOD  : out   BOOLEAN) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                    := (VALUE'length+3)/4;
    constant pad : INTEGER                    := ne*4 - VALUE'length;
    variable sv  : BIT_VECTOR (0 to ne*4 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE := (VALUE'range => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      GOOD := false;
      return;
    end if;
    Char2QuadBits(c, sv(0 to 3), ok, false);
    if not ok then
      GOOD := false;
      return;
    end if;
    read(L, s, ok);
    if not ok then
      GOOD := false;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, false);
      if not ok then
        GOOD := false;
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      GOOD := false;                    -- vector was truncated.
    else
      GOOD  := true;
      VALUE := sv (pad to sv'high);
    end if;
  end procedure HREAD;

  procedure HREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                   := (VALUE'length+3)/4;
    constant pad : INTEGER                   := ne*4 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*4 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE := (VALUE'range => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      report "TEXTIO.HREAD Error: Failed skipping white space"
        severity error;
      return;
    end if;
    Char2QuadBits(c, sv(0 to 3), ok, true);
    if not ok then
      return;
    end if;
    read(L, s, ok);
    if not ok then
      report "TEXTIO.HREAD Error: Failed to read the STRING"
        severity error;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2QuadBits(s(i), sv(4*i to 4*i+3), ok, true);
      if not ok then
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      report "TEXTIO.HREAD Error: Vector truncated"
        severity error;
    else
      VALUE := sv (pad to sv'high);
    end if;
  end procedure HREAD;

  procedure HWRITE (L         : inout LINE;
                    VALUE     : in    BIT_VECTOR;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    write (L         => L,
           VALUE     => to_hstring(VALUE),
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure HWRITE;

  -- Procedure only visible internally.
  procedure Char2TriBits (C           :     CHARACTER;
                          RESULT      : out BIT_VECTOR(2 downto 0);
                          GOOD        : out BOOLEAN;
                          ISSUE_ERROR : in  BOOLEAN) is
  begin
    case c is
      when '0'    => result := o"0"; good := true;
      when '1'    => result := o"1"; good := true;
      when '2'    => result := o"2"; good := true;
      when '3'    => result := o"3"; good := true;
      when '4'    => result := o"4"; good := true;
      when '5'    => result := o"5"; good := true;
      when '6'    => result := o"6"; good := true;
      when '7'    => result := o"7"; good := true;
      when others =>
        assert not ISSUE_ERROR
          report
          "TEXTIO.OREAD Error: Read a '" & c &
          "', expected an Octal character (0-7)."
          severity error;
        GOOD := false;
    end case;
  end procedure Char2TriBits;

  -- Read and Write procedures for Octal values
  procedure OREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR;
                   GOOD  : out   BOOLEAN) is
    variable ok  : BOOLEAN;
    variable c   : CHARACTER;
    constant ne  : INTEGER                   := (VALUE'length+2)/3;
    constant pad : INTEGER                   := ne*3 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE := (VALUE'range => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      GOOD := false;
      return;
    end if;
    Char2TriBits(c, sv(0 to 2), ok, false);
    if not ok then
      GOOD := false;
      return;
    end if;
    read(L, s, ok);
    if not ok then
      GOOD := false;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2TriBits(s(i), sv(3*i to 3*i+2), ok, false);
      if not ok then
        GOOD := false;
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      GOOD := false;                    -- vector was truncated.
    else
      GOOD  := true;
      VALUE := sv (pad to sv'high);
    end if;
  end procedure OREAD;

  procedure OREAD (L     : inout LINE;
                   VALUE : out   BIT_VECTOR) is
    variable c   : CHARACTER;
    variable ok  : BOOLEAN;
    constant ne  : INTEGER                   := (VALUE'length+2)/3;
    constant pad : INTEGER                   := ne*3 - VALUE'length;
    variable sv  : BIT_VECTOR(0 to ne*3 - 1) := (others => '0');
    variable s   : STRING(1 to ne-1);
  begin
    VALUE := (VALUE'range => '0');
    loop                                -- skip white space
      read(l, c, ok);
      exit when (ok = false) or ((c /= ' ') and (c /= NBSP) and (c /= HT));
    end loop;
    -- Bail out if there was a bad read
    if not ok then
      report "TEXTIO.OREAD Error: Failed skipping white space"
        severity error;
      return;
    end if;
    Char2TriBits(c, sv(0 to 2), ok, true);
    if not ok then
      return;
    end if;
    read(L, s, ok);
    if not ok then
      report "TEXTIO.OREAD Error: Failed to read the STRING"
        severity error;
      return;
    end if;
    for i in 1 to ne-1 loop
      Char2TriBits(s(i), sv(3*i to 3*i+2), ok, true);
      if not ok then
        return;
      end if;
    end loop;
    if or_reduce (sv (0 to pad-1)) = '1' then
      report "TEXTIO.OREAD Error: Vector truncated"
        severity error;
    else
      VALUE := sv (pad to sv'high);
    end if;
  end procedure OREAD;

  procedure OWRITE (L         : inout LINE;
                    VALUE     : in    BIT_VECTOR;
                    JUSTIFIED : in    SIDE  := right;
                    FIELD     : in    WIDTH := 0) is
  begin
    write (L         => L,
           VALUE     => to_ostring(VALUE),
           JUSTIFIED => JUSTIFIED,
           FIELD     => FIELD);
  end procedure OWRITE;

  -- read and write for vector versions
  -- These versions produce "value1, value2, value3 ...."
  procedure read (L     : inout LINE;
                  VALUE : out   boolean_vector;
                  GOOD  : out   BOOLEAN) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN := true;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            GOOD  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        good := false;
        return;
      end if;
    end loop;
    good := true;
  end procedure read;

  procedure read (L     : inout LINE;
                  VALUE : out   boolean_vector) is
    variable dummy : CHARACTER;
    variable igood : BOOLEAN;
  begin
    for i in VALUE'range loop
      read (L     => L,
            VALUE => VALUE(i),
            good  => igood);
      if (igood) and (i /= value'right) then
        read (L     => L,
              VALUE => dummy,           -- Toss the comma or seperator
              good  => igood);
      end if;
      if (not igood) then
        report "STANDARD.STD_TEXTIO(BOOLEAN_VECTOR) "
          & "Read error ecounted during vector read" severity error;
        return;
      end if;
    end loop;
  end procedure read;

  procedure write (L         : inout LINE;
                   VALUE     : in    boolean_vector;
                   JUSTIFIED : in    SIDE  := right;
                   FIELD     : in    WIDTH := 0) is
  begin
    for i in VALUE'range loop
      write (L         => L,
             VALUE     => VALUE(i),
             JUSTIFIED => JUSTIFIED,
             FIELD     => FIELD);
      if (i /= value'right) then
        swrite (L, ", ");
      end if;
    end loop;
  end procedure write;

  procedure WRITE (L: inout LINE; VALUE: in REAL;
                   FORMAT: in STRING) is
  begin
    swrite ( L => L,
             VALUE => to_string (VALUE, FORMAT));
  end procedure WRITE;

  function justify (
    value     : STRING;
    justified : SIDE  := right;
    field     : width := 0)
    return STRING is
    constant VAL_LEN : INTEGER             := value'length;
    variable result  : STRING (1 to field) := (others => ' ');
  begin  -- function justify
    -- return value if field is too small
    if VAL_LEN >= field then
      return value;
    end if;
    if justified = left then
      result(1 to VAL_LEN) := value;
    elsif justified = right then
      result(field - VAL_LEN + 1 to field) := value;
    end if;
    return result;
  end function justify;

  function to_string (
    VALUE     : SIDE) return STRING is
  begin
    return SIDE'image(VALUE);
  end function to_string;

  -- pragma synthesis_on
  -- Will be implicit
  function minimum (L, R : SIDE) return SIDE is
  begin
    if L > R then return R;
    else return L;
    end if;
  end function minimum;

  function maximum (L, R : SIDE) return SIDE is
  begin
    if L > R then return L;
    else return R;
    end if;
  end function maximum;

end package body standard_textio_additions;
OpenPOWER on IntegriCloud