Netlist.pm 31.5 KB
Newer Older
1
2
#** @file Netlist.pm
# @verbatim
Christian Fibich's avatar
Christian Fibich committed
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#-------------------------------------------------------------------------------
#  University of Applied Sciences Technikum Wien
#
#  Department of Embedded Systems
#  http://embsys.technikum-wien.at
#
#  Josef Ressel Center for Verification of Embedded Computing Systems
#  http://vecs.technikum-wien.at
#
#-------------------------------------------------------------------------------
#  File:              Netlist.pm
#  Created on:        29.04.2015
#  $LastChangedBy$
#  $LastChangedDate$
#
#  Description:
#
20
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
Christian Fibich's avatar
Christian Fibich committed
21
#-------------------------------------------------------------------------------
22
23
# @endverbatim
#*
Christian Fibich's avatar
Christian Fibich committed
24

Christian Fibich's avatar
Christian Fibich committed
25
26
27
28
29
## @file Netlist.pm
# @brief Contains class \ref FIJI::Netlist

## @class FIJI::Netlist
# @brief Functions to instrument & export a Verilog::Netlist
30
31
32
33
34
35
36
package FIJI::Netlist;

use strict;
use warnings;

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

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

use FIJI::VHDL;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

172
173
174
175
176
177
178
179
180
#** @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 {

181
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
182
    my ($self, $nets_ref, $mod, $hier) = @_;
183

184
    my $thishier = $hier;
Christian Fibich's avatar
Christian Fibich committed
185
    $thishier .= HIERSEP if $thishier ne "";
186
    $thishier .= $mod->name;
187

Christian Fibich's avatar
Christian Fibich committed
188
    foreach my $n ($mod->nets) {
Christian Fibich's avatar
Christian Fibich committed
189
        if (defined $n->msb && $n->lsb) {
190
191
192
193
194
195
196
197
            my $low = $n->lsb;
            my $high = $n->msb;
            # msb might be lower than lsb if index range is "upto"
            if ($n->msb < $n->lsb) {
                $low = $n->msb;
                $high = $n->lsb;
            }
            for (my $sub = $low ; $sub <= $high ; $sub++) {
Christian Fibich's avatar
Christian Fibich committed
198
                my $thisnet_ref = {name => $n->name . "[$sub]", path => $thishier, net => $n, index => $sub};
199
200
201
202
203
204
205
                push(@{$nets_ref}, $thisnet_ref);
            }
        } else {
            my $thisnet_ref = {name => $n->name, path => $thishier, net => $n};
            push(@{$nets_ref}, $thisnet_ref);
        }

206
    }
207

208
    foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
209
210
        if (defined($cell->submod)) {
            $self->_get_subnets($nets_ref, $cell->submod, $thishier);
211
        }
212
213
214
    }
}

215
216
217
## @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.
218
#
219
220
# @param startmod    the module to start with
# @param name        the name to check against
221
sub _check_name_in_hierarchy {
222

223
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
224
    my ($startmod, $name) = @_;
225
226
    my $nl = $startmod->netlist;

Christian Fibich's avatar
Christian Fibich committed
227
    $logger->debug("Checking " . $startmod->name . " for name $name");
228
229

    # check if a net is named the same
230
    for my $net ($startmod->nets) {
Christian Fibich's avatar
Christian Fibich committed
231
        if ($net->name eq $name) {
232
            my $msg = "Name $name does already exist as net in " . $startmod->name;
233
            return $msg;
234
235
236
237
        }
    }

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

245
    for my $cell ($startmod->cells) {
Christian Fibich's avatar
Christian Fibich committed
246
        if ($cell->name eq $name) {
247
            my $msg = "Name $name does already exist as cell in " . $startmod->name;
248
            return $msg;
249
250
251
252
        }
    }

    # find any module instantiating the current start module
253
254
    foreach my $mod ($nl->modules) {
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
255
256
            if (defined $cell->submod && $cell->submod == $startmod) {
                my $msg = _check_name_in_hierarchy($mod, $name);
257
                return $msg if defined $msg;
258
259
260
            }
        }
    }
261

262
    return undef;
263
264
}

