Netlist.pm 62.8 KB
Newer Older
1
2
3
#-----------------------------------------------------------------------
# Fault InJection Instrumenter (FIJI)
# https://embsys.technikum-wien.at/projects/vecs/fiji
Christian Fibich's avatar
Christian Fibich committed
4
#
5
6
# Copyright (C) 2017 Christian Fibich <fibich@technikum-wien.at>
# Copyright (C) 2017 Stefan Tauner <tauner@technikum-wien.at>
Christian Fibich's avatar
Christian Fibich committed
7
#
8
9
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
Christian Fibich's avatar
Christian Fibich committed
10
#
11
12
13
# This program 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.
Christian Fibich's avatar
Christian Fibich committed
14
#
15
16
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
Christian Fibich's avatar
Christian Fibich committed
17

Christian Fibich's avatar
Christian Fibich committed
18
19
20
21
22
## @file Netlist.pm
# @brief Contains class \ref FIJI::Netlist

## @class FIJI::Netlist
# @brief Functions to instrument & export a Verilog::Netlist
23

24
25
26
27
28
package FIJI::Netlist;

use strict;
use warnings;

29
use List::Util qw[min max];
30
use Log::Log4perl qw(get_logger :easy);
31
use File::Basename qw(basename);
32

33
34
use Verilog::Netlist 3.442;
use Verilog::Language 3.442;
35
36

use FIJI::VHDL;
37
use FIJI qw(:fiji_logo :fiji_version);
38

39
use constant HIERSEP               => "/";
40
41
use constant EQUALSEP              => "=";
use constant FIJI_NAMESPACE_PREFIX => "fiji_";
Christian Fibich's avatar
Christian Fibich committed
42
43
use constant FIJI_PORT_IN_POSTFIX  => "_inj_i";
use constant FIJI_PORT_OUT_POSTFIX => "_ori_o";
44
use constant MAX_UNIQUE_TRIES      => 10;
45

46
47
## @function public new ()
# @brief creates a new FIJI::Netlist object
Christian Fibich's avatar
Christian Fibich committed
48
#
49
50
# @returns the newly created FIJI::Netlist object
sub new {
Christian Fibich's avatar
Christian Fibich committed
51

52
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
53

54
55
    my $self = {};
    bless $self, $class;
Christian Fibich's avatar
Christian Fibich committed
56

57
    $self->{'nl'} = new Verilog::Netlist(
Christian Fibich's avatar
Christian Fibich committed
58

59
60
61
        # options => $opt,
        # keep_comments => 1, # include comments in netlist
        link_read_nonfatal => 1,    # do not fail if module description not found
62
        use_pinselects     => 1,
63
64
    );
    return $self;
65
66
}

67
68
69
70
71
72
73
74
## @method public read_file ($filename)
# @brief Tries to read a Verilog netlist from the given file
#
# @param filename    The Verilog file to read
#
# @returns 1   if an error occurred
# @returns 0   if successful
sub read_file {
75
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
76
    my ($self, $filename) = @_;
77

78
79
    ## Netlist synthesized from VHDL could contain SV keywords at this point.
    Verilog::Language::language_standard("1364-2001");
80

81
    $logger->info("Reading in netlist from file \"$filename\".");
82
    eval {
83
84
85
        # Stop croak and friends from printing stuff to stderr
        # FIXME: how to capture the messages?
        $SIG{__WARN__} = sub {};
Christian Fibich's avatar
Christian Fibich committed
86
87
        $self->{'nl'}->read_file(filename => $filename);    # read Verilog file
        $self->{'nl'}->link();                              # Read in any sub-modules
88
    };
89

Christian Fibich's avatar
Christian Fibich committed
90
91
    if ($self->{'nl'}->errors() != 0 || $@) {
        $logger->error("Could not parse $filename!", $@ ? "\n" . $@ : "");
92
93
        return 1;
    }
94

95
    $self->{'filename'} = $filename;
96

97
98
    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
99
100
}

101
102
103
104
105
## @method public get_toplevel_port_names ()
# @brief retrieves the port names of all toplevel modules
#
# @returns an array of Verilog::Port references
sub get_toplevel_port_names {
Christian Fibich's avatar
Christian Fibich committed
106
    my ($self, $dir) = @_;
107
    my $ports_ref = [];
Christian Fibich's avatar
Christian Fibich committed
108
    foreach my $mod ($self->{'nl'}->top_modules_sorted) {
109
        foreach my $port ($mod->ports) {
Christian Fibich's avatar
Christian Fibich committed
110
111
112
113
            if (   !defined($dir)
                || ($dir eq "o" && $port->direction eq "out")
                || ($dir eq "i" && $port->direction eq "in"))
            {
Christian Fibich's avatar
Christian Fibich committed
114
115
                push @{$ports_ref}, $port->name;
            }
116
117
118
        }
    }
    return $ports_ref;
119
120
}

