Netlist.pm 63 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
7
8
# The creation of this file has been supported by the publicly funded
# R&D project Josef Ressel Center for Verification of Embedded Computing
# Systems (VECS) managed by the Christian Doppler Gesellschaft (CDG).
#
9
10
11
# Authors:
# Christian Fibich <fibich@technikum-wien.at>
# Stefan Tauner <tauner@technikum-wien.at>
Christian Fibich's avatar
Christian Fibich committed
12
#
13
14
# 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
15
#
16
17
18
# 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
19
#
20
21
# See the LICENSE file for more details.
#-----------------------------------------------------------------------
Christian Fibich's avatar
Christian Fibich committed
22

Christian Fibich's avatar
Christian Fibich committed
23
24
25
26
27
## @file Netlist.pm
# @brief Contains class \ref FIJI::Netlist

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

29
30
31
32
33
package FIJI::Netlist;

use strict;
use warnings;

34
use List::Util qw[min max];
35
use Log::Log4perl qw(get_logger :easy);
36
use File::Basename qw(basename);
37

38
39
use Verilog::Netlist 3.442;
use Verilog::Language 3.442;
40
41

use FIJI::VHDL;
42
use FIJI qw(:fiji_logo :fiji_version);
43

44
use constant HIERSEP               => "/";
45
46
use constant EQUALSEP              => "=";
use constant FIJI_NAMESPACE_PREFIX => "fiji_";
Christian Fibich's avatar
Christian Fibich committed
47
48
use constant FIJI_PORT_IN_POSTFIX  => "_inj_i";
use constant FIJI_PORT_OUT_POSTFIX => "_ori_o";
49
use constant MAX_UNIQUE_TRIES      => 10;
50

51
52
## @function public new ()
# @brief creates a new FIJI::Netlist object
Christian Fibich's avatar
Christian Fibich committed
53
#
54
55
# @returns the newly created FIJI::Netlist object
sub new {
Christian Fibich's avatar
Christian Fibich committed
56

57
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
58

59
60
    my $self = {};
    bless $self, $class;
Christian Fibich's avatar
Christian Fibich committed
61

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

64
65
66
        # options => $opt,
        # keep_comments => 1, # include comments in netlist
        link_read_nonfatal => 1,    # do not fail if module description not found
67
        use_pinselects     => 1,
68
69
    );
    return $self;
70
71
}

72
73
74
75
76
77
78
79
## @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 {
80
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
81
    my ($self, $filename) = @_;
82

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

86
    $logger->info("Reading in netlist from file \"$filename\".");
87
    eval {
88
89
90
        # 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
91
92
        $self->{'nl'}->read_file(filename => $filename);    # read Verilog file
        $self->{'nl'}->link();                              # Read in any sub-modules
93
    };
94

Christian Fibich's avatar
Christian Fibich committed
95
96
    if ($self->{'nl'}->errors() != 0 || $@) {
        $logger->error("Could not parse $filename!", $@ ? "\n" . $@ : "");
97
98
        return 1;
    }
99

100
    $self->{'filename'} = $filename;
101

102
103
    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
104
105
}

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

Christian Fibich's avatar
Christian Fibich committed
126
## @method public get_toplevel_module ()
127
# @brief retrieves the top-level module
Christian Fibich's avatar
Christian Fibich committed
128
129
130
131
#
# @returns a Verilog::Module reference
sub get_toplevel_module {
    my ($self) = @_;
Christian Fibich's avatar
Christian Fibich committed
132
133
134
    my @m      = $self->{'nl'}->top_modules_sorted;
    my $n      = @m;
    return $m[0] if ($n == 1);
135
136
    return "More than one top-level module present in netlist" if ($n > 1);
    return "No top-level module found";
Christian Fibich's avatar
Christian Fibich committed
137
138
}

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

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
152
153
154
    my $top      = $self->get_toplevel_module();
    if ($top->isa("Verilog::Netlist::Module")) {
        $self->_get_subnets($nets_ref, $top, $hier);
155
156
    }
    return $nets_ref;
157
158
}

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
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);
}

174
175
176
177
178
179
180
181
182
#** @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 {

183
    my $logger = get_logger("");
184
    my ($self, $nets_ref, $mod, $hier, $instname) = @_;
185

186
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
187
    $thishier .= HIERSEP if $thishier ne "";
