Netlist.pm 51.7 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
15
16
17
18
19
#-------------------------------------------------------------------------------
#  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
#
#-------------------------------------------------------------------------------
#  File:              Netlist.pm
#  Created on:        29.04.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  Description:
#
20
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
Christian Fibich's avatar
Christian Fibich committed
21
#-------------------------------------------------------------------------------
22
23
# @endverbatim
#*
Christian Fibich's avatar
Christian Fibich committed
24

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

## @class FIJI::Netlist
# @brief Functions to instrument & export a Verilog::Netlist
30
31
32
33
34
package FIJI::Netlist;

use strict;
use warnings;

35
use Scalar::Util 'blessed';
36
use Log::Log4perl qw(get_logger :easy);
37
use File::Basename qw(basename);
38

39
40
use Verilog::Netlist 99.415;
use Verilog::Language 99.415;
41
42
43
44
use Data::Dumper;

use FIJI::VHDL;

Christian Fibich's avatar
Christian Fibich committed
45
use constant HIERSEP               => "|";
46
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

Christian Fibich's avatar
Christian Fibich committed
51
use constant FIJI_LOGO => <<logo_end;
52
53
54
55
56
57
//  FIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJIF   FIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJ    IFIJIFIJIFIJIFIJIFIJI
//  FIJIF       FI           IJIFIJIFIJIFIJI
//  FIJIFIJIFI            JIFIJIFIJIFIJIFIJI
//  FIJIFIJI            FIJIFIJIFIJIFIJIFIJI
58
59
//  FIJIFI    JI   IFI   IJIFIJIFIJIFIJIFIJI
//  FIJIF   FIJ   JIFIJ   JIFIJIFIJIFIJIFIJI
60
61
62
63
64
65
66
67
68
69
//  FIJIFIJIFI   IJIFIJI   IFIJIFIJIFIJIFIJI
//  FIJIFIJIF    IJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJI    FIJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJ     FIJIF           FIJIFIJIFIJI
//  FIJIFI     IFI      Fault      IFIJIFIJI
//  FIJIF             InJection     FIJIFIJI
//  FIJ              Instrumenter    IJIFIJI
//  F                                    IJI
//  FIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJI
logo_end
70

71
72
## @function public new ()
# @brief creates a new FIJI::Netlist object
Christian Fibich's avatar
Christian Fibich committed
73
#
74
75
# @returns the newly created FIJI::Netlist object
sub new {
Christian Fibich's avatar
Christian Fibich committed
76

77
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
78

79
80
    my $self = {};
    bless $self, $class;
Christian Fibich's avatar
Christian Fibich committed
81

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

84
85
86
87
88
89
        # 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;
90
91
}

92
93
94
95
96
97
98
99
## @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 {
100
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
101
    my ($self, $filename) = @_;
102

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

106
    $logger->info("Reading in netlist from file \"$filename\".");
107
    eval {
Christian Fibich's avatar
Christian Fibich committed
108
109
        $self->{'nl'}->read_file(filename => $filename);    # read Verilog file
        $self->{'nl'}->link();                              # Read in any sub-modules
110
    };
111

Christian Fibich's avatar
Christian Fibich committed
112
113
    if ($self->{'nl'}->errors() != 0 || $@) {
        $logger->error("Could not parse $filename!", $@ ? "\n" . $@ : "");
114
115
        return 1;
    }
116

117
    $self->{'filename'} = $filename;
118

119
120
    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
121
122
}

123
124
125
126
127
## @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
128
    my ($self, $dir) = @_;
129
    my $ports_ref = [];
Christian Fibich's avatar
Christian Fibich committed
130
    foreach my $mod ($self->{'nl'}->top_modules_sorted) {
131
        foreach my $port ($mod->ports) {
Christian Fibich's avatar
Christian Fibich committed
132
133
134
135
            if (   !defined($dir)
                || ($dir eq "o" && $port->direction eq "out")
                || ($dir eq "i" && $port->direction eq "in"))
            {
Christian Fibich's avatar
Christian Fibich committed
136
137
                push @{$ports_ref}, $port->name;
            }
138
139
140
        }
    }
    return $ports_ref;
