Netlist.pm 61.1 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
# @param net_descriptor  a hash containing the keys 'net' => Net Object, 'net_name' => Net name string, 'msb', 'lsb', 'mod' => The module containing the net
# @param function        the function out of FIJI::VHDL->FIJI_PORTTYPE_xxx
# @param port_name       how the port shall be named (will be prefixed with "fiji_")
# @param index           for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
374
375
376
#
# @returns undef
sub net_add_function {
377
    my $logger = get_logger("");
378
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
379

380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
    if (ref($net_descriptor) ne "HASH") {
        return $net_descriptor;
    }

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

    # We need to produce names for the i/o ports that route the signals
    # to the FIC. To allow to instrument multiple indices of a single
    # signal we need to make these names unique thus we even include the
    # indices if used.
    if (defined $msb && defined $lsb) {
        if ($msb ne $lsb) {
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
            return "The given net to instrument is a vector with multiple bits.\nThis is not supported.\nMaybe you want to instrument a single bit of said vector instead?";
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
        } else {
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
        }
    }


    $logger->debug("Adding function to \"" . $mod . "\", net \"" . $net_name . "\"");
410
411

    my $prefix = "fiji_";
412

413
    my $unique_name = _unique_name($mod,$prefix.$port_name);
414
415
416

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

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

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

Christian Fibich's avatar
Christian Fibich committed
424
    # connect the net to the newly created port
425
426
427
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
428
        rhs     => $net_name.$idx,
429
430
431
        module  => $op->module,
        netlist => $op->module->netlist
    );
432

433
434
435
    return undef;
}

436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
# 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
}

460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
# 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
    );
}

484
485
486
487
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
488
489
490
#   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
491
#
492
# @param net_path        the Verilog::Net to instrument
493
# @param fiu_idx         the FIU number this external access shall be connected to
494
495
# @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)
496
497
498
499
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
500

501
    my $logger = get_logger("");
502
    my ($self, $net_path, $fiu_idx, $driver_path, $driver_type) = @_;
503

504
    # split hierarchical net path
505
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
506
507

    if (ref($net_descriptor) ne "HASH") {
508
        return $net_descriptor;
509
510
511
    }

    my $net = $net_descriptor->{'net'};
512
    my $net_name = $net_descriptor->{'net_name'};
513
514
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
515
    my $mod = $net_descriptor->{'mod'};
516
517
518
    my $idx = '';
    my $idx_postfix = '';

519
520
521
522
523
524
    # 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) {
525
            # We dont support the instrumentation of vectors (only sinlge indices of busses).
526
            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?";
527
528
            # $idx         = "[".$msb.":".$lsb."]";
            # $idx_postfix = "_".$msb."_".$lsb."_";
529
        } else {
530
531
            $idx         = "[".$msb."]";
            $idx_postfix = "_".$msb."_";
532
533
534
        }
    }

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

537
538
539
540
541
    # 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);

542
543
544
545
    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);
546

547
    # generate unique name for output port, return with error message if that fails
548
    my $unique_output_name = _unique_name($mod, $output_name);
549
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
550

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

554
555
    # generate unique name for input port, return with error message if that fails
    my $unique_input_name = _unique_name($mod, $input_name);
556
    return "Could not generate unique name for prefix $input_name" if (!defined $unique_input_name);
557

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

Christian Fibich's avatar
Christian Fibich committed
561

562
563
564
    # Add an intermediate net to allow patching without rewriting connections everywhere
    #
    # We use the requested signal as sink/destination.
565
    # That way we only need to change the driver to drive our intermediate net.
566
    #
567
568
569
    # 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.
570

571
    # Choose intermediate net name
572
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
573
    my $net_tmp = $mod->find_net($net_name_tmp);
574
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
575

576
577
578
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
579
    my $driver_bit = $msb;
580
    my $driver;