Christian Fibich's avatar
Christian Fibich committed
121
122
123
124
125
126
## @method public get_toplevel_module ()
# @brief retrieves the port names of all toplevel modules
#
# @returns a Verilog::Module reference
sub get_toplevel_module {
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
127
128
129
    my @m      = $self->{'nl'}->top_modules_sorted;
    my $n      = @m;
    return $m[0] if ($n == 1);
130
131
    return "More than one toplevel module present in netlist" if ($n > 1);
    return "No toplevel module found";
Christian Fibich's avatar
Christian Fibich committed
132
133
}

134
135
136
137
## @method public get_nets ()
# @brief retrieves all nets in the netlist
#
# @returns an array of hashes for all nets containing:
138
139
140
# 'name' the name of the net
# 'path' the hierarchical path of the net
# 'net'  the Verilog::Netlist::Net reference to the net
141
sub get_nets {
142
143
144
145
146
    my ($self) = @_;

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
147
148
149
    my $top      = $self->get_toplevel_module();
    if ($top->isa("Verilog::Netlist::Module")) {
        $self->_get_subnets($nets_ref, $top, $hier);
150
151
    }
    return $nets_ref;
152
153
}

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
sub _extract_low_high {
    my ($in_low, $in_high) = @_;
    my ($out_low, $out_high);

    # msb might be lower than lsb if index range is "upto" -> swap
    if ($in_high < $in_low) {
        $out_low = $in_high;
        $out_high = $in_low;
    } else {
        $out_low = $in_low;
        $out_high = $in_high;
    }
    return ($out_low, $out_high);
}

169
170
171
172
173
174
175
176
177
#** @method private _get_subnets ($nets_ref,$mod,$hier)
# @brief retrieves all nets in the given module
#
# @param nets_ref    the central reference to push found nets (name,path,netref) to
# @param mod         the module to search
# @param hier        a string representing the current hierarchy level, separated
#                    be HIERSEP
sub _get_subnets {

178
    my $logger = get_logger("");
179
    my ($self, $nets_ref, $mod, $hier, $instname) = @_;
180

181
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
182
    $thishier .= HIERSEP if $thishier ne "";
183
184
185
186
187
    if (defined $instname) {
        $thishier .= $instname;
    } else {
        $thishier .= $mod->name;
    }
188

Christian Fibich's avatar
Christian Fibich committed
189
    foreach my $n ($mod->nets) {
190
        if (defined($n->msb) && defined($n->lsb)) {
191
            my ($low, $high) = _extract_low_high($n->lsb, $n->msb);
192
            for (my $sub = $low ; $sub <= $high ; $sub++) {
Christian Fibich's avatar
Christian Fibich committed
193
                my $thisnet_ref = {name => $n->name . "[$sub]", path => $thishier, net => $n, index => $sub};
194
195
196
197
198
199
200
                push(@{$nets_ref}, $thisnet_ref);
            }
        } else {
            my $thisnet_ref = {name => $n->name, path => $thishier, net => $n};
            push(@{$nets_ref}, $thisnet_ref);
        }

201
    }
202

203
    foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
204
        if (defined($cell->submod)) {
205
            $self->_get_subnets($nets_ref, $cell->submod, $thishier, $cell->name);
206
        }
207
208
209
    }
}

210
211
212
## @function private _check_name_in_hierarchy ($startmod,$name)
# @brief checks if a given name exists
# checks if the $name exists as port, net, or cell name in the instantiation tree.
213
#
214
215
# @param startmod    the module to start with
# @param name        the name to check against
216
sub _check_name_in_hierarchy {
217

218
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
219
    my ($startmod, $name) = @_;
220
221
    my $nl = $startmod->netlist;

222
    $logger->debug("Checking \"" . $startmod->name . "\" for name \"$name\"");
223
224

    # check if a net is named the same
225
    for my $net ($startmod->nets) {
Christian Fibich's avatar
Christian Fibich committed
226
        if ($net->name eq $name) {
227
            my $msg = "Name \"$name\" does already exist as net in " . $startmod->name;
228
            return $msg;
229
230
231
232
        }
    }

    # check if a port is named the same
233
    for my $port ($startmod->ports) {
Christian Fibich's avatar
Christian Fibich committed
234
        if ($port->name eq $name) {
235
            my $msg = "Name \"$name\" does already exist as port in " . $startmod->name;
236
            return $msg;
237
238
239
        }
    }

240
    for my $cell ($startmod->cells) {
Christian Fibich's avatar
Christian Fibich committed
241
        if ($cell->name eq $name) {
242
            my $msg = "Name \"$name\" does already exist as cell in " . $startmod->name;
243
            return $msg;
244
245
246
247
        }
    }

    # find any module instantiating the current start module
248
249
    foreach my $mod ($nl->modules) {
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
250
251
            if (defined $cell->submod && $cell->submod == $startmod) {
                my $msg = _check_name_in_hierarchy($mod, $name);
252
                return $msg if defined $msg;
253
254
255
            }
        }
    }
256

257
    return undef;
258
259
}

