Netlist.pm 46.9 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
35
36
package FIJI::Netlist;

use strict;
use warnings;

use Log::Log4perl qw(get_logger :easy);

37
38
use Verilog::Netlist 99.415;
use Verilog::Language 99.415;
39
40
41
42
use Data::Dumper;

use FIJI::VHDL;

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

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

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

75
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
76

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

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

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

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

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

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

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

115
    $self->{'filename'} = $filename;
116

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

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

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

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

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

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

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

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

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

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

216
    }
217

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

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

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

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

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

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

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

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

272
    return undef;
273
274
}

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

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

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

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

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

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

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

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

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

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

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

349
350
351
    return $np;
}

352
353
354
## @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
355
356
357
358
359
360
# 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
#
361
362
363
364
365
366
367
# @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 {
368
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
369
    my ($self, $net, $function, $port_name, $index) = @_;
370

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

    my $prefix = "fiji_";
374
375
376
377
378

    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)
379
380
    }

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

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

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

395
396
397
    return undef;
}

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

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

446
447
448
449
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
Christian Fibich's avatar
Christian Fibich committed
450
451
452
453
#   1. tries to determine the driver, or otherwise prompts the user to select it
#   2. generate external access output and input ports
#   3. interconnects these ports to the matching driver and driven cells
#
454
# @param net_path        the Verilog::Net to instrument
455
# @param fiu_idx         the FIU number this external access shall be connected to
456
457
# @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)
458
459
460
461
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
462

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

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

    if (ref($net_descriptor) ne "HASH") {
471
        return $net_descriptor;
472
473
474
475
476
477
478
479
    }

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

480
481
482
483
484
485
    # 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) {
486
487
488
489
            # 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."_";
490
        } else {
491
492
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
493
494
495
        }
    }

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

498
499
500
501
    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);
502

503
504
505
    # generate unique name for output port, return with error message if that fails
    my $unique_output_name = _unique_name($net->module, $output_name);
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
506

507
508
    $logger->debug("\"" . $unique_output_name . "\" will be used as fiji connector (output)");
    my $op = _add_port_to_hierarchy($net->module, $unique_output_name, FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL, $fiu_idx);
509

510
511
512
    # generate unique name for output port, return with error message if that fails
    my $unique_input_name = _unique_name($net->module, $input_name);
    return "Could not generate unique name for prefix $input_name" if (!defined $unique_input_name);
513

514
515
    $logger->debug("\"" . $unique_input_name . "\" will be used as fiji connector (input)");
    my $ip = _add_port_to_hierarchy($net->module, $unique_input_name, FIJI::VHDL->FIJI_PORTTYPE_MODIFIED, $fiu_idx);
516

517
    my %connections;
518
    my $rv = $self->_get_net_connections($net, \%connections, $msb, $driver_path, $driver_type);
519
    return $rv if (defined $rv);
520

521
    # connecting newly created output to driver
