Netlist.pm 60.2 KB
Newer Older
1
2
#** @file Netlist.pm
# @verbatim
Christian Fibich's avatar
Christian Fibich committed
3
4
5
6
7
8
9
10
11
12
13
14
#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  Description:
#
15
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
Christian Fibich's avatar
Christian Fibich committed
16
#-------------------------------------------------------------------------------
17
18
# @endverbatim
#*
Christian Fibich's avatar
Christian Fibich committed
19

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

## @class FIJI::Netlist
# @brief Functions to instrument & export a Verilog::Netlist
25
26
27
28
29
package FIJI::Netlist;

use strict;
use warnings;

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

34
35
use Verilog::Netlist 99.415;
use Verilog::Language 99.415;
36
37

use FIJI::VHDL;
38
use FIJI qw(:fiji_logo);
39

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

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

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

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

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

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

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

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

82
    $logger->info("Reading in netlist from file \"$filename\".");
83
    eval {
Christian Fibich's avatar
Christian Fibich committed
84
85
        $self->{'nl'}->read_file(filename => $filename);    # read Verilog file
        $self->{'nl'}->link();                              # Read in any sub-modules
86
    };
87

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

93
    $self->{'filename'} = $filename;
94

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

99
100
101
102
103
## @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
104
    my ($self, $dir) = @_;
105
    my $ports_ref = [];
Christian Fibich's avatar
Christian Fibich committed
106
    foreach my $mod ($self->{'nl'}->top_modules_sorted) {
107
        foreach my $port ($mod->ports) {
Christian Fibich's avatar
Christian Fibich committed
108
109
110
111
            if (   !defined($dir)
                || ($dir eq "o" && $port->direction eq "out")
                || ($dir eq "i" && $port->direction eq "in"))
            {
Christian Fibich's avatar
Christian Fibich committed
112
113
                push @{$ports_ref}, $port->name;
            }
114
115
116
        }
    }
    return $ports_ref;
117
118
}

Christian Fibich's avatar
Christian Fibich committed
119
120
121
122
123
124
## @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
125
126
127
128
129
    my @m      = $self->{'nl'}->top_modules_sorted;
    my $n      = @m;
    return $m[0] if ($n == 1);
    return "More than one toplevel module present in netlist." if ($n > 1);
    return "No toplevel module found.";
Christian Fibich's avatar
Christian Fibich committed
130
131
}

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

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

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
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);
}

167
168
169
170
171
172
173
174
175
#** @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 {

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

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

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

199
    }
200

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

208
209
210
## @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.
211
#
212
213
# @param startmod    the module to start with
# @param name        the name to check against
214
sub _check_name_in_hierarchy {
215

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

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

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

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

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

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

255
    return undef;
256
257
}

258
259
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
260
#
261
262
263
264
265
266
267
268
# @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
269
sub _add_port_to_hierarchy {
270

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

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

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

    # decide direction
286
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
287
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT)
288
    {
289
        $direction = "in";
290
    } else {
291
292
293
294
        $direction = "out";
    }

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

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

    # set indices
301
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
302
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
303
    {
Christian Fibich's avatar
Christian Fibich committed
304
305
306
        $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);
307
308
    }

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

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
313
    foreach my $mod ($nl->modules_sorted) {
314
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
315
            if (defined $cell->submod && $cell->submod == $startmod) {
316
317
                $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 . "\"");
318
319
320
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
321
                    netnames => [{'netname' => $np->net->name}],
322
323
                );

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

331
332
333
    return $np;
}

334
335
336
## @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
337
338
339
340
341
342
# 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
#
343
344
345
346
# @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)
347
348
349
#
# @returns undef
sub net_add_function {
350
    my $logger = get_logger("");
351
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
352

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
    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 . "\"");
383
384

    my $prefix = "fiji_";
385

386
    my $unique_name = _unique_name($mod,$prefix.$port_name);
387
388
389

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

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

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

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

406
407
408
    return undef;
}

409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
# 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
}

433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
# 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
    );
}

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

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

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

    if (ref($net_descriptor) ne "HASH") {
481
        return $net_descriptor;
482
483
484
    }

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

492
493
494
495
496
497
    # 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) {
498
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
499
            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?";
500
501
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
502
        } else {
503
504
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
505
506
507
        }
    }

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

510
511
512
513
514
    # 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);

515
516
517
518
    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);
519

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

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

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

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

Christian Fibich's avatar
Christian Fibich committed
534

535
536
537
    # Add an intermediate net to allow patching without rewriting connections everywhere
    #
    # We use the requested signal as sink/destination.
538
    # That way we only need to change the driver to drive our intermediate net.
539
    #
540
541
542
    # 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.
543

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

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

Stefan Tauner's avatar
Stefan Tauner committed
630
631
632
633
634
635
            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);
