Netlist.pm 61 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
#-------------------------------------------------------------------------------
#  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
#
#-------------------------------------------------------------------------------
#  Description:
#
15
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
Christian Fibich's avatar
Christian Fibich committed
16
#-------------------------------------------------------------------------------
17
18
# @endverbatim
#*
Christian Fibich's avatar
Christian Fibich committed
19

Christian Fibich's avatar
Christian Fibich committed
20
21
22
23
24
## @file Netlist.pm
# @brief Contains class \ref FIJI::Netlist

## @class FIJI::Netlist
# @brief Functions to instrument & export a Verilog::Netlist
25
26
27
28
29
package FIJI::Netlist;

use strict;
use warnings;

30
use List::Util qw[min max];
31
use Log::Log4perl qw(get_logger :easy);
32
use File::Basename qw(basename);
33

34
35
use Verilog::Netlist 99.415;
use Verilog::Language 99.415;
36
37
38
39
use Data::Dumper;

use FIJI::VHDL;

40
use constant HIERSEP               => "/";
41
42
use constant EQUALSEP              => "=";
use constant FIJI_NAMESPACE_PREFIX => "fiji_";
Christian Fibich's avatar
Christian Fibich committed
43
44
use constant FIJI_PORT_IN_POSTFIX  => "_inj_i";
use constant FIJI_PORT_OUT_POSTFIX => "_ori_o";
45
use constant MAX_UNIQUE_TRIES      => 10;
46

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

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

73
    my ($class) = @_;
Christian Fibich's avatar
Christian Fibich committed
74

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

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

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

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

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

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

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

113
    $self->{'filename'} = $filename;
114

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

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

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

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

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
165
166
167
    my $top      = $self->get_toplevel_module();
    if ($top->isa("Verilog::Netlist::Module")) {
        $self->_get_subnets($nets_ref, $top, $hier);
168
169
    }
    return $nets_ref;
170
171
}

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

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

196
    my $logger = get_logger("");
197
    my ($self, $nets_ref, $mod, $hier, $instname) = @_;
198

199
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
200
    $thishier .= HIERSEP if $thishier ne "";
201
202
203
204
205
    if (defined $instname) {
        $thishier .= $instname;
    } else {
        $thishier .= $mod->name;
    }
206

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

219
    }
220

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

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

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

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

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

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

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

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

275
    return undef;
276
277
}

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

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

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

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

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

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

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

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

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

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

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

351
352
353
    return $np;
}

354
355
356
## @method public net_add_function($net, $function, $port_name, $index)
# @brief Generate external access to a single net
#
Christian Fibich's avatar
Christian Fibich committed
357
358
359
360
361
362
# Performs the following steps:
#    1.  check if the default port name does not yet exist
#    1a. if it exists, generate a new net name
#    2.  add a port through the entire hierarchy
#    3.  assign the net to the port using a contassign statement
#
363
364
365
366
# @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)
367
368
369
#
# @returns undef
sub net_add_function {
370
    my $logger = get_logger("");
371
    my ($self, $net_descriptor, $function, $port_name, $index) = @_;
372

373
374
375
376
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
    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 . "\"");
403
404

    my $prefix = "fiji_";
405

406
    my $unique_name = _unique_name($mod,$prefix.$port_name);
407
408
409

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

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

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

Christian Fibich's avatar
Christian Fibich committed
417
    # connect the net to the newly created port
418
419
420
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
421
        rhs     => $net_name.$idx,
422
423
424
        module  => $op->module,
        netlist => $op->module->netlist
    );
425

426
427
428
    return undef;
}

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

453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
# 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
    );
}

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

494
    my $logger = get_logger("");
495
    my ($self, $net_path, $fiu_idx, $driver_path, $driver_type) = @_;
496

497
    # split hierarchical net path
498
    my $net_descriptor = $self->get_netdescriptor_from_path($net_path);
499
500

    if (ref($net_descriptor) ne "HASH") {
501
        return $net_descriptor;
502
503
504
    }

    my $net = $net_descriptor->{'net'};
505
    my $net_name = $net_descriptor->{'net_name'};
506
507
    my $msb = $net_descriptor->{'msb'};
    my $lsb = $net_descriptor->{'lsb'};
508
    my $mod = $net_descriptor->{'mod'};
509
510
511
    my $idx = '';
    my $idx_postfix = '';

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

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

530
531
532
533
534
    # 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);

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