260
261
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
262
#
263
264
265
266
267
268
269
270
# @param startmod    the module to start with
# @param name        the port name to be generated
# @param function    the function of this port in FIJI (FIJI::VHDL->FIJI_PORTTYPE_xxx)
# @param index       for ORIGINAL,MODIFIED and FAULT_DETECT: the index of this net
# @param indent      optional, needed just for formatting logging output
#
# @returns undef if the given port $name is already found
# @returns Verilog::Port reference to the new port if successful
Christian Fibich's avatar
Christian Fibich committed
271
sub _add_port_to_hierarchy {
272

273
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
274
    my ($startmod, $name, $function, $index, $indent) = @_;
275
    my $nl        = $startmod->netlist;
276
    my $direction = "undef";
Christian Fibich's avatar
Christian Fibich committed
277
    if (!defined $indent) {
278
279
280
281
282
        $indent = "";
    } else {
        $indent .= "  ";
    }

Christian Fibich's avatar
Christian Fibich committed
283
    return undef if ($startmod->find_port($name));
284

285
    $logger->debug($indent . "Adding port \"$name\" to module \"" . $startmod->name . "\"");
286
287

    # decide direction
288
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
289
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RST_TO_DUT)
290
    {
291
        $direction = "in";
292
    } else {
293
294
295
296
        $direction = "out";
    }

    # generate port
Christian Fibich's avatar
Christian Fibich committed
297
    my $np = $startmod->new_port(name => $name, direction => $direction);
298
299

    # set port type for wrapper generation
Christian Fibich's avatar
Christian Fibich committed
300
    $np->userdata(FIJI::VHDL->FIJI_USERDATA_PORTTYPE, $function);
301
302

    # set indices
303
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
304
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
305
    {
Christian Fibich's avatar
Christian Fibich committed
306
307
308
        $np->userdata(FIJI::VHDL->FIJI_USERDATA_FIU_INDEX, $index);
    } elsif ($function == FIJI::VHDL->FIJI_PORTTYPE_FAULT_DETECTION) {
        $np->userdata(FIJI::VHDL->FIJI_USERDATA_FD_INDEX, $index);
309
310
    }

Christian Fibich's avatar
Christian Fibich committed
311
312
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
313
314

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
315
    foreach my $mod ($nl->modules_sorted) {
316
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
317
            if (defined $cell->submod && $cell->submod == $startmod) {
318
319
                $logger->debug($indent . "Adding pin \"$name\" to cell \"" . $cell->name . "\"");
                $logger->debug($indent . "Connecting pin \"" . $cell->name . HIERSEP . $name . "\" to port \"" . $np->module->name . HIERSEP . $np->name . "\"");
320
321
322
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
323
                    pinselects => [{'netname' => $np->net->name}],
324
325
                );

Christian Fibich's avatar
Christian Fibich committed
326
                # let verilog-perl find the net and port.
327
                $startmod->link;
Christian Fibich's avatar
Christian Fibich committed
328
                _add_port_to_hierarchy($mod, $name, $function, $index, $indent);
329
330
331
            }
        }
    }
332

333
334
335
    return $np;
}

336
337
338
## @method public net_add_function($net, $function, $port_name, $index)
# @brief Generate external access to a single net
#
Christian Fibich's avatar
Christian Fibich committed
339
340
341
342
343
344
# Performs the following steps:
#    1.  check if the default port name does not yet exist
#    1a. if it exists, generate a new net name
#    2.  add a port through the entire hierarchy
#    3.  assign the net to the port using a contassign statement
#
345
346
347
348
# @param net_descriptor  a hash containing the keys 'net' => Net Object, 'net_name' => Net name string, 'msb', 'lsb', 'mod' => The module containing the net
# @param function        the function out of FIJI::VHDL->FIJI_PORTTYPE_xxx
# @param port_name       how the port shall be named (will be prefixed with "fiji_")
# @param index           for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
349
350
351
#
# @returns undef
sub net_add_function {
352
    my $logger = get_logger("");
353
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
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
    if (ref($net_descriptor) ne "HASH") {
        return $net_descriptor;
    }

    my $net = $net_descriptor->{'net'};
    my $net_name = $net_descriptor->{'net_name'};
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
    my $mod = $net_descriptor->{'mod'};
    my $idx = '';
    my $idx_postfix = '';

    # We need to produce names for the i/o ports that route the signals
    # to the FIC. To allow to instrument multiple indices of a single
    # signal we need to make these names unique thus we even include the
    # indices if used.
    if (defined $msb && defined $lsb) {
        if ($msb ne $lsb) {
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
            return "The given net to instrument is a vector with multiple bits.\nThis is not supported.\nMaybe you want to instrument a single bit of said vector instead?";
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
        } else {
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
        }
    }


    $logger->debug("Adding function to \"" . $mod . "\", net \"" . $net_name . "\"");
385
386

    my $prefix = "fiji_";
387

388
    my $unique_name = _unique_name($mod,$prefix.$port_name);
389
390
391

    if (!defined $unique_name) {
        $logger->error("Could not find a unique name for prefix ".$prefix.$port_name)
392
393
    }

394
395
    $logger->debug("\"" . $unique_name . "\" can be used as fiji connector");
    my $op = _add_port_to_hierarchy($net->module, $unique_name, $function, $index);
396

397
    $logger->debug("Connecting Port \"" . $op->name . "\" to net \"" . $net_name.$idx . "\"");
398

Christian Fibich's avatar
Christian Fibich committed
399
    # connect the net to the newly created port
400
401
402
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
403
        rhs     => $net_name.$idx,
404
405
406
        module  => $op->module,
        netlist => $op->module->netlist
    );
