Netlist.pm 31 KB
Newer Older
Christian Fibich's avatar
Christian Fibich committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#-------------------------------------------------------------------------------
#  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:
#
18
#  FIJI Netlist class: Functions to instrument & export a Verilog::Netlist
Christian Fibich's avatar
Christian Fibich committed
19
20
#-------------------------------------------------------------------------------

21
22
23
24
25
26
27
28
29
30
31
32
33
## @file

## @class FIJI::Netlist
#
#
package FIJI::Netlist;

use strict;
use warnings;

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

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

use FIJI::VHDL;

39
my $HIERSEP               = "|";
40
41
42
my $FIJI_PORT_PREFIX      = "fiji_";
my $FIJI_PORT_IN_POSTFIX  = "_inj_i";
my $FIJI_PORT_OUT_POSTFIX = "_ori_o";
43

44
my $FIJI_LOGO = <<logo_end;
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
//  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
63

Christian Fibich's avatar
Christian Fibich committed
64
65
66
67
68
69
70
71
#FIXME Verilog-Perl "link"ing...
# Linking a module
#   ->links Ports, Cells, and Pins
#
# Linking a Port
#   if port has no net assigned, assign net with matching name or create a new
#   net. does not assign netname (needed for correct ->verilog_text output)

72
73
sub new ($) {
    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
}

sub read_file ($) {
89
    my $logger = get_logger("");
90
    my ( $self, $filename ) = @_;
91

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

95
96
97
98
    eval {
        $self->{'nl'}->read_file( filename => $filename );    # read Verilog file
        $self->{'nl'}->link();                                # Read in any sub-modules
    };
99

100
101
102
103
    if ( $self->{'nl'}->errors() != 0 || $@ ) {
        $logger->error( "Could not parse $filename!", $@ ? "\n" . $@ : "" );
        return 1;
    }
104

105
    $self->{'filename'} = $filename;
106

107
108
    $logger->info("Successfully read in netlist from file \"$filename\".");
    return 0;
109
110
}

111
sub get_toplevel_port_names ($) {
112
113
114
115
116
117
118
119
    my ($self) = @_;
    my $ports_ref = [];
    foreach my $mod ( $self->{'nl'}->top_modules_sorted ) {
        foreach my $port ( $mod->ports_sorted ) {
            push @{$ports_ref}, $port->name;
        }
    }
    return $ports_ref;
120
121
}

122
123
124
125
# returns an array of hashes for all nets containing:
# 'name' the name of the net
# 'path' the hierarchical path of the net
# 'net'  the Verilog::Netlist::Net reference to the net
126
#
127
sub get_nets ($) {
128
129
130
131
132
133
134
135
136
    my ($self) = @_;

    # my $nets_ref = {'metadata' => [], 'names' => [], 'nets' => []};
    my $nets_ref = [];
    my $hier     = "";
    foreach my $mod ( $self->{'nl'}->top_modules_sorted ) {
        $self->_get_subnets( $nets_ref, $mod, $hier );
    }
    return $nets_ref;
137
138
}

139
sub _get_subnets ($$) {
140
    my $logger = get_logger("");
141
    my ( $self, $nets_ref, $mod, $hier ) = @_;
142

143
144
145
    my $thishier = $hier;
    $thishier .= $HIERSEP if $thishier ne "";
    $thishier .= $mod->name;
146

147
148
149
150
    foreach my $n ( $mod->nets ) {
        my $thisnet_ref = { name => $n->name, path => $thishier, net => $n };
        push( @{$nets_ref}, $thisnet_ref );
    }
151

152
153
154
155
    foreach my $cell ( $mod->cells_sorted ) {
        if ( defined( $cell->submod ) ) {
            $self->_get_subnets( $nets_ref, $cell->submod, $thishier );
        }
156
157
158
    }
}