581
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
582
        if (ref($connection) eq "Verilog::Netlist::Pin") {
583
584
            # If the driver is a pin of a (sub)cell, connect this pin to the intermediate net
            $logger->debug("Connecting (output) pin \"" . $connection->cell->name . HIERSEP . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
Stefan Tauner's avatar
Stefan Tauner committed
585
            for my $netname ($connection->netnames) {
586
                if ($netname->{'netname'} eq $net->name) {
587
                    $driver = $connection;
588
                    $netname->{'netname'} = $net_name_tmp; # FIXME: do we need to force a re-link (by deleting $connection->nets)?
589
                    # The intermediate net is a vector if the underlying net is a bus and we do not just select a single bit
590
                    # This is the case if
591
592
593
594
595
596
597
                    #   - the underlying net is a vector and the driver covers all indices (implicitly by having no msb/lsb set)
                    #   - the underlying net is a vector and the driver covers some indices (by having two different indices set)
                    # Also, if we instrument a second bit of a vector we need to make sure this instrumentation is handled as if the
                    # the driver itself is a vector.
                    if (defined($net->msb) && (!defined($netname->{'msb'}) || ($netname->{'msb'} != $netname->{'lsb'}))) {
                        $driver_is_vector = 1;
                    } elsif (defined($net_tmp) && defined($net_tmp->userdata("first_instrumented_bit")))  {
598
                        $driver_is_vector = 1;
599
600
601
602
                    } 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'});
603
                    }
604
                }
605
            }
606
607
608
            # $connection->port(undef);    # resolved by link
        } else {
            if (ref($connection) eq "Verilog::Netlist::Port") {
609
                $driver_is_port = 1;
610
                $driver = $connection;
611
612
613
614
                # 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);
                }
615
616
617
618
619
                # 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");
620
621
622
623
624
625
626
627
                my $data_type;
                # If instrumented net is a vector we will need an intermediate bus
                if (defined($net->msb)) {
                    $driver_is_vector = 1;
                    $data_type = "[".$net->msb.":".$net->lsb."]";
                    $connection->data_type($data_type);
                }
                $connection->net->data_type($data_type);
628
629
630
                # Unsetting the port<->net inter-references forces their automatic re-setting at link time
                $connection->net->port(undef);
                $connection->net(undef);
631
                # Eventually connect this port to the intermediate net by changing its name
632
                $logger->debug("Connecting (input) port \"" . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
633
                $connection->name($net_name_tmp); # NB: this will automatically change the cell's configuration on the next link() call.
634
635
            } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
                # If the driver is an assignment, replace the LHS with the intermediate net
636
637
638
639
640
641
642
643
                # 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 . "\"";
644
                    }
645
646
647
648
                    # FIXME: so this is actually a port...
                    $logger->fatal("Found port name in continuous assignment. This is not supported yet.");
                    return "BORKED";
                }
649
                $driver = $connection;
650
651
652
                if (defined($connection->userdata->{'fiji_driver_bit'})) {
                    $driver_is_vector = 1;
                    $driver_bit = $connection->userdata->{'fiji_driver_bit'};
653
                }
654
655
656
657
658
659
660
661

                if (!defined($net_tmp) || !defined($net_tmp->userdata("first_instrumented_bit"))) {
                    $logger->debug("Connecting to intermediate net \"" . $net_name_tmp . "\" the continuous assignment of \"" . $connection->rhs . "\"");
                    # need to remember what was originally connected to this assign
                    # to instrument two nets driven by one assign
                    $connection->userdata('former_assign' => {'lhs' => $connection->lhs, 'rhs' => $connection->rhs});
                    $connection->lhs($net_name_tmp);
                }
662

663
            } else {
664
                $logger->error("Driver instance is neither pin, port nor contassign?");
665
            }
666
667
        }
    }
668

669
670
671
672
673
674
675
    # 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
    #
676
677
678
679
680
    # However, if the net is already instrumented we need to jump through some hoops:
    # In that case we either have an error, or we need to instrument another bit of a bus.
    # The latter complicates things a bit...
    if (defined($net_tmp) && defined($net_tmp->userdata("first_instrumented_bit"))) {
        # FIXME: maybe we should try harder to find out the reason why _check_name_in_hierarchy failed
681
682
683
684
685
        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;
        }
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

        if (!defined($net_tmp->msb)) {
            # If we instrument the second bit of a net (as wittnessed by the missing msb field)
            # then we need to make sure the intermediate net is or becomes a vector
            my $prev_bit = $net_tmp->userdata("first_instrumented_bit");
            my $prev_driver = $net_tmp->userdata("first_driver");
            $logger->debug("    widening \"" . $net_tmp->name . " to [" . $net->msb . ":" . $net->lsb . "]");
            $net_tmp->msb($net->msb);
            $net_tmp->lsb($net->lsb);
            $net_tmp->data_type("[".$net->msb.":".$net->lsb."]");

            # Additionally the previous exporting of the original signal needs to be adepted
            foreach my $statement ($mod->statements) {
                if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E$/) {
                    $statement->rhs($net_name_tmp."[".$prev_bit."]");
                    $logger->debug("    reassigning \"" . $statement->lhs . " = " . $statement->rhs . "\" --> \"".$net_name_tmp."[".$prev_bit."]\"");
                }
            }

            # We also need to fix the previous assignment of the respective bit...
            if (ref($prev_driver) eq "Verilog::Netlist::Pin") {
                $logger->debug("    reassigning pin \"" . $prev_driver->name . "\": $net_name_tmp --> $net_name_tmp\[$prev_bit\]");
                for my $netname ($prev_driver->netnames) {
                    if ($netname->{'netname'} eq $net_name_tmp) {
                        $netname->{'msb'} = $prev_bit;
                        $netname->{'lsb'} = $prev_bit;
                        last;
                    }
                }
            } elsif (ref($prev_driver) eq "Verilog::Netlist::Port") {
                $logger->debug("    reassigning port \"" . $prev_driver->name . "\"");
                return "BORKED"; # not implemented yet
            } elsif (ref($prev_driver) eq "Verilog::Netlist::ContAssign") {
                $logger->debug("    reassigning ContAssign \"" . $prev_driver->lhs . " = " . $prev_driver->rhs . "\"");
                $prev_driver->rhs($net_name_tmp."[".$prev_bit."]");
            }

            # And add the default assignments of the (possibly yet) uninstrumented bits
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
            $logger->debug("    assigning \"" . $net_name."[".$low."-".$high."] = ...");
            for (my $i = $low ; $i <= $high ; $i++) {
                if ($i != $driver_bit && $i != $prev_bit) {
                    generate_contassign($mod, $net_name."[".$i."]", $net_name_tmp."[".$i."]");
                }
            }
        } else {
            # For all additional bits (starting with the third one)
            # the previous assignment of the respective bit needs to be undone
            foreach my $statement ($mod->statements) {
                if ($statement->rhs =~ /^[ \t]*~?[ \t]*\Q$net_name_tmp\E(\[(\Q$driver_bit\E)\])$/) {
                    $logger->debug("    unassigning \"" . $statement->lhs . " = " . $statement->rhs . "\"");
                    $statement->delete();
                }
739
740
741
            }
        }