407

408
409
410
    return undef;
}

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
# tries to generate a unique but recognizable net name by appending a
# random hex number if necessary
sub _unique_name {
    my $logger = get_logger("");
    my ($mod,$requested_name) = @_;

    # check if requested name is OK
    my $msg = _check_name_in_hierarchy($mod, $requested_name);
    
    if (!defined $msg) {
        return $requested_name;
    }

    # else try up to 10 times to generate a unique name by appending
    # a 4-digit random hex number
    for (my $tries = 0; $tries < MAX_UNIQUE_TRIES; $tries++) {
        my $name = sprintf("%s_%04x", $requested_name, rand(0xffff));
        $msg = _check_name_in_hierarchy($mod, $name);
        return $name if (!defined $msg);
    }
    
    return undef
}

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
# take a possible escaped identifier and make it a legal _and_ sane verilog identifier
sub _sanitize_identifier {
    my $insane = shift;

    # Verilog allows "non-alphanumeric" characters in identifiers if they start with a backslash and end with whitespace (escaped identifiers) but we don't want to.
    my $sane = ($insane =~ s/[^a-zA-Z0-9_]+/_/gr);
    # VHDL signals must not contain multiple subsequent underscores
    $sane =~ s/__+/_/g;
    return $sane
}

sub generate_contassign {
    my $logger = get_logger("");
    my ($module, $lhs, $rhs) = @_;
    $logger->trace("Setting \"$lhs = $rhs\"");
    $module->new_contassign(
        keyword => "assign",
        lhs     => $lhs,
        rhs     => $rhs,
        module  => $module,
        netlist => $module->netlist
    );
}

459
460
461
462
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
463
464
465
#   1. determine the connected objects (driver as well as driven nets, pins etc)
#   2. generate external access output and input ports and intermediate nets
#   3. interconnect these ports to the matching driver and driven cells via the intermediate nets
Christian Fibich's avatar
Christian Fibich committed
466
#
467
# @param net_path        the Verilog::Net to instrument
468
# @param fiu_idx         the FIU number this external access shall be connected to
469
470
# @param driver_path     the path to the driver of this net (optional but depends on driver_type)
# @param driver_type     the type of the driver (can be PIN, PORT, ASSIGN) (optional but depends on driver_path)
471
472
473
474
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
475

476
    my $logger = get_logger("");
477
    my ($self, $net_path, $fiu_idx, $driver_path, $driver_type) = @_;
478

479
    # split hierarchical net path
480
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
481
482

    if (ref($net_descriptor) ne "HASH") {
483
        return $net_descriptor;
484
485
486
    }

    my $net = $net_descriptor->{'net'};
487
    my $net_name = $net_descriptor->{'net_name'};
488
489
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
490
    my $mod = $net_descriptor->{'mod'};
491
492
493
    my $idx = '';
    my $idx_postfix = '';

494
495
496
497
498
499
    # We need to produce names for the i/o ports that route the signals
    # to the FIC. To allow to instrument multiple indices of a single
    # signal we need to make these names unique thus we even include the
    # indices if used.
    if (defined $msb && defined $lsb) {
        if ($msb ne $lsb) {
500
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
501
            return "The given net to instrument is a vector with multiple bits.\nThis is not supported.\nMaybe you want to instrument a single bit of said vector instead?";
502
503
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
504
        } else {
505
506
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
507
508
509
        }
    }

510
    $logger->info("Instrumenting \"" . $net->module->name . "\", net \"" . $net->name.$idx . "\"");
511

512
513
514
515
516
    # we want to perceive the connection state before any changes (at least w/o changes by this invocation)
    my %connections;
    my $rv = $self->_get_net_connections($net, \%connections, $msb, $driver_path, $driver_type);
    return $rv if (defined $rv);

517
518
519
520
    my $output_name = (FIJI_NAMESPACE_PREFIX . $net->name . $idx_postfix . FIJI_PORT_OUT_POSTFIX);
    $output_name = _sanitize_identifier($output_name);
    my $input_name  = (FIJI_NAMESPACE_PREFIX . $net->name . $idx_postfix . FIJI_PORT_IN_POSTFIX);
    $input_name = _sanitize_identifier($input_name);
521

522
    # generate unique name for output port, return with error message if that fails
523
    my $unique_output_name = _unique_name($mod, $output_name);
524
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
525

526
    $logger->debug("\"" . $unique_output_name . "\" will be used as fiji connector (output)");
527
    my $op = _add_port_to_hierarchy($mod, $unique_output_name, FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL, $fiu_idx);
528

529
530
    # generate unique name for input port, return with error message if that fails
    my $unique_input_name = _unique_name($mod, $input_name);
531
    return "Could not generate unique name for prefix $input_name" if (!defined $unique_input_name);
532

533
    $logger->debug("\"" . $unique_input_name . "\" will be used as fiji connector (input)");