636

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

642
643
644
645
646
647
648
    # 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
    #
649
650
651
652
653
    # 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
654
655
656
657
658
        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;
        }
659
660
661
662
663
664
665
666
667
668
669

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

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

            # 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();
                }
713
714
715
            }
        }

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

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

794
795
796
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
797
798
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
799
800
801
802
803
804
805
#
# @param net_path        The hierarchical path of the net, separeted by HIERSEP
# @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
# @returns undef           if successfull
806
sub _validate_driver {
807
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
808
    my ($self, $net_path, $driver_path, $driver_type) = @_;
809

Christian Fibich's avatar
Christian Fibich committed
810
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
811
    my $connections       = {};
812
    $self->_get_net_connections_from_path($net_path, $connections);
813

814
815
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
816
817
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
818

819
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
820
821

    return undef;
822
823
824
825
826

FAIL:
    my $msg = "No possible driver found";
    $logger->error($msg);
    return $msg;
827
828
}

829
830
831
832
833
834
835
836
837
## @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
838
    my ($connected, $net) = @_;
839

840
    print "Select driver for net " . $net->name . ": \n";
841
    my $di;
Christian Fibich's avatar
Christian Fibich committed
842
843
    for ($di = 0 ; $di < @{$connected} ; $di++) {
        printf("[%d] %s\n", $di, FIJI::Netlist->_connection_tostr(@{$connected}[$di]));
844
    }
Christian Fibich's avatar
Christian Fibich committed
845
    printf("[x] none of the above.\n", $di);
846
    my $sel;
847
    while (1) {
848
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
849
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
850
            last;
Christian Fibich's avatar
Christian Fibich committed
851
        } elsif ($sel =~ m/[xX]/) {
852
            my $msg = "No driver selected for net " . $net->name;
853
            return $msg;
854
855
        } else {
            print "Invalid driver.\n";
856
857
858
        }
    }
    return @{$connected}[$sel];
859
860
}

861
862
863
## @method private _connection_tostr ($connection,$conn_str_list_ref)
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
864
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
865
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
866
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
867
#
868
869
870
# @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
871
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
872
sub _connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
873
    my ($self, $connection, $conn_str_list_ref) = @_;
874
875
    my $path;
    my $type;
876
    my $str;
877

Christian Fibich's avatar
Christian Fibich committed
878
    if (ref($connection) eq "Verilog::Netlist::Pin") {
879
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
880
        $type = "PIN";
881
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
882
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
883
        $path = $connection->module->name . HIERSEP . $connection->name;
884
        $type = "PORT";
885
        $str = $type . ": " . $path
886
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
887
        $path = $connection->module->name . HIERSEP . $connection->lhs . EQUALSEP . $connection->rhs;
888
        $type = "ASSIGN";
889
        $str = $type . ": " . $connection->lhs . EQUALSEP . $connection->rhs;
890
    }
891
892
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
893
894
}

895
896
897
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
898
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
899
900
901
902
903
# 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}
#
904
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
905
sub get_connection_object {
906
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
907
    my ($self, $connection_path, $connection_type) = @_;
908
909

    my $rv;
910
    my $SEP = HIERSEP;
911

912
913
    my @path_elements = _split_path($connection_path);

Christian Fibich's avatar
Christian Fibich committed
914
    if ($connection_type eq "PIN") {
915
916
917
        if (@path_elements == 3) {

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

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

921
922
923
            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);
924
925
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
926
    } elsif ($connection_type eq "PORT") {
927
        if (@path_elements == 2) {
928

929
            my ($module_name, $port_name) = @path_elements;
930

931
932
933
934
            $logger->trace("Looking for port named \"$port_name\" in module \"$module_name\"...");

            my $mod = $self->{'nl'}->find_module($module_name);
            my $port = $mod->find_port($port_name) if (defined $mod);
935
936
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
937
    } elsif ($connection_type eq "ASSIGN") {
938
939
940
        if (@path_elements >= 2) {
            my $module_name = $path_elements[0];
            my $assign_string = substr $connection_path, length($module_name)+1;
941

942
943
            $logger->trace("Looking for assignment $assign_string in module \"$module_name\"...");
            my $mod = $self->{'nl'}->find_module($module_name);
944

Christian Fibich's avatar
Christian Fibich committed
945
            if (defined $mod) {
946
                my $assign;
947
                for my $a (grep { $_->isa("Verilog::Netlist::ContAssign") } $mod->statements) {
948
949
                    my $former_assign = $a->userdata('former_assign');
                    if ($assign_string eq $a->lhs.EQUALSEP.$a->rhs || (defined $former_assign && ($former_assign->{'lhs'}).EQUALSEP.($former_assign->{'rhs