159
160
# checks if a givn name exists as port, net, or cell name in the instantiation
# tree.
161
#
162
163
164
165
166
# params:
#   startmod the module to start with
#   name the name to check against
#
sub _check_name_in_hierarchy {
167
    my $logger = get_logger("");
168
    my ( $startmod, $name ) = @_;
169
170
    my $nl = $startmod->netlist;

171
    $logger->debug( "Checking " . $startmod->name . " for name $name" );
172
173

    # check if a net is named the same
174
175
176
    for my $net ( $startmod->nets_sorted ) {
        if ( $net->name eq $name ) {
            my $msg = "Name $name does already exist as net in " . $startmod->name;
177
            return $msg;
178
179
180
181
        }
    }

    # check if a port is named the same
182
183
184
    for my $port ( $startmod->ports_sorted ) {
        if ( $port->name eq $name ) {
            my $msg = "Name $name does already exist as port in " . $startmod->name;
185
            return $msg;
186
187
188
        }
    }

189
190
191
    for my $cell ( $startmod->cells_sorted ) {
        if ( $cell->name eq $name ) {
            my $msg = "Name $name does already exist as cell in " . $startmod->name;
192
            return $msg;
193
194
195
196
        }
    }

    # find any module instantiating the current start module
197
198
199
200
201
    foreach my $mod ( $nl->modules_sorted ) {
        foreach my $cell ( $mod->cells_sorted ) {
            if ( defined $cell->submod && $cell->submod == $startmod ) {
                my $msg = _check_name_in_hierarchy( $mod, $name );
                return $msg if defined $msg;
202
203
204
            }
        }
    }
205

206
    return undef;
207
208
209
}

# adds a port to all modules starting from a leaf node
210
#
211
212
213
214
215
216
# params
#   startmod the module to start with
#   name the port name to be generated
#   function the function of this port in FIJI (FIJI::VHDL->FIJI_PORTTYPE_xxx)
#   index for ORIGINAL,MODIFIED and FAULT_DETECT: the index of this net
#   (indent just for formatting output)
Christian Fibich's avatar
Christian Fibich committed
217
sub _add_port_to_hierarchy {
218
    my $logger = get_logger("");
219
220
    my ( $startmod, $name, $function, $index, $indent ) = @_;
    my $nl        = $startmod->netlist;
221
    my $direction = "undef";
222
    if ( !defined $indent ) {
223
224
225
226
227
        $indent = "";
    } else {
        $indent .= "  ";
    }

228
229
230
    return if ( $startmod->find_port($name) );

    $logger->debug( $indent . "Adding port $name to module " . $startmod->name );
231
232

    # decide direction
233
234
235
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
        || $function == FIJI::VHDL->FIJI_PORTTYPE_RESET_TO_DUT )
    {
236
        $direction = "in";
237
    } else {
238
239
240
241
        $direction = "out";
    }

    # generate port
242
    my $np = $startmod->new_port( name => $name, direction => $direction );
243
244

    # set port type for wrapper generation
245
    $np->userdata( FIJI::VHDL->FIJI_USERDATA_PORTTYPE, $function );
246
247

    # set indices
248
249
250
251
252
253
    if (   $function == FIJI::VHDL->FIJI_PORTTYPE_MODIFIED
        || $function == FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL )
    {
        $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 );
254
255
    }

Christian Fibich's avatar
Christian Fibich committed
256
257
    # let Verilog-Perl create a new net for the new port.
    $startmod->link;
258
259

    # find all modules instantiating the current module
260
261
262
263
264
265
266
267
268
269
270
    foreach my $mod ( $nl->modules_sorted ) {
        foreach my $cell ( $mod->cells_sorted ) {
            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 );
                $cell->new_pin(
                    name     => $name,
                    portname => $np->name,
                    netname  => $np->net->name
                );

Christian Fibich's avatar
Christian Fibich committed
271
272
273
                # let verilog-perl find the net and port.
                # FIXME sufficient to link "mod" here?
                $mod->link;
274
                _add_port_to_hierarchy( $mod, $name, $function, $index, $indent );
275
276
277
            }
        }
    }
278

279
280
281
    return $np;
}