265
266
## @function private _add_port_to_hierarchy ($startmod,$name,$function,$index,$indent)
# @brief adds a port to all modules starting from a leaf node
267
#
268
269
270
271
272
273
274
275
# @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
276
sub _add_port_to_hierarchy {
277

278
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
279
    my ($startmod, $name, $function, $index, $indent) = @_;
280
    my $nl        = $startmod->netlist;
281
    my $direction = "undef";
Christian Fibich's avatar
Christian Fibich committed
282
    if (!defined $indent) {
283
284
285
286
287
        $indent = "";
    } else {
        $indent .= "  ";
    }

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

Christian Fibich's avatar
Christian Fibich committed
290
    $logger->debug($indent . "Adding port $name to module " . $startmod->name);
291
292

    # decide direction
293
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
294
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT)
295
    {
296
        $direction = "in";
297
    } else {
298
299
300
301
        $direction = "out";
    }

    # generate port
Christian Fibich's avatar
Christian Fibich committed
302
    my $np = $startmod->new_port(name => $name, direction => $direction);
303
304

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

    # set indices
308
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
Christian Fibich's avatar
Christian Fibich committed
309
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL)
310
    {
Christian Fibich's avatar
Christian Fibich committed
311
312
313
        $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);
314
315
    }

Christian Fibich's avatar
Christian Fibich committed
316
317
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
318
319

    # find all modules instantiating the current module
Christian Fibich's avatar
Christian Fibich committed
320
    foreach my $mod ($nl->modules_sorted) {
321
        foreach my $cell ($mod->cells) {
Christian Fibich's avatar
Christian Fibich committed
322
323
324
            if (defined $cell->submod && $cell->submod == $startmod) {
                $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);
325
326
327
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
328
                    netnames => [{'netname' => $np->net->name}],
329
330
                );

Christian Fibich's avatar
Christian Fibich committed
331
                # let verilog-perl find the net and port.
Christian Fibich's avatar
Christian Fibich committed
332
                # @FIXME sufficient to link "mod" here?
Christian Fibich's avatar
Christian Fibich committed
333
                $mod->link;
Christian Fibich's avatar
Christian Fibich committed
334
                _add_port_to_hierarchy($mod, $name, $function, $index, $indent);
335
336
337
            }
        }
    }
338

339
340
341
    return $np;
}

342
343
344
## @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
345
346
347
348
349
350
# 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
#
351
352
353
354
355
356
357
# @param net         the Verilog::Net object to be used
# @param function    the function out of FIJI::VHDL->FIJI_PORTTYPE_xxx
# @param port_name   how the port shall be named (will be prefixed with "fiji_")
# @param index       for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
#
# @returns undef
sub net_add_function {
358
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
359
    my ($self, $net, $function, $port_name, $index) = @_;
360

Christian Fibich's avatar
Christian Fibich committed
361
    $logger->debug("Adding function to " . $net->module->name . ", net " . $net->name);
362
363

    my $prefix = "fiji_";
364
    while (1) {
Christian Fibich's avatar
Christian Fibich committed
365
366
        my $msg = _check_name_in_hierarchy($net->module, $prefix . $port_name);
        if (!defined $msg) {
367
            $port_name = $prefix . $port_name;
368
369
            last;
        } else {
Christian Fibich's avatar
Christian Fibich committed
370
            $prefix = sprintf("fiji_%4x_", rand(0xffff));
371
372
373
        }
    }

Christian Fibich's avatar
Christian Fibich committed
374
375
    $logger->debug($port_name . " can be used as fiji connector");
    my $op = _add_port_to_hierarchy($net->module, $port_name, $function, $index);
376

Christian Fibich's avatar
Christian Fibich committed
377
    $logger->debug("Connecting Port " . $op->name . " to net " . $net->name);
378

Christian Fibich's avatar
Christian Fibich committed
379
    # connect the net to the newly created port
380
381
382
383
384
385
386
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
        rhs     => $net->name,
        module  => $op->module,
        netlist => $op->module->netlist
    );
387

388
389
390
    return undef;
}

