Netlist.pm 56.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
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
package FIJI::Netlist;

use strict;
use warnings;
34
use diagnostics;
35

36
use Scalar::Util 'blessed';
37
use List::Util qw[min max];
38
use Log::Log4perl qw(get_logger :easy);
39
use File::Basename qw(basename);
40

41
42
use Verilog::Netlist 99.415;
use Verilog::Language 99.415;
43
44
45
46
use Data::Dumper;

use FIJI::VHDL;

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

Christian Fibich's avatar
Christian Fibich committed
54
use constant FIJI_LOGO => <<logo_end;
55
56
57
58
59
60
//  FIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJIF   FIJIFIJIFIJIFIJIFIJI
//  FIJIFIJIFIJIFIJ    IFIJIFIJIFIJIFIJIFIJI
//  FIJIF       FI           IJIFIJIFIJIFIJI
//  FIJIFIJIFI            JIFIJIFIJIFIJIFIJI
//  FIJIFIJI            FIJIFIJIFIJIFIJIFIJI
61
62
//  FIJIFI    JI   IFI   IJIFIJIFIJIFIJIFIJI
//  FIJIF   FIJ   JIFIJ   JIFIJIFIJIFIJIFIJI
63
64
65
66
67
68
69
70
71
72
//  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
73

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

80
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
81

82
83
    my $self = {};
    bless $self, $class;
Christian Fibich's avatar
Christian Fibich committed
84

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

87
88
89
90
91
92
        # 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;
93
94
}

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

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

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

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

120
    $self->{'filename'} = $filename;
121

122
123
    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
124
125
}

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

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

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

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
172
173
174
    my $top      = $self->get_toplevel_module();
    if ($top->isa("Verilog::Netlist::Module")) {
        $self->_get_subnets($nets_ref, $top, $hier);
175
176
    }
    return $nets_ref;
177
178
}

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
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);
}

194
195
196
197
198
199
200
201
202
#** @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 {

203
    my $logger = get_logger("");
204
    my ($self, $nets_ref, $mod, $hier, $instname) = @_;
205

206
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
207
    $thishier .= HIERSEP if $thishier ne "";
208
209
210
211
212
    if (defined $instname) {
        $thishier .= $instname;
    } else {
        $thishier .= $mod->name;
    }
213

Christian Fibich's avatar
Christian Fibich committed
214
    foreach my $n ($mod->nets) {
215
        if (defined($n->msb) && defined($n->lsb)) {
216
            my ($low, $high) = _extract_low_high($n->lsb, $n->msb);
217
            for (my $sub = $low ; $sub <= $high ; $sub++) {
Christian Fibich's avatar
Christian Fibich committed
218
                my $thisnet_ref = {name => $n->name . "[$sub]", path => $thishier, net => $n, index => $sub};
219
220
221
222
223
224
225
                push(@{$nets_ref}, $thisnet_ref);
            }
        } else {
            my $thisnet_ref = {name => $n->name, path => $thishier, net => $n};
            push(@{$nets_ref}, $thisnet_ref);
        }

226
    }
227

228
    foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
229
        if (defined($cell->submod)) {
230
            $self->_get_subnets($nets_ref, $cell->submod, $thishier, $cell->name);
231
        }
232
233
234
    }
}

235
236
237
## @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.
238
#
239
240
# @param startmod    the module to start with
# @param name        the name to check against
241
sub _check_name_in_hierarchy {
242

243
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
244
    my ($startmod, $name) = @_;
245
246
    my $nl = $startmod->netlist;

247
    $logger->debug("Checking \"" . $startmod->name . "\" for name \"$name\"");
248
249

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

    # check if a port is named the same
258
    for my $port ($startmod->ports) {
Christian Fibich's avatar
Christian Fibich committed
259
        if ($port->name eq $name) {
260
            my $msg = "Name \"$name\" does already exist as port in " . $startmod->name;
261
            return $msg;
262
263
264
        }
    }

265
    for my $cell ($startmod->cells) {
Christian Fibich's avatar
Christian Fibich committed
266
        if ($cell->name eq $name) {
267
            my $msg = "Name \"$name\" does already exist as cell in " . $startmod->name;
268
            return $msg;
269
270
271
272
        }
    }

    # find any module instantiating the current start module
273
274
    foreach my $mod ($nl->modules) {
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
275
276
            if (defined $cell->submod && $cell->submod == $startmod) {
                my $msg = _check_name_in_hierarchy($mod, $name);
277
                return $msg if defined $msg;
278
279
280
            }
        }
    }