Christian Fibich's avatar
Christian Fibich committed
282
283
284
285
286
287
288
289
# Generate external access to a single net
# 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
#
# params:
290
#   net the Verilog::Net object to be used
Christian Fibich's avatar
Christian Fibich committed
291
292
293
#   function the function out of FIJI::VHDL->FIJI_PORTTYPE_xxx
#   port_name how the port shall be named (will be prefixed with "fiji_")
#   index for some FIJI_PORTTYPEs, an index is needed (FIU and Fault Detect)
294
sub net_add_function ($$$;$) {
295
    my $logger = get_logger("");
296
    my ( $self, $net, $function, $port_name, $index ) = @_;
297

298
    $logger->debug( "Adding function to " . $net->module->name . ", net " . $net->name );
299
300

    my $prefix = "fiji_";
301
302
303
304
    while (1) {
        my $msg = _check_name_in_hierarchy( $net->module, $prefix . $port_name );
        if ( !defined $msg ) {
            $port_name = $prefix . $port_name;
305
306
            last;
        } else {
307
            $prefix = sprintf( "fiji_%4x_", rand(0xffff) );
308
309
310
        }
    }

311
312
    $logger->debug( $port_name . " can be used as fiji connector" );
    my $op = _add_port_to_hierarchy( $net->module, $port_name, $function, $index );
313

314
    $logger->debug( "Connecting Port " . $op->name . " to net " . $net->name );
315

Christian Fibich's avatar
Christian Fibich committed
316
    # connect the net to the newly created port
317
318
319
320
321
322
323
    $net->module->new_contassign(
        keyword => "assign",
        lhs     => $op->name,
        rhs     => $net->name,
        module  => $op->module,
        netlist => $op->module->netlist
    );
324

325
326
327
    return undef;
}

Christian Fibich's avatar
Christian Fibich committed
328
329
330
331
332
# instruments a single net for fault injection
#   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
#
333
# params
Christian Fibich's avatar
Christian Fibich committed
334
#   net the Verilog::Net to instrument
335
#   fiu_idx the FIU number this external access shall be connected to
336
337
338
#   driver the driver of this net (optional)
#   driver_type the type of the driver (can be PIN, PORT, ASSIGN)
sub instrument_net ($$;$$) {
339

340
    #FIXME only works with single-bit pins/ports/nets
341
    my $logger = get_logger("");
342
    my ( $self, $net, $fiu_idx, $driver, $driver_type ) = @_;
343
    my $msg;
344

345
    $logger->info( "Instrumenting " . $net->module->name . ", net " . $net->name );
346

347
348
349
350
351
352
353
354
    # 1. Try to find a suitable driver.
    #   - Get all candidates from _get_net_connections()
    #     (this includes identified drivers as well as candidates)
    #   - If we can't identify any drivers then rely on the parameter, or
    #     if that is undefined we ask the user here (FIXME: this seems like a candidate for refactoring)
    #     To that end, modify the connections hash accordingly.
    #   - If a single driver is found then we make sure it matches the parameter (if available)
    #   - If no or mulitple drivers are found eventually we abort.
355
    my %connections;
356
    $self->_get_net_connections( $net, \%connections );
357
358
359

    # if _get_net_connections() could not determine a driver
    # the user must choose manually
360
361
362
363
    if ( !defined $driver && @{ $connections{'drivers'} } == 0 ) {
        $driver = _select_driver( $connections{'connected'}, $net );

        if ( ref($driver) eq "STRING" ) {
364
365
366
            return $driver;
        }
    }
367

368
369
    # if _get_net_connections() could not determine a driver
    #   take the one chosen by the user
370
371
372
373
    if ( @{ $connections{'drivers'} } == 0 ) {
        foreach my $connection ( @{ $connections{'connected'} } ) {
            if ( $connection == $driver ) {
                push @{ $connections{'drivers'} }, $connection;
374
            } else {
375
                push @{ $connections{'driven'} }, $connection;
376
377
            }
        }
378
379
380
381

        # if _get_net_connections() determined a driver
    } elsif ( @{ $connections{'drivers'} } == 1 ) {

382
        # and the user supplied a driver, check if they both match
383
384
        if ( defined $driver && @{ $connections{'drivers'} }[0] != $driver ) {
            $msg = "Driver mismatch on net " . $net->name;
385
            return $msg;
386
        }
387
        @{ $connections{'driven'} } = @{ $connections{'connected'} };
388
    } else {
389
        $msg = "Net " . $net->name . " has multiple drivers";
390
        return $msg;
391
392
    }

393
394
    if ( @{ $connections{'drivers'} } == 0 ) {
        $msg = "No driver for net " . $net->name;
395
        return $msg;
396
397
    }

398
    # VHDL signals must not contain multiple subsequent underscores
399
400
    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 );