391
392
393
394
## @method public instrument_net($net,$fiu_idx, $driver, $driver_type)
# @brief instruments a single net for fault injection
#
# This method performs the following steps
Christian Fibich's avatar
Christian Fibich committed
395
396
397
398
#   1. tries to determine the driver, or otherwise prompts the user to select it
#   2. generate external access output and input ports
#   3. interconnects these ports to the matching driver and driven cells
#
399
400
401
402
403
404
405
406
# @param net             the Verilog::Net to instrument
# @param fiu_idx         the FIU number this external access shall be connected to
# @param driver          the driver of this net (optional)
# @param driver_type     the type of the driver (can be PIN, PORT, ASSIGN)
#
# @returns STRING          if an error occurred
# @returns undef           if successful
sub instrument_net {
407

408
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
409
    my ($self, $net, $fiu_idx, $driver, $driver_type) = @_;
410
    my $msg;
411

Christian Fibich's avatar
Christian Fibich committed
412
    $logger->info("Instrumenting " . $net->module->name . ", net " . $net->name);
413

414
    # VHDL signals must not contain multiple subsequent underscores
Christian Fibich's avatar
Christian Fibich committed
415
416
    my $output_name = ((FIJI_PORT_PREFIX . $net->name . FIJI_PORT_OUT_POSTFIX) =~ s/__+/_/gr);
    my $input_name  = ((FIJI_PORT_PREFIX . $net->name . FIJI_PORT_IN_POSTFIX) =~ s/__+/_/gr);
417

Christian Fibich's avatar
Christian Fibich committed
418
    $msg = _check_name_in_hierarchy($net->module, $output_name);
419
    return $msg if defined $msg;
420

421
    $logger->debug($output_name . " will be used as fiji connector (output)");
Christian Fibich's avatar
Christian Fibich committed
422
    my $op = _add_port_to_hierarchy($net->module, $output_name, FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL, $fiu_idx);
423

Christian Fibich's avatar
Christian Fibich committed
424
    $msg = _check_name_in_hierarchy($net->module, $input_name);
425
    return $msg if defined $msg;
426

427
    $logger->debug($input_name . " will be used as fiji connector (input)");
Christian Fibich's avatar
Christian Fibich committed
428
    my $ip = _add_port_to_hierarchy($net->module, $input_name, FIJI::VHDL->FIJI_PORTTYPE_MODIFIED, $fiu_idx);
429

430
431
432
    my %connections;
    $self->_get_net_connections($net, \%connections);

433
    # connecting newly created output to driver
Christian Fibich's avatar
Christian Fibich committed
434
    foreach my $connection (@{$connections{'drivers'}}) {
435
        my $log = "Original: Connecting ";
Christian Fibich's avatar
Christian Fibich committed
436
        if (ref($connection) eq "Verilog::Netlist::Pin") {
437

438
            # if it is a pin of a cell, connect this pin to the newly created net
Christian Fibich's avatar
Christian Fibich committed
439
            $log .= "(output) pin " . $connection->cell->name . HIERSEP . $connection->name;
440
            for my $netname (@{$connection->netnames}) {
Christian Fibich's avatar
Christian Fibich committed
441
442

                # @FIXME work to be done for Buses
443
444
                $netname->{'netname'} = $op->net->name if $netname->{'netname'} eq $net->name;
            }
Christian Fibich's avatar
Christian Fibich committed
445
446
            $connection->portname($op->name);

447
            #$connection->net(undef);     # resolved by link
448
            $connection->port(undef);    # resolved by link
449

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

452
            # if it is a port of a module, connect this port to the newly created net
453
            $log .= "(input)  port " . $connection->name;
Christian Fibich's avatar
Christian Fibich committed
454
            $connection->net($op->net);
455
456
457
458
459
460
461
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $op->name,
                rhs     => $connection->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
462
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
463
            $log .= "assignment " . $connection->lhs;
Christian Fibich's avatar
Christian Fibich committed
464
            $connection->rhs($connection->rhs =~ s/^\Q$net->name\E$/oip->net->name/r);
465
        }
466
        $log .= " to generated output " . $op->name;
467
        $logger->debug($log);
468

Christian Fibich's avatar
Christian Fibich committed
469
        # create interconnections for newly created port/pin
Christian Fibich's avatar
Christian Fibich committed
470
        # @TODO needed here or OK linking once after loop?
Christian Fibich's avatar
Christian Fibich committed
471
        # $net->module->link;
472
473
    }

474
    # exactly the same for the input
475
    # connecting newly created input to driven cells
Christian Fibich's avatar
Christian Fibich committed
476
    foreach my $connection (@{$connections{'driven'}}) {
477
        my $log = "Modified: Connecting ";
Christian Fibich's avatar
Christian Fibich committed
478
479
        if (ref($connection) eq "Verilog::Netlist::Pin") {
            $log .= "(input)  pin " . $connection->cell->name . HIERSEP . $connection->name;
480
            for my $netname (@{$connection->netnames}) {
Christian Fibich's avatar
Christian Fibich committed
481
482

                # @FIXME work to be done for Buses
483
484
                $netname->{'netname'} = $ip->net->name if $netname->{'netname'} eq $net->name;
            }
Christian Fibich's avatar
Christian Fibich committed
485
486
            $connection->portname($ip->name);

487
            #$connection->net(undef);     # resolved by link
488
            $connection->port(undef);    # resolved by link
Christian Fibich's avatar
Christian Fibich committed
489
490
        } elsif (ref($connection) eq "Verilog::Netlist::Port") {
            $log .= "(output) port " . $connection->module->name . HIERSEP . $connection->name;
491
492
493
494
495
496
497
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $connection->name,
                rhs     => $ip->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
498
        } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
499
            $log .= "assignment " . $connection->rhs;
Christian Fibich's avatar
Christian Fibich committed
500
            $connection->lhs($connection->lhs =~ s/\Q$net->name\E)?$/$ip->net->name/r);
501
        }