281

282
    return undef;
283
284
}

285
286
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
287
#
288
289
290
291
292
293
294
295
# @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
296
sub _add_port_to_hierarchy {
297

298
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
299
    my ($startmod, $name, $function, $index, $indent) = @_;
300
    my $nl        = $startmod->netlist;
301
    my $direction = "undef";
Christian Fibich's avatar
Christian Fibich committed
302
    if (!defined $indent) {
303
304
305
306
307
        $indent = "";
    } else {
        $indent .= "  ";
    }

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

310
    $logger->debug($indent . "Adding port \"$name\" to module \"" . $startmod->name . "\"");
311
312

    # decide direction
313
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
314
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT)
315
    {
316
        $direction = "in";
317
    } else {
318
319
320
321
        $direction = "out";
    }

    # generate port
Christian Fibich's avatar
Christian Fibich committed
322
    my $np = $startmod->new_port(name => $name, direction => $direction);
323
324

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

    # set indices
328
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
329
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
330
    {
Christian Fibich's avatar
Christian Fibich committed
331
332
333
        $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);
334
335
    }

Christian Fibich's avatar
Christian Fibich committed
336
337
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
338
339

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
340
    foreach my $mod ($nl->modules_sorted) {
341
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
342
            if (defined $cell->submod && $cell->submod == $startmod) {
343
344
                $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 . "\"");
345
346
347
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
348
                    netnames => [{'netname' => $np->net->name}],
349
350
                );

Christian Fibich's avatar
Christian Fibich committed
351
                # let verilog-perl find the net and port.
352
                $startmod->link;
Christian Fibich's avatar
Christian Fibich committed
353
                _add_port_to_hierarchy($mod, $name, $function, $index, $indent);
354
355
356
            }
        }
    }
357

358
359
360
    return $np;
}

361
362
363
## @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
364
365
366
367
368
369
# 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
#
370
371
372
373
374
375
376
# @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 {
377
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
378
    my ($self, $net, $function, $port_name, $index) = @_;
379

380
    $logger->debug("Adding function to \"" . $net->module->name . "\", net \"" . $net->name . "\"");
381
382

    my $prefix = "fiji_";
383
384
385
386
387

    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)
388
389
    }

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

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

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

404
405
406
    return undef;
}

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

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

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

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

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

    if (ref($net_descriptor) ne "HASH") {
479
        return $net_descriptor;
480
481
482
    }

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

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

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

508
509
510
511
512
    # 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);

513
514
515
516
    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);
517

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

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

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

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

Christian Fibich's avatar
Christian Fibich committed
532

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

542
    # Choose intermediate net name
543
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
544
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
545

546
547
548
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
549
    my $driver_bit = $msb;
550
    my $driver;
551
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
552
        if (ref($connection) eq "Verilog::Netlist::Pin") {
553
554
555
            # 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...
Stefan Tauner's avatar
Stefan Tauner committed
556
            for my $netname ($connection->netnames) {
557
                if ($netname->{'netname'} eq $net->name) {
558
                    $driver = $connection;
559
560
                    $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
561
562
563
564
                    # If driver is a vector we need a vectored intermediate bus.
                    # This is the case if
                    #   - the underlying net is a vector and there are no indices
                    #   - the underlying net is a vector and there are two different indices
565
                    if (defined($net->msb) && (!defined($netname->{'msb'}) || $netname->{'msb'} != $netname->{'lsb'})) {
566
                        $driver_is_vector = 1;
567
568
569
570
                    } 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'});
571
                    }
572
                }
573
            }