188
189
190
191
192
    if (defined $instname) {
        $thishier .= $instname;
    } else {
        $thishier .= $mod->name;
    }
193

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

206
    }
207

208
    foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
209
        if (defined($cell->submod)) {
210
            $self->_get_subnets($nets_ref, $cell->submod, $thishier, $cell->name);
211
        }
212
213
214
    }
}

215
216
217
## @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.
218
#
219
220
# @param startmod    the module to start with
# @param name        the name to check against
221
sub _check_name_in_hierarchy {
222

223
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
224
    my ($startmod, $name) = @_;
225
226
    my $nl = $startmod->netlist;

227
    $logger->debug("Checking \"" . $startmod->name . "\" for name \"$name\"");
228
229

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

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

245
    for my $cell ($startmod->cells) {
Christian Fibich's avatar
Christian Fibich committed
246
        if ($cell->name eq $name) {
247
            my $msg = "Name \"$name\" does already exist as cell in " . $startmod->name;
248
            return $msg;
249
250
251
252
        }
    }

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

262
    return undef;
263
264
}

265
266
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
267
#
268
269
270
271
272
273
274
275
# @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
276
sub _add_port_to_hierarchy {
277

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

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

290
    $logger->debug($indent . "Adding port \"$name\" to module \"" . $startmod->name . "\"");
291
292

    # decide direction
293
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
294
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RST_TO_DUT)
295
    {
296
        $direction = "in";
297
    } else {
298
299
300
301
        $direction = "out";
    }

    # generate port
Christian Fibich's avatar
Christian Fibich committed
302
    my $np = $startmod->new_port(name => $name, direction => $direction);
303
304

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

    # set indices
308
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
309
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
310
    {
Christian Fibich's avatar
Christian Fibich committed
311
312
313
        $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);
314
315
    }

Christian Fibich's avatar
Christian Fibich committed
316
317
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
318
319

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
320
    foreach my $mod ($nl->modules_sorted) {
321
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
322
            if (defined $cell->submod && $cell->submod == $startmod) {
323
324
                $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 . "\"");
325
326
327
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
328
                    pinselects => [{'netname' => $np->net->name}],
329
330
                );

Christian Fibich's avatar
Christian Fibich committed
331
                # let verilog-perl find the net and port.
332
                $startmod->link;
Christian Fibich's avatar
Christian Fibich committed
333
                _add_port_to_hierarchy($mod, $name, $function, $index, $indent);
334
335
336
            }
        }
    }
337

338
339
340
    return $np;
}

341
342
343
## @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
344
345
346
347
348
349
# 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
#
350
351
352
353
# @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)
354
355
356
#
# @returns undef
sub net_add_function {
357
    my $logger = get_logger("");
358
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
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
    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 . "\"");
390
391

    my $prefix = "fiji_";
392

393
    my $unique_name = _unique_name($mod,$prefix.$port_name);
394
395
396

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

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

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

Christian Fibich's avatar
Christian Fibich committed
404
    # connect the net to the newly created port
405
406
407
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
408
        rhs     => $net_name.$idx,
409
410
411
        module  => $op->module,
        netlist => $op->module->netlist
    );
412

413
414
415
    return undef;
}

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
# 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
}

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
# 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
    );
}

464
465
466
467
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
468
469
470
#   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
471
#
472
# @param net_path        the Verilog::Net to instrument
473
# @param fiu_idx         the FIU number this external access shall be connected to
474
475
# @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)
476
477
478
479
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
480

481
    my $logger = get_logger("");
482
    my ($self, $net_path, $fiu_idx, $driver_path, $driver_type) = @_;
483

484
    # split hierarchical net path
485
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
486
487

    if (ref($net_descriptor) ne "HASH") {
488
        return $net_descriptor;
489
490
491
    }

    my $net = $net_descriptor->{'net'};
492
    my $net_name = $net_descriptor->{'net_name'};
493
494
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
495
    my $mod = $net_descriptor->{'mod'};
496
497
498
    my $idx = '';
    my $idx_postfix = '';

499
500
501
502
503
504
    # 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) {
505
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
506
            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?";
507
508
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
509
        } else {
510
511
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
512
513
514
        }
    }

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

517
518
519
520
521
    # 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);

522
523
524
525
    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);