502
        $log .= " to generated input " . $ip->name;
503
        $logger->debug($log);
504

Christian Fibich's avatar
Christian Fibich committed
505
        # create interconnections for newly created port/pin
Christian Fibich's avatar
Christian Fibich committed
506
        # @TODO needed here or OK linking once after loop?
Christian Fibich's avatar
Christian Fibich committed
507
        # $net->module->link;
508
    }
509
510

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

514
515
516
    return undef;
}

517
518
519
## @method public validate_driver($net_path, $driver_path, $driver_type)
# @brief Check if the given driver is valid for the given net
#
520
521
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
522
523
524
525
526
527
528
#
# @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
529
sub _validate_driver {
530
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
531
    my ($self, $net_path, $driver_path, $driver_type) = @_;
532

Christian Fibich's avatar
Christian Fibich committed
533
    my $connection_object = $self->get_connection_object($driver_path, $driver_type);
534
    my $connections       = {};
535
    $self->_get_net_connections($net_path, $connections);
536

Christian Fibich's avatar
Christian Fibich committed
537
538
    my @in_drivers     = grep { $_ == $connection_object } @{$connections->{'drivers'}};
    my @in_connections = grep { $_ == $connection_object } @{$connections->{'connected'}};
539

Christian Fibich's avatar
Christian Fibich committed
540
    if (@in_drivers == 0 && @in_connections == 0) {
541
542
543
544
545
546
547
548
        my $msg = "No possible driver found";
        $logger->error($msg);
        return $msg;
    }

    return undef;
}

549
550
551
552
553
554
555
556
557
## @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
558
    my ($connected, $net) = @_;
559

560
    print "Select driver for net " . $net->name . ": \n";
561
    my $di;
Christian Fibich's avatar
Christian Fibich committed
562
563
    for ($di = 0 ; $di < @{$connected} ; $di++) {
        printf("[%d] %s\n", $di, FIJI::Netlist->_connection_tostr(@{$connected}[$di]));
564
    }
Christian Fibich's avatar
Christian Fibich committed
565
    printf("[x] none of the above.\n", $di);
566
    my $sel;
567
    while (1) {
568
        $sel = <STDIN>;
Christian Fibich's avatar
Christian Fibich committed
569
        if ($sel =~ m/[0-9]+/ && defined @{$connected}[$sel]) {
570
            last;
Christian Fibich's avatar
Christian Fibich committed
571
        } elsif ($sel =~ m/[xX]/) {
572
            my $msg = "No driver selected for net " . $net->name;
573
            return $msg;
574
575
        } else {
            print "Invalid driver.\n";
576
577
578
        }
    }
    return @{$connected}[$sel];
579
580
}