141
142
}

Christian Fibich's avatar
Christian Fibich committed
143
144
145
146
147
148
## @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
149
150
151
152
153
    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
154
155
}

156
157
158
159
## @method public get_nets ()
# @brief retrieves all nets in the netlist
#
# @returns an array of hashes for all nets containing:
160
161
162
# 'name' the name of the net
# 'path' the hierarchical path of the net
# 'net'  the Verilog::Netlist::Net reference to the net
163
sub get_nets {
164
165
166
167
168
    my ($self) = @_;

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
Christian Fibich's avatar
Christian Fibich committed
169
170
    foreach my $mod ($self->{'nl'}->top_modules_sorted) {
        $self->_get_subnets($nets_ref, $mod, $hier);
171
172
    }
    return $nets_ref;
173
174
}

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
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);
}

190
191
192
193
194
195
196
197
198
#** @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 {

199
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
200
    my ($self, $nets_ref, $mod, $hier) = @_;
201

202
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
203
    $thishier .= HIERSEP if $thishier ne "";
204
    $thishier .= $mod->name;
205

Christian Fibich's avatar
Christian Fibich committed
206
    foreach my $n ($mod->nets) {
207
        if (defined($n->msb) && defined($n->lsb)) {
208
            my ($low, $high) = _extract_low_high($n->lsb, $n->msb);
209
            for (my $sub = $low ; $sub <= $high ; $sub++) {
Christian Fibich's avatar
Christian Fibich committed
210
                my $thisnet_ref = {name => $n->name . "[$sub]", path => $thishier, net => $n, index => $sub};
211
212
213
214
215
216
217
                push(@{$nets_ref}, $thisnet_ref);
            }
        } else {
            my $thisnet_ref = {name => $n->name, path => $thishier, net => $n};
            push(@{$nets_ref}, $thisnet_ref);
        }

218
    }
219

220
    foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
221
222
        if (defined($cell->submod)) {
            $self->_get_subnets($nets_ref, $cell->submod, $thishier);
223
        }
224
225
226
    }
}

227
228
229
## @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.
230
#
231
232
# @param startmod    the module to start with
# @param name        the name to check against
233
sub _check_name_in_hierarchy {
234

235
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
236
    my ($startmod, $name) = @_;
237
238
    my $nl = $startmod->netlist;

239
    $logger->debug("Checking \"" . $startmod->name . "\" for name \"$name\"");
240
241

    # check if a net is named the same
242
    for my $net ($startmod->nets) {
Christian Fibich's avatar
Christian Fibich committed
243
        if ($net->name eq $name) {
244
            my $msg = "Name \"$name\" does already exist as net in " . $startmod->name;
245
            return $msg;
246
247
248
249
        }
    }

    # check if a port is named the same
250
    for my $port ($startmod->ports) {
Christian Fibich's avatar
Christian Fibich committed
251
        if ($port->name eq $name) {
252
            my $msg = "Name \"$name\" does already exist as port in " . $startmod->name;
253
            return $msg;
254
255
256
        }
    }

257
    for my $cell ($startmod->cells) {
Christian Fibich's avatar
Christian Fibich committed
258
        if ($cell->name eq $name) {
259
            my $msg = "Name \"$name\" does already exist as cell in " . $startmod->name;
260
            return $msg;
261
262
263
264
        }
    }

    # find any module instantiating the current start module
265
266
    foreach my $mod ($nl->modules) {
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
267
268
            if (defined $cell->submod && $cell->submod == $startmod) {
                my $msg = _check_name_in_hierarchy($mod, $name);
269
                return $msg if defined $msg;
270
271
272
            }
        }
    }
273

274
    return undef;
275
276
}

