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
34
package FIJI::Netlist;

use strict;
use warnings;

35
use List::Util qw[min max];
36
use Log::Log4perl qw(get_logger :easy);
37
use File::Basename qw(basename);
38

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

use FIJI::VHDL;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

224
    }
225

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

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

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

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

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

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

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

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

280
    return undef;
281
282
}

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

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

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

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

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

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

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

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

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

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

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

356
357
358
    return $np;
}

359
360
361
## @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
362
363
364
365
366
367
# 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
#
368
369
370
371
# @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)
372
373
374
#
# @returns undef
sub net_add_function {
375
    my $logger = get_logger("");
376
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
377

378
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
    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 . "\"");
408
409

    my $prefix = "fiji_";
410

411
    my $unique_name = _unique_name($mod,$prefix.$port_name);
412
413
414

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

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

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

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

431
432
433
    return undef;
}

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

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

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

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

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

    if (ref($net_descriptor) ne "HASH") {
506
        return $net_descriptor;
507
508
509
    }

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

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

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

535
536
537
538
539
    # 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);

540
541
542
543
    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);
544

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

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

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

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

Christian Fibich's avatar
Christian Fibich committed
559

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

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

574
575
576
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
577
    my $driver_bit = $msb;
578
    my $driver;
579
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
580
        if (ref($connection) eq "Verilog::Netlist::Pin") {
581
582
            # 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
583
            for my $netname ($connection->netnames) {
584
                if ($netname->{'netname'} eq $net->name) {
585
                    $driver = $connection;
586
                    $netname->{'netname'} = $net_name_tmp; # FIXME: do we need to force a re-link (by deleting $connection->nets)?
587
                    # The intermediate net is a vector if the underlying net is a bus and we do not just select a single bit
588
                    # This is the case if
589
590
591
592
593
594
595
                    #   - 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")))  {
596
                        $driver_is_vector = 1;
597
598
599
600
                    } 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'});
601
                    }
602
                }
603
            }
604
            # $connection->port(undef);    # resolved by link
Stefan Tauner's avatar
Stefan Tauner committed
605
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
631
632
633
634
635
636
637
638
639
640
641
642
        } elsif (ref($connection) eq "Verilog::Netlist::Port") {
            $driver_is_port = 1;
            $driver = $connection;
            # If we are changing the name of a port of the top module we need to inform the VHDL generator
            if ($mod->is_top) {
                    $connection->userdata(FIJI::VHDL->FIJI_USERDATA_PREV_PORTNAME, $connection->name);
            }
            # Change type of existing non-instrumented input to wire -
            # practically transforming it to an ordinary wire that can easily be intrumented.
            $logger->debug("Transforming previous port named \"". $connection->name . "\" into an ordinary wire");
            $connection->net->decl_type(undef);
            $connection->net->net_type("wire");
            my $data_type;
            # If instrumented net is a vector we will need an intermediate bus
            if (defined($net->msb)) {
                $driver_is_vector = 1;
                $data_type = "[".$net->msb.":".$net->lsb."]";
                $connection->data_type($data_type);
            }
            $connection->net->data_type($data_type);
            # Unsetting the port<->net inter-references forces their automatic re-setting at link time
            $connection->net->port(undef);
            $connection->net(undef);
            # Eventually connect this port to the intermediate net by changing its name
            $logger->debug("Connecting (input) port \"" . $connection->name . "\" to intermediate net \"$net_name_tmp\"");
            $connection->name($net_name_tmp); # NB: this will automatically change the cell's configuration on the next link() call.
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
            # If the driver is an assignment, replace the LHS with the intermediate net
            # Retrieve net object of LHS of the assignment to determine if it is a bus and if the assignment is to the complete net or a single bit.
            my $lhs_elems = $self->_extract_netstring_elements($connection->lhs);
            my $lhs_net_name = $lhs_elems->{'net_name'};
            my $lhs_net_msb = $lhs_elems->{'msb'};
            my $lhs_net_lsb = $lhs_elems->{'lsb'};
            my $lhs_net = $mod->find_net($lhs_net_name);
            if (!defined($lhs_net)) {
                my $lhs_port = $mod->find_port($lhs_net_name);
                if (!defined($lhs_port)) {
                    return "Could not find net or port in module \"" . $mod->name . "\" matching LHS of assignment \"" . $connection->lhs . "\" = \"" . $connection->rhs . "\"";
643
                }
Stefan Tauner's avatar
Stefan Tauner committed
644
645
646
647
648
649
650
651
652
653
                # FIXME: so this is actually a port...
                my $msg = "Found port name in continuous assignment. This is not supported yet.";
                $logger->fatal($msg);
                return $msg;
            }
            $driver = $connection;
            if (defined($connection->userdata->{'fiji_driver_bit'})) {
                $driver_is_vector = 1;
                $driver_bit = $connection->userdata->{'fiji_driver_bit'};
            }
654

Stefan Tauner's avatar
Stefan Tauner committed
655
656
657
658
659
660
            my $indices = ($driver_is_vector && defined($lhs_net_msb)) ? "[$lhs_net_msb:$lhs_net_lsb]" : "";
            $logger->debug("Connecting to intermediate net \"$net_name_tmp$indices\" the continuous assignment of \"" . $connection->rhs . "\"");
            # need to remember what was originally connected to this assign
            # to instrument two nets driven by one assign
            $connection->userdata('former_assign' => {'lhs' => $connection->lhs, 'rhs' => $connection->rhs});
            $connection->lhs($net_name_tmp.$indices);
661

Stefan Tauner's avatar
Stefan Tauner committed
662
663
        } else {
            $logger->error("Driver instance is neither pin, port nor contassign?");
664
665
        }
    }
666

667
668
669
670
671
672
673
    # 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
    #
674
675
676
677
678
    # 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
679
680
681
682
683
        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;
        }
684
685
686
687
688
689
690
691
692
693
694

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

695
            # Additionally the previous exporting of the original signal needs to be adapted
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
            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") {
714
715
716
                my $msg = "Allegedly we have instrumented another bit of port \"" . $prev_driver->name . "\" previously without creating a temporary vector. If true, this would be a bug.";
                $logger->fatal($msg);
                return $msg;
717
            } elsif (ref($prev_driver) eq "Verilog::Netlist::ContAssign") {
718
719
                $logger->debug("    reassigning ContAssign \"" . $prev_driver->lhs . " --> \"".$net_name_tmp."[".$prev_bit."]\" = ". $prev_driver->rhs . "\" ");
                $prev_driver->lhs($net_name_tmp."[".$prev_bit."]");
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
            }

            # 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();
                }
738
739
740
            }
        }

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

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

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

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

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

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

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

    return undef;
847
848
849
850
851

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

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

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

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

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

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

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

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

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

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

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

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

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

956
957
958
959
            $logger->trace("Looking for port named \"$port_name\" in module \"$module_name\"...");

            my $mod = $self->{'nl'}->find_module($module_name);
            my $port = $mod->find_port($port_name) if (defined $mod);
960
961
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
962
    } elsif ($connection_type eq "ASSIGN") {
963
964
965
        if (@path_elements >= 2) {
            my $module_name = $path_elements[0];
            my $assign_string = substr $connection_path, length($module_name)+1;
966

967
968
            $logger->trace("Looking for assignment $assign_string in module \"$module_name\"...");