581
582
583
## @method private _connection_tostr ($connection,$conn_str_list_ref)
# @brief Stringifies a connection information
#
Christian Fibich's avatar
Christian Fibich committed
584
# The string is in the format \<TYPE\>: \<PATH|TO|Netname\>
585
# Where '|' can be any HIERSEP and TYPE is one of {PIN, PORT, ASSIGN}
586
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
587
#
588
589
590
# @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
591
# @returns STRING  in the format \<TYPE\>: \<PATH|TO|Netname\>
592
sub _connection_tostr {
Christian Fibich's avatar
Christian Fibich committed
593
    my ($self, $connection, $conn_str_list_ref) = @_;
594
595
    my $path;
    my $type;
596
    my $str;
597

Christian Fibich's avatar
Christian Fibich committed
598
    if (ref($connection) eq "Verilog::Netlist::Pin") {
599
        $path = $connection->cell->module->name . HIERSEP . $connection->cell->name . HIERSEP . $connection->name;
600
        $type = "PIN";
601
        $str = $type . ": " . $path
Christian Fibich's avatar
Christian Fibich committed
602
    } elsif (ref($connection) eq "Verilog::Netlist::Port") {
603
        $path = $connection->module->name . HIERSEP . $connection->name;
604
        $type = "PORT";
605
        $str = $type . ": " . $path
606
    } elsif (ref($connection) eq "Verilog::Netlist::ContAssign") {
607
        $path = $connection->rhs;
608
        $type = "ASSIGN";
609
        $str = $type . ": " . $connection->rhs;
610
    }
611
612
    push @{$conn_str_list_ref}, {path => $path, type => $type} if defined $conn_str_list_ref;
    return $str
613
614
}

615
616
617
## @method public get_connection_object ($connection_path,$connection_type)
# @brief Retrieves the connection object specified by path and type
#
618
# Retrieves a reference to the Verilog::Pin, Verilog::Port or Verilog::ContAssign
619
620
621
622
623
# 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}
#
624
# @returns the Verilog::Pin, Verilog::Port or Verilog::ContAssign Object specified by the parameters
625
sub get_connection_object {
626
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
627
    my ($self, $connection_path, $connection_type) = @_;
628
629
630

    my $rv;

Christian Fibich's avatar
Christian Fibich committed
631
632
    if ($connection_type eq "PIN") {
        if ($connection_path =~ /^(.+)\|(.+)\|(.+)$/) {
633

634
            $logger->debug("Looking for pin named $3 in cell $2 of module $1...");
635
636

            my $mod  = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
637
638
            my $cell = $mod->find_cell($2) if (defined $mod);
            my $pin  = $cell->find_pin($3) if (defined $cell);
639
640
            $rv = $pin;
        }
Christian Fibich's avatar
Christian Fibich committed
641
642
    } elsif ($connection_type eq "PORT") {
        if ($connection_path =~ /^(.+)\|(.+)$/) {
643

644
            $logger->debug("Looking for port named $2 in module $1...");
645

646
            my $mod = $self->{'nl'}->find_module($1);
Christian Fibich's avatar
Christian Fibich committed
647
            my $port = $mod->find_port($2) if (defined $mod);
648
649
            $rv = $port;
        }
Christian Fibich's avatar
Christian Fibich committed
650
651
    } elsif ($connection_type eq "ASSIGN") {
        if ($connection_path =~ /^(.+)\|(.+)$/) {
652
            my $lhs = $2;
653

654
            $logger->debug("Looking for assignment to $2 in module $1...");
655
            my $mod = $self->{'nl'}->find_module($1);
656

Christian Fibich's avatar
Christian Fibich committed
657
            if (defined $mod) {
658
                my $assign;
Christian Fibich's avatar
Christian Fibich committed
659
660
                for my $a (grep { ref($_) eq "Verilog::ContAssign" } $mod->statements) {
                    if ($a->lhs eq $lhs) {
661
                        $assign = $a;
662
                        $logger->debug("Constant assignment: $assign");
663
664
665
                        last;
                    }
                }
666
                $rv = $assign;
667
668
669
            }
        }
    }
670
    $logger->warn("Could not find $connection_type \"$connection_path\"!") if !defined($rv);
671
    return $rv;
672
673
}