534
    my $ip = _add_port_to_hierarchy($mod, $unique_input_name, FIJI::VHDL->FIJI_PORTTYPE_MODIFIED, $fiu_idx);
535

Christian Fibich's avatar
Christian Fibich committed
536

537
538
539
    # Add an intermediate net to allow patching without rewriting connections everywhere
    #
    # We use the requested signal as sink/destination.
540
    # That way we only need to change the driver to drive our intermediate net.
541
    #
542
543
544
    # We first generate a suitable name for the intermediate net,
    # then change the driver accordingly and handle other aspects of
    # the intermediate net at the very bottom of this function.
545

546
    # Choose intermediate net name
547
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
548
    my $net_tmp = $mod->find_net($net_name_tmp);
549
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
550

551
552
553
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
554
    my $driver_bit = $msb;
555
    my $driver;
556
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
557
        if (ref($connection) eq "Verilog::Netlist::Pin") {
558
559
            # If the driver is a pin of a (sub)cell, connect this pin to the intermediate net
            $logger->debug("Connecting (output) pin \"" . $connection->cell->name . HIERSEP . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
560
561
            for my $pinselect ($connection->pinselects) {
                if ($pinselect->netname eq $net->name) {
562
                    $driver = $connection;
563
                    $pinselect->netname($net_name_tmp); # FIXME: do we need to force a re-link (by deleting $connection->nets)?
564
                    # The intermediate net is a vector if the underlying net is a bus and we do not just select a single bit
565
                    # This is the case if
566
567
568
569
                    #   - the underlying net is a vector and the driver covers all indices (implicitly by having no msb/lsb set)
                    #   - the underlying net is a vector and the driver covers some indices (by having two different indices set)
                    # Also, if we instrument a second bit of a vector we need to make sure this instrumentation is handled as if the
                    # the driver itself is a vector.
570
                    if (defined($net->msb) && (!defined($pinselect->msb) || ($pinselect->msb != $pinselect->lsb))) {
571
572
                        $driver_is_vector = 1;
                    } elsif (defined($net_tmp) && defined($net_tmp->userdata("first_instrumented_bit")))  {
573
                        $driver_is_vector = 1;
574
575
                    } else {
                        # Make sure we do not output the index unnecessarily (if the driver is a single bit of a vector)
576
577
                        $pinselect->msb(undef);
                        $pinselect->lsb(undef);
578
                    }
579
                }
580
            }
581
            # $connection->port(undef);    # resolved by link
Stefan Tauner's avatar
Stefan Tauner committed
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
        } elsif (ref($connection) eq "Verilog::Netlist::Port") {
            $driver_is_port = 1;
            $driver = $connection;
            # If we are changing the name of a port of the top module we need to inform the VHDL generator
            if ($mod->is_top) {
                    $connection->userdata(FIJI::VHDL->FIJI_USERDATA_PREV_PORTNAME, $connection->name);
            }
            # Change type of existing non-instrumented input to wire -
            # practically transforming it to an ordinary wire that can easily be intrumented.
            $logger->debug("Transforming previous port named \"". $connection->name . "\" into an ordinary wire");
            $connection->net->decl_type(undef);
            $connection->net->net_type("wire");
            my $data_type;
            # If instrumented net is a vector we will need an intermediate bus
            if (defined($net->msb)) {
                $driver_is_vector = 1;
                $data_type = "[".$net->msb.":".$net->lsb."]";
                $connection->data_type($data_type);
            }
            $connection->net->data_type($data_type);
            # Unsetting the port<->net inter-references forces their automatic re-setting at link time
            $connection->net->port(undef);
            $connection->net(undef);
            # Eventually connect this port to the intermediate net by changing its name
            $logger->debug("Connecting (input) port \"" . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
            $connection->name($net_name_tmp); # NB: this will automatically change the cell's configuration on the next link() call.
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
            # If the driver is an assignment, replace the LHS with the intermediate net
            # Retrieve net object of LHS of the assignment to determine if it is a bus and if the assignment is to the complete net or a single bit.
            my $lhs_elems = $self->_extract_netstring_elements($connection->lhs);
            my $lhs_net_name = $lhs_elems->{'net_name'};
            my $lhs_net_msb = $lhs_elems->{'msb'};
            my $lhs_net_lsb = $lhs_elems->{'lsb'};
            my $lhs_net = $mod->find_net($lhs_net_name);
            if (!defined($lhs_net)) {
                my $lhs_port = $mod->find_port($lhs_net_name);
                if (!defined($lhs_port)) {
                    return "Could not find net or port in module \"" . $mod->name . "\" matching LHS of assignment \"" . $connection->lhs . "\" = \"" . $connection->rhs . "\"";
620
                }
Stefan Tauner's avatar
Stefan Tauner committed
621
622
623
624
625
626
627
628
629
630
                # FIXME: so this is actually a port...
                my $msg = "Found port name in continuous assignment. This is not supported yet.";
                $logger->fatal($msg);
                return $msg;
            }
            $driver = $connection;
            if (defined($connection->userdata->{'fiji_driver_bit'})) {
                $driver_is_vector = 1;
                $driver_bit = $connection->userdata->{'fiji_driver_bit'};
            }
631

Stefan Tauner's avatar
Stefan Tauner committed
632
633
634
635
636
637
            my $indices = ($driver_is_vector && defined($lhs_net_msb)) ? "[$lhs_net_msb:$lhs_net_lsb]" : "";
            $logger->debug("Connecting to intermediate net \"$net_name_tmp$indices\" the continuous assignment of \"" . $connection->rhs . "\"");
            # need to remember what was originally connected to this assign
            # to instrument two nets driven by one assign
            $connection->userdata('former_assign' => {'lhs' => $connection->lhs, 'rhs' => $connection->rhs});
            $connection->lhs($net_name_tmp.$indices);
638

Stefan Tauner's avatar
Stefan Tauner committed
639
640
        } else {
            $logger->error("Driver instance is neither pin, port nor contassign?");
641
642
        }
    }
643

644
645
646
647
648
649
650
    # Below we create the intermediate net as needed.
    # A suitable name for the tmp net was already determined.
    # 1.) Generate the tmp net.
    # 2.) Assign injected signal from input pin to original signal.
    # 3.) If original signal is a bus forward orignal data from tmp net to untouched bits of original signal
    # 4.) Forward (injected bit of) intermediate net to FIC by assigning it to the output pin
    #
651
652
653
654
655
    # However, if the net is already instrumented we need to jump through some hoops:
    # In that case we either have an error, or we need to instrument another bit of a bus.
    # The latter complicates things a bit...
    if (defined($net_tmp) && defined($net_tmp->userdata("first_instrumented_bit"))) {
        # FIXME: maybe we should try harder to find out the reason why _check_name_in_hierarchy failed
656
657
658
659
660
        if (!defined($net->msb)) {
            my $err = "Tried to instrument non-vector signal (\"$net_name\") twice or we really have a naming conflict.";
            $logger->error($err);
            return $err;
        }
661
662
663
664
665
666
667
668
669
670
671

        if (!defined($net_tmp->msb)) {
            # If we instrument the second bit of a net (as wittnessed by the missing msb field)
            # then we need to make sure the intermediate net is or becomes a vector
            my $prev_bit = $net_tmp->userdata("first_instrumented_bit");
            my $prev_driver = $net_tmp->userdata("first_driver");
            $logger->debug("    widening \"" . $net_tmp->name . " to [" . $net->msb . ":" . $net->lsb . "]");
            $net_tmp->msb($net->msb);
            $net_tmp->lsb($net->lsb);
            $net_tmp->data_type("[".$net->msb.":".$net->lsb."]");

672
            # Additionally the previous exporting of the original signal needs to be adapted
673
674
675
676
677
678
679
680
681
682
            foreach my $statement ($mod->statements) {
                if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E$/) {
                    $statement->rhs($net_name_tmp."[".$prev_bit."]");
                    $logger->debug("    reassigning \"" . $statement->lhs . " = " . $statement->rhs . "\" --> \"".$net_name_tmp."[".$prev_bit."]\"");
                }
            }

            # We also need to fix the previous assignment of the respective bit...
            if (ref($prev_driver) eq "Verilog::Netlist::Pin") {
                $logger->debug("    reassigning pin \"" . $prev_driver->name . "\": $net_name_tmp --> $net_name_tmp\[$prev_bit\]");
683
684
685
686
                for my $pinselect ($prev_driver->pinselects) {
                    if ($pinselect->netname eq $net_name_tmp) {
                        $pinselect->msb($prev_bit);
                        $pinselect->lsb($prev_bit);
687
688
689
690
                        last;
                    }
                }
            } elsif (ref($prev_driver) eq "Verilog::Netlist::Port") {
691
692
693
                my $msg = "Allegedly we have instrumented another bit of port \"" . $prev_driver->name . "\" previously without creating a temporary vector. If true, this would be a bug.";
                $logger->fatal($msg);
                return $msg;
694
            } elsif (ref($prev_driver) eq "Verilog::Netlist::ContAssign") {
695
696
                $logger->debug("    reassigning ContAssign \"" . $prev_driver->lhs . " --> \"".$net_name_tmp."[".$prev_bit."]\" = ". $prev_driver->rhs . "\" ");
                $prev_driver->lhs($net_name_tmp."[".$prev_bit."]");
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
            }

            # And add the default assignments of the (possibly yet) uninstrumented bits
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
            $logger->debug("    assigning \"" . $net_name."[".$low."-".$high."] = ...");
            for (my $i = $low ; $i <= $high ; $i++) {
                if ($i != $driver_bit && $i != $prev_bit) {
                    generate_contassign($mod, $net_name."[".$i."]", $net_name_tmp."[".$i."]");
                }
            }
        } else {
            # For all additional bits (starting with the third one)
            # the previous assignment of the respective bit needs to be undone
            foreach my $statement ($mod->statements) {
                if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E(\[(\Q$driver_bit\E)\])$/) {
                    $logger->debug("    unassigning \"" . $statement->lhs . " = " . $statement->rhs . "\"");
                    $statement->delete();
                }
715
716
717
            }
        }