277
278
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
279
#
280
281
282
283
284
285
286
287
# @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
288
sub _add_port_to_hierarchy {
289

290
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
291
    my ($startmod, $name, $function, $index, $indent) = @_;
292
    my $nl        = $startmod->netlist;
293
    my $direction = "undef";
Christian Fibich's avatar
Christian Fibich committed
294
    if (!defined $indent) {
295
296
297
298
299
        $indent = "";
    } else {
        $indent .= "  ";
    }

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

302
    $logger->debug($indent . "Adding port \"$name\" to module \"" . $startmod->name . "\"");
303
304

    # decide direction
305
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
306
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT)
307
    {
308
        $direction = "in";
309
    } else {
310
311
312
313
        $direction = "out";
    }

    # generate port
Christian Fibich's avatar
Christian Fibich committed
314
    my $np = $startmod->new_port(name => $name, direction => $direction);
315
316

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

    # set indices
320
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
321
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
322
    {
Christian Fibich's avatar
Christian Fibich committed
323
324
325
        $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);
326
327
    }

Christian Fibich's avatar
Christian Fibich committed
328
329
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
330
331

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
332
    foreach my $mod ($nl->modules_sorted) {
333
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
334
            if (defined $cell->submod && $cell->submod == $startmod) {
335
336
                $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 . "\"");
337
338
339
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
340
                    netnames => [{'netname' => $np->net->name}],
341
342
                );

Christian Fibich's avatar
Christian Fibich committed
343
                # let verilog-perl find the net and port.
Christian Fibich's avatar
Christian Fibich committed
344
                # @FIXME sufficient to link "mod" here?
Christian Fibich's avatar
Christian Fibich committed
345
                $mod->link;
Christian Fibich's avatar
Christian Fibich committed
346
                _add_port_to_hierarchy($mod, $name, $function, $index, $indent);
347
348
349
            }
        }
    }
350

351
352
353
    return $np;
}

354
355
356
## @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
357
358
359
360
361
362
# 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
#
363
364
365
366
367
368
369
# @param net         the Verilog::Net object to be used
# @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)
#
# @returns undef
sub net_add_function {
370
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
371
    my ($self, $net, $function, $port_name, $index) = @_;
372

373
    $logger->debug("Adding function to \"" . $net->module->name . "\", net \"" . $net->name . "\"");
374
375

    my $prefix = "fiji_";
376
377
378
379
380

    my $unique_name = _unique_name($net->module,$prefix.$port_name);

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

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

386
    $logger->debug("Connecting Port \"" . $op->name . "\" to net \"" . $net->name . "\"");
387

Christian Fibich's avatar
Christian Fibich committed
388
    # connect the net to the newly created port
389
390
391
392
393
394
395
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
        rhs     => $net->name,
        module  => $op->module,
        netlist => $op->module->netlist
    );
396

397
398
399
    return undef;
}

400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
# 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
}

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
# 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
    );
}

448
449
450
451
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
452
453
454
#   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
455
#
456
# @param net_path        the Verilog::Net to instrument
457
# @param fiu_idx         the FIU number this external access shall be connected to
458
459
# @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)
460
461
462
463
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
464

465
    my $logger = get_logger("");
466
    my ($self, $net_path, $fiu_idx, $driver_path, $driver_type) = @_;
467

468
    # split hierarchical net path
469
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
470
471

    if (ref($net_descriptor) ne "HASH") {
472
        return $net_descriptor;
473
474
475
    }

    my $net = $net_descriptor->{'net'};
476
    my $net_name = $net_descriptor->{'net_name'};
477
478
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
479
    my $mod = $net_descriptor->{'mod'};
480
481
482
    my $idx = '';
    my $idx_postfix = '';

483
484
485
486
487
488
    # 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) {
489
490
491
492
            # 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.\nMay you want to instrument a single bit of said vector instead?";
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
493
        } else {
494
495
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
496
497
498
        }
    }

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

501
502
503
504
505
    # 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);

506
507
508
509
    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);
510

511
    # generate unique name for output port, return with error message if that fails
512
    my $unique_output_name = _unique_name($mod, $output_name);
513
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
514

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

518
519
    # generate unique name for input port, return with error message if that fails
    my $unique_input_name = _unique_name($mod, $input_name);
520
    return "Could not generate unique name for prefix $input_name" if (!defined $unique_input_name);
521

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

Christian Fibich's avatar
Christian Fibich committed
525