526

527
    # generate unique name for output port, return with error message if that fails
528
    my $unique_output_name = _unique_name($mod, $output_name);
529
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
530

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

534
535
    # generate unique name for input port, return with error message if that fails
    my $unique_input_name = _unique_name($mod, $input_name);
536
    return "Could not generate unique name for prefix $input_name" if (!defined $unique_input_name);
537

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

Christian Fibich's avatar
Christian Fibich committed
541

542
543
544
    # Add an intermediate net to allow patching without rewriting connections everywhere
    #
    # We use the requested signal as sink/destination.
545
    # That way we only need to change the driver to drive our intermediate net.
546
    #
547
548
549
    # 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.
550

551
    # Choose intermediate net name
552
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
553
    my $net_tmp = $mod->find_net($net_name_tmp);
554
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
555

556
557
558
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
559
    my $driver_bit = $msb;
560
    my $driver;
561
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
562
        if (ref($connection) eq "Verilog::Netlist::Pin") {
563
564
            # 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\"");
565
566
            for my $pinselect ($connection->pinselects) {
                if ($pinselect->netname eq $net->name) {
567
                    $driver = $connection;
568
                    $pinselect->netname($net_name_tmp); # FIXME: do we need to force a re-link (by deleting $connection->nets)?
569
                    # The intermediate net is a vector if the underlying net is a bus and we do not just select a single bit
570
                    # This is the case if
571
572
573
574
                    #   - 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.
575
                    if (defined($net->msb) && (!defined($pinselect->msb) || ($pinselect->msb != $pinselect->lsb))) {
576
577
                        $driver_is_vector = 1;
                    } elsif (defined($net_tmp) && defined($net_tmp->userdata("first_instrumented_bit")))  {
578
                        $driver_is_vector = 1;
579
580
                    } else {
                        # Make sure we do not output the index unnecessarily (if the driver is a single bit of a vector)
581
582
                        $pinselect->msb(undef);
                        $pinselect->lsb(undef);
583
                    }
584
                }
585
            }
586
            # $connection->port(undef);    # resolved by link
Stefan Tauner's avatar
Stefan Tauner committed
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
620
621
622
623
624
        } 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 . "\"";
625
                }
Stefan Tauner's avatar
Stefan Tauner committed
626
627
628
629
630
631
632
633
634
635
                # 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'};
            }
636

Stefan Tauner's avatar
Stefan Tauner committed
637
638
639
640
641
642
            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);
643

Stefan Tauner's avatar
Stefan Tauner committed
644
645
        } else {
            $logger->error("Driver instance is neither pin, port nor contassign?");
646
647
        }
    }
648

649
650
651
652
653
654
655
    # 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
    #
656
657
658
659
660
    # 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
661
662
663
664
665
        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;
        }
666
667
668
669
670
671
672
673
674
675
676

        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."]");

677
            # Additionally the previous exporting of the original signal needs to be adapted
678
679
680
681
682
683
684
685
686
687
            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\]");
688
689
690
691
                for my $pinselect ($prev_driver->pinselects) {
                    if ($pinselect->netname eq $net_name_tmp) {
                        $pinselect->msb($prev_bit);
                        $pinselect->lsb($prev_bit);
692
693
694
695
                        last;
                    }
                }
            } elsif (ref($prev_driver) eq "Verilog::Netlist::Port") {
696
697
698
                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;
699
            } elsif (ref($prev_driver) eq "Verilog::Netlist::ContAssign") {
700
701
                $logger->debug("    reassigning ContAssign \"" . $prev_driver->lhs . " --> \"".$net_name_tmp."[".$prev_bit."]\" = ". $prev_driver->rhs . "\" ");
                $prev_driver->lhs($net_name_tmp."[".$prev_bit."]");
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
            }

            # 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();
                }
720
721
722
            }
        }

723
        $logger->debug("    assigning to currently processed signal \"" . $net_name."[".$driver_bit."] = " . $ip->net->name . "\"");
724
        generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
725
        $driver_is_vector = 1;
726
727
    } else {
        # 2.) Generate intermediate (tmp) net for easier input and output routing
728
729
730
        # 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) {
731
            $logger->debug("Intermediate port named \"" . $net_name_tmp . (defined($net->msb) ? "[" . $net->msb .":". $net->lsb . "]" : "") . "\" to patch \"$net_name\" will be generated automatically later");
732
        } else {
733
734
735
736
737
738
739
740
741
742
743
744
745
            # 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\"");
            }