718
        $logger->debug("    assigning to currently processed signal \"" . $net_name."[".$driver_bit."] = " . $ip->net->name . "\"");
719
        generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
720
        $driver_is_vector = 1;
721
722
    } else {
        # 2.) Generate intermediate (tmp) net for easier input and output routing
723
724
725
        # For ports we don't need to do that ourselves because Verilog::Perl will
        # generate a new apropriate net when linking the port.
        if ($driver_is_port) {
726
            $logger->debug("Intermediate port named \"" . $net_name_tmp . (defined($net->msb) ? "[" . $net->msb .":". $net->lsb . "]" : "") . "\" to patch \"$net_name\" will be generated automatically later");
727
        } else {
728
729
730
731
732
733
734
735
736
737
738
739
740
            # If the driver is a vector then we will generate a vectored intermediate net as well.
            # However, if the driver is a single-bit net or a single bit of a vector we generate
            # a simple intermediate net (and could get away with none at all actually).
            my @net_cfg = (name => $net_name_tmp);
            if ($driver_is_vector) {
                $logger->debug("Generating intermediate wire named \"" . $net_name_tmp . "[" . $net->msb .":". $net->lsb . "]\" to patch \"$net_name\"");
                push(@net_cfg,
                    msb => $net->msb,
                    lsb => $net->lsb,
                );
            } else {
                $logger->debug("Generating intermediate wire named \"" . $net_name_tmp . "\" to patch \"$net_name\"");
            }
741
742
743
744
745
746
747
            $net_tmp = $mod->new_net(@net_cfg);
            # If we possibly instrument other bits we need to remember some things
            if (defined($net->msb)) {
                $net_tmp->userdata("first_instrumented_bit", $driver_bit);
                $net_tmp->userdata("first_driver", $driver);
                $logger->debug("Remembering the first instrumented bit ($driver_bit) assigned to \"" . $net_name_tmp . "\" driven by \"" . $driver->name . "\"");
            }
748
749
750
751
752
753
754
755
756
757
        }

        # 3+4.) Assign injected (and uninjected bits of vectors) to previous signal.
        # Below we assign the altered signal from the FIC to the original signal.
        # For busses we need to connect all non-instrumented bits of the tmp net
        # additionally to preserve their unmodified values.

        if (!defined($net->msb)) {
            # If the instrumented net is not a vector we simply assign the injected signal
            generate_contassign($mod, $net_name, $ip->net->name);
758
        } elsif (!$driver_is_vector) {
759
760
            # If the net is a vector but the driver was driving only one bit
            # then we need to drive the originally driven bit only
761
            generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
762
763
764
        } else {
            # For drivers of complete busses we need to connect all non-instrumented bits of the tmp net
            # additionally to preserve their unmodified values.
765
            # In case of concatenations the index might be different to the one given.
766
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
767
            for (my $i = $low ; $i <= $high ; $i++) {
768
                if ($i == $driver_bit) {
769
770
771
772
773
774
775
776
777
                    generate_contassign($mod, $net_name."[".$i."]", $ip->net->name);
                } else {
                    generate_contassign($mod, $net_name."[".$i."]", $net_name_tmp."[".$i."]");
                }
            }
        }
    }

    # 5.) Connect the tmp net to the output pin that forwards the signal to the FIC