674
675
676
## @method private _get_net_connections ($net,$connection_hashref)
# @brief retrieves connections of a given net
#
677
678
679
# gets all pins, ports and assignments a net is connected to
# currently only works for single-bit signals and instantiations not using
# buses and concatenations
680
#
681
682
683
684
685
686
687
# @param net                    the net to be examined
# @param connection_hashref     a hashref where the results can be placed
#                               connection_hashref->{'drivers'} contains a list of driver cells
#                               connection_hashref->{'driven'} contains a list of driven cells
#                               connection_hashref->{'connected'} contains a list cells connected to the
#                               net but driver/driven cannot be decided
sub _get_net_connections {
688
    my $logger = get_logger("");
689
    my ($self, $net_path, $connection_hashref) = @_;
690
691
692


    my $connections = $connection_hashref;
693
694
695
    my @drivers     = ();
    my @driven      = ();
    my @connected   = ();
696
697
698
    $connections->{'drivers'}   = \@drivers;
    $connections->{'driven'}    = \@driven;
    $connections->{'connected'} = \@connected;
699

Christian Fibich's avatar
Christian Fibich committed
700
701
    # @FIXME what to do with bussed nets
    # @FIXME what to do with instantiations like that (concatenated nets):
702
    # input [5:0] p_nbus_byte_controller_c_state ;
Christian Fibich's avatar
Christian Fibich committed
703
704
705
706
707
708
    #  ...
    # .p_nbus_byte_controller_c_state (
    #                     {byte_controller_c_state[5],byte_controller_c_state[3]
    #                      ,byte_controller_c_state[2],byte_controller_c_state[1]
    #                      ,byte_controller_c_state[4],byte_controller_c_state[0]
    #                      })
709
    #
Christian Fibich's avatar
Christian Fibich committed
710
    # @TODO: can Verilog::Language::split_bus help us here?
711

712
713
714
715
716
717
    $logger->debug("Net $net_path, connections:");

    my $splitnet = $self->splitnet($net_path);
    return $splitnet if (ref($splitnet) ne "HASH");
    my $net = $splitnet->{net};
    my $mod = $net->module;
Christian Fibich's avatar
Christian Fibich committed
718

719
    # find nets driven by continuous assignment (e.g., constant or inverter)
Christian Fibich's avatar
Christian Fibich committed
720
721
    foreach my $statement ($mod->statements) {
        if ($statement->lhs eq $net->name) {
722
            # continuous assign statement to this net, there can't be another driver
723
            # FIXME: use that knowledge to fail early (if another iteration matches too)?
Christian Fibich's avatar
Christian Fibich committed
724
            $logger->debug("    assign: " . $mod->name . ": " . $net->name . " = " . $statement->rhs);
725
            push @drivers, $statement;
Christian Fibich's avatar
Christian Fibich committed
726
        } elsif ($statement->rhs =~ /\Q$net->name\E$/) {
727
            push @driven, $statement;
728
        }
729
    }
730

731
    # find nets driven by this module's input ports
732
    foreach my $port ($mod->ports) {
Christian Fibich's avatar
Christian Fibich committed
733
734
        if (defined $port->net && ($port->net->name eq $net->name)) {
            $logger->debug("    port:   " . $mod->name . HIERSEP . $port->name);
735
736

            # driven from an input, there can't be another driver
Christian Fibich's avatar
Christian Fibich committed
737
            if ($port->direction eq "in") {
738
                push @drivers, $port;
Christian Fibich's avatar
Christian Fibich committed
739
            } elsif ($port->direction eq "out") {
740
                push @driven, $port;
Christian Fibich's avatar
Christian Fibich committed
741
            } elsif ($port->direction eq "inout") {
742
                push @connected, $port;
743
            }
Christian Fibich's avatar
Christian Fibich committed
744
        }
745
    }
746

747
748
749
750
    # find nets driven by other cells' output pins
    foreach my $cell ($mod->cells) {
        foreach my $pin ($cell->pins) {
            next if defined($pin->port) && $pin->port->direction eq 'in';
751
            foreach my $netname (@{$pin->netnames}) {
Christian Fibich's avatar
Christian Fibich committed
752
                if ($netname->{'netname'} eq $net->name) {
753
754
755
756
                    if (!_is_pinrange_in_net($splitnet->{msb}, $splitnet->{lsb}, $net)) {
                        $logger->warn("Out of range (of net ${net->name})\n");
                        next;
                    }
Christian Fibich's avatar
Christian Fibich committed
757
                    $logger->debug("    pin " . $pin->cell->name . HIERSEP . $netname->{'netname'});
758
                    push @connected, $pin;
759
                }
Christian Fibich's avatar
Christian Fibich committed
760
            }
761
        }
762
    }
763
    return undef;
764
765
}