746
747
748
749
750
751
752
            $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 . "\"");
            }
753
754
755
756
757
758
759
760
761
762
        }

        # 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);
763
        } elsif (!$driver_is_vector) {
764
765
            # If the net is a vector but the driver was driving only one bit
            # then we need to drive the originally driven bit only
766
            generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
767
768
769
        } else {
            # For drivers of complete busses we need to connect all non-instrumented bits of the tmp net
            # additionally to preserve their unmodified values.
770
            # In case of concatenations the index might be different to the one given.
771
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
772
            for (my $i = $low ; $i <= $high ; $i++) {
773
                if ($i == $driver_bit) {
774
775
776
777
778
779
780
781
782
                    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
783
784
    #     If the driver is not a vector a simple assignment is fine, else
    if (!$driver_is_vector) {
785
786
787
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp . "\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp);
    } else {
788
789
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp ."[".$driver_bit."]\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp."[".$driver_bit."]");
790
    }
791
    $mod->link;
792
793
794
795
796
797
    # 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);
    }
798
799
800
    return undef;
}

801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
## @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;
}

823
824
825
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
826
827
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
828
#
829
# @param net_path        The hierarchical path of the net, separated by HIERSEP
830
831
832
833
# @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
834
835
# @returns undef           if successful
sub validate_driver {
836
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
837
    my ($self, $net_path, $driver_path, $driver_type) = @_;
838

839
840
841
842
843
    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
844
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
845
    return "Specified driver not found in netlist" if (!defined $connection_object);
846

847
848
849
    my $connections       = {};
    my $rv = $self->_get_net_connections_from_path($net_path, $connections);
    return $rv if defined($rv);
850

Christian Fibich's avatar
Christian Fibich committed
851
852
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
853

854
    return "Driver \"$driver_path\" exists in netlist but is not connected to net \"$net_path\" at all" if (@in_drivers == 0 && @in_connections == 0);
855
856
857
    return undef;
}

858
859
860
861
862
863
864
865
866
## @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
867
    my ($connected, $net) = @_;
868

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

890
## @method connection_tostr ($connection,$conn_str_list_ref)
891
892
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
893
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
894
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
895
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
896
#
897
898
899
# @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
900
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
901
sub connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
902
    my ($self, $connection, $conn_str_list_ref) = @_;
903
904
    my $path;
    my $type;
905
    my $str;
906

Christian Fibich's avatar
Christian Fibich committed
907
    if (ref($connection) eq "Verilog::Netlist::Pin") {
908
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
909
        $type = "PIN";
910
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
911
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
912
        $path = $connection->module->name . HIERSEP . $connection->name;
913
        $type = "PORT";
914
        $str = $type . ": " . $path
915
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
916
        $path = $connection->module->name . HIERSEP . $connection->lhs . EQUALSEP . $connection->rhs;
917
        $type = "ASSIGN";
918
        $str = $type . ": " . $connection->lhs . EQUALSEP . $connection->rhs;
919
    }
920
921
922
923
924
925
926
927
    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;
}

928
929
930
931
932
933
934
935
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 {
936
937
938
939
940
941
942
943
    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};
944
945
946
947
948
949
    return \@list;
}

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

    return \@list;
952
953
}

954
955
956
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
957
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
958
959
960
961
962
# 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}
#
963
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
964
sub get_connection_object {
965
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
966
    my ($self, $connection_path, $connection_type) = @_;
967

968
969
    my @path_elements = _split_path($connection_path);

970
    my $rv;
Christian Fibich's avatar
Christian Fibich committed
971
    if ($connection_type eq "PIN") {
972
973
974
        if (@path_elements == 3) {

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

976
            $logger->trace("Looking for pin named \"$pin_name\" in cell \"$cell_name\" of module \"$module_name\"...");
977

978
979
980
            my $mod  = $self->{'nl'}->find_module($module_name);
            my $cell = $mod->find_cell($cell_name) if (defined $mod);
            my $pin  = $cell->find_pin($pin_name) if (defined $cell);
981
982
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
983
    } elsif ($connection_type eq "PORT") {
984
        if (@p