526
527
528
    # Add an intermediate net to allow patching without rewriting connections everywhere
    #
    # We use the requested signal as sink/destination.
529
    # That way we only need to change the driver to drive our intermediate net.
530
    #
531
532
533
    # 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.
534

535
    # Choose intermediate net name
536
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
537
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
538

539
540
541
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
542
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
543
        if (ref($connection) eq "Verilog::Netlist::Pin") {
544
545
546
            # 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\"");
            # FIXME: do concatenations really work? They are apparently split already by Verilog::perl but...
547
            for my $netname (@{$connection->netnames}) {
548
                if ($netname->{'netname'} eq $net->name) {
549
550
551
552
553
                    $netname->{'netname'} = $net_name_tmp; # FIXME: do we need to force a re-link (by deleting $connection->nets)?
                    # This net is a vector if the underlying net is a bus and we do not just select a single bit
                    if (defined($net->msb) || (!defined($netname->{'msb'}) || $netname->{'msb'} != $netname->{'lsb'})) {
                        $driver_is_vector = 1;
                    }
554
                }
555
            }
556
557
558
            # $connection->port(undef);    # resolved by link
        } else {
            if (ref($connection) eq "Verilog::Netlist::Port") {
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
                $driver_is_port = 1;
                # If instrumented net is a vector we will need an intermediate bus
                if (defined($net->msb)) {
                    $driver_is_vector = 1;
                    # If port is vector change type of existing non-instrumented input to wire -
                    # practically transforming it to an ordinary wire that can easily be intrumented
                    $connection->net->net_type("wire");
                    $connection->net->port(undef);
                    $logger->debug("Transforming previous port named \"". $connection->name . "\" into an ordinary wire");
                }
                # FIXME: rename port in instantiation of current module
                $logger->warn("Instantiation of module \"" . $mod->name . "\" needs to change port \"" . $connection->name . "\" to \"$net_name_tmp\" - not supported yet...");
                # if ($mod->is_top) {
                    # FIXME: add naming information for wrapper generator
                # } else {
                # }
                # Eventually connect this port to the intermediate net by changing its name
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
                $logger->debug("Connecting (input) port \"" . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
                $connection->name($net_name_tmp);
            } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
                # FIXME: concatenations
                # If the driver is an assignment, replace the LHS with the intermediate net
                if(0) {
                    $logger->debug("Connecting to intermediate net \"" . $net_name_tmp . "\" the continuous assignment of \"" . $connection->rhs . "\"");
                    $connection->lhs($net_name_tmp);
                } else {
                    # 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 = $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 . "\"";
                        }
                        # FIXME: so this is actually a port...
                        $logger->fatal("Found port name in continuous assignment. This is not supported yet.");
                        return "BORKED";
                    }
598
599
600
601
602
603
604
605
606
607
608
609
610
611
                    my $rhs_elems = $self->_extract_netstring_elements($connection->rhs);
                    my $rhs_net_name = $rhs_elems->{'net_name'};

                    my $rhs_net = $mod->find_net($rhs_net_name);
                    # If driver is a vector we need a vectored intermediate bus.
                    # This is the case if on the RHS
                    #   - the underlying net is a vector and there are no indices
                    #   - the underlying net is a vector and there are two different indices
                    if (defined($rhs_net->msb) && (!defined($rhs_elems->{'msb'}) || ($rhs_elems->{'msb'} != $rhs_elems->{'msb'}))) {
                        $driver_is_vector = 1;
                    }
                    $logger->debug("Connecting to intermediate net \"" . $net_name_tmp . "\" the continuous assignment of \"" . $connection->rhs . "\"");
                    $connection->lhs($net_name_tmp);
                     if(1) {} else {
612
613
614
615
616
617
                        # If LHS is a bus however we need to drive the bit we want to instrument only
                        $logger->debug("Connecting to intermediate net \"" . $net_name_tmp."[".$msb."]" . "\" the continuous assignment of \"" . $connection->rhs . "\"");
                        $connection->lhs($net_name_tmp."[".$msb."]");
                        # $logger->debug("Connecting to non-instrumented bits of the intermediate net \"" . $connection->lhs."[".$msb."]" . "\" the continuous assignment of \"" . $net_name_tmp."[".$msb."]" . "\"");
                        # generate_contassign($mod, $connection->lhs."[".$msb."]", $net_name_tmp."[".$msb."]");
                    }
618
619
                }
            } else {
620
                $logger->debug("Driver instance is neither pin, port nor contassign?");
621
            }