766
767
## @method public export ($filename,$id)
# @brief Writes the current netlist to the specified file
768
#
769
770
771
# Writes the netlist to $filename.
# @param filename     the filename for the resulting Verilog file
# @param id           the FIJI id (included in a header comment if defined)
772
#
773
sub export {
774

775
    my $logger = get_logger("");
Christian Fibich's avatar
Christian Fibich committed
776
    my ($self, $filename, $id) = @_;
777

Christian Fibich's avatar
Christian Fibich committed
778
    open(my $fh_nl, ">", $filename);
779

Christian Fibich's avatar
Christian Fibich committed
780
    if (!defined $fh_nl) {
781
782
783
784
785
786
787
        my $msg = "Could not open $filename for writing: $!";
        return $msg;
    }

    print $fh_nl "//------------------------------------------------------------------------------\n";
    print $fh_nl "// FIJI instrumented netlist\n";
    print $fh_nl "//\n";
Christian Fibich's avatar
Christian Fibich committed
788
    print $fh_nl FIJI_LOGO;
789
790
791
    print $fh_nl "//\n";
    print $fh_nl "//------------------------------------------------------------------------------\n";
    print $fh_nl "// Generated " . localtime() . " by $0\n";
Christian Fibich's avatar
Christian Fibich committed
792
    print $fh_nl "// Netlist ID: 0x" . sprintf("%04x", $id) . "\n" if defined $id;
793
794
    print $fh_nl "//------------------------------------------------------------------------------\n\n";

795
    for my $mod ($self->{'nl'}->modules) {
Christian Fibich's avatar
Christian Fibich committed
796
        $logger->debug("Exporting module " . $mod->name);
797
        my $verilog_text = $mod->verilog_text;
798
799
800
801
802
803
        print $fh_nl $verilog_text;
    }

    close($fh_nl);
    return undef;
}
804

805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
sub _is_net_range_valid {
    my ($net) = @_;
    if (defined($net->lsb) && !defined($net->msb)) {
        return 0;
    }
    if (!defined($net->lsb) && defined($net->msb)) {
        return 0;
    }
    return 1;
}

## @method private _is_pin_in_range($pin_msb, $pin_lsb, $net)
# @brief Tests if pin range is contained in the range of a net
sub _is_pinrange_in_net {
    my ($pin_msb, $pin_lsb, $net) = @_;

    return 0 if !_is_net_range_valid($net);

    if (defined($pin_msb)) {
        return 0 if (!defined($net->msb));
         # MSB out of net range
        if ((($pin_msb < $net->lsb) && ($pin_msb < $net->msb)) || # completely below range
            (($pin_msb > $net->lsb) && ($pin_msb > $net->msb))) { # completely above range
            return 0;
        }
    } else {
        if (defined($net->msb)) {
            return 0;
        }
    }
    if (defined($pin_lsb)) {
        return 0 if (!defined($net->lsb));
         # LSB out of net range
        if ((($pin_lsb < $net->lsb) && ($pin_msb < $net->msb)) || # completely below range
            (($pin_lsb > $net->lsb) && ($pin_msb > $net->msb))) { # completely above range
            return 0;
        }
    } else {
        if (defined($net->lsb)) {
            return 0;
        }
    }
    return 1;
}

850
851
## @method public splitnet($netpath)
# @brief splits a hierarchical path of a net
852
853
854
# splits a hierarchical path of a net in the form of module1|module2|netname
# to the net object corresponding to "netname" in module "module2"
#
855
# @param netpath     the hierarchical PATH|TO|netname with '|' as separator
Christian Fibich's avatar
Christian Fibich committed
856
#
857
# @returns STRING      if an error occurred
858
# @returns HASHREF     with the keys 'mod', 'net', 'msb' and 'lsb', if successful.