401

402
    $msg = _check_name_in_hierarchy( $net->module, $output_name );
403
    return $msg if defined $msg;
404

405
406
407
408
    $logger->debug( $output_name . " can be used as fiji connector" );
    my $op = _add_port_to_hierarchy( $net->module, $output_name, FIJI::VHDL->FIJI_PORTTYPE_ORIGINAL, $fiu_idx );

    $msg = _check_name_in_hierarchy( $net->module, $input_name );
409
    return $msg if defined $msg;
410

411
412
    $logger->debug( $input_name . " can be used as fiji connector" );
    my $ip = _add_port_to_hierarchy( $net->module, $input_name, FIJI::VHDL->FIJI_PORTTYPE_MODIFIED, $fiu_idx );
413

414
    # connecting newly created output to driver
415
    foreach my $connection ( @{ $connections{'drivers'} } ) {
416
        my $log = "Original: Connecting ";
417
418
        if ( ref($connection) eq "Verilog::Netlist::Pin" ) {

419
            # if it is a pin of a cell, connect this pin to the newly created net
420
421
422
423
424
425
426
            $log .= "(output) pin " . $connection->cell->name . $HIERSEP . $connection->name;
            $connection->netname( $op->net->name );
            $connection->portname( $op->name );
            $connection->net(undef);     # resolved by link
            $connection->port(undef);    # resolved by link
        } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {

427
            # if it is a port of a module, connect this port to the newly created net
428
429
430
431
432
433
434
435
436
437
438
439
            $log .= "(input)  port " . $connection->name;
            $connection->net( $op->net );
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $op->name,
                rhs     => $connection->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
        } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
            $log .= "assignment " . $connection->lhs;
            $connection->rhs( $connection->rhs =~ s/^\Q$net->name\E$/oip->net->name/r );
440
        }
441
        $log .= " to generated output " . $op->name;
442
        $logger->debug($log);
443

Christian Fibich's avatar
Christian Fibich committed
444
445
446
        # create interconnections for newly created port/pin
        # FIXME needed here or OK linking once after loop?
        # $net->module->link;
447
448
    }

449
    # exactly the same for the input
450
    # connecting newly created input to driven cells
451
    foreach my $connection ( @{ $connections{'driven'} } ) {
452
        my $log = "Modified: Connecting ";
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
        if ( ref($connection) eq "Verilog::Netlist::Pin" ) {
            $log .= "(input)  pin " . $connection->cell->name . $HIERSEP . $connection->name;
            $connection->netname( $ip->net->name );
            $connection->portname( $ip->name );
            $connection->net(undef);     # resolved by link
            $connection->port(undef);    # resolved by link
        } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {
            $log .= "(output) port " . $connection->module->name . $HIERSEP . $connection->name;
            $net->module->new_contassign(
                keyword => "assign",
                lhs     => $connection->name,
                rhs     => $ip->name,
                module  => $net->module,
                netlist => $net->module->netlist
            );
        } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
            $log .= "assignment " . $connection->rhs;
            $connection->lhs( $connection->lhs =~ s/\Q$net->name\E)?$/$ip->net->name/r );
471
        }
472
        $log .= " to generated input " . $ip->name;
473
        $logger->debug($log);
474

Christian Fibich's avatar
Christian Fibich committed
475
476
477
        # create interconnections for newly created port/pin
        # FIXME needed here or OK linking once after loop?
        # $net->module->link;
478
    }
479
480

    # create interconnections for newly created ports/pins
Christian Fibich's avatar
Christian Fibich committed
481
482
    # FIXME OK linking once after loop?
    $net->module->link;
483

484
485
486
    return undef;
}