Christian Fibich's avatar
Christian Fibich committed
522
523
    foreach my $connection (@{$connections{'drivers'}}) {
        if (ref($connection) eq "Verilog::Netlist::Pin") {
524

525
            # if it is a pin of a cell, connect this pin to the newly created net
526
527
            $logger->debug("Original: Connecting (output) pin \"" . $connection->cell->name . HIERSEP . $connection->name . "\" to generated output \"" . $op->name . "\"");
            my $tmp_bus;
528
            for my $netname (@{$connection->netnames}) {
Christian Fibich's avatar
Christian Fibich committed
529
530

                # @FIXME work to be done for Buses
531
532
533
534
535
536
537
538
                if (($netname->{'netname'} eq $net->name) && 
                     (!defined $netname->{lsb} || $netname->{lsb} eq $lsb) &&
                     (!defined $netname->{msb} || $netname->{msb} eq $msb)) {
                    $netname->{'netname'} = $op->net->name;
                    # there will never be an indexed newly created port (only single-bit FIUs)
                    $netname->{lsb} = undef;
                    $netname->{msb} = undef;
                }
539
            }
Christian Fibich's avatar
Christian Fibich committed
540

541
            #$connection->net(undef);     # resolved by link
542
            $connection->port(undef);    # resolved by link
543

Christian Fibich's avatar
Christian Fibich committed
544
        } elsif (ref($connection) eq "Verilog::Netlist::Port") {
545

546
                # @FIXME work to be done for Buses
547
            # if it is a port of a module, connect this port to the newly created net
548
            $logger->debug("Original: Connecting (input) port \"" . $connection->name . "\" to generated output \"" . $op->name . "\"");
Christian Fibich's avatar
Christian Fibich committed
549
            $connection->net($op->net);
550
551
552
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $op->name,
553
                rhs     => $connection->name.$idx,
554
555
556
                module  => $net->module,
                netlist => $net->module->netlist
            );
557
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
            # 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_net_elements($connection->lhs);
            my $lhs_net_name = $lhs_elems->{net_name};
            my $lhs_net = $net->module->find_net($lhs_net_name);
            if (!defined($lhs_net)) {
                return "Could not find net in module \"" . $net->module->name . "\" matching LHS of assignment \"" . $connection->lhs . "\" = \"" . $connection->rhs . "\"";
            }
            if (!defined($lhs_net->msb)) {
                # If the signal in LHS is not a vector at all we simply drive the new port instead, easy.
                $connection->lhs($op->name);
                $logger->debug("Original: Connecting to generated output \"" . $op->name . "\" continuous assignment of \"" . $connection->rhs . "\"");
            } else {
                # If LHS is a bus however we need more effort.
                # We need to extract the bit we want and drive the new port, but
                # also continue to drive the remaining bits of the vector just like before
                # e.g. when we want to tap [1] of \dumb.non.hierarchical_bus then we need to transform this:
                #   wire   [3:0] wirebus;
                #   wire   [3:0] \dumb.non.hierarchical_bus ;
                #   assign \dumb.non.hierarchical_bus = ~wirebus;
                # into this:
                #   wire   [3:0] wirebus;
                #   wire   [3:0] \dumb.non.hierarchical_bus ;
                #   wire   [3:0] tmp_hierarchical_bus;
                #   assign tmp_hierarchical_bus = ~wirebus;
                #   assign tmp_signal_o = tmp_hierarchical_bus[1];
                #   assign \dumb.non.hierarchical_bus[0] = tmp_hierarchical_bus[0];
                #   assign \dumb.non.hierarchical_bus[1] = tmp_signal_i;
                #   assign \dumb.non.hierarchical_bus[2] = tmp_hierarchical_bus[2];
                #   assign \dumb.non.hierarchical_bus[3] = tmp_hierarchical_bus[3];
                # However, we just need to create the temporary bus once even if more than one bit of it get instrumented...

                my ($op_rhs, $ip_lhs);
                # If the LHS is a bit range of a vector we have either
                # - generated the net earlier (in the else branch below) or,
                # - it was a bit-wise assignment in the original netlist as well.
                # In any case we only need to generate a temporary net if the assignment is not to a bit of a vector.
                if (defined($lhs_elems->{lsb})) {
                    $op_rhs = $connection->rhs;
                    $ip_lhs = $connection->lhs;
                } else {
                    my $tmp_name = FIJI_NAMESPACE_PREFIX . $lhs_net->name . "tmp";
599
600
                    my $unique_tmp_name = _unique_name($net->module, $tmp_name);
                    return "Could not generate unique name for prefix ".$tmp_name if (!defined $unique_tmp_name);
601
602
603
604

                    # Generate intermediate (tmp) bus and assign old RHS to it
                    $logger->debug("Generating intermediate bus to connect split up result of \"" . $connection->rhs . "\"");
                    my $tmp_bus = $net->module->new_net(
605
                        name => _sanitize_identifier($unique_tmp_name),
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
                        msb => $lhs_net->msb,
                        lsb => $lhs_net->lsb,
                    );
                    generate_contassign($net->module, $tmp_bus->name, $connection->rhs);

                    # Connect the individual bits of the tmp bus with the (previous) LHS that we don't want to instrument
                    my ($low, $high) = _extract_low_high($lhs_net->lsb, $lhs_net->msb);
                    for (my $i = $low ; $i <= $high ; $i++) {
                        if ($i != $msb) {
                            generate_contassign($net->module, $connection->lhs."[".$i."]", $tmp_bus->name."[".$i."]");
                        }
                    }
                    $op_rhs = $tmp_bus->name . "[".$msb."]";
                    $ip_lhs = $connection->lhs."[".$msb."]";
                }
                # Connect requested bit of the tmp bus with the output port
                $logger->debug("Original: Adding assignment \"" . $op->name . " = " . $op_rhs . "\"");
                generate_contassign($net->module, $op->name, $op_rhs);

                $logger->debug("Modified: Adding assignment \"" . $ip_lhs . " =  " . $ip->name . "\"");
                $connection->rhs($ip->name);
                $connection->lhs($ip_lhs);
            }
        } else {
            $logger->debug("Driver instance is neither pin, port nor contassign?");
631
        }
632

Christian Fibich's avatar
Christian Fibich committed
633
        # create interconnections for newly created port/pin
Christian Fibich's avatar
Christian Fibich committed
634
        # @TODO needed here or OK linking once after loop?
Christian Fibich's avatar
Christian Fibich committed
635
        # $net->module->link;
636
637
    }

638
    # exactly the same for the input
639
    # connecting newly created input to driven cells