574
575
576
            # $connection->port(undef);    # resolved by link
        } else {
            if (ref($connection) eq "Verilog::Netlist::Port") {
577
578
579
580
581
                $driver_is_port = 1;
                # If instrumented net is a vector we will need an intermediate bus
                if (defined($net->msb)) {
                    $driver_is_vector = 1;
                }
582
                $driver = $connection;
583
584
585
586
                # 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);
                }
587
588
589
590
591
592
593
594
                # 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");
                # Unsetting the port<->net inter-references forces their automatic re-setting at link time
                $connection->net->port(undef);
                $connection->net(undef);
595
                # Eventually connect this port to the intermediate net by changing its name
596
                $logger->debug("Connecting (input) port \"" . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
597
                $connection->name($net_name_tmp); # NB: this will automatically change the cell's configuration on the next link() call.
598
599
            } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
                # If the driver is an assignment, replace the LHS with the intermediate net
600
601
602
603
604
605
606
607
                # 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 . "\"";
608
                    }
609
610
611
612
                    # FIXME: so this is actually a port...
                    $logger->fatal("Found port name in continuous assignment. This is not supported yet.");
                    return "BORKED";
                }
613
                $driver = $connection;
614
615
616
                if (defined($connection->userdata->{'fiji_driver_bit'})) {
                    $driver_is_vector = 1;
                    $driver_bit = $connection->userdata->{'fiji_driver_bit'};
617
                }
618
                $logger->debug("Connecting to intermediate net \"" . $net_name_tmp . "\" the continuous assignment of \"" . $connection->rhs . "\"");
619
620
621
                # 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});
622
                $connection->lhs($net_name_tmp);
623

624
            } else {
625
                $logger->error("Driver instance is neither pin, port nor contassign?");
626
            }
627
628
        }
    }
629

630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
    # 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
    #
    # 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;
        }
        # We need to undo the previous assignment of the respective bit
        foreach my $statement ($mod->statements) {
647
            if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E(\[(\Q$driver_bit\E)\])?$/) {
648
649
650
651
652
                $logger->debug("    unassigning \"" . $statement->lhs . " = " . $statement->rhs . "\"");
                $statement->delete();
            }
        }

653
654
        $logger->debug("    reassigning \"" . $net_name."[".$driver_bit."] = " . $ip->net->name . "\"");
        generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
655
        $driver_is_vector = 1;
656
657
    } else {
        # 2.) Generate intermediate (tmp) net for easier input and output routing
658
659
660
        # 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) {
661
            $logger->debug("Intermediate port named \"" . $net_name_tmp . (defined($net->msb) ? "[" . $net->msb .":". $net->lsb . "]" : "") . "\" to patch \"$net_name\" will be generated automatically later");
662
        } else {
663
664
665
666
667
668
669
670
671
672
673
674
675
            # 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\"");
            }
676
677
678
679
680
681
682
            $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 . "\"");
            }
683
684
685
686
687
688
689
690
691
692
        }

        # 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);