778
779
    #     If the driver is not a vector a simple assignment is fine, else
    if (!$driver_is_vector) {
780
781
782
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp . "\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp);
    } else {
783
784
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp ."[".$driver_bit."]\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp."[".$driver_bit."]");
785
    }
786
    $mod->link;
787
788
789
790
791
792
    # Normally we set first_instrumented_bit way earlier but since we autogenerate
    # the port we don't have the respective net available before linking thus...
    if ($driver_is_vector && $driver_is_port && !defined($net_tmp)) {
        my $port_net = $mod->find_net($net_name_tmp);
        $port_net->userdata("first_instrumented_bit", $driver_bit);
    }
793
794
795
    return undef;
}

796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
## @method public validate_net($net_path)
# @brief Check if the given net path is valid (i.e., referring to an existing net)
#
# @param net_path        The hierarchical path of the net, separated by HIERSEP
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub validate_net {
    my ($self, $net_path,) = @_;

    if ($net_path eq "") {
        return "Net path is empty";
    }

    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
    if (ref($net_descriptor) ne "HASH") {
        return $net_descriptor;
    }

    return undef;
}

818
819
820
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
821
822
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
823
#
824
# @param net_path        The hierarchical path of the net, separated by HIERSEP
825
826
827
828
# @param driver_path     The hierarchical path of the driver object, separated by HIERSEP
# @param driver_type     The type of the driver object, one of {PIN, PORT, ASSIGN}
#
# @returns STRING          if an error occurred
829
830
# @returns undef           if successful
sub validate_driver {
831
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
832
    my ($self, $net_path, $driver_path, $driver_type) = @_;
833

834
835
836
837
838
    return "Net path is empty" if (!defined($net_path) || ($net_path eq ""));
    return "Driver path is empty" if (!defined($driver_path) || ($driver_path eq ""));
    return "Driver type is empty" if (!defined($driver_type) || ($driver_type eq ""));


Christian Fibich's avatar
Christian Fibich committed
839
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
840
    return "Specified driver not found in netlist" if (!defined $connection_object);
841

842
843
844
    my $connections       = {};
    my $rv = $self->_get_net_connections_from_path($net_path, $connections);
    return $rv if defined($rv);
845

Christian Fibich's avatar
Christian Fibich committed
846
847
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
848

849
    return "Driver \"$driver_path\" exists in netlist but is not connected to net \"$net_path\" at all" if (@in_drivers == 0 && @in_connections == 0);
850
851
852
    return undef;
}