Christian Fibich's avatar
Christian Fibich committed
640
641
    foreach my $connection (@{$connections{'driven'}}) {
        if (ref($connection) eq "Verilog::Netlist::Pin") {
642
            for my $netname (@{$connection->netnames}) {
643
644
645
646
647
                if ($netname->{'netname'} eq $net->name) {
                    # FIXME: we'll ignore all indexed nets for now but that certainly is not right... or is it?
                    if (!defined $netname->{lsb} && !defined $netname->{msb}) {
                        # $logger->debug("Modified: Connecting (input) pin \"" . $connection->cell->name . HIERSEP . $connection->name . "\" to generated input \"" . $ip->name . "\"");
                        # $netname->{'netname'} = $ip->net->name;
Christian Fibich's avatar
Christian Fibich committed
648

649
650
651
652
653
654
                        #$connection->net(undef);     # resolved by link
                        $connection->port(undef);    # resolved by link

                    # } else {
                     # $netname->{lsb} eq $lsb) &&
                     # $netname->{msb} eq $msb)) {
655
                    # there will never be an indexed newly created port (only single-bit FIUs)
656
657
658
                    # $netname->{lsb} = undef;
                    # $netname->{msb} = undef;
                    }
659
                }
660
            }
Christian Fibich's avatar
Christian Fibich committed
661
        } elsif (ref($connection) eq "Verilog::Netlist::Port") {
662
                # @FIXME work to be done for Buses
663
            $logger->debug("Modified: Connecting (output) port \"" . $connection->module->name . HIERSEP . $connection->name . "\" to generated input \"" . $ip->name . "\"");
664
665
            $net->module->new_contassign(
                keyword => "assign",
666
                lhs     => $connection->name.$idx,
667
668
669
670
                rhs     => $ip->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
671
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
672
673
674
675
            # @FIXME work to be done for Buses:
            # - if either the RHS or LHS is a bus containing one or more wires we instrumented, we might need to create a temp wire to preserve the old values like for drivers(?)
            # - for now we just print a warning for awareness
            $logger->warn("Setting RHS of \"" . $connection->lhs . " = " . $connection->rhs . "\" to \"$input_name\"");
676
            $connection->rhs($input_name);
677
678
        } else {
            $logger->debug("Driven instance is neither pin, port nor contassign?");
679
680
        }
    }
681
682

    # create interconnections for newly created ports/pins
Christian Fibich's avatar
Christian Fibich committed
683
    # @TODO OK linking once after loop?
Christian Fibich's avatar
Christian Fibich committed
684
    $net->module->link;
685

686
687
    # FIXME: clean up "loose" wires
    # If we instrument nets that are only wired through this module from and into others the need for the intermediate wire is removed by the introduction of our instrumentation pins
688
689
690
    return undef;
}

691
692
693
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
694
695
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
696
697
698
699
700
701
702
#
# @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
703
sub _validate_driver {
704
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
705
    my ($self, $net_path, $driver_path, $driver_type) = @_;
706

Christian Fibich's avatar
Christian Fibich committed
707
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
708
    my $connections       = {};
709
    $self->_get_net_connections_from_path($net_path, $connections);
710

711
712
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
713
714
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
715

716
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
717
718

    return undef;
719
720
721
722
723

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

726
727
728
729
730
731
732
733
734
## @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
735
    my ($connected, $net) = @_;
736

737
    print "Select driver for net " . $net->name . ": \n";
738
    my $di;
Christian Fibich's avatar
Christian Fibich committed
739
740
    for ($di = 0 ; $di < @{$connected} ; $di++) {
        printf("[%d] %s\n", $di, FIJI::Netlist->_connection_tostr(@{$connected}[$di]));
741
    }
Christian Fibich's avatar
Christian Fibich committed
742
    printf("[x] none of the above.\n", $di);
743
    my $sel;
744
    while (1) {
745
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
746
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
747
            last;
Christian Fibich's avatar
Christian Fibich committed
748
        } elsif ($sel =~ m/[xX]/) {
749
            my $msg = "No driver selected for net " . $net->name;
750
            return $msg;
751
752
        } else {
            print "Invalid driver.\n";
753
754
755
        }
    }
    return @{$connected}[$sel];
756
757
}

758
759
760
## @method private _connection_tostr ($connection,$conn_str_list_ref)
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
761
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
762
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
763
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
764
#
765
766
767
# @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
768
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
769
sub _connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
770
    my ($self, $connection, $conn_str_list_ref) = @_;
771
772
    my $path;
    my $type;
773
    my $str;
774