487
488
489
490
## @method validate_driver(net_path, driver_path, driver_type)
# Check if the driver specified by $driver_type and $driver_path
# is actually connected to the net specified by $net_path
sub _validate_driver {
491
    my $logger = get_logger("");
492
    my ( $self, $net_path, $driver_path, $driver_type ) = @_;
493

494
495
496
    my $connection_object = $self->get_connection_object( $driver_path, $driver_type );
    my $net_ref           = $self->splitnet($net_path);
    my $connections       = {};
497

498
499
    if ( ref($net_ref) eq "HASH" ) {
        $self->_get_net_connections( $net_ref->{'net'}, $connections );
500
501
502
503
    } else {
        return $net_ref;
    }

504
505
    my @in_drivers     = grep { $_ == $connection_object } @{ $connections->{'drivers'} };
    my @in_connections = grep { $_ == $connection_object } @{ $connections->{'connected'} };
506

507
    if ( @in_drivers == 0 && @in_connections == 0 ) {
508
509
510
511
512
513
514
515
        my $msg = "No possible driver found";
        $logger->error($msg);
        return $msg;
    }

    return undef;
}

516
517
518
519
# Prompt the user to select a driver for a net from a set of given cells/outputs
# Params:
#   connected list reference containing connected Verilog::Perl instances
#   net the Verilog::Perl::Net instance to select the driver for
520
sub _select_driver($$) {
521
    my ( $connected, $net ) = @_;
522

523
    print "Select driver for net " . $net->name . ": \n";
524
    my $di;
525
526
    for ( $di = 0 ; $di < @{$connected} ; $di++ ) {
        printf( "[%d] %s\n", $di, FIJI::Netlist->_connection_tostr( @{$connected}[$di] ) );
527
    }
528
    printf( "[x] none of the above.\n", $di );
529
    my $sel;
530
    while (1) {
531
        $sel = <STDIN>;
532
        if ( $sel =~ m/[0-9]+/ && defined @{$connected}[$sel] ) {
533
            last;
534
535
        } elsif ( $sel =~ m/[xX]/ ) {
            my $msg = "No driver selected for net " . $net->name;
536
            return $msg;
537
538
        } else {
            print "Invalid driver.\n";
539
540
541
        }
    }
    return @{$connected}[$sel];
542
543
544
}

# prints the type of a connection
545
# and optionally pushes a hash {path=>...,type=>...,} onto the list @$conn_str_list_ref
546
547
548
#
# params
#   connection the connection to print
549
sub _connection_tostr($;$) {
550
    my ( $self, $connection, $conn_str_list_ref ) = @_;
551
552
553
    my $path;
    my $name;
    my $type;
554
555

    if ( ref($connection) eq "Verilog::Netlist::Pin" ) {
556
        $name = $connection->name;
557
        $path = $connection->cell->module->name . $HIERSEP . $connection->cell->name;
558
        $type = "PIN";
559
    } elsif ( ref($connection) eq "Verilog::Netlist::Port" ) {
560
561
562
        $name = $connection->name;
        $path = $connection->module->name;
        $type = "PORT";
563
    } elsif ( ref($connection) eq "Verilog::Netlist::Contassign" ) {
564
565
566
        $name = $connection->lhs;
        $path = $connection->module->name;
        $type = "ASSIGN";
567
    }
568
569
    push @{$conn_str_list_ref}, { path => $path . $HIERSEP . $name, type => $type } if defined $conn_str_list_ref;
    return $type . ": " . $path . $HIERSEP . $name;
570
571
572
}