853
854
855
856
857
858
859
860
861
## @function private _select_driver($connected,$net)
# @brief Prompt the user to select a driver for a net from a set of given cells/outputs
#
# @param connected       list reference containing connected Verilog::Perl instances
# @param net             the Verilog::Perl::Net instance to select the driver for
#
# @returns STRING          if an error occurred
# @returns Driver object   if successful
sub _select_driver {
Christian Fibich's avatar
Christian Fibich committed
862
    my ($connected, $net) = @_;
863

864
    print "Select driver for net " . $net->name . ": \n";
865
    my $di;
Christian Fibich's avatar
Christian Fibich committed
866
    for ($di = 0 ; $di < @{$connected} ; $di++) {
867
        printf("[%d] %s\n", $di, FIJI::Netlist->connection_tostr(@{$connected}[$di]));
868
    }
Christian Fibich's avatar
Christian Fibich committed
869
    printf("[x] none of the above.\n", $di);
870
    my $sel;
871
    while (1) {
872
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
873
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
874
            last;
Christian Fibich's avatar
Christian Fibich committed
875
        } elsif ($sel =~ m/[xX]/) {
876
            my $msg = "No driver selected for net " . $net->name;
877
            return $msg;
878
879
        } else {
            print "Invalid driver.\n";
880
881
882
        }
    }
    return @{$connected}[$sel];
883
884
}

885
## @method connection_tostr ($connection,$conn_str_list_ref)
886
887
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
888
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
889
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
890
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
891
#
892
893
894
# @param connection          the connection to print
# @param conn_str_list_ref   optional list where a hash describing the connection is pushed
#
Christian Fibich's avatar
Christian Fibich committed
895
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
896
sub connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
897
    my ($self, $connection, $conn_str_list_ref) = @_;
898
899
    my $path;
    my $type;
900
    my $str;
901

Christian Fibich's avatar
Christian Fibich committed
902
    if (ref($connection) eq "Verilog::Netlist::Pin") {
903
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
904
        $type = "PIN";
905
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
906
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
907
        $path = $connection->module->name . HIERSEP . $connection->name;
908
        $type = "PORT";
909
        $str = $type . ": " . $path
910
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
911
        $path = $connection->module->name . HIERSEP . $connection->lhs . EQUALSEP . $connection->rhs;
912
        $type = "ASSIGN";
913
        $str = $type . ": " . $connection->lhs . EQUALSEP . $connection->rhs;
914
    }
915
916
917
918
919
920
921
922
    if (defined($connection->userdata->{'fiji_driver_bit'})) {
        $str .= "[" . $connection->userdata('fiji_driver_bit') . "]";
    }

    push @{$conn_str_list_ref}, {path => $path, type => $type, str => $str} if defined $conn_str_list_ref;
    return $str;
}

923
924
925
926
927
928
929
930
sub uniq_conn_str_list {
    my %seen;
    my ($self, $conn_str_list_ref) = @_;
    my @list = grep !$seen{$_->{str}}++, @{$conn_str_list_ref};
    return \@list;
}

sub sort_conn_str_list {
931
932
933
934
935
936
937
938
    my ($self, $conn_str_list_ref) = @_;
    my @list = sort {
        my $a_out = ($a->{str} =~ /[QOqo](\[[0-9]+\]){0,1}[ ]*$/);
        my $b_out = ($b->{str} =~ /[QOqo](\[[0-9]+\]){0,1}[ ]*$/);
        return $a->{str} cmp $b->{str}  if (!($a_out ^ $b_out));
        return -1 if ($a_out);
        return 1  if ($b_out);
    } @{$conn_str_list_ref};
939
940
941
942
943
944
    return \@list;
}

sub filter_conn_str_list {
    my ($self, $conn_str_list_ref, $regex) = @_;
    my @list = grep { $_->{'path'} =~ $regex } @{$conn_str_list_ref};
945
946

    return \@list;
947
948
}

949
950
951
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
952
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
953
954
955
956
957
# Object specified by the parameters
#
# @param connection_path     the hierarchichal PATH|To|the|object
# @param connection_type     the type of the object {PIN,PORT,ASSIGN}
#
958
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
959
sub get_connection_object {
960
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
961
    my ($self, $connection_path, $connection_type) = @_;
962

963
964
    my @path_elements = _split_path($connection_path);

965
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
966
    if ($connection_type eq "PIN") {
967
968
969
        if (@path_elements == 3) {

            my ($module_name, $cell_name, $pin_name) = @path_elements;