Christian Fibich's avatar
Christian Fibich committed
775
    if (ref($connection) eq "Verilog::Netlist::Pin") {
776
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
777
        $type = "PIN";
778
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
779
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
780
        $path = $connection->module->name . HIERSEP . $connection->name;
781
        $type = "PORT";
782
        $str = $type . ": " . $path
783
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
784
        $path = $connection->module->name . HIERSEP . $connection->rhs;
785
        $type = "ASSIGN";
786
        $str = $type . ": " . $connection->rhs;
787
    }
788
789
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
790
791
}

792
793
794
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
795
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
796
797
798
799
800
# 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}
#
801
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
802
sub get_connection_object {
803
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
804
    my ($self, $connection_path, $connection_type) = @_;
805
806

    my $rv;
807
    my $SEP = HIERSEP;
808

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

812
            $logger->debug("Looking for pin named \"$3\" in cell \"$2\" of module \"$1\"...");
813
814

            my $mod  = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
815
816
            my $cell = $mod->find_cell($2) if (defined $mod);
            my $pin  = $cell->find_pin($3) if (defined $cell);
817
818
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
819
    } elsif ($connection_type eq "PORT") {
820
        if ($connection_path =~ /^(.+)\Q$SEP\E(.+)$/) {
821

822
            $logger->debug("Looking for port named \"$2\" in module \"$1\"...");
823

824
            my $mod = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
825
            my $port = $mod->find_port($2) if (defined $mod);
826
827
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
828
    } elsif ($connection_type eq "ASSIGN") {
829
        if ($connection_path =~ /^(.+)\Q$SEP\E(.+)$/) {
830
            my $lhs = $2;
831

832
            $logger->debug("Looking for assignment to/from \"$2\" in module \"$1\"...");
833
            my $mod = $self->{'nl'}->find_module($1);
834

Christian Fibich's avatar
Christian Fibich committed
835
            if (defined $mod) {
836
                my $assign;
837
838
                for my $a (grep { $_->isa("Verilog::Netlist::ContAssign") } $mod->statements) {
                    if ($a->lhs eq $lhs || $a->rhs =~ /\Q$lhs\E/) {
839
                        $assign = $a;
840
                        $logger->debug(sprintf("Constant assignment: \"%s\" = \"%s\"", $a->lhs, $a->rhs));
841
842
843
                        last;
                    }
                }
844
                $rv = $assign;
845
846
847
            }
        }
    }
848
    $logger->warn("Could not find $connection_type \"$connection_path\"!") if !defined($rv);
849
    return $rv;
850
851
}

852

853
854
855
## @method private _get_net_connections ($net,$connection_hashref)
# @brief retrieves connections of a given net
#
856
857
858
# gets all pins, ports and assignments a net is connected to
# currently only works for single-bit signals and instantiations not using
# buses and concatenations
859
#
860
# @param net_path               hierarchical path string of the net to be examined
861
862
863
864
865
# @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
866
sub _get_net_connections_from_path {
867
    my $logger = get_logger("");
868
    my ($self, $net_path, $connection_hashref) = @_;
869
870
871
872
873
    my $splitnet = $self->splitnet($net_path);
    return $splitnet if (ref($splitnet) ne "HASH");
    my $net = $splitnet->{net};
    return $self->_get_net_connections($net,$connection_hashref);
}
874

875
876
877
878
879
880
881
882
883
884
885
886
887
## @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
# currently only works for single-bit signals and instantiations not using
# buses and concatenations
#
# @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
888
# @param bit                    one bit of the net to check for connections (optional, only useful for vectored nets)
889
890
# @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)
891
892
sub _get_net_connections {
    my $logger = get_logger("");
893
    my ($self, $net, $connection_hashref, $bit, $driver_path, $driver_type) = @_;
894
895
896
897
898
899
900
901
902
903
904
905
906
907

    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);
    }
908
909
910
911
912
913
    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();
914
915

    my $connections = $connection_hashref;
916
917
918
    my @drivers     = ();
    my @driven      = ();
    my @connected   = ();
919
920
921
    $connections->{'drivers'}   = \@drivers;
    $connections->{'driven'}    = \@driven;
    $connections->{'connected'} = \@connected;
922

Christian Fibich's avatar
Christian Fibich committed
923
924
    # @FIXME what to do with bussed nets
    # @FIXME what to do with instantiations like that (concatenated nets):
925
    # input [5:0] p_nbus_byte_controller_c_state ;
Christian Fibich's avatar
Christian Fibich committed
926
927
928
929
930
931
    #  ...
    # .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]
    #                      })
932
    #
Christian Fibich's avatar
Christian Fibich committed
933
    # @TODO: can Verilog::Language::split_bus help us here?
934

935
936
937
938
939
    if (!$net->isa("Verilog::Netlist::Net")) {
        my $msg = "$net is no Verilog::Netlist::Net";
        $logger->error($msg);
        return $msg;
    }
940
941

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

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