sub get_connection_object($$) {
573
    my $logger = get_logger("");
574
    my ( $self, $connection_path, $connection_type ) = @_;
575
576
577

    my $rv;

578
579
    if ( $connection_type eq "PIN" ) {
        if ( $connection_path =~ /^(.+)\|(.+)\|(.+)$/ ) {
580
581
582
583

            $logger->info("Looking for $connection_type:$1|$2|$3");

            my $mod  = $self->{'nl'}->find_module($1);
584
585
            my $cell = $mod->find_cell($2) if ( defined $mod );
            my $pin  = $cell->find_pin($3) if ( defined $cell );
586
587
            $rv = $pin;
        }
588
589
    } elsif ( $connection_type eq "PORT" ) {
        if ( $connection_path =~ /^(.+)\|(.+)$/ ) {
590
591
592

            $logger->info("Looking for $connection_type:$1|$2");

593
594
            my $mod = $self->{'nl'}->find_module($1);
            my $port = $mod->find_port($2) if ( defined $mod );
595
596
            $rv = $port;
        }
597
598
599
    } elsif ( $connection_type eq "ASSIGN" ) {
        if ( $connection_path =~ /^(.+)\|(.+)$/ ) {
            my $lhs = $2;
600

601
            my $mod = $self->{'nl'}->find_module($1);
602
603
            my $assign;

604
605
606
            if ( defined $mod ) {
                for my $a ( grep { ref($_) eq "Verilog::ContAssign" } $mod->statements ) {
                    if ( $a->lhs eq $lhs ) {
607
608
609
610
611
                        $assign = $a;
                        last;
                    }
                }
            }
612
            $rv = $assign;
613
614
615
        }
    }
    return $rv;
616
617
618
619
620
}

# 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
621
#
622
623
624
# params
#   net the net to be examined
#   connection_hashref a hashref where the results can be placed
625
626
627
628
#   -> 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
629
sub _get_net_connections ($$) {
630
    my $logger = get_logger("");
631
    my ( $self, $net, $connection_hashref ) = @_;
632
633
634
635

    my $mod = $net->module;

    my $connections = $connection_hashref;
636
637
638
    my @drivers     = ();
    my @driven      = ();
    my @connected   = ();
639

Christian Fibich's avatar
Christian Fibich committed
640
    # FIXME what to do with bussed nets
641
642
    # FIXME what to do with instantiations like that (concatenated nets):
    # input [5:0] p_nbus_byte_controller_c_state ;
Christian Fibich's avatar
Christian Fibich committed
643
644
645
646
647
648
    #  ...
    # .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]
    #                      })
649
650
651
    #
    # TODO: can Verilog::Language::split_bus help us here?

652
653
654
655
    # if ( $netname =~ m/.+\[([0-9]+)\]/ ) {
        # my $idx = $1;
    # }
    $logger->debug( "Net " . $mod->name . $HIERSEP . $net->name . ", connections:" );
Christian Fibich's avatar
Christian Fibich committed
656

657
658
659
    # find nets driven by continuous assignment (e.g., constant or inverter)
    foreach my $statement ( $mod->statements ) {
        if ( $statement->lhs eq $net->name ) {
660

661
662
663
664
665
            # continuous assign statement to this net, there can't be another driver
            $logger->debug( "    assign: " . $mod->name . ": " . $net->name . " = " . $statement->rhs );
            push @drivers, $statement;
        } elsif ( $statement->rhs =~ /\Q$net->name\E$/ ) {
            push @driven, $statement;
666
        }
667
    }
668

669
670
671
672
673
674
675
676
677
678
679
680
    # find nets driven by this module's input ports
    foreach my $port ( $mod->ports_sorted ) {
        if ( defined $port->net && ( $port->net->name eq $net->name ) ) {
            $logger->debug( "    port:   " . $mod->name . $HIERSEP . $port->name );

            # driven from an input, there can't be another driver
            if ( $port->direction eq "in" ) {
                push @drivers, $port;
            } elsif ( $port->direction eq "out" ) {
                push @driven, $port;
            } elsif ( $port->direction eq "inout" ) {
                push @connected, $port;
681
            }
Christian Fibich's avatar
Christian Fibich committed
682
        }
683
    }
684

685
686
687
688
689
690
    # find nets driven by other cells output pins
    foreach my $cell ( $mod->cells_sorted ) {
        foreach my $pin ( $cell->pins_sorted ) {
            foreach my $netname (@{$pin->netnames}) {
                if ( $netname eq $net->name ) {
                    $logger->debug( "    pin " . $pin->cell->name . $HIERSEP . $netname );
691
                    push @connected, $pin;
692
                }
Christian Fibich's avatar
Christian Fibich committed
693
            }
694
        }
695
    }
696
697
698
    $connections->{'drivers'}   = \@drivers;
    $connections->{'driven'}    = \@driven;
    $connections->{'connected'} = \@connected;
699
700
}