540
    # generate unique name for output port, return with error message if that fails
541
    my $unique_output_name = _unique_name($mod, $output_name);
542
    return "Could not generate unique name for prefix $output_name" if (!defined $unique_output_name);
543

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

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

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

Christian Fibich's avatar
Christian Fibich committed
554

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

564
    # Choose intermediate net name
565
    my $net_name_tmp = _sanitize_identifier(FIJI_NAMESPACE_PREFIX . $net_name . "_in_tmp");
566
    my $net_tmp = $mod->find_net($net_name_tmp);
567
    my $name_check = _check_name_in_hierarchy($mod, $net_name_tmp);
568

569
570
571
    # Switch the driver from the original signal to the intermediate net.
    my $driver_is_vector = 0;
    my $driver_is_port = 0;
572
    my $driver_bit = $msb;
573
    my $driver;
574
    foreach my $connection (@{$connections{'drivers'}}) {
Christian Fibich's avatar
Christian Fibich committed
575
        if (ref($connection) eq "Verilog::Netlist::Pin") {
576
577
            # 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
578
            for my $netname ($connection->netnames) {
579
                if ($netname->{'netname'} eq $net->name) {
580
                    $driver = $connection;
581
                    $netname->{'netname'} = $net_name_tmp; # FIXME: do we need to force a re-link (by deleting $connection->nets)?
582
                    # The intermediate net is a vector if the underlying net is a bus and we do not just select a single bit
583
                    # This is the case if
584
585
586
587
588
589
590
                    #   - 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")))  {
591
                        $driver_is_vector = 1;
592
593
594
595
                    } 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'});
596
                    }
597
                }
598
            }
599
            # $connection->port(undef);    # resolved by link
Stefan Tauner's avatar
Stefan Tauner committed
600
601
602
603
604
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
        } 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 . "\"";
638
                }
Stefan Tauner's avatar
Stefan Tauner committed
639
640
641
642
643
644
645
646
647
648
                # 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'};
            }
649

Stefan Tauner's avatar
Stefan Tauner committed
650
651
652
653
654
655
            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);
656

Stefan Tauner's avatar
Stefan Tauner committed
657
658
        } else {
            $logger->error("Driver instance is neither pin, port nor contassign?");
659
660
        }
    }
661

662
663
664
665
666
667
668
    # 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
    #
669
670
671
672
673
    # 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
674
675
676
677
678
        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;
        }
679
680
681
682
683
684
685
686
687
688
689

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

690
            # Additionally the previous exporting of the original signal needs to be adapted
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
            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") {
709
710
711
                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;
712
            } elsif (ref($prev_driver) eq "Verilog::Netlist::ContAssign") {
713
714
                $logger->debug("    reassigning ContAssign \"" . $prev_driver->lhs . " --> \"".$net_name_tmp."[".$prev_bit."]\" = ". $prev_driver->rhs . "\" ");
                $prev_driver->lhs($net_name_tmp."[".$prev_bit."]");
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
            }

            # 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();
                }
733
734
735
            }
        }

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

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

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

Christian Fibich's avatar
Christian Fibich committed
830
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
831
    my $connections       = {};
832
    $self->_get_net_connections_from_path($net_path, $connections);
833

834
835
    goto FAIL if (!defined $connection_object);

Christian Fibich's avatar
Christian Fibich committed
836
837
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
838

839
    goto FAIL if (@in_drivers == 0 && @in_connections == 0);
840
841

    return undef;
842
843
844
845
846

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

849
850
851
852
853
854
855
856
857
## @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
858
    my ($connected, $net) = @_;
859

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

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

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

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

    my $rv;
930
    my $SEP = HIERSEP;
931

932
933
    my @path_elements = _split_path($connection_path);

Christian Fibich's avatar
Christian Fibich committed
934
    if ($connection_type eq "PIN") {
935
936
937
        if (@path_elements == 3) {

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

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

941
942
943
            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);
944
945
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
946
    } elsif ($connection_type eq "PORT") {
947
        if (@path_elements == 2) {
948

949
            my ($module_name, $port_name) = @path_elements;
950

951
952
953
954
            $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);
955
956
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
957
    } elsif ($connection_type eq "ASSIGN") {
958
959
960
        if (@path_elements >= 2) {
            my $module_name = $path_elements[0];
            my $assign_string = substr $connection_path, length($module_name)+1;
961

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