693
        } elsif (!$driver_is_vector) {
694
695
            # If the net is a vector but the driver was driving only one bit
            # then we need to drive the originally driven bit only
696
            generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
697
698
699
        } else {
            # For drivers of complete busses we need to connect all non-instrumented bits of the tmp net
            # additionally to preserve their unmodified values.
700
            # In case of concatenations the index might be different to the one given.
701
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
702
            for (my $i = $low ; $i <= $high ; $i++) {
703
                if ($i == $driver_bit) {
704
705
706
707
708
709
710
711
712
                    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
713
714
    #     If the driver is not a vector a simple assignment is fine, else
    if (!$driver_is_vector) {
715
716
717
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp . "\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp);
    } else {
718
719
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp ."[".$driver_bit."]\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp."[".$driver_bit."]");
720
    }
721
    $mod->link;
722
723
724
    return undef;
}

725
726
727
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
728
729
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
730
731
732
733
734
735
736
#
# @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
737
sub _validate_driver {
738
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
739
    my ($self, $net_path, $driver_path, $driver_type) = @_;
740

Christian Fibich's avatar
Christian Fibich committed
741
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
742
    my $connections       = {};
743
    $self->_get_net_connections_from_path($net_path, $connections);
744

745
746
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
747
748
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
749

750
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
751
752

    return undef;
753
754
755
756
757

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

760
761
762
763
764
765
766
767
768
## @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
769
    my ($connected, $net) = @_;
770

771
    print "Select driver for net " . $net->name . ": \n";
772
    my $di;
Christian Fibich's avatar
Christian Fibich committed
773
774
    for ($di = 0 ; $di < @{$connected} ; $di++) {
        printf("[%d] %s\n", $di, FIJI::Netlist->_connection_tostr(@{$connected}[$di]));
775
    }
Christian Fibich's avatar
Christian Fibich committed
776
    printf("[x] none of the above.\n", $di);
777
    my $sel;
778
    while (1) {
779
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
780
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
781
            last;
Christian Fibich's avatar
Christian Fibich committed
782
        } elsif ($sel =~ m/[xX]/) {
783
            my $msg = "No driver selected for net " . $net->name;
784
            return $msg;
785
786
        } else {
            print "Invalid driver.\n";
787
788
789
        }
    }
    return @{$connected}[$sel];
790
791
}

792
793
794
## @method private _connection_tostr ($connection,$conn_str_list_ref)
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
795
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
796
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
797
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
798
#
799
800
801
# @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
802
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
803
sub _connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
804
    my ($self, $connection, $conn_str_list_ref) = @_;
805
806
    my $path;
    my $type;
807
    my $str;
808

Christian Fibich's avatar
Christian Fibich committed
809
    if (ref($connection) eq "Verilog::Netlist::Pin") {
810
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
811
        $type = "PIN";
812
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
813
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
814
        $path = $connection->module->name . HIERSEP . $connection->name;
815
        $type = "PORT";
816
        $str = $type . ": " . $path
817
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
818
        $path = $connection->module->name . HIERSEP . $connection->lhs . EQUALSEP . $connection->rhs;
819
        $type = "ASSIGN";
820
        $str = $type . ": " . $connection->lhs . EQUALSEP . $connection->rhs;
821
    }
822
823
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
824
825
}

826
827
828
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
829
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
830
831
832
833
834
# 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}
#
835
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
836
sub get_connection_object {
837
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
838
    my ($self, $connection_path, $connection_type) = @_;
839
840

    my $rv;
841
    my $SEP = HIERSEP;
842

843
844
    my @path_elements = _split_path($connection_path);

Christian Fibich's avatar
Christian Fibich committed
845
    if ($connection_type eq "PIN") {
846
847
848
        if (@path_elements == 3) {

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

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

852
853
854
            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);
855
856
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
857
    } elsif ($connection_type eq "PORT") {
858
        if (@path_elements == 2) {
859

860
            my ($module_name, $port_name) = @path_elements;
861

862
863
864
865
            $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);
866
867
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
868
    } elsif ($connection_type eq "ASSIGN") {
869
870
871
        if (@path_elements >= 2) {
            my $module_name = $path_elements[0];
            my $assign_string = substr $connection_path, length($module_name)+1;
872

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

Christian Fibich's avatar
Christian Fibich committed
876
            if (defined $mod) {
877
                my $assign;
878
                for my $a (grep { $_->isa("Verilog::Netlist::ContAssign") } $mod->statements) {
879
880
                    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'}) eq $assign_string)) {
881
                        $assign = $a;
882
                        $logger->trace(sprintf("Continuous assignment: \"%s\" = \"%s\"", $a->lhs, $a->rhs));
883
884
885
                        last;
                    }
                }
886
                $rv = $assign;
887
888
889
            }
        }
    }
890
    $logger->warn("Could not find $connection_type \"$connection_path\"!") if !defined($rv);
891
    return $rv;
892
893
}

894

895
896
897
## @method private _get_net_connections ($net,$connection_hashref)
# @brief retrieves connections of a given net
#
898
# gets all pins, ports and assignments a net is connected to
899
#
900
# @param net_path               hierarchical path string of the net to be examined
901
902
903
904
905
# @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
Christian Fibich's avatar