701
702
703
704
705
706
707
708
# Writes the current netlist to a specified file
#
# params
#    filename the filename for the resulting Verilog file
#    id the FIJI id (included in a comment if defined)
#
sub export ($;$) {

709
    my $logger = get_logger("");
710
    my ( $self, $filename, $id ) = @_;
711

712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
    open( my $fh_nl, ">", $filename );

    if ( !defined $fh_nl ) {
        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";
    print $fh_nl $FIJI_LOGO;
    print $fh_nl "//\n";
    print $fh_nl "//------------------------------------------------------------------------------\n";
    print $fh_nl "// Generated " . localtime() . " by $0\n";
    print $fh_nl "// Netlist ID: 0x" . sprintf( "%04x", $id ) . "\n" if defined $id;
    print $fh_nl "//------------------------------------------------------------------------------\n\n";

    for my $mod ( $self->{'nl'}->modules_sorted ) {
        my $verilog_text = _export_module($mod);
        print $fh_nl $verilog_text;
    }

    close($fh_nl);
    return undef;
}
737
738
739
740
741
742
743
744

# exports a Verilog::Netlist module to vqm-compatible Verilog.
# returns the Verilog text as a large string.
#
# params
#   mod the module to be exported
#
sub _export_module($) {
745
746

    # FIXME do we need any additional Verilog Syntax (Interface, Modport)?
747

748
    my $logger = get_logger("");
749
750
    my ($mod) = @_;

751
    $logger->info( "Generating verilog text for module " . $mod->name );
752

753
    my $module_header    = "module " . $mod->name . " (\n";
754
755
756
    my $net_declarations = "";
    my $assigns          = "";
    my $instantiations   = "";
757
758
759
    my $module_footer    = "endmodule /* " . $mod->name . " */\n\n";

    my @ports = $mod->ports_sorted;
760
761
762
    my %defparams;
    my @contassigns;

763
    $logger->info( "Generating ports for module " . $mod->name );
764

765
    for ( my $i = 0 ; $i < @ports ; $i++ ) {
766
767
        my $port = $ports[$i];

Christian Fibich's avatar
Christian Fibich committed
768
        # add port declaration to module header part "module (<PORTS>)"
769
        $module_header .= "    " . $port->name;
Christian Fibich's avatar
Christian Fibich committed
770
771
772
773
774

        # port direction
        # Verilog::Perl specifies them as 'in', 'out', or 'inout'
        # Correct Verilog syntax is 'input', 'output' or 'inout'
        # => Add the suffix 'put' where applicable
775
        my $direction = $port->direction . ( ( $port->direction =~ m/^(in|out)$/ ) ? "put" : "" );
776
777

        my $comment = "";
778
        if ( defined( $port->userdata( FIJI::VHDL->FIJI_USERDATA_PORTTYPE ) ) ) {
779
780
781
            $comment = " /* FIJI */";
        }

Christian Fibich's avatar
Christian Fibich committed
782
783
        # add port declaration to net declaration part "input <FOO>; output <BAR>; wire <SOME_WIRE>"
        # data_type also contains the vector specification ([7:0]) where applicable
784
785
786
        $net_declarations .= sprintf( "    %-6s %+7s %s;%s\n", $direction, ( defined $port->data_type ) ? $port->data_type : "", $port->name, $comment );
        if ( $i < @ports - 1 ) {
            $module_header .= ",";
787
        }
788
        $module_header .= $comment . "\n";
789
    }
790

791
792
    $module_header .= ");\n";

793
794
795
796
    $logger->info( "Generating nets for module " . $mod->name );

    foreach my $net ( $mod->nets ) {
        if ( $net->net_type ne "" && $net->decl_type eq "net" ) {
797

Christian Fibich's avatar
Christian Fibich committed
798
799
            # don't declare nets with empty net_type
            # FIXME when do we get empty net_types?
800
            $net_declarations .= sprintf( "    %-6s %+7s %s;\n", $net->net_type, ( defined $net->data_type ) ? $net->data_type : "", $net->name );
801
802
803
804
805
806
        }
    }

    my $assign_indent   = 0;
    my $defparam_indent = 0;

807
    $logger->info( "Generating assigns for module " . $mod->name );
808

809
810
811
812
    # NOTE we need to separate assigns from defparams because Quartus requires
    # the defparams setting LUT mask etc.to be right after the cell instantiation.
    foreach my $statement ( $mod->statements_sorted ) {
        if ( ref($statement) eq "Verilog::Netlist::ContAssign" ) {
813
            push @contassigns, $statement;
814
815
816
            $assign_indent = length $statement->lhs if ( length $statement->lhs > $assign_indent );
        } elsif ( ref($statement) eq "Verilog::Netlist::Defparam" ) {

817
            # Build a hash of defparams, with the key being the cell identifier.
818
819
820
            # FIXME this regex might break with other synthesis tool because of other delimiters
            my $k = ( split( /\./, $statement->lhs ) )[0];
            push @{ $defparams{$k} }, $statement;
821
822
823
824
        }
    }

    foreach my $assign (@contassigns) {
825
        $assigns .= sprintf( "    assign %-${assign_indent}s = %s;\n", $assign->lhs, $assign->rhs );
826
827
    }

828
    $logger->info( "Generating instantiations for module " . $mod->name );
829

830
831
    # FIXME this is somewhat slow for large modules. Other solutions?
    foreach my $cell ( $mod->cells_sorted ) {
832
833
        my $cellname = $cell->name;

834
        $instantiations .= "    " . $cell->submodname . " " . $cell->name . " (\n";
835
        my @pins = $cell->pins_sorted;
836
        for ( my $i = 0 ; $i < @pins ; $i++ ) {
837
            my $pin = $pins[$i];
838
839
            $instantiations .= "         ." . $pin->name . " (" . $pin->netname . ")";
            if ( $i < @pins - 1 ) {
840
841
842
843
                $instantiations .= ",\n";
            }
        }
        $instantiations .= "\n    );\n";
844
845
846
847
848

        # NOTE this is needed because Quartus requires the defparams setting LUT mask etc.
        #      to be right after the cell instantiation.
        foreach my $defparam ( @{ $defparams{$cellname} } ) {
            $instantiations .= sprintf( "    defparam %-${defparam_indent}s = %s;\n", $defparam->lhs, $defparam->rhs );
849
850
        }
        $instantiations .= "\n";
851
852

        # not needed anymore
853
854
855
        delete $defparams{$cellname};
    }

856
857
858
859
    # all defparams should be matched with a cell
    foreach my $k ( keys(%defparams) ) {
        $logger->warn( "Defparam " . $defparams{$k}->lhs . " could not be matched with a cell" );
        $instantiations .= sprintf( "    defparam %-${defparam_indent}s = %s;\n", $defparams{$k}->lhs, $defparams{$k}->rhs );
860
861
862
    }
    $instantiations .= "\n";

863
    return $module_header . "\n" . $net_declarations . "\n" . $assigns . "\n" . $instantiations . $module_footer;
864
865
}

866
867
868
869
## @method splitnet($netpath)
# splits a hierarchical path of a net in the form of module1|module2|netname
# to the net object corresponding to "netname" in module "module2"
#
870
sub splitnet ($) {
871
    my $logger = get_logger("");
872
873
    my ( $self, $netpath ) = @_;
    my $rv = {};
874

875
    my $msg;
876

877
    my @net_split = split( /\|/, $netpath );
878

879
880
881
882
    if ( !defined $net_split[-2] ) {
        $msg = "Not a valid net path.";
        return $msg;
    }
883

884
    my $mod = $self->{'nl'}->find_module( $net_split[-2] );
885

886
887
888
889
    if ( !defined $mod ) {
        $msg = "Could not find module '" . $net_split[-2] . "' in netlist $self->{'filename'}\n";
        return $msg;
    }
890

891
    my $net = $mod->find_net( $net_split[-1] );
892

893
894
895
896
    if ( !defined $net ) {
        $msg = "Could not find net '" . $mod->name . "|" . $net_split[-1] . " in netlist $self->{'filename'}'\n";
        return $msg;
    }
897

898
899
    $rv->{'mod'} = $mod;
    $rv->{'net'} = $net;
900

901
    return $rv;
902
903
904

}

905
1;