742
        $logger->debug("    assigning to currently processed signal \"" . $net_name."[".$driver_bit."] = " . $ip->net->name . "\"");
743
        generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
744
        $driver_is_vector = 1;
745
746
    } else {
        # 2.) Generate intermediate (tmp) net for easier input and output routing
747
748
749
        # 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) {
750
            $logger->debug("Intermediate port named \"" . $net_name_tmp . (defined($net->msb) ? "[" . $net->msb .":". $net->lsb . "]" : "") . "\" to patch \"$net_name\" will be generated automatically later");
751
        } else {
752
753
754
755
756
757
758
759
760
761
762
763
764
            # 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\"");
            }
765
766
767
768
769
770
771
            $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 . "\"");
            }
772
773
774
775
776
777
778
779
780
781
        }

        # 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);
782
        } elsif (!$driver_is_vector) {
783
784
            # If the net is a vector but the driver was driving only one bit
            # then we need to drive the originally driven bit only
785
            generate_contassign($mod, $net_name."[".$driver_bit."]", $ip->net->name);
786
787
788
        } else {
            # For drivers of complete busses we need to connect all non-instrumented bits of the tmp net
            # additionally to preserve their unmodified values.
789
            # In case of concatenations the index might be different to the one given.
790
            my ($low, $high) = _extract_low_high($net->lsb, $net->msb);
791
            for (my $i = $low ; $i <= $high ; $i++) {
792
                if ($i == $driver_bit) {
793
794
795
796
797
798
799
800
801
                    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
802
803
    #     If the driver is not a vector a simple assignment is fine, else
    if (!$driver_is_vector) {
804
805
806
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp . "\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp);
    } else {
807
808
        $logger->debug("    assigning \"" . $op->net->name . " = " . $net_name_tmp ."[".$driver_bit."]\"");
        generate_contassign($mod, $op->net->name, $net_name_tmp."[".$driver_bit."]");
809
    }
810
    $mod->link;
811
812
813
814
815
816
    # Normally we set first_instrumented_bit way earlier but since we autogenerate
    # the port we don't have the respective net available before linking thus...
    if ($driver_is_vector && $driver_is_port && !defined($net_tmp)) {
        my $port_net = $mod->find_net($net_name_tmp);
        $port_net->userdata("first_instrumented_bit", $driver_bit);
    }
817
818
819
    return undef;
}

820
821
822
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
823
824
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
825
826
827
828
829
830
831
#
# @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
832
sub _validate_driver {
833
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
834
    my ($self, $net_path, $driver_path, $driver_type) = @_;
835

Christian Fibich's avatar
Christian Fibich committed
836
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
837
    my $connections       = {};
838
    $self->_get_net_connections_from_path($net_path, $connections);
839

840
841
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
842
843
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
844

845
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
846
847

    return undef;
848
849
850
851
852

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

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

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

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

Christian Fibich's avatar
Christian Fibich committed
904
    if (ref($connection) eq "Verilog::Netlist::Pin") {
905
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
906
        $type = "PIN";
907
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
908
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
909
        $path = $connection->module->name . HIERSEP . $connection->name;
910
        $type = "PORT";
911
        $str = $type . ": " . $path
912
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
913
        $path = $connection->module->name . HIERSEP . $connection->lhs . EQUALSEP . $connection->rhs;
914
        $type = "ASSIGN";
915
        $str = $type . ": " . $connection->lhs . EQUALSEP . $connection->rhs;
916
    }
917
918
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
919
920
}

921
922
923
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
924
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
925
926
927
928
929
# 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}
#
930
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
931
sub get_connection_object {
932
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
933
    my ($self, $connection_path, $connection_type) = @_;
934
935

    my $rv;
936
    my $SEP = HIERSEP;
937

938
939
    my @path_elements = _split_path($connection_path);

Christian Fibich's avatar
Christian Fibich committed
940
    if ($connection_type eq "PIN") {
941
942
943
        if (@path_elements == 3) {

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

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

947
948
949
            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);
950
951
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
952
    } elsif ($connection_type eq "PORT") {
953
        if (@path_elements == 2) {
954

955
            my ($module_name, $port_name) = @path_elements;