622
623
        }
    }
624

625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
    # 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
    #
    my $net_tmp;
    # If the name is already taken then assume we need to instrument another bit of a bus
    # FIXME: maybe we should try harder to find out the reason why _check_name_in_hierarchy failed
    if (defined($name_check)) {
        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;
        }
        $net_tmp = $mod->find_net($net_name_tmp);
        # We need to undo the previous assignment of the respective bit
        foreach my $statement ($mod->statements) {
            if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E(\[(\Q$msb\E)\])?$/) {
                $logger->debug("    unassigning \"" . $statement->lhs . " = " . $statement->rhs . "\"");
                $statement->delete();
            }
        }

        $logger->debug("    reassigning \"" . $net_name."[".$msb."] = " . $ip->net->name . "\"");
        generate_contassign($mod, $net_name."[".$msb."]", $ip->net->name);
    } else {
        # 2.) Generate intermediate (tmp) net for easier input and output routing
        # 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 get away
        # without an intermediate net.
        my @net_cfg = (name => $net_name_tmp);
        push(@net_cfg, net_type => 'input') if $driver_is_port;
        
        if ($driver_is_vector) {
            $logger->debug("Generating intermediate " . ($driver_is_port ? 'port' : '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 " . ($driver_is_port ? 'port' : 'wire') . " named \"" . $net_name_tmp . "\" to patch \"$net_name\"");
        }
        $net_tmp = $mod->new_net(@net_cfg,);

        # 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);
        
        } elsif (!defined($net_tmp->msb)) {
            # If the net is a vector but the driver was driving only one bit
            # then we need to drive the originally driven bit only
            generate_contassign($mod, $net_name."[".$msb."]", $ip->net->name);
        } else {
            # For drivers of complete busses we need to connect all non-instrumented bits of the tmp net
            # additionally to preserve their unmodified values.
            my ($low, $high) = _extract_low_high($net_tmp->lsb, $net_tmp->msb);
            for (my $i = $low ; $i <= $high ; $i++) {
                if ($i == $msb) {
                    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
    if (!defined($net_tmp->msb)) {
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp . "\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp);
    } else {
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp ."[".$msb."]\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp."[".$msb."]");
    }
706
    $mod->link;
707
708
709
    return undef;
}

710
711
712
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
713
714
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
715
716
717
718
719
720
721
#
# @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
722
sub _validate_driver {
723
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
724
    my ($self, $net_path, $driver_path, $driver_type) = @_;
725

Christian Fibich's avatar
Christian Fibich committed
726
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
727
    my $connections       = {};
728
    $self->_get_net_connections_from_path($net_path, $connections);
729

730
731
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
732
733
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
734

735
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
736
737

    return undef;
738
739
740
741
742

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

745
746
747
748
749
750
751
752
753
## @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
754
    my ($connected, $net) = @_;
755

756
    print "Select driver for net " . $net->name . ": \n";
757
    my $di;
Christian Fibich's avatar
Christian Fibich committed
758
759
    for ($di = 0 ; $di < @{$connected} ; $di++) {
        printf("[%d] %s\n", $di, FIJI::Netlist->_connection_tostr(@{$connected}[$di]));
760
    }
Christian Fibich's avatar
Christian Fibich committed
761
    printf("[x] none of the above.\n", $di);
762
    my $sel;
763
    while (1) {
764
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
765
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
766
            last;
Christian Fibich's avatar
Christian Fibich committed
767
        } elsif ($sel =~ m/[xX]/) {
768
            my $msg = "No driver selected for net " . $net->name;
769
            return $msg;
770
771
        } else {
            print "Invalid driver.\n";
772
773
774
        }
    }
    return @{$connected}[$sel];
775
776
}

777
778
779
## @method private _connection_tostr ($connection,$conn_str_list_ref)
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
780
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
781
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
782
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
783
#
784
785
786
# @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
787
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
788
sub _connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
789
    my ($self, $connection, $conn_str_list_ref) = @_;
790
791
    my $path;
    my $type;
792
    my $str;
793

Christian Fibich's avatar
Christian Fibich committed
794
    if (ref($connection) eq "Verilog::Netlist::Pin") {
795
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
796
        $type = "PIN";
797
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
798
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
799
        $path = $connection->module->name . HIERSEP . $connection->name;
800
        $type = "PORT";
801
        $str = $type . ": " . $path
802
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
803
        $path = $connection->module->name . HIERSEP . $connection->rhs;
804
        $type = "ASSIGN";
805
        $str = $type . ": " . $connection->rhs;
806
    }
807
808
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
809
810
}

811
812
813
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
814
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
815
816
817
818
819
# 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}
#
820
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
821
sub get_connection_object {
822
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
823
    my ($self, $connection_path, $connection_type) = @_;
824
825

    my $rv;
826
    my $SEP = HIERSEP;
827

Christian Fibich's avatar
Christian Fibich committed
828
    if ($connection_type eq "PIN") {
829
        if ($connection_path =~ /^(.+)\Q$SEP\E(.+)\Q$SEP\E(.+)$/) {
830

831
            $logger->trace("Looking for pin named \"$3\" in cell \"$2\" of module \"$1\"...");
832
833

            my $mod  = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
834
835
            my $cell = $mod->find_cell($2) if (defined $mod);
            my $pin  = $cell->find_pin($3) if (defined $cell);
836
837
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
838
    } elsif ($connection_type eq "PORT") {
839
        if ($connection_path =~ /^(.+)\Q$SEP\E(.+)$/) {
840

841
            $logger->trace("Looking for port named \"$2\" in module \"$1\"...");
842

843
            my $mod = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
844
            my $port = $mod->find_port($2) if (defined $mod);
845
846
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
847
    } elsif ($connection_type eq "ASSIGN") {
848
        if ($connection_path =~ /^(.+)\Q$SEP\E(.+)$/) {
849
            my $lhs = $2;
850

851
            $logger->trace("Looking for assignment to/from \"$2\" in module \"$1\"...");
852
            my $mod = $self->{'nl'}->find_module($1);
853

Christian Fibich's avatar
Christian Fibich committed
854
            if (defined $mod) {
855
                my $assign;
856
857
                for my $a (grep { $_->isa("Verilog::Netlist::ContAssign") } $mod->statements) {
                    if ($a->lhs eq $lhs || $a->rhs =~ /\Q$lhs\E/) {
858
                        $assign = $a;
859
                        $logger->trace(sprintf("Constant assignment: \"%s\" = \"%s\"", $a->lhs, $a->rhs));
860
861
862
                        last;
                    }
                }
863
                $rv = $assign;
864
865
866
            }
        }
    }
867
    $logger->warn("Could not find $connection_type \"$connection_path\"!") if !defined($rv);
868
    return $rv;
869
870
}

871

872
873
874
## @method private _get_net_connections ($net,$connection_hashref)
# @brief retrieves connections of a given net
#
875
# gets all pins, ports and assignments a net is connected to
876
#
877
# @param net_path               hierarchical path string of the net to be examined
878
879
880
881
882
# @param connection_hashref     a hashref where the results can be placed
#                               connection_hashref->{'drivers'} contains a list of driver cells
#                               connection_hashref->{'driven'} contains a list of driven cells
#                               connection_hashref->{'connected'} contains a list cells connected to the
#                               net but driver/driven cannot be decided
883
sub _get_net_connections_from_path {
884
    my $logger = get_logger("");
885
    my ($self, $net_path, $connection_hashref) = @_;
Stefan Tauner's avatar
Stefan Tauner committed
886
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
887
888
    return $net_descriptor if (ref($net_descriptor) ne "HASH");
    my $net = $net_descriptor->{net};
889
    return $self->_get_net_connections($net, $connection_hashref, $net_descriptor->{'msb'});
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
}

## @method private _untie_concatenations ($concat, $arrayref)
# @brief breaks up a verilog concatenation into single net elements
#
# @param concat     string (including the {}) forming a verilog concatenation
# @return arrayref   array reference containing the individual concatenated verilog expressions in the given string
sub _untie_concatenations {
    my $logger = get_logger("");
    my ($self, $concat) = @_;

    if ($concat =~ /^\{(.+)\}$/) {
        $concat = $1;
    }
    my @net_strings;
    foreach my $net_string ($concat =~ /(.+)/g) {
        push(@net_strings, $net_string);
    }
    return \@net_strings;
909
}
910

911
912
913
914
915
916
917
918
919
920
921
## @method private _get_net_connections ($net,$connection_hashref)
# @brief retrieves connections of a given net
#
# gets all pins, ports and assignments a net is connected to
#
# @param net                    the net to be examined
# @param connection_hashref     a hashref where the results can be placed
#                               connection_hashref->{'drivers'} contains a list of driver cells
#                               connection_hashref->{'driven'} contains a list of driven cells
#                               connection_hashref->{'connected'} contains a list cells connected to the
#                               net but driver/driven cannot be decided
922
# @param bit                    one bit of the net to check for connections (optional, only useful for vectored nets)
923
924
# @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)
925
926
sub _get_net_connections {
    my $logger = get_logger("");
927
    my ($self, $net, $connection_hashref, $bit, $driver_path, $driver_type) = @_;
928
929
930
931
932
933
934
935
936
937
938
939
940
941

    my $driver;
    my $pin_driver_supplied;
    my $port_driver_supplied;
    my $assign_driver_supplied;
    if (defined $driver_path && defined $driver_type) {
        $driver = $self->get_connection_object($driver_path, $driver_type);
        if (!defined($driver)) {
            return sprintf("No driver found for \"%s\".", $driver_path);
        }
        $pin_driver_supplied = $driver->isa("Verilog::Netlist::Pin");
        $port_driver_supplied = $driver->isa("Verilog::Netlist::Port");
        $assign_driver_supplied = (!$pin_driver_supplied && !$port_driver_supplied);
    }
942
943
944
945
946
947
    if (!defined($bit)) {
        $bit = "";
    }

    # We need this in regexes below, that do not execute function calls (FFS) thus create an intermediate variable.
    my $net_name = $net->name();
948
949

    my $connections = $connection_hashref;
950
951
952
    my @drivers     = ();
    my @driven      = ();
    my @connected   = ();
953
954
955
    $connections->{'drivers'}   = \@drivers;
    $connections->{'driven'}    = \@driven;
    $connections->{'connected'} = \@connected;
956

Christian Fibich's avatar
Christian Fibich committed
957
958
    # @FIXME what to do with bussed nets
    # @FIXME what to do with instantiations like that (concatenated nets):
959
    # input [5:0] p_nbus_byte_controller_c_state ;
Christian Fibich's avatar
Christian Fibich committed
960
961
962
963
964
965
    #  ...
    # .p_nbus_byte_controller_c_state (
    #                     {byte_controller_c_state[5],byte_controller_c_state[3]
    #                      ,byte_controller_c_state[2],byte_controller_c_state[1]
    #                      ,byte_controller_c_state[4],byte_controller_c_state[0]
    #                      })
966
    #
Christian Fibich's avatar
Christian Fibich committed
967
    # @TODO: can Verilog::Language::split_bus help us here?
968

969
970
971
972
973
    if (!$net->isa("Verilog::Netlist::Net")) {
        my $msg = "$net is no Verilog::Netlist::Net";
        $logger->error($msg);
        return $msg;
    }
974
975

    my $mod = $net->module;
Christian Fibich's avatar
Christian Fibich committed
976

977
    $logger->debug("Net \"" . $mod->name . HIERSEP . $net_name . "\", connections:");
978

979
    # find nets driven by continuous assignment (e.g., constant or inverter)
Christian Fibich's avatar
Christian Fibich committed
980
    foreach my $statement ($mod->statements) {
981
982