OpenCores
URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [rvp.pm] - Blame information for rev 48

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 16 alirezamon
###############################################################################
2
#
3
# File:         rvp.pm
4
# RCS:          $Header: /home/cc/v2html/build/../RCS/rvp.pm,v 7.61 2006/03/25 22:24:57 cc Exp $
5
# Description:  The Rough Verilog Parser Perl Module
6
# Author:       Costas Calamvokis
7
# Created:      Fri Apr 10 16:59:30 1998
8
# Modified:     Thu Jan 12 10:45:27 2006
9
# Language:     Perl
10
#
11
# Copyright 1998-2006 Costas Calamvokis
12
#
13
#  This file nay be copied, modified and distributed only in accordance
14
#  with the terms of the limited licence contained in the accompanying
15
#  file LICENCE.TXT.
16
#
17
###############################################################################
18
#
19
 
20
=head1 rvp - Rough Verilog Parser Perl Module
21
 
22
The basic idea is that first you call read_verilog will a list of all of your
23
files. The files are parsed and information stored away. You are then
24
handed back a pointer to the information which you can use in calls
25
to the various get_ function to get information about the verilog design.
26
 
27
For Example:
28
 
29
 #!/usr/bin/perl -w
30
 use rvp;   # use the rough verilog parser
31
 
32
 # Read in all the files specified on the command line
33
 $vdata = rvp->read_verilog(\@ARGV,[],{},1,[],[],'');
34
 
35
 # Print out all the modules found
36
 foreach $module ($vdata->get_modules()) { print "$module\n"; }
37
 
38
Unless you are doing something very strange, you can probably ignore all
39
of the functions that have the words 'context' or 'anchors' in them!
40
 
41
=cut
42
 
43
package rvp;
44
 
45
#use strict;
46
#use Tie::IxHash;
47
 
48
use File::Basename;
49
 
50
use vars qw(@verilog_gatetype_keywords $verilog_gatetype_regexp
51
            @verilog_compiler_keywords
52
            @verilog_signal_keywords @verilog_sigs $verilog_sigs_regexp
53
            $quiet $debug $VID $HVID $VNUM
54
            $takenArcs
55
            $baseEval $rvpEval $debugEval $languageDef $vid_vnum_or_string
56
            $version $VERSION);
57
 
58
BEGIN {
59
    # $VERSION is used by 'use', but keep $version for backwards compatibility
60
    $version = '$Header: /home/cc/v2html/build/../RCS/rvp.pm,v 7.61 2006/03/25 22:24:57 cc Exp $'; #'
61
    $version =~ s/^\S+ \S+ (\S+) .*$/$1/;
62
    $VERSION = $version;
63
 
64
    @verilog_signal_keywords = qw(input    output  inout
65
                       wire     tri     tri1   supply0 wand  triand tri0
66
                       supply1  wor     time   trireg  trior
67
                       reg      integer real   realtime
68
 
69
                       genvar
70
                       );
71
    @verilog_sigs = @verilog_signal_keywords; # for backwards compatiblity
72
 
73
    #V2001
74
 
75
    $verilog_sigs_regexp = "\\b(?:" .
76
        join("|",@verilog_signal_keywords) .
77
            ")\\b";
78
 
79
    @verilog_gatetype_keywords = qw(and  nand  or  nor xor xnor  buf  bufif0 bufif1
80
                                    not  notif0 notif1  pulldown  pullup
81
                                    nmos  rnmos pmos rpmos cmos rcmos   tran rtran
82
                                    tranif0  rtranif0  tranif1 rtranif1
83
                                    );
84
 
85
    $verilog_gatetype_regexp = "\\b(?:" .
86
        join("|",@verilog_gatetype_keywords) .
87
            ")\\b";
88
 
89
    # Note: optimisation code in _search() assumes all of
90
    #  these compiler keywords contain a ` 
91
    @verilog_compiler_keywords = qw(
92
     `celldefine            `define
93
     `delay_mode_path       `disable_portfaults
94
     `else                  `enable_portfaults
95
     `endcelldefine         `endif
96
     `ifdef                 `include
97
     `nosuppress_faults     `suppress_faults
98
     `timescale             `undef
99
     `resetall              `delay_mode_distributed
100 48 alirezamon
 
101 16 alirezamon
     `default_nettype  `file `line `ifndef `elsif
102
    );    #`
103
 
104
    # a verilog identifier is this reg exp 
105
    #  a non-escaped identifier is A-Z a-z _ 0-9 or $ 
106
    #  an escaped identifier is \ followed by non-whitespace
107
    #   why \\\\\S+ ? This gets \\\S+ in to the string then when it
108
    #   it used we get it searching for \ followed by non-whitespace (\S+)
109
    $VID = '(?:[A-Za-z_][A-Za-z_0-9\$]*|\\\\\S+)';
110
 
111
    # hierarchical VID - just $VID(.$VID)+ but can't write it like this
112
    #  because of \ escaping (and must include whitespace after esc.ids.)
113
    $HVID = '(?:(?:[A-Za-z_][A-Za-z_0-9\$]*|\\\\\S+\s+)'.
114
           '(?:\.(?:[A-Za-z_][A-Za-z_0-9\$]*|\\\\\S+\s+))+)';
115
  # V2001: added [sS] - is this correct
116
    $VNUM= '(?:(?:[0-9]*\'[sS]?[bBhHdDoO]\s*[0-9A-Fa-f_zZxX?]+)|(?:[-0-9Ee._]+))';
117
 
118
 
119
    $quiet=0;
120
    $debug=0;
121
 
122
}
123
 
124
###########################################################################
125
 
126
=head1 read_verilog
127
 
128
reads in verilog files, parses them and stores results in an internal
129
data structure (which I call a RVP database).
130
 
131
  Arguments:  - reference to array of files to read (can have paths)
132
              - reference to hash of defines with names as keys
133
              - reference to array of global includes - not used anymore,
134
                 just kept for backwards compatibility
135
              - quite flag. 1=be quiet, 0=be chatty.
136
              - reference to array of include directories
137
              - reference to array of library directories
138
              - library extension string (eg '.v') or reference to array of strings
139
 
140
  Returns:    - a pointer to the internal data structure.
141
 
142
  Example:
143
    $defines{'TRUE'}=1;  # same as +define+TRUE=1 on verilog cmd line
144
    $vdata = rvp->read_verilog(\@files,[],\%defines,1,
145
                                     \@inc_dirs,\@lib_dirs,\@lib_exts);
146
 
147
=cut
148
sub read_verilog {
149
    # be backwards compatible with non-OO call
150
    my $class = ("ARRAY" eq ref $_[0]) ? "rvp" : shift;
151
    my ($files,$global_includes,$cmd_line_defines,$local_quiet,$inc_dirs,
152
        $lib_dirs,$lib_ext_arg,$exp)
153
        = @_;
154
    my ($file,$fb,$old_quiet,@search_files,@new_search_files,$lib_exts);
155
 
156
    my $self;
157
 
158
    die "read_verilog needs an array ref as arg 1" unless "ARRAY" eq ref $files;
159
    die "read_verilog needs an hash ref as arg 2" unless "HASH" eq ref $cmd_line_defines;
160
    die "read_verilog needs 0 or 1 as arg 3" unless $local_quiet==0 || $local_quiet==1;
161
 
162
    # be backwards compatible
163
    if (!defined($inc_dirs)) { $inc_dirs=[]; }
164
    if (!defined($lib_dirs)) { $lib_dirs=[]; }
165
 
166
    if (!defined($lib_ext_arg)) {  # no libexts given
167
        $lib_exts=[''];
168
    }
169
    elsif (!ref($lib_ext_arg))  {  # a string given
170
        $lib_exts=[$lib_ext_arg];
171
    }
172
    else {                         # an array ref given
173
        $lib_exts=$lib_ext_arg;
174
    }
175
 
176
 
177
    # make the parser
178
    if (! defined &parse_line) {
179
 
180
        my $perlCode=_make_parser( $debug ? [ $baseEval,$debugEval,$rvpEval ]:
181
                                          [ $baseEval,$rvpEval ] ,
182
                                 $debug );
183
        if ($debug) {
184
            open(PC,">v2html-parser.pl");
185
            print PC $perlCode;
186
        }
187
        eval($perlCode);
188
        print STDERR $@ if ($@);
189
    }
190
 
191
    if (! defined &_parse_line) { die "Parse code generation failed";}
192
 
193
    $old_quiet=$quiet;
194
    $quiet=$local_quiet;
195
    # set up top of main data structure
196
    $self = {};
197
    $self->{files}               = {}; # information on each file
198
    $self->{modules}             = {}; # pointers to module info in {files}
199
    $self->{defines}             = {};
200
    $self->{ignored_modules}     = {}; # list of modules were duplicates were found
201
    $self->{unresolved_modules}  = {}; # modules we have not found yet
202
    $self->{problems}            = []; # warning/confused messages
203
 
204
    bless($self,$class);
205
 
206
    foreach my $d (keys(%$cmd_line_defines)) {
207
        _add_define($self->{defines}, $d , $cmd_line_defines->{$d}, '', 0 );
208
    }
209
 
210
    # go through all the files and find information
211
    @new_search_files = @{$files};
212
    while (@new_search_files) {
213
        @search_files = @new_search_files;
214
        @new_search_files = ();
215
        foreach $file (@search_files) {
216
            $self->_search($file,$inc_dirs);
217
        }
218
        push( @new_search_files , _resolve_modules( $self, $lib_dirs, $lib_exts ) );
219
    }
220
 
221
 
222
    if ($debug) {
223
        _check_coverage();
224
    }
225
 
226
    # cross reference files' information
227
    print "Cross referencing\n" unless $quiet;
228
    $self->_cross_reference();
229
 
230
    $quiet=$old_quiet;
231
 
232
    foreach my $m ( sort (keys %{$self->{unresolved_modules}} )) {
233
        # find somewhere it is instantiated for warning message
234
        my $file="";
235
        my $line="";
236
        foreach my $m2 (sort (keys %{$self->{modules}})) {
237
            foreach my $inst (@{$self->{modules}{$m2}{instances}}) {
238
                if ($inst->{module} eq $m) {
239
                    $file = $inst->{file};
240
                    $line = $inst->{line};
241
                    last;
242
                }
243
            }
244
        }
245 25 alirezamon
        #$self->_add_warning("$file:$line: Could not find module $m");
246 16 alirezamon
    }
247
    return $self;
248
}
249
 
250
###########################################################################
251
 
252
=head1 get_problems
253
 
254
Return any problems that happened during parsing
255
 
256
  Returns:    - array of strings of problems. Each one is:
257
                    "TYPE:FILE:LINE: description"
258
 
259
=cut
260
sub get_problems {
261
    my ($self) = @_;
262
 
263
    return (@{$self->{problems}});
264
}
265
 
266
###########################################################################
267
 
268
=head1 set_debug
269
 
270
Turns on debug printing in the parser.
271
 
272
  Returns:    - nothing
273
 
274
=cut
275
sub set_debug {
276
    $debug=1;
277
}
278
 
279
###########################################################################
280
 
281
=head1 unset_debug
282
 
283
Turns off debug printing in the parser.
284
 
285
  Returns:    - nothing
286
 
287
=cut
288
sub unset_debug {
289
    $debug=0;
290
}
291
 
292
###########################################################################
293
 
294
=head1 get_files
295
 
296
Get a list of all the files in the database.
297
 
298
  Returns:    - list of all the files
299
 
300
  Example:   @all_files = $vdata->get_files();
301
 
302
=cut
303
sub get_files{
304
    my ($self) = @_;
305
 
306
    if (wantarray) {
307
        return sort (keys %{$self->{files}});
308
    }
309
    else { # in a scalar context keys returns the number of elements - sort doesn't
310
        return keys %{$self->{files}};
311
    }
312
}
313
 
314
###########################################################################
315
 
316
=head1 get_files_modules
317
 
318
Get a list of all the modules in a particular file.
319
 
320
  Arguments:  - name of file
321
 
322
  Returns:    - list of module names
323
 
324
  Example:   @modules = $vdata->get_files_modules($file);
325
 
326
=cut
327
sub get_files_modules{
328
    my ($self,$file) = @_;
329
    my (@modules,$m);
330
 
331
    foreach $m (sort (keys %{$self->{files}{$file}{modules}})) {
332
        push(@modules,$m)
333
    }
334
 
335
    return @modules;
336
}
337
 
338
 
339
###########################################################################
340
 
341
=head1 get_files_full_name
342
 
343
Get the full name (including path) of a file.
344
 
345
  Arguments:  - name of file
346
 
347
  Returns:    - full path name
348
 
349
  Example  $full_name = $vdata->get_files_full_name($file);
350
 
351
=cut
352
sub get_files_full_name{
353
    my ($self,$file) = @_;
354
 
355
    return $self->{files}{$file}{full_name};
356
 
357
}
358
 
359
###########################################################################
360
 
361
=head1 get_files_stats
362
 
363
Get statistics about a file
364
 
365
  Arguments:  - name of file
366
 
367
  Returns:    - number of lines in the file (more later...)
368
 
369
  Example  $full_name = $vdata->get_files_stats($file);
370
 
371
=cut
372
sub get_files_stats{
373
    my ($self,$file) = @_;
374
 
375
    return $self->{files}{$file}{lines};
376
 
377
}
378
 
379
###########################################################################
380
 
381
=head1 file_exists
382
 
383
Test if a particular module file  in the database.
384
 
385
  Arguments:  - file name to test.
386
 
387
  Returns:    - 1 if exists otherwise 0
388
 
389
  Example:   if ($vdata->file_exists($file))....
390
 
391
=cut
392
sub file_exists{
393
    my ($self,$file) = @_;
394
    return exists($self->{files}{_ffile($file)});
395
}
396
 
397
###########################################################################
398
 
399
=head1 get_modules
400
 
401
Get a list of all the modules in the database.
402
 
403
 
404
  Returns:   - list of all the modules
405
 
406
  Example:   @all_modules = $vdata->get_modules();
407
 
408
=cut
409
sub get_modules{
410
    my ($self) = @_;
411
 
412
    if (wantarray) {
413
        return sort (keys %{$self->{modules}});
414
    }
415
    else { # in a scalar context keys returns the number of elements - sort doesn't
416
        return keys %{$self->{modules}};
417
    }
418
 
419
}
420
 
421
 
422
###########################################################################
423
 
424
=head1 get_modules_t_and_f
425
 
426
Get a list of all the tasks and functions in a particular module.
427
 
428
  Arguments:  - name of module
429
 
430
  Returns:    - list of tasks and function names
431
 
432
  Example:    if ( @t_and_f = $vdata->get_modules_t_and_f($m))...
433
 
434
=cut
435
# return a list of all the tasks and functions in a module
436
sub get_modules_t_and_f{
437
    my ($self,$module) = @_;
438
 
439
    if (wantarray) {
440
        return sort (keys %{$self->{modules}{$module}{t_and_f}});
441
    }
442
    else { # in a scalar context keys returns the number of elements - sort doesn't
443
        return keys %{$self->{modules}{$module}{t_and_f}};
444
    }
445
 
446
}
447
 
448
###########################################################################
449
 
450
=head1 get_modules_t_or_f
451
 
452
Get information on a task or function in a module.
453
 
454
  Arguments:  - module name
455
              - task or function name
456
 
457
  Returns:    - A 4 element list: type (task or function), definition line,
458
                  file, anchor
459
 
460
  Example:    ($t_type,$t_line ,$t_file,$t_anchor)=
461
                $vdata->get_modules_t_or_f($m,$tf);
462
 
463
=cut
464
sub get_modules_t_or_f{
465
    my ($self,$mod,$t_or_f) = @_;
466
 
467
    if (exists($self->{modules}{$mod}{t_and_f}{$t_or_f})) {
468
        return($self->{modules}{$mod}{t_and_f}{$t_or_f}{type},
469
               $self->{modules}{$mod}{t_and_f}{$t_or_f}{line},
470
               $self->{modules}{$mod}{t_and_f}{$t_or_f}{file},
471
               $self->{modules}{$mod}{t_and_f}{$t_or_f}{anchor});
472
    }
473
    else {
474
        return ();
475
    }
476
}
477
 
478
###########################################################################
479
 
480
=head1 get_modules_signals
481
 
482
Get a list of all the signals in a particular module.
483
 
484
  Arguments:  - name of module
485
 
486
  Returns:    - list of signal names
487
 
488
  Example:    if ( @signs = $vdata->get_modules_signals($m))...
489
 
490
=cut
491
# return a list of all the tasks and functions in a module
492
sub get_modules_signals{
493
    my ($self,$module) = @_;
494
 
495
    if (wantarray) {
496
        return sort (keys %{$self->{modules}{$module}{signals}});
497
    }
498
    else { # in a scalar context keys returns the number of elements - sort doesn't
499
        return keys %{$self->{modules}{$module}{signals}};
500
    }
501
 
502
}
503
 
504
###########################################################################
505
 
506
=head1 get_modules_file
507
 
508
Get the file name (no path) that a module is defined in.
509
 
510
  Arguments:  - module name
511
 
512
  Returns:    - file name without path, and the line number module starts on
513
 
514
  Example:    ($f) = $vdata->get_modules_file($m);
515
 
516
=cut
517
# get the file name that contains a module
518
sub get_modules_file{
519
    my ($self,$module) = @_;
520
 
521
    return ($self->{modules}{$module}{file},$self->{modules}{$module}{line});
522
}
523
 
524
 
525
###########################################################################
526
 
527
=head1 get_modules_type
528
 
529
Get the type of the module - It is one of: module, macromodule or primitive
530
(rvp treats these all as modules).
531
 
532
  Arguments:  - module name
533
 
534
  Returns:    - type
535
 
536
  Example:    $t = $vdata->get_modules_type($m);
537
 
538
=cut
539
# get the file name that contains a module
540
sub get_modules_type{
541
    my ($self,$module) = @_;
542
 
543
    return ($self->{modules}{$module}{type});
544
}
545
 
546
###########################################################################
547
 
548
=head1 get_files_includes
549
 
550
Get the file names (no path) of files included in a file.
551
 
552
  Arguments:  - file name
553
 
554
  Returns:    - list of file names without paths
555
 
556
  Example:    @f = $vdata->get_files_includes($file);
557
 
558
=cut
559
sub get_files_includes {
560
    my ($self,$f) = @_;
561
    my @includes_found = ();
562
 
563
    if (exists($self->{files}{$f})) {
564
        foreach my $inc ( sort ( keys %{$self->{files}{$f}{includes}} )) {
565
            push(@includes_found,$inc);
566
            # do the includes for the included file
567
            push(@includes_found, $self->get_files_includes($inc));
568
        }
569
    }
570
 
571
    return @includes_found;
572
}
573
 
574
###########################################################################
575
 
576
=head1 get_files_included_by
577
 
578
Get the file names (no path) of files that included this file.
579
 
580
  Arguments:  - file name
581
 
582
  Returns:    - list of file names without paths
583
 
584
  Example:    @f = $vdata->get_files_included_by($file);
585
 
586
=cut
587
sub get_files_included_by {
588
    my ($self,$f) = @_;
589
 
590
    return @{$self->{files}{$f}{included_by}};
591
 
592
}
593
 
594
 
595
###########################################################################
596
 
597
=head1 module_ignored
598
 
599
Test if a particular module has been ignored because of duplicates found
600
 
601
  Arguments:  - module name to test
602
 
603
  Returns:    - 1 if ignored otherwise 0
604
 
605
  Example:   if ($vdata->module_ignored($module))....
606
 
607
=cut
608
sub module_ignored {
609
    my ($self,$module) = @_;
610
    return (exists($self->{modules}{$module}) &&
611
            $self->{modules}{$module}{duplicate});
612
}
613
 
614
###########################################################################
615
 
616
=head1 module_exists
617
 
618
Test if a particular module exists in the database.
619
 
620
  Arguments:  - module name to test
621
 
622
  Returns:    - 1 if exists otherwise 0
623
 
624
  Example:   if ($vdata->module_exists($module))....
625
 
626
=cut
627
sub module_exists{
628
    my ($self,$module) = @_;
629
    return exists($self->{modules}{$module});
630
}
631
 
632
###########################################################################
633
 
634
=head1 get_ignored_modules
635
 
636
Return a list of the ignored modules. These are modules where duplicates
637
have been found.
638
 
639
  Returns:    - List of ignored modules
640
 
641
  Example:    - foreach $module ($vdata->get_ignored_modules())....
642
 
643
=cut
644
sub get_ignored_modules {
645
    my ($self) = @_;
646
    my @ig =();
647
    foreach my $m (sort (keys %{$self->{modules}})) {
648
        push(@ig, $m) if ($self->{modules}{$m}{duplicate});
649
    }
650
    return @ig;
651
}
652
 
653
###########################################################################
654
 
655
=head1 get_module_signal
656
 
657
Get information about a particular signal in a particular module.
658
 
659
  Arguments:  - name of module
660
              - name of signal
661
 
662
  Returns:    - A list containing:
663
                 - the line signal is defined
664
                 - the line signal is assigned first (or -1)
665
                 - line in instantiating module where an input
666
                       is driven from (or -1)
667
                 - the type of the signal (input,output,reg etc)
668
                 - the file the signal is in
669
                 - posedge flag (1 if signal ever seen with posedge)
670
                 - negedge flag (1 if signal ever seen with negedge)
671
                 - second type (eg reg for a registered output)
672
                 - signal real source file
673
                 - signal real source line
674
                 - range string if any ( not including [ and ] )
675
                 - the file signal is assigned first (or '')
676
                 - file for the instantiating module where an input
677
                       is driven from (or "")
678
                 - a pointer to an array of dimensions for memories
679
                       each element of the array is a dimension, array
680
                       is empty for non-memories
681
 
682
  Note posedge and negedge information is propagated up the hierarchy to
683
  attached signals. It is not propagated down the hierarchy.
684
 
685
  Example:    ($s_line,$s_a_line,$s_i_line,$s_type,$s_file,$s_p,$s_n,
686
               $s_type2,$s_r_file,$s_r_line,$range,$s_a_file,$s_i_file) =
687
                      $vdata->get_module_signal($m,$sig);
688
 
689
=cut
690
sub get_module_signal{
691
    my ($self,$module,$sig) = @_;
692
 
693
    if (exists( $self->{modules}{$module}{signals}{$sig} )) {
694
        return ($self->{modules}{$module}{signals}{$sig}{line},
695
                $self->{modules}{$module}{signals}{$sig}{a_line},
696
                $self->{modules}{$module}{signals}{$sig}{i_line},
697
                $self->{modules}{$module}{signals}{$sig}{type},
698
                $self->{modules}{$module}{signals}{$sig}{file},
699
                $self->{modules}{$module}{signals}{$sig}{posedge},
700
                $self->{modules}{$module}{signals}{$sig}{negedge},
701
                $self->{modules}{$module}{signals}{$sig}{type2},
702
                $self->{modules}{$module}{signals}{$sig}{source}{file},
703
                $self->{modules}{$module}{signals}{$sig}{source}{line},
704
                $self->{modules}{$module}{signals}{$sig}{range},
705
                $self->{modules}{$module}{signals}{$sig}{a_file},
706
                $self->{modules}{$module}{signals}{$sig}{i_file},
707
                $self->{modules}{$module}{signals}{$sig}{dimensions});
708
    }
709
    else {
710
        return ();
711
    }
712
}
713
 
714
###########################################################################
715
 
716
=head1 get_first_signal_port_con
717
 
718
Get the first port that this signal in this module is connected to.
719
 
720
  Arguments:  - module name
721
              - signal name
722
 
723
  Returns:    - a 5 element list: instantiated module name, instance name
724
                  port name, line number and file
725
 
726
  Example:    ($im,$in,$p,$l,$f)=$vdata->get_first_signal_port_con($m,$s);
727
 
728
=cut
729
sub get_first_signal_port_con{
730
    my ($self,$module,$signal) = @_;
731
 
732
    $self->{current_signal_port_con}       =0;
733
    $self->{current_signal_port_con_module}=$module;
734
    $self->{current_signal_port_con_module_signal}=$signal;
735
 
736
    return $self->get_next_signal_port_con();
737
}
738
 
739
###########################################################################
740
 
741
=head1 get_next_signal_port_con
742
 
743
Get the next port that this signal in this module is connected to.
744
 
745
  Returns:    - a 5 element list: instantiated module name, instance name
746
                  port name, line number and file
747
 
748
  Example:    ($im,$in,$p,$l,$f)=$vdata->get_next_signal_port_con();
749
 
750
=cut
751
sub get_next_signal_port_con{
752
    my ($self) = @_;
753
    my ($module,$signal,$i,$pcref);
754
 
755
    $module = $self->{current_signal_port_con_module};
756
    $signal = $self->{current_signal_port_con_module_signal};
757
    $i      = $self->{current_signal_port_con};
758
 
759
    $pcref = $self->{modules}{$module}{signals}{$signal}{port_con};
760
    if (@{$pcref} > $i ) {
761
        $self->{current_signal_port_con}++;
762
        return ( $pcref->[$i]{module},$pcref->[$i]{inst},$pcref->[$i]{port},
763
                $pcref->[$i]{line},$pcref->[$i]{file});
764
    }
765
    else {
766
        return ();
767
    }
768
}
769
 
770
###########################################################################
771
 
772
=head1 get_first_signal_con_to
773
 
774
Get the first signal that is connected to this port in an
775
instantiation of this module. This only works for instances that use
776
the .port(sig) notation.
777
 
778
  Arguments:  - module name
779
              - signal name
780
 
781
  Returns:    - a 4 element list: signal connected to this port
782
                                  module signal is in
783
                                  instance (of this module) where the connection
784
                                    occurs
785
 
786
  Example:    ($cts,$ctm,$cti)=$vdata->get_first_signal_con_to($m,$s);
787
 
788
=cut
789
sub get_first_signal_con_to{
790
    my ($self,$module,$signal) = @_;
791
 
792
    $self->{current_signal_con_to}       =0;
793
    $self->{current_signal_con_to_module}=$module;
794
    $self->{current_signal_con_to_module_signal}=$signal;
795
 
796
    return $self->get_next_signal_con_to();
797
}
798
 
799
###########################################################################
800
 
801
=head1 get_next_signal_con_to
802
 
803
Get the next signal that is connected to this port in an
804
instantiation of this module. This only works for instances that use
805
the .port(sig) notation.
806
 
807
  Arguments:  - module name
808
              - signal name
809
 
810
  Returns:    - a 4 element list: signal connected to this port
811
                                  module signal is in
812
                                  instance (of this module) where the connection
813
                                    occurs
814
 
815
  Example:    ($cts,$ctm,$cti)=$vdata->get_next_signal_con_to();
816
 
817
=cut
818
sub get_next_signal_con_to{
819
    my ($self) = @_;
820
    my ($module,$signal,$i,$ctref);
821
 
822
    $module = $self->{current_signal_con_to_module};
823
    $signal = $self->{current_signal_con_to_module_signal};
824
    $i      = $self->{current_signal_con_to};
825
 
826
    $ctref = $self->{modules}{$module}{signals}{$signal}{con_to};
827
    if (@{$ctref} > $i ) {
828
        $self->{current_signal_con_to}++;
829
        return ( $ctref->[$i]{signal},$ctref->[$i]{module},$ctref->[$i]{inst});
830
    }
831
    else {
832
        return ();
833
    }
834
}
835
 
836
###########################################################################
837
 
838
=head1 get_first_instantiator
839
 
840
Get the first thing that instantiates this module.
841
 
842
  Arguments:  - module name
843
 
844
  Returns:    - a 4 element list: instantiating module, file, instance name, line
845
 
846
  Example:
847
                ($im,$f,$i) = $vdata->get_first_instantiator($m );
848
 
849
=cut
850
# Get the first thing that instantiates or empty list if none.
851
#  Returns: { module, file, inst }
852
sub get_first_instantiator{
853
    my ($self,$module) = @_;
854
 
855
    if ( exists( $self->{modules}{$module} )) {
856
        $self->{current_instantiator}       =0;
857
        $self->{current_instantiator_module}=$module;
858
        return $self->get_next_instantiator();
859
    }
860
    else {
861
        return ();
862
    }
863
}
864
 
865
###########################################################################
866
 
867
=head1 get_next_instantiator
868
 
869
Get the first thing that instantiates the module specified in
870
get_first_instantiator (or _by_context).
871
 
872
  Returns:    - a 4 element list: instantiating module, file,
873
                                    instance name, line
874
 
875
  Example:
876
                ($im,$f,$i) = $vdata->get_next_instantiator();
877
 
878
=cut
879
sub get_next_instantiator{
880
    my ($self) = @_;
881
    my ($module,$i);
882
 
883
    $module = $self->{current_instantiator_module};
884
    $i      = $self->{current_instantiator};
885
 
886
    if (@{$self->{modules}{$module}{inst_by}} > $i ) {
887
        $self->{current_instantiator}++;
888
        return ($self->{modules}{$module}{inst_by}[$i]{module},
889
                $self->{modules}{$module}{inst_by}[$i]{file},
890
                $self->{modules}{$module}{inst_by}[$i]{inst},
891
                $self->{modules}{$module}{inst_by}[$i]{line} );
892
    }
893
    else {
894
        return ();
895
    }
896
}
897
 
898
###########################################################################
899
 
900
=head1 get_first_instantiation
901
 
902
Get the first thing that this module instantiates.
903
 
904
  Arguments:  - module name
905
 
906
  Returns:    - a 4 element list: instantiated module name, file,
907
                  instance name, and line number
908
 
909
  Example:
910
                ($im,$f,$i,$l) = $vdata->get_first_instantiation($m);
911
 
912
=cut
913
sub get_first_instantiation{
914
    my ($self,$module) = @_;
915
 
916
    if ( exists( $self->{modules}{$module} )) {
917
        $self->{current_instantiation}       =0;
918
        $self->{current_instantiation_module}=$module;
919
        return $self->get_next_instantiation();
920
    }
921
    else {
922
        return ();
923
    }
924
}
925
 
926
###########################################################################
927
 
928
=head1 get_next_instantiation
929
 
930
Get the next thing that this module instantiates.
931
 
932
 
933
  Returns:    - a 4 element list: instantiated module name, file,
934
                  instance name, and line number
935
 
936
  Example:
937
                ($im,$f,$i,$l) = $vdata->get_next_instantiation();
938
 
939
=cut
940
sub get_next_instantiation{
941
    my ($self) = @_;
942
    my ($module,$i);
943
 
944
    $module = $self->{current_instantiation_module};
945
    $i      = $self->{current_instantiation};
946
 
947
    if (@{$self->{modules}{$module}{instances}} > $i ) {
948
        $self->{current_instantiation}++;
949
        return ($self->{modules}{$module}{instances}[$i]{module},
950
                $self->{modules}{$module}{instances}[$i]{file},
951
                $self->{modules}{$module}{instances}[$i]{inst_name},
952
                $self->{modules}{$module}{instances}[$i]{line} );
953
    }
954
    else {
955
        return ();
956
    }
957
}
958
 
959
###########################################################################
960
 
961
=head1 get_current_instantiations_port_con
962
 
963
Gets the port connections for the current instantiations (which is got
964
using get_first_instantiation and get_next_instantiation). If the
965
instantiation does not use .port(...) syntax and rvp does not have the
966
access to the source of the module then the port names will be returned as
967
numbers in connection order starting at 0.
968
 
969
 
970
  Returns:    - A hash (well, really a list that can be assigned to a hash).
971
               The keys of the hash are the port names. The values of the
972
               hash is everything (except comments) that appeared in the
973
               brackets in the verilog.
974
 
975
  Example:    %port_con = $vdata->get_current_instantiations_port_con();
976
              foreach $port (keys %port_con) { ...
977
 
978
=cut
979
sub get_current_instantiations_port_con{
980
    my ($self) = @_;
981
    my ($module,$i);
982
 
983
    $module = $self->{current_instantiation_module};
984
    $i      = $self->{current_instantiation} -  1;
985
 
986
    if (@{$self->{modules}{$module}{instances}} > $i ) {
987
        return (%{$self->{modules}{$module}{instances}[$i]{connections}});
988
    }
989
    else {
990
        return {};
991
    }
992
}
993
 
994
###########################################################################
995
 
996
=head1 get_current_instantiations_parameters
997
 
998
Gets the parameters for the current instantiations (which is set using
999
get_first_instantiation and get_next_instantiation).  If the
1000
instantiation parameters does not use the verilog 2001 .name(...)
1001
syntax and rvp does not have the access to the source of the module
1002
then the parameter names will be returned as numbers reflecting the
1003
order (starting at 0).
1004
 
1005
 
1006
  Returns:    - A hash (well, really a list that can be assigned to a hash).
1007
               The keys of the hash are the parameters names. The values of the
1008
               hash is everything (except comments) in the value.
1009
 
1010
  Example:    %parameters = $vdata->get_current_instantiations_parameters();
1011
              foreach my $p (keys %parameters) { ...
1012
 
1013
=cut
1014
sub get_current_instantiations_parameters{
1015
    my ($self) = @_;
1016
    my ($module,$i);
1017
 
1018
    $module = $self->{current_instantiation_module};
1019
    $i      = $self->{current_instantiation} -  1;
1020
 
1021
    my %r;
1022
    if (@{$self->{modules}{$module}{instances}} > $i ) {
1023
        foreach my $p (keys %{$self->{modules}{$module}{instances}[$i]{parameters}}) {
1024
            $r{$p}=$self->{modules}{$module}{instances}[$i]{parameters}{$p}{value};
1025
        }
1026
    }
1027
 
1028
    return %r;
1029
}
1030
 
1031
###########################################################################
1032
 
1033
=head1 get_modules_parameters
1034
 
1035
Gets the parameters for a module.
1036
 
1037
  Arguments:  - module name
1038
 
1039
  Returns:    - A hash (well, really a list that can be assigned to a hash).
1040
               The keys of the hash are the parameters names. The values of the
1041
               hash is everything (except comments) in the value.
1042
 
1043
  Example:    %parameters = $vdata->get_modules_parameters();
1044
              foreach my $p (keys %parameters) { ...
1045
 
1046
=cut
1047
sub get_modules_parameters{
1048
    my ($self,$module) = @_;
1049
 
1050
    my %r;
1051
    foreach my $p (keys %{$self->{modules}{$module}{parameters}}) {
1052
        $r{$p}=$self->{modules}{$module}{parameters}{$p}{value};
1053
    }
1054
    return %r;
1055
}
1056
 
1057
#######################################################
1058
################### Modified ###########################
1059
#######################################################
1060
 
1061
=head1 get_modules_parameters_not_local
1062
 
1063
Gets the parameters for a module.
1064
 
1065
  Arguments:  - module name
1066
 
1067
  Returns:    - A hash (well, really a list that can be assigned to a hash).
1068
               The keys of the hash are the parameters names. The values of the
1069
               hash is everything (except comments) in the value.
1070
 
1071
  Example:    %parameters = $vdata->get_modules_parameters();
1072
              foreach my $p (keys %parameters) { ...
1073
 
1074
=cut
1075
sub get_modules_parameters_not_local{
1076
    my ($self,$module) = @_;
1077
 
1078
    my %r;
1079
    foreach my $p (keys %{$self->{modules}{$module}{parameters}}) {
1080
        if ($self->{modules}{$module}{parameters}{$p}{ptype} ne "localparam"){
1081
                #print "$p\n";
1082
                $r{$p}=$self->{modules}{$module}{parameters}{$p}{value};
1083
        }
1084
    }
1085
    return %r;
1086
}
1087
 
1088
 
1089
 
1090
 
1091
=head1 get_modules_parameters_not_local_in_order
1092
 
1093
Gets the parameter names in_order for a module.
1094
 
1095
 
1096
 
1097
=cut
1098
sub get_modules_parameters_not_local_order{
1099
    my ($self,$module) = @_;
1100
        my @r=@{$self->{modules}{$module}{parameter_order}};#param/localparam inorder
1101
        my @w; #parameter inorder
1102
        foreach my $p (@r) {
1103
                if ($self->{modules}{$module}{parameters}{$p}{ptype} ne "localparam"){
1104
                        push(@w,$p);
1105
                }
1106
 
1107
        }
1108
 
1109
        return @w;
1110
}
1111
 
1112
 
1113
 
1114
 
1115
=head1 get_module_ports_inorder
1116
 
1117
Gets the parameter names in_order for a module.
1118
 
1119
 
1120
 
1121
=cut
1122
sub get_module_ports_order{
1123
    my ($self,$module) = @_;
1124
        return @{$self->{modules}{$module}{port_order}};
1125
}
1126
 
1127
 
1128
 
1129
 
1130
 
1131
 
1132
###########################################################################
1133
 
1134
=head1 get_define
1135
 
1136
Find out where a define is defined and what the value is
1137
 
1138
  Arguments:  - name of the define
1139
             Optional arguments where a you want the correct location and
1140
               value for a particular use of a multiplely defined define:
1141
              - file where define is used
1142
              - line where define is used
1143
 
1144
  Returns:    - list with three elements: file, line, value
1145
                 or if the define does not exist it returns a empty list.
1146
                 if the define was defined on the command line it sets file=""
1147
                  and line=0
1148
 
1149
 
1150
  Example:    ($f,$l,$v) = $vdata->get_define($word,$file,$line);
1151
 
1152
=cut
1153
sub get_define {
1154
    my ($self,$define,$file,$line) = @_;
1155
 
1156
    if ( !defined($self) || !defined($define) ||
1157
         ( defined($file) && !defined($line) ) ) {
1158
        die "Get define takes either two or four arguments";
1159
    }
1160
 
1161
    $define =~ s/^\`// ; # remove the ` if any
1162
 
1163
    if (!exists( $self->{defines}{$define} )) {
1164
        return ();
1165
    }
1166
    my $index = 0;
1167
    my $dh = $self->{defines}{$define};
1168
 
1169
    if (defined($file) &&
1170
        exists($dh->{used}{$file}) &&
1171
        exists($dh->{used}{$file}{$line})) {
1172
        $index = $dh->{used}{$file}{$line};
1173
    }
1174
 
1175
 
1176
    if ($index eq "XX") {   # define has been undefed
1177
        return ();
1178
    }
1179
 
1180
    return ( $dh->{defined}[$index]{file},
1181
             $dh->{defined}[$index]{line},
1182
             $dh->{defined}[$index]{value});
1183
}
1184
 
1185
###########################################################################
1186
 
1187
=head1 get_context
1188
 
1189
Get the context (if any) for a line in a file.
1190
 
1191
  Arguments:  - file name
1192
              - line number
1193
 
1194
  Returns:    - line number if there is a context, zero if there is none.
1195
 
1196
  Example:      $l = $vdata->get_context($filename,$line);
1197
 
1198
=cut
1199
sub get_context{
1200
    my ($self,$file,$line) = @_;
1201
 
1202
    if ( exists( $self->{files}{$file}{contexts}{$line} )) {
1203
        return $line;
1204
    }
1205
    else {
1206
        return 0;
1207
    }
1208
}
1209
 
1210
###########################################################################
1211
 
1212
=head1 get_module_start_by_context
1213
 
1214
Test if the context is a module definition start.
1215
 
1216
  Arguments:  - file name
1217
              - line number
1218
 
1219
  Returns:    - module name if it is a module start, 0 otherwise
1220
 
1221
  Example:     if($vdata->get_module_start_by_context($filename,$line))..
1222
 
1223
=cut
1224
# return true if the context for this line is a module start
1225
sub get_module_start_by_context{
1226
    my ($self,$file,$line) = @_;
1227
 
1228
    if ( exists( $self->{files}{$file}{contexts}{$line}{module_start})) {
1229
        return $self->{files}{$file}{contexts}{$line}{module_start};
1230
    }
1231
    else {
1232
        return 0;
1233
    }
1234
}
1235
 
1236
###########################################################################
1237
 
1238
=head1 get_has_value_by_context
1239
 
1240
Check if the context has a value (ie a new module or something). Contexts
1241
that just turn on and off preprocessor ignoring do not have values.
1242
 
1243
  Arguments:  - file name
1244
              - line number
1245
 
1246
  Returns:    - 1 if there is a value, 0 otherwise
1247
 
1248
  Example:    if ($vdata->get_has_value_by_context($file,$line))..
1249
 
1250
=cut
1251
sub get_has_value_by_context{
1252
    my ($self,$file,$line) = @_;
1253
 
1254
    return exists( $self->{files}{$file}{contexts}{$line}{value});
1255
}
1256
 
1257
###########################################################################
1258
 
1259
=head1 get_context_name_type
1260
 
1261
Find the reason for a new context - is it a module / function or task.
1262
Contexts that just turn on and off preprocessor ignoring do not have values.
1263
 
1264
  Arguments:  - file name
1265
              - line number
1266
 
1267
  Returns:    - name
1268
              - type [ module | function | task ]
1269
 
1270
  Example:    ($n,$t)=$vdata->get_context_name_type($file,$line);
1271
 
1272
=cut
1273
sub get_context_name_type{
1274
    my ($self,$file,$line) = @_;
1275
    my ($name,$type);
1276
 
1277
    $type='';
1278
    if (exists( $self->{files}{$file}{contexts}{$line}{value})) {
1279
        $name= $self->{files}{$file}{contexts}{$line}{value}{name};
1280
        if (exists( $self->{files}{$file}{contexts}{$line}{value}{type})) {
1281
            $type=$self->{files}{$file}{contexts}{$line}{value}{type};
1282
            $type='module' if ($type eq 'primitive' || $type eq 'macromodule');
1283
        }
1284
        return ($name,$type);
1285
    }
1286
    else {
1287
        return ();
1288
    }
1289
}
1290
 
1291
###########################################################################
1292
 
1293
=head1 get_pre_ignore_by_context
1294
 
1295
Test if the context is preprocessor ignore.
1296
 
1297
  Arguments:  - file name
1298
              - line number
1299
 
1300
  Returns:    - 1 if it is, 0 otherwise
1301
 
1302
  Example:    if ($vdata->get_pre_ignore_by_context($file,$line))..
1303
 
1304
=cut
1305
sub get_pre_ignore_by_context{
1306
    my ($self,$file,$line) = @_;
1307
 
1308
    if (exists($self->{files}{$file}{contexts}{$line}{pre_ignore})) {
1309
        return $self->{files}{$file}{contexts}{$line}{pre_ignore};
1310
    }
1311
    else {
1312
        return 0;
1313
    }
1314
 
1315
}
1316
 
1317
###########################################################################
1318
 
1319
=head1 get_first_instantiator_by_context
1320
 
1321
Get the first thing that instantiates this module using the context. The
1322
context must be a module_start.
1323
 
1324
  Arguments:  - file name (for context)
1325
              - line name (for context)
1326
 
1327
  Returns:    - a 4 element list: instantiating module, file, instance name, line
1328
 
1329
  Example:
1330
              @i=$vdata->get_first_instantiator_by_context($f,$l );
1331
 
1332
=cut
1333
sub get_first_instantiator_by_context{
1334
    my ($self,$file,$line) = @_;
1335
 
1336
    # note: the second exists() checks that the module still exists as
1337
    #  it could have been deleted because a duplicate was found
1338
    if (exists($self->{files}{$file}{contexts}{$line}{module_start}) &&
1339
        exists($self->{modules}
1340
               {$self->{files}{$file}{contexts}{$line}{module_start}}) &&
1341
        exists($self->{files}{$file}{contexts}{$line}{value}{inst_by})) {
1342
        $self->{current_instantiator}       =0;
1343
        $self->{current_instantiator_module}=
1344
            $self->{files}{$file}{contexts}{$line}{module_start};
1345
        return $self->get_next_instantiator();
1346
    }
1347
    else {
1348
        return ();
1349
    }
1350
 
1351
}
1352
 
1353
###########################################################################
1354
 
1355
=head1 get_inst_on_line
1356
 
1357
Gets the instance name of a line in a file
1358
 
1359
  Arguments:  - file name
1360
              - line number
1361
 
1362
  Returns:    - name if the line has an instance name, 0 otherwise
1363
 
1364
  Example:    if ( $new_inst = $vdata->get_inst_on_line($file,$line) ) ...
1365
 
1366
=cut
1367
sub get_inst_on_line{
1368
    my ($self,$file,$line) = @_;
1369
 
1370
    if ( exists( $self->{files}{$file}{instance_lines}{$line})){
1371
        return $self->{files}{$file}{instance_lines}{$line};
1372
    }
1373
    else {
1374
        return 0;
1375
    }
1376
}
1377
 
1378
###########################################################################
1379
 
1380
=head1 get_signal_by_context
1381
 
1382
Same as get_module_signal but works by specifying a context.
1383
 
1384
  Arguments:  - context file name
1385
              - context line number
1386
              - signal name
1387
 
1388
  Returns:    same as get_module_signal
1389
 
1390
  Example:
1391
 
1392
=cut
1393
# get a signal by context - returns: line, a_line, i_line, type, file
1394
sub get_signal_by_context{
1395
    my ($self,$file,$cline,$sig) = @_;
1396
 
1397
    my $sigp;
1398
 
1399
    # in tasks and functions signals can come from module (m_signals)
1400
    #  or from the task or function itself (which gets precedence).
1401
    if (exists( $self->{files}{$file}{contexts}{$cline}{value}{signals}{$sig} )) {
1402
        print " found signal $sig\n" if $debug;
1403
        $sigp=$self->{files}{$file}{contexts}{$cline}{value}{signals}{$sig};
1404
    }
1405
    elsif (exists( $self->{files}{$file}{contexts}{$cline}{value}{m_signals}{$sig} )) {
1406
        print " found m_signal $sig\n" if $debug;
1407
        $sigp=$self->{files}{$file}{contexts}{$cline}{value}{m_signals}{$sig};
1408
    }
1409
    else {
1410
        return ();
1411
    }
1412
 
1413
    return ($sigp->{line},
1414
            $sigp->{a_line},
1415
            $sigp->{i_line},
1416
            $sigp->{type},
1417
            $sigp->{file},
1418
            $sigp->{posedge},
1419
            $sigp->{negedge},
1420
            $sigp->{type2},
1421
            $sigp->{source}{file},
1422
            $sigp->{source}{line},
1423
            $sigp->{range},
1424
            $sigp->{a_file},
1425
            $sigp->{i_file},
1426
            $sigp->{dimensions});
1427
}
1428
 
1429
###########################################################################
1430
 
1431
=head1 get_t_or_f_by_context
1432
 
1433
Same as get_modules_t_or_f but works by specifying a context.
1434
 
1435
  Arguments:  - context file name
1436
              - context line number
1437
              - task name
1438
 
1439
  Returns:    - same as get_modules_t_or_f
1440
 
1441
  Example:
1442
 
1443
=cut
1444
sub get_t_or_f_by_context{
1445
    my ($self,$cfile,$cline,$t_or_f) = @_;
1446
 
1447
    if (exists($self->{files}{$cfile}{contexts}{$cline}{value}{t_and_f}{$t_or_f})) {
1448
        return($self->{files}{$cfile}{contexts}{$cline}{value}{t_and_f}{$t_or_f}{type},
1449
               $self->{files}{$cfile}{contexts}{$cline}{value}{t_and_f}{$t_or_f}{line},
1450
               $self->{files}{$cfile}{contexts}{$cline}{value}{t_and_f}{$t_or_f}{file},
1451
               $self->{files}{$cfile}{contexts}{$cline}{value}{t_and_f}{$t_or_f}{anchor});
1452
    }
1453
    else {
1454
        return ();
1455
    }
1456
}
1457
###########################################################################
1458
 
1459
=head1 get_parameter_by_context
1460
 
1461
Return the file and line for a named parameter using context
1462
 
1463
  Arguments:  - context file name
1464
              - context line number
1465
              - parameter name
1466
 
1467
  Returns:    - file and line of definition
1468
 
1469
  Example:
1470
 
1471
=cut
1472
sub get_parameter_by_context{
1473
    my ($self,$cfile,$cline,$parameter) = @_;
1474
 
1475
    if (exists($self->{files}{$cfile}{contexts}{$cline}{value}{parameters}{$parameter})) {
1476
        return($self->{files}{$cfile}{contexts}{$cline}{value}{parameters}{$parameter}{file},
1477
               $self->{files}{$cfile}{contexts}{$cline}{value}{parameters}{$parameter}{line});
1478
    }
1479
    else {
1480
        return ();
1481
    }
1482
}
1483
###########################################################################
1484
 
1485
=head1 get_anchors
1486
 
1487
Get the anchors for a line in a file.
1488
 
1489
 
1490
  Returns:    - a list of anchors
1491
 
1492
  Example:   foreach $anchor ( $vdata->get_anchors($file,$line) ) ..
1493
 
1494
=cut
1495
sub get_anchors{
1496
    my ($self,$file,$line) = @_;
1497
 
1498
    if (exists($self->{files}{$file}{anchors}{$line})) {
1499
        return @{$self->{files}{$file}{anchors}{$line}};
1500
    }
1501
    else {
1502
        return ();
1503
    }
1504
}
1505
 
1506
###########################################################################
1507
 
1508
=head1 expand_defines
1509
 
1510
Expand the defines in a line of verilog code.  for best use this
1511
should be called line by line, so that the defines get the correct
1512
values when defines are defined multiple times
1513
 
1514
  Arguments:  - a pointer to the string to expand the defines in
1515
              - the file the line is from
1516
              - the line number of the line
1517
 
1518
  Returns:    - nothing
1519
 
1520
  Example:   $vdata->expand_defines(\$line_to_expand,$file,$line);
1521
 
1522
=cut
1523
###############################################################################
1524
#
1525
sub expand_defines {
1526
    my ($self,$bufp,$file,$line) = @_;
1527
 
1528
    if (exists($self->{files}{$file}{define_lines}{$line})) {
1529
        # do not expand on a `define line - it doesn't make sense to do so
1530
        #  as the substitution of defines in the value only occurs at the
1531
        #  time of use when they could have different values!
1532
        return;
1533
    }
1534
 
1535
 
1536
    while ( $$bufp =~ m/^(.*?)\`($VID)/ ) {
1537
        my $b = $1;
1538
        my $d = $2;
1539
        my $dq = quotemeta($d);
1540
        my $v;
1541
        if ((undef,undef,$v) = $self->get_define($d,$file,$line)) {
1542
            $$bufp =~ s/\`$dq/$v/;
1543
        }
1544
        else {
1545
            $$bufp =~ s/\`$dq/_BaCkQuOtE_$dq/;
1546
        }
1547
 
1548
    }
1549
    $$bufp =~ s/_BaCkQuOtE_/\`/g;
1550
}
1551
 
1552
 
1553
###########################################################################
1554
 
1555
=head1 verilog_gatetype_keywords
1556
 
1557
 
1558
  Returns:    - a list of verilog gatetype keywords
1559
 
1560
  Example:   @keywords = rvp->verilog_gatetype_keywords();
1561
 
1562
=cut
1563
sub verilog_gatetype_keywords {
1564
    return (@verilog_gatetype_keywords);
1565
}
1566
###########################################################################
1567
 
1568
=head1 verilog_compiler_keywords
1569
 
1570
  Returns:    - a list of verilog compiler keywords
1571
 
1572
  Example:   @keywords = rvp->verilog_compiler_keywords();
1573
 
1574
=cut
1575
sub verilog_compiler_keywords {
1576
    return (@verilog_compiler_keywords);
1577
}
1578
###########################################################################
1579
 
1580
=head1 verilog_signal_keywords
1581
 
1582
  Returns:    - a list of verilog signal keywords
1583
 
1584
  Example:   @keywords = rvp->verilog_signal_keywords();
1585
 
1586
=cut
1587
sub verilog_signal_keywords {
1588
    return (@verilog_signal_keywords);
1589
}
1590
 
1591
 
1592
###########################################################################
1593
 
1594
=head1 chunk_read_init
1595
 
1596
Initialise a file for chunk reading (see chunk_read for more
1597
details). It actually reads the whole file into a string, which
1598
chunk_read then reads a chunk at a time. The file is closed before
1599
chuck_read_init returns.
1600
 
1601
  Arguments:  - the file to read (with path if needed)
1602
              - tabstop: 0 = leave tabs alone
1603
                         N = turn tabs spaces with each tabstop=N
1604
  Returns:    - a handle to pass to chunk_read or 0 if file open fails
1605
 
1606
  Example:
1607
            my $chunkRead = rvp->chunkr_read_init($f,$opts{tabstop});
1608
 
1609
=cut
1610
sub chunk_read_init {
1611
 
1612
    my ($class,$f,$tabstop) = @_;
1613
    local (*F);
1614
 
1615
    open(F,"<$f") || return 0;
1616
 
1617
    my $chunk = { type => "",
1618
                  text => "",
1619
                  isANewLine => 0,
1620
                  isStart => 0,
1621
                  isEnd => 1 ,
1622
                  line => 0 };
1623
 
1624
    my $this = { chunk => $chunk ,
1625
                 tabstop => $tabstop ,
1626
                 linebuf => "" ,
1627
                 state => 0 ,
1628
                 fh => *F };
1629
    return $this;
1630
}
1631
 
1632
###########################################################################
1633
 
1634
=head1 chunk_read
1635
 
1636
Reads verilog a chunk at a time. The file is opened using
1637
chunk_read_init. Then chunk_read is used to read the file a chunk at a
1638
time.  A chunk is a line or part of a line that is all the same type.
1639
 
1640
  The types are:
1641
              comment   - either // or /* */ comment
1642
              attribute - verilog 2001 (* *) atribute
1643
              include   - a line containing `include "file"
1644
              string    - a string
1645
              code      - anything else (verilog code, defines, compliler keywords)
1646
 
1647
Nothing is removed from the file, so if each chunk is printed after being read
1648
you will end up with exactly the same file as you put in.
1649
 
1650
  Arguments:  - handle (from chunk_read_init)
1651
 
1652
  Returns:    - 0 at the end of file, or a hash ref with the following keys:
1653
              type       - one of the types (see above)
1654
              text       - the text read from the file
1655
              line       - the line number the text is on
1656
              isANewLine - true if chunk is the first chunk of the line
1657
              isStart    - true if the chunk is the start (eg "/*..." for
1658
                             a comment )
1659
              isEnd      - true if the chunk is the end ( eg "*/" )
1660
                      NOTE: isEnd is set to undefined for a
1661
                       type="code" that ends in a newline. This is
1662
                       because chunk_read doesn't know if the code is
1663
                       ending or not. If you need to know in this case
1664
                       you can read the next chunk and see what type it is.
1665
 
1666
  Example:
1667
            my $chunkRead = rvp->chunk_read_init($f,0);
1668
            while ($chunk = rvp->chunk_read($chunkRead)) {
1669
                    print $chunk->{text} unless $chunk->{type} eq "comment";
1670
            }
1671
 
1672
=cut
1673
sub chunk_read {
1674
   my ($class,$this) = @_;
1675
 
1676
   my $chunk = $this->{chunk};
1677
   $chunk->{isStart} = $chunk->{isEnd};
1678
   $chunk->{isEnd}  = 0;
1679
   $chunk->{isANewLine} = 0;
1680
 
1681
   if ( $this->{linebuf} eq "" ) {
1682
       if (!defined($this->{linebuf} = readline($this->{fh}))) {
1683
           close($this->{fh});
1684
           return 0;
1685
       }
1686
       $chunk->{isANewLine} = 1;
1687
       $chunk->{line}++;
1688
       if ($this->{tabstop}!=0) {
1689
           # 1 while is some stupid perl thing meaning while (cond) {} may be a bit faster?
1690
           1 while ($this->{linebuf} =~ s/(^|\n)([^\t\n]*)(\t+)/
1691
                    $1. $2 . (" " x ($this->{tabstop} * length($3) -
1692
                                     (length($2) % $this->{tabstop})))
1693
                    /gsex);
1694
       }
1695
   }
1696
 
1697
 STATE_SWITCH:
1698
   if ( $this->{state} == 0 ) {
1699
       $chunk->{type} = "code";
1700
       if ( $this->{linebuf} =~
1701 48 alirezamon
            s%^(.*?)((/\*)|           # anything followed by /* comment              
1702 16 alirezamon
                     (//)|            #    or // comment
1703
                     (\(\*(?!\s*\)))| #    or (* attribute (but not (*)
1704
                     (\`include\s)|   #    or `include
1705 48 alirezamon
                     (\")|            #    or start of string
1706
                     (import\s))      # import package
1707
 
1708
 
1709 16 alirezamon
            %$2%ox ) {
1710
           $chunk->{isEnd} = 1;
1711
           $chunk->{text} = $1;
1712
           if (defined($3)) {
1713
               $this->{state} = 1;  # long comment
1714
           }
1715 48 alirezamon
           elsif (defined($4) ||defined($8) ) {
1716 16 alirezamon
               $this->{state} = 2;  # short comment
1717
           }
1718
           elsif (defined($5)) {
1719
               $this->{state} = 3;  # attribute
1720
           }
1721
           elsif (defined($6)) {
1722
               $this->{state} = 4;  # include
1723
           }
1724
           elsif (defined($7)) {
1725
               $this->{state} = 5;  # string
1726
           }
1727
           else {
1728
               die "chunk_read internal error!";
1729
           }
1730
           if (!$chunk->{text}) {
1731
               # this happens if we are in state code and a new line
1732
               #  starts with something that isn't code. So we change
1733
               #  and go back to the top.
1734
               $chunk->{isStart} = 1;
1735
               $chunk->{isEnd}  = 0;
1736
               goto STATE_SWITCH;
1737
           }
1738
       }
1739
       else {
1740
           $chunk->{text} = $this->{linebuf};
1741
           $this->{linebuf} = "";
1742
           # in this case we might be at end, but we don't really know!
1743
           $chunk->{isEnd}  = undef;
1744
       }
1745
   }
1746
   elsif ( $this->{state} == 1 ) {
1747
       $chunk->{type} = "comment";
1748
       # this first test is needed to work so /*/  */ works
1749
       if ( $chunk->{isStart} && $this->{linebuf} =~ s%^/\*%% ) {
1750
           $chunk->{text} = "/*";
1751
       }
1752
       else {
1753
           $chunk->{text} = "";
1754
       }
1755
       if ( $this->{linebuf} =~ s%^(.*?\*/)%% ) {          # anything followed by */
1756
           $chunk->{text} .= $1;
1757
           $this->{state} = 0;
1758
           $chunk->{isEnd} = 1;
1759
       }
1760
       else {
1761
           $chunk->{text} .= $this->{linebuf};
1762
           $this->{linebuf} = "";
1763
       }
1764
   }
1765
   elsif ( $this->{state} == 2 ) {
1766
       $chunk->{type} = "comment";
1767
       $chunk->{text} = $this->{linebuf};
1768
       $chunk->{isEnd} = 1;
1769
       $this->{linebuf} = "";
1770
       if ( $chunk->{text} =~ s/\n$// ) {
1771
           $this->{linebuf} = "\n";
1772
       }
1773
       $this->{state} = 0;
1774
   }
1775
   elsif ( $this->{state} == 3 ) {
1776
       $chunk->{type} = "attribute";
1777
       if ( $this->{linebuf} =~ s%^(.*?\*\))%% ) {          # anything followed by *)
1778
           $chunk->{text} = $1;
1779
           $this->{state} = 0;
1780
           $chunk->{isEnd} = 1;
1781
       }
1782
       else {
1783
           $chunk->{text} = $this->{linebuf};
1784
           $this->{linebuf} = "";
1785
       }
1786
   }
1787
   elsif ( $this->{state} == 4 ) {
1788
       $chunk->{type} = "include";
1789
       $chunk->{isEnd} = 1;
1790
       if ( $this->{linebuf} =~ s%^(\`include\s+\".*?\")%% ) {
1791
           $chunk->{text} = $1;
1792
           $this->{state} = 0;
1793
       }
1794
       else {
1795
           # this is an error - just return the line as code - the parser will
1796
           #  report the error
1797
           $chunk->{type} = 0;
1798
           $chunk->{text} = $this->{linebuf};
1799
           $this->{linebuf} = "";
1800
       }
1801
   }
1802
   elsif ( $this->{state} == 5 ) {
1803
       $chunk->{type} = "string";
1804
       # string all on one line
1805
       if ( $this->{linebuf} =~ s%^(\"(?:(?:\\\\)|(?:\\\")|(?:[^\"]))*?\")%% ) {
1806
           $chunk->{text} = $1;
1807
           $this->{state} = 0;
1808
           $chunk->{isEnd} = 1;
1809
       }
1810
       # end of multiline string (doesn't start with quote)
1811
       elsif ( $this->{linebuf} =~ s%^([^\"](?:(?:\\\\)|(?:\\\")|(?:[^\"]))*?\")%% ) {
1812
           $chunk->{text} = $1;
1813
           $this->{state} = 0;
1814
           $chunk->{isEnd} = 1;
1815
       }
1816
       # middle of multiline string
1817
       else {
1818
           $chunk->{text} = $this->{linebuf};
1819
           $this->{linebuf} = "";
1820
       }
1821
   }
1822
 
1823
   return $chunk;
1824
}
1825
 
1826
###############################################################################
1827
#  RVP internal functions from now on.... (they all start with _ to
1828
#   let you know they are internal
1829
###############################################################################
1830
 
1831
###############################################################################
1832
# search a file, putting the data in $self
1833
#   Note: be careful coding in the main loop... there are a few optimisations
1834
#    which result in big chunks of code being skipped if the line does not
1835
#    contain certain characters (eg ' " / *)
1836
sub _search {
1837
    my ($self,$f,$inc_dirs) = @_;
1838
 
1839
    my $verilog_compiler_keywords_regexp = "(?:" .
1840
        join("|",@verilog_compiler_keywords) .
1841
            ")";
1842
 
1843
 
1844
    my $file=_ffile($f);
1845
    _init_file($self->{files},$f);
1846
 
1847
    print "Searching $f " unless $quiet;
1848
    my $chunkRead= rvp->chunk_read_init($f,0) ||
1849
        die "Error: can not open file $f to read: $!\n";
1850
    my $file_dir = dirname($f);
1851
 
1852
    my $rs = {};
1853
    $rs->{modules}   = $self->{modules};
1854
    $rs->{files}     = $self->{files};
1855
    $rs->{unres_mod} = $self->{unresolved_modules};
1856
 
1857
    $rs->{module}   = '';
1858
    $rs->{function} = '';
1859
    $rs->{task}     = '';
1860
    $rs->{t}        = undef; # temp store
1861
    $rs->{p}        = undef;
1862
 
1863
    my $printline = 1000;
1864
 
1865
    my $ps = {};
1866
    my $nest=0;
1867
    my $nest_at_ignore;
1868
    my @ignore_from_elsif;
1869
    my $ignoring=0;
1870
    my @fileStack =();
1871
    my $pp_ignore;
1872
    my $chunk;
1873
    while (1) {
1874
        while ($chunk = rvp->chunk_read($chunkRead)) {
1875
            $self->{files}{$file}{lines} = $chunk->{line};
1876
            if ($chunk->{line}>$printline && !$quiet) {
1877
                $printline+=1000;
1878
                $|=1; # turn on autoflush
1879
                print ".";
1880
                $|=0 unless $debug; # turn off autoflush
1881
            }
1882
 
1883
            # deal quickly with blank lines
1884
            if ( $chunk->{text} =~ m/^\s*\n/ ) {
1885
                next;
1886
            }
1887
 
1888
 
1889
            if ( $chunk->{type} eq "code" ) {
1890
 
1891
 
1892
                ####################################################
1893
                # Optimisation: if there are no ` 
1894
                #  we can parse the line now
1895
                if ( $chunk->{text} !~ m|[\`]| ) {
1896
                    if ($nest && $ignoring) {
1897
                        next;
1898
                    }
1899
                    $self->_parse_line($chunk->{text},$file,$chunk->{line},$ps,$rs);
1900
                    next;
1901
                }
1902
 
1903
                # handle ifdefs
1904
                if ($nest && $ignoring) {
1905
                    if ( $chunk->{text} =~ m/^\s*\`(?:ifdef|ifndef)\s+($VID)/ ) {
1906
                        print " Found at line $chunk->{line} : if[n]def (nest=$nest)\n" if $debug;
1907
                        $nest++;
1908
                    }
1909
                    elsif ( $chunk->{text} =~ m/^\s*\`(else|(?:elsif\s+($VID)))/ ) {
1910
                        print " Found at line $chunk->{line} : $1 (nest=$nest)\n" if $debug;
1911
                        if ($1 eq 'else' ||
1912
                            _parsing_is_defined($self->{defines},$2,
1913
                                                $file,$chunk->{line})) {
1914
                            # true elsif or plain else
1915
                            if ($nest == $nest_at_ignore &&
1916
                                !$ignore_from_elsif[$nest]) {
1917
                                $ignoring=0;
1918
                                $$pp_ignore = $chunk->{line};
1919
                            }
1920
                        }
1921
                    }
1922
                    elsif ( $chunk->{text} =~ m/^\s*\`endif/ ) {
1923
                        print " Found at line $chunk->{line} : endif (nest=$nest)\n" if $debug;
1924
                        if ($nest == $nest_at_ignore) {
1925
                            $ignoring=0;
1926
                            $$pp_ignore = $chunk->{line};
1927
                        }
1928
                        $nest--;
1929
                    }
1930
                    next;
1931
                }
1932
                # handle the case where the endif is on the same line as the ifdef
1933
                #  (note: generally I only accept endif at the start of a line)
1934
                if ( $chunk->{text} =~ m/\`(ifdef|ifndef)\s+($VID).*\`endif/ ) {
1935
                    print "$file: ifdef and endif on same line\n" if $debug;
1936
                    my $is_defined = _parsing_is_defined($self->{defines},$2,
1937
                                                         $file,$chunk->{line});
1938
                    if ( (($1 eq 'ifdef' ) && !$is_defined) ||
1939
                         (($1 eq 'ifndef') &&  $is_defined)) {
1940
                        # replace ifdef with nothing
1941
                        $chunk->{text} =~ s/\`(ifdef|ifndef)\s+($VID)(.*)\`endif//;
1942
                    }
1943
                    else {
1944
                        # replace ifdef with what is between the ifdef and endif
1945
                        $chunk->{text} =~ s/\`(ifdef|ifndef)\s+($VID)(.*)\`endif/$3/;
1946
                    }
1947
                }
1948
                if ( $chunk->{text} =~ m/^\s*\`(ifdef|ifndef)\s+($VID)/ ) {
1949
                    $nest++;
1950
                    print " Found at line $chunk->{line} : $1 $2 (nest=$nest)\n" if $debug;
1951
                    my $is_defined = _parsing_is_defined($self->{defines},$2,
1952
                                                         $file,$chunk->{line});
1953
                    if ( (($1 eq 'ifdef' ) && !$is_defined) ||
1954
                         (($1 eq 'ifndef') &&  $is_defined)) {
1955
                        $ignoring=1;
1956
                        $self->{files}{$file}{contexts}{$chunk->{line}}{pre_ignore} = 'XX';
1957
                        $pp_ignore = \$self->{files}{$file}{contexts}{$chunk->{line}}{pre_ignore};
1958
                        $nest_at_ignore=$nest;
1959
                        $ignore_from_elsif[$nest]=0;
1960
                    }
1961
                    next;
1962
                }
1963
                if ( $chunk->{text} =~ m/^\s*\`(else|(?:elsif\s+($VID)))/ ) {
1964
                    print " Found at line $chunk->{line} : $1 (nest=$nest)\n" if $debug;
1965
                    if ($nest) {
1966
                        $ignoring=1;
1967
                        $self->{files}{$file}{contexts}{$chunk->{line}}{pre_ignore} = 'XX';
1968
                        $pp_ignore = \$self->{files}{$file}{contexts}{$chunk->{line}}{pre_ignore};
1969
                        $nest_at_ignore=$nest;
1970
                        # an ignore from an elsif means you will never stop ignoring
1971
                        #   at this nest level
1972
                        $ignore_from_elsif[$nest]=($1 ne 'else');
1973
                    }
1974
                    else {
1975
                        $self->_add_warning("$file:$chunk->{line}: found $1 without \`ifdef");
1976
                    }
1977
                    next;
1978
                }
1979
                if ( $chunk->{text} =~ m/^\s*\`endif/ ) {
1980
                    print " Found at line $chunk->{line} : endif (nest=$nest)\n" if $debug;
1981
                    if ($nest) {
1982
                        $nest--;
1983
                    }
1984
                    else {
1985
                        $self->_add_warning("$file:$chunk->{line}: found \`endif without \`ifdef");
1986
                    }
1987
                    next;
1988
                }
1989
 
1990
                # match define. Note: /s makes the .* match the \n too
1991
                if ( $chunk->{text} =~ m/^\s*\`define\s+($VID)(.*)/s ) {
1992
                    my $def = $1;
1993
                    my $rest = defined($2)?$2:'';
1994
                    my $defLine = $chunk->{line};
1995
                    $self->{files}{$file}{define_lines}{$chunk->{line}} = 1;
1996
 
1997
                    # _parsing_expand_defines is called to register the use
1998
                    #  of any multiplely defined defines in the value part of
1999
                    #  the define
2000
                    my $tmpValue=$rest;
2001
                    $self->_parsing_expand_defines(\$tmpValue,$file,$chunk->{line});
2002
 
2003
                    # handle multiline defines: read more stuff if line ends in backslash
2004
                    #  (revisit: verilog spec says leave the newline in the value)
2005
                    # also keep adding stuff to value until it ends in a newline or comment
2006
                    #  because strings are seperated out, `define T $display("test")
2007
                    #  is delivered as chunks '`define T $display(' ,'"test"', ')\n'
2008
                    while ( (($rest =~ s|\\\n|| ) ||  ($rest !~ m/\n$/) )
2009
                            && ($chunk = rvp->chunk_read($chunkRead))) {
2010
                        last if $chunk->{type} eq "comment";
2011
                        $rest .= $chunk->{text};
2012
                        $self->{files}{$file}{define_lines}{$chunk->{line}} = 1;
2013
                        # _parsing_expand_defines call: see comment ~15 lines back
2014
                        my $tmpValue=$chunk->{text};
2015
                        $self->_parsing_expand_defines(\$tmpValue,$file,$chunk->{line});
2016
                    }
2017
                    my $value = $rest;
2018
                    $value =~ s/^\s+(.*)(\n)?/$1/;
2019
 
2020
                    print " Found in $file line $defLine : define $def = $value\n"
2021
                        if $debug;
2022
                    _add_define($self->{defines}, $def , $value , $file, $defLine );
2023
                    _add_anchor($self->{files}{$file}{anchors},$defLine,"");
2024
                    # Don't substitute now: [defines] shall be substituted after the 
2025
                    # original macro is substituted, not when it is defined(1364-2001 pg353)
2026
                    next;
2027
                }
2028
 
2029
                if ( $chunk->{text} =~ m/^\s*\`undef\s+($VID)/ ) {
2030
                    _undef_define($self->{defines},$1);
2031
                    print " Found at line $chunk->{line} : undef $1\n" if $debug;
2032
                    next;
2033
                }
2034
 
2035
                if ( $chunk->{text} =~ m/^\s*$verilog_compiler_keywords_regexp/ ) {
2036
                    next;
2037
                }
2038
                $self->_parsing_expand_defines(\$chunk->{text},$file,$chunk->{line});
2039
 
2040
                # Note this is called from two other places (optimisations)
2041
                $self->_parse_line($chunk->{text},$file,$chunk->{line},$ps,$rs);
2042
            }
2043
            elsif ( $chunk->{type} eq "include" ) {
2044
                if ($nest && $ignoring) {
2045
                    next;
2046
                }
2047
 
2048
                $chunk->{text} =~ m/^\s*\`include\s+\"(.*?)\"/ ;
2049
                # revisit - need to check for recursive includes
2050
                print " Found at line $chunk->{line} : include $1\n" if $debug;
2051
                $self->{files}{$file}{includes}{_ffile($1)}=$chunk->{line};
2052
                my $inc_file = $1;
2053
                my $inc_file_and_path = _scan_dirs($inc_file,$inc_dirs,$file_dir);
2054
                if ($inc_file_and_path) {
2055
                    push(@fileStack,$chunkRead,$f);
2056
                    $f = $inc_file_and_path;
2057
                    $file=_ffile($f);
2058
                    $file_dir = dirname($f);
2059
 
2060
                    if (!exists($self->{files}{$file})) {
2061
                        _init_file($self->{files},$f);
2062
                        if (exists($rs->{modules}{$rs->{module}})) {
2063
                            $self->{files}{$file}{contexts}{"1"}{value} =
2064
                                $rs->{modules}{$rs->{module}};
2065
                        }
2066
                    }
2067
                    print "\n Include: $f " unless $quiet;
2068
                    $chunkRead=rvp->chunk_read_init($f,0);
2069
                }
2070
                else {
2071
                    $self->_add_warning("$file:$chunk->{line}: Include file $inc_file not found");
2072
                }
2073
                next;
2074
            }
2075
 
2076
            if (defined($pp_ignore) && $pp_ignore eq "XX") { # no endif
2077
                $$pp_ignore = $chunk->{line};
2078
            }
2079
        }
2080
        # check if we were included from another file
2081
        if (0==scalar(@fileStack)) {
2082
            print "Stack is empty\n" if $debug;
2083
            last;
2084
        }
2085
        else {
2086
            $f    = pop(@fileStack);
2087
            $chunkRead = pop(@fileStack);
2088
            $file = _ffile($f);
2089
            $file_dir = dirname($f);
2090
            print "\n Back to $f" unless $quiet;
2091
        }
2092
    }
2093
 
2094
    print "\n" unless $quiet;
2095
 
2096
    $self->_check_end_state($file,$self->{files}{$file}{lines},$ps);
2097
 
2098
}
2099
 
2100
sub _open_file {
2101
    my ($f) = @_;
2102
    local (*F);
2103
 
2104
    print "Searching $f " unless $quiet;
2105
    open(F,"<$f") || die "Error: can not open file $f to read: $!\n ";
2106
    return *F;
2107
}
2108
 
2109
# only for use while parsing - returns the last defined value
2110
#  in a multiple define case, and also sets up the {used} info
2111
#  for use later when querying the database
2112
# returns ($value,$errcode)
2113
#  where $errcode = 0  value ok
2114
#                   1  value never defined
2115
#                   2  value has been undefined
2116
sub _parsing_get_define_value {
2117
    my ($defines,$define,$file,$line) = @_;
2118
 
2119
    if (!exists( $defines->{$define} )) {
2120
        return ('',1);
2121
    }
2122
    my $index = 0;
2123
    my $dh = $defines->{$define};
2124
 
2125
    if ( 1 < @{$dh->{defined}} ) {
2126
        $index = $#{$dh->{defined}};
2127
 
2128
        $dh->{used}{$file}{$line} = $index;
2129
    }
2130
 
2131
    if ($dh->{defined}[$index]{undefed}) {
2132
        $dh->{used}{$file}{$line} = "XX";
2133
        return ('',2);
2134
    }
2135
 
2136
    return  ( $dh->{defined}[$index]{value} , 0 );
2137
}
2138
 
2139
sub _parsing_is_defined {
2140
    my ($defines,$define,$file,$line) = @_;
2141
 
2142
    my $v;
2143
    my $errcode;
2144
    ($v,$errcode) = _parsing_get_define_value($defines,$define,$file,$line);
2145
    if ( ($errcode == 1)  ||   # never defined
2146
         ($errcode == 2) ) {   # defined then undefed
2147
        return 0;
2148
    }
2149
    elsif ($errcode == 0) {
2150
        return 1;
2151
    }
2152
    else {
2153
        die "parsing_is_defined internal error code=$errcode";
2154
    }
2155
}
2156
 
2157
sub _undef_define {
2158
    my ($defines,$define) = @_;
2159
 
2160
    if (exists( $defines->{$define} )) {
2161
        my $index = $#{$defines->{$define}{defined}};
2162
        $defines->{$define}{defined}[$index]{undefed} = 1;
2163
    }
2164
}
2165
 
2166
###############################################################################
2167
# for best use this should be called line by line, so that the
2168
#  defines get the correct values when defines are defined multiple
2169
#  times
2170
# - this function is only used during the initial parsing of the files
2171
#  (it has the error reproting code in it), use expand_defines() other times
2172
#  it also expands on define lines (used to register the use of multiple
2173
#   define defines) which expand_defines doesn't
2174
#
2175
sub _parsing_expand_defines {
2176
    my ($self,$bufp,$file,$line) = @_;
2177
 
2178
    my $defines = $self->{defines};
2179
    while ( $$bufp =~ m/^(.*?)\`($VID)/ ) {
2180
        my $b = $1;
2181
        my $d = $2;
2182
        my $dq = quotemeta($d);
2183
        my $v;
2184
        my $errCode=0;
2185
        ($v,$errCode)=_parsing_get_define_value($defines,$d,$file,$line);
2186
 
2187
        if ($errCode == 0) {  # no error
2188
            $$bufp =~ s/\`$dq/$v/;
2189
        }
2190
        else {
2191
            if ($errCode == 2) {  # defined but then undefed
2192
                $self->_add_warning("$file:$line: define `$d used after undef");
2193
                $$bufp =~ s/\`$dq//;
2194
            }
2195
            elsif ($b =~ m/^\s*$/) {
2196
                $self->_add_warning("$file:$line: unknown define: `$d, guessing it is a compiler directive");
2197
                $$bufp='';
2198
            }
2199
            else {
2200
                $self->_add_warning("$file:$line: found undefined define `$d");
2201
                $$bufp =~ s/\`$dq//;
2202
            }
2203
        }
2204
    }
2205
}
2206
 
2207
###############################################################################
2208
# Look through all the include/library directories for an include/library file
2209
#  optional $file_dir is used when including - here a relative path is
2210
#   relative to the file doing the including, so check this it checks this
2211
sub _scan_dirs {
2212
    my ($fname,$inc_dirs,$file_dir) = @_;
2213
    my ($dir);
2214
 
2215
    if ( $fname =~ m|^/| ) { # an absolute path
2216
      return "$fname" if ( -r "$fname" && ! -d "$fname");
2217
    }
2218
    if (defined($file_dir) && -r "$file_dir/$fname" && ! -d "$file_dir/$fname") {
2219
        return "$file_dir/$fname";
2220
    }
2221
    else {
2222
      foreach $dir (@{$inc_dirs}) {
2223
          $dir =~ s|/$||;
2224
          return "$dir/$fname" if ( -r "$dir/$fname" && ! -d "$dir/$fname");
2225
      }
2226
    }
2227
    return '';
2228
}
2229
 
2230
###############################################################################
2231
# Take a look through the unresolved modules , delete any that have already
2232
#  been found, and for the others look on the search path
2233
#
2234
sub _resolve_modules {
2235
    my ($self,$lib_dirs, $lib_exts)= @_;
2236
    my ($m,$file,@resolved,$lib_ext);
2237
 
2238
    @resolved=();
2239
    foreach $m (sort (keys %{$self->{unresolved_modules}})) {
2240
        if ( exists( $self->{modules}{$m} )) {
2241
            delete( $self->{unresolved_modules}{$m} );
2242
        }
2243
        else {
2244
            foreach $lib_ext (@{$lib_exts}) {
2245
                if ($file = _scan_dirs("$m$lib_ext",$lib_dirs)){
2246
                    delete( $self->{unresolved_modules}{$m} );
2247
                    print "resolve_modules: found $m in $file\n" if $debug;
2248
                    push(@resolved,$file);
2249
                    last;
2250
                }
2251
            }
2252
        }
2253
    }
2254
    return @resolved;
2255
}
2256
 
2257
 
2258
###############################################################################
2259
# Initialize fdata->{files}{FILE} which stores file data
2260
#
2261
sub _init_file {
2262
    my ($fdataf,$file) = @_;
2263
    my ($fb);
2264
    $fb = _ffile($file);
2265
    $fdataf->{$fb} = {};                 # set up hash for each file
2266
    $fdataf->{$fb}{full_name} = $file;
2267
    $fdataf->{$fb}{anchors}  = {};
2268
    $fdataf->{$fb}{modules}  = {};
2269
    $fdataf->{$fb}{contexts} = {};
2270
    $fdataf->{$fb}{includes} = {};
2271
    $fdataf->{$fb}{inc_done} = 0;
2272
    $fdataf->{$fb}{lines}    = 0;
2273
    $fdataf->{$fb}{instance_lines} = {};
2274
    $fdataf->{$fb}{define_lines} = {};
2275
    $fdataf->{$fb}{included_by} = [];
2276
 
2277
}
2278
 
2279
###############################################################################
2280
# Initialize fdata->{FILE}{modules}{MODULE} which stores 
2281
#  module (or macromodule or primitive) data
2282
#
2283
sub _init_module {
2284
    my ($modules,$module,$file,$line,$type) = @_;
2285
 
2286
 
2287
    die "Error: attempt to reinit module" if (exists($modules->{$module}));
2288
 
2289
    $modules->{$module}{line}     = $line;
2290
    $modules->{$module}{name}     = $module;
2291
    $modules->{$module}{type}     = $type;
2292
    $modules->{$module}{end}       = -1;
2293
    $modules->{$module}{file}      = $file;
2294
    $modules->{$module}{t_and_f}   = {}; # tasks and functions
2295
    $modules->{$module}{signals}   = {};
2296
    $modules->{$module}{parameter_order}= [];
2297
    $modules->{$module}{parameters}= {};
2298
    $modules->{$module}{instances} = []; # things that this module instantiates
2299
    $modules->{$module}{inst_by}   = []; # things that instantiated this module
2300
    $modules->{$module}{port_order} = [];
2301
    $modules->{$module}{named_ports} = 1; # assume named ports in instantiations
2302
    $modules->{$module}{duplicate} = 0;   # set if another definition is found
2303
 
2304
}
2305
 
2306
###############################################################################
2307
# Initialize fdata->{FILE}{modules}{MODULE}{t_and_f}{TF} which
2308
#  stores tasks and functions' data
2309
#
2310
sub _init_t_and_f {
2311
    my ($self,$module,$type,$tf,$file,$line,$anchor) = @_;
2312
 
2313
    if (exists($module->{t_and_f}{$tf})) {
2314
        $self->_add_warning("$file:$line new definition of $tf ".
2315
                    "(discarding previous from ".
2316
                    "$module->{t_and_f}{$tf}{file}:$module->{t_and_f}{$tf}{line})");
2317
    }
2318
    $module->{t_and_f}{$tf} = {};
2319
    $module->{t_and_f}{$tf}{type}      = $type;
2320
    $module->{t_and_f}{$tf}{name}      = $tf;
2321
    $module->{t_and_f}{$tf}{line}      = $line;
2322
    $module->{t_and_f}{$tf}{end}       = -1;
2323
    $module->{t_and_f}{$tf}{file}      = $file;
2324
    $module->{t_and_f}{$tf}{signals}   = {};
2325
    $module->{t_and_f}{$tf}{anchor}    = $anchor;
2326
    # point up at things to share with module:
2327
    #  - task and functions
2328
    #  - module signals
2329
    $module->{t_and_f}{$tf}{t_and_f}    = $module->{t_and_f};
2330
    $module->{t_and_f}{$tf}{parameters} = $module->{parameters};
2331
    $module->{t_and_f}{$tf}{parameter_order} = $module->{parameter_order};
2332
    $module->{t_and_f}{$tf}{m_signals}  = $module->{signals};
2333
}
2334
 
2335
# note returns 1 if a signal is added (and an anchor needs to be dropped)
2336
sub _init_signal  {
2337
    my ($self,$signals,$name,$type,$type2,$range,$file,$line,$warnDuplicate,$dims) = @_;
2338
 
2339
    if (exists( $signals->{$name} )) {
2340
        if ($warnDuplicate) {
2341
            if (($signals->{$name}{type} eq "output")||
2342
                ($signals->{$name}{type} eq "inout")||
2343
                ($signals->{$name}{type} eq "input")) {
2344
                if (($signals->{$name}{type} eq "input")
2345
                    && ($type eq "reg")) {
2346
                    $self->_add_warning("$file:$line: ignoring definition".
2347
                                " of input $name as reg (defined as input at".
2348
                                " $signals->{$name}{file}:$signals->{$name}{line})");
2349
                }
2350
                else {
2351
                    $signals->{$name}{type2}=$type;
2352
                }
2353
            }
2354
            elsif (($signals->{$name}{type} eq "reg")&&  # reg before output
2355
                   (($type eq "output") ||
2356
                    ($type eq "inout"))) {
2357
                $signals->{$name}{type}=$type;
2358
                $signals->{$name}{type2}="reg";
2359
            }
2360
            else {
2361
                $self->_add_warning("$file:$line: ignoring another definition".
2362
                            " of signal $name ($type) first seen as".
2363
                            " $signals->{$name}{type} at".
2364
                            " $signals->{$name}{file}:$signals->{$name}{line}");
2365
            }
2366
        }
2367
        return 0;
2368
    }
2369
    else {
2370
        $signals->{$name} = { type     => $type,
2371
                              file     => $file,
2372
                              line     => $line,
2373
                              a_line   => -1,
2374
                              a_file   => "",
2375
                              i_line   => -1,
2376
                              i_file   => "",
2377
                              port_con => [],
2378
                              con_to   => [],
2379
                              posedge  => 0,
2380
                              negedge  => 0,
2381
                              type2    => $type2,
2382
                              source   => { checked => 0, file => "" ,
2383
                                            line => "" },
2384
                              range    => $range,
2385
                              dimensions => $dims,
2386
                              };
2387
        return 1;
2388
    }
2389
}
2390
 
2391
###############################################################################
2392
# Add an anchor to the list of anchors that need to be put in
2393
#  the file
2394
#
2395
sub _add_anchor {
2396
    my ($anchors,$line,$name) = @_;
2397
 
2398
    my ($a,$no_name_exists);
2399
 
2400
    if (! exists($anchors->{$line}) ) {
2401
        $anchors->{$line} = [];
2402
    }
2403
 
2404
    if ( $name ) {
2405
        push( @{$anchors->{$line}} , $name );
2406
    }
2407
    else {
2408
        # if no name is specified then you'll get the line number
2409
        #  as the name, but make sure this only happens once
2410
        $no_name_exists = 0;
2411
        foreach $a ( @{$anchors->{$line}} ) {
2412
            if ($a eq $line) {
2413
                $no_name_exists=1;
2414
                last;
2415
            }
2416
        }
2417
        push( @{$anchors->{$line}} , $line ) unless ($no_name_exists);
2418
    }
2419
}
2420
 
2421
sub _add_define {
2422
    my ($defines,$def_name,$def_value,$file,$line) = @_;
2423
 
2424
    $def_value = '' if (!defined($def_value));
2425
    $def_value =~ s/\s+$//; # remove whitespace from end of define
2426
 
2427
    if (!exists($defines->{$def_name})) {
2428
        $defines->{$def_name} = { defined => [] , used => {} };
2429
    }
2430
 
2431
    if ( (1 == @{$defines->{$def_name}{defined}}) &&
2432
         ($defines->{$def_name}{defined}[0]{file} eq $file) &&
2433
         ($defines->{$def_name}{defined}[0]{line} == $line) ) {
2434
        # if the define is already defined once (and only once) and that 
2435
        #  was the same def (file & line the same - for instance in included
2436
        #   file) then there is no need to do anything
2437
    }
2438
    else {
2439
        push (@{$defines->{$def_name}{defined}},
2440
              { line => $line, file => $file ,
2441
                value => $def_value, undefed => 0 });
2442
    }
2443
}
2444
 
2445
###############################################################################
2446
#   Cross referencing
2447
###############################################################################
2448
 
2449
###############################################################################
2450
# Cross-reference all the files:
2451
#  - find the modules and set up $self->{modules}
2452
#  - store the data about where it is instatiated with each module
2453
#  - check for self instantiation
2454
#  - check for files with modules + instances outside modules
2455
#  - set a_line for signals driven by output and i_line
2456
#
2457
sub _cross_reference {
2458
    my ($self) = @_;
2459
    my ($f,$m,$fr,$mr,$m2,$inst,$sig,$sigp,$port_con,$param,$i,$port,$con_to);
2460
 
2461
    # stores the instantiation data in an 
2462
    #  array so that we can easily tell which modules
2463
    #  are disconnected and which are the tops of the
2464
    #  hierarchy and makes it easier to go up
2465
    foreach $m (sort (keys %{$self->{modules}})) {
2466
        print " Making inst_by for $m\n" if $debug;
2467
        foreach $m2 (sort (keys %{$self->{modules}})) {
2468
            foreach $inst (@{$self->{modules}{$m2}{instances}}) {
2469
                if (($inst->{module} eq $m) &&
2470
                    exists($self->{modules}{$m})) {
2471
                    print "    inst by $m2\n" if $debug;
2472
                    push( @{$self->{modules}{$m}{inst_by}},
2473
                           { module => $m2,
2474
                             file   => $inst->{file},
2475
                             inst   => $inst->{inst_name} ,
2476
                             line   => $inst->{line} } );
2477
                }
2478
            }
2479
        }
2480
    }
2481
 
2482
    # Find any modules that appear to instantiate themselves
2483
    #  (to prevent getting into infinite recursions later on)
2484
    foreach $m (sort (keys %{$self->{modules}})) {
2485
        print " Checking  self instantiations for $m\n" if $debug;
2486
        foreach $inst (@{$self->{modules}{$m}{instances}}) {
2487
            if ($inst->{module} eq $m) {
2488
                $self->_add_warning("$inst->{file}:$inst->{line}: $m ".
2489
                            "instantiates itself");
2490
                $inst->{module} = '_ERROR_SELF_INSTANTIATION_';
2491
                # remove the port con for all signals not attached
2492
                foreach $sig (sort (keys %{$self->{modules}{$m}{signals}})) {
2493
                    $sigp = $self->{modules}{$m}{signals}{$sig};
2494
                    my $port_con_ok=[];
2495
                    foreach $port_con (@{$sigp->{port_con}}) {
2496
                        if ($port_con->{module} ne $m) { push(@$port_con_ok,$port_con); }
2497
                        else {  print " Deleting connection for $sig\n" if $debug; }
2498
                    }
2499
                    $sigp->{port_con} = $port_con_ok;
2500
                }
2501
            }
2502
        }
2503
    }
2504
 
2505
    # Go through instances without named ports (port will be a number instead) and
2506
    #  resolve name if you can, otherwise delete. These can appear in signal's port_con
2507
    #  lists and in instances connections lists.
2508
    foreach $m (sort (keys %{$self->{modules}})) {
2509
        if (0 == $self->{modules}{$m}{named_ports}) {
2510
            $f = $self->{modules}{$m}{file}; # for error messages
2511
            print " Resolving numbered port connections in $m\n" if $debug;
2512
            foreach $sig (sort (keys %{$self->{modules}{$m}{signals}})) {
2513
                print "   doing $sig\n" if $debug;
2514
                $sigp = $self->{modules}{$m}{signals}{$sig};
2515
 
2516
                foreach $port_con (@{$sigp->{port_con}}) {
2517
                    if ($port_con->{port} =~ m/^[0-9]/ ) {
2518
                        if ( exists( $self->{modules}{$port_con->{module}}) ) {
2519
                            $m2 = $self->{modules}{$port_con->{module}};
2520
                            if (defined($m2->{port_order}[$port_con->{port}])) {
2521
                                $port_con->{port}=$m2->{port_order}[$port_con->{port}];
2522
                            }
2523
                            else {
2524
                                $self->_add_warning("$port_con->{file}:$port_con->{line}:".
2525
                                            " could not resolve port number to name");
2526
                            }
2527
                        }
2528
                    }
2529
                }
2530
            }
2531
 
2532
            foreach $inst (@{$self->{modules}{$m}{instances}}) {
2533
                if ( exists( $self->{modules}{$inst->{module}}) ) {
2534
                    $m2 = $self->{modules}{$inst->{module}};
2535
                    foreach $port (sort (keys %{$inst->{connections}})) {
2536
                        last if ($port !~ m/^[0-9]/); # if any are named, all are named
2537
                        if (defined($m2->{port_order}[$port])) {
2538
                            # move old connection to named port
2539
                            $inst->{connections}{$m2->{port_order}[$port]} =
2540
                                $inst->{connections}{$port};
2541
                            # remove old numbered port from hash
2542
                            delete($inst->{connections}{$port});
2543
                        }
2544
                        else {
2545
                            $self->_add_warning("$inst->{file}:$inst->{line}:".
2546
                                        "could not resolve port number $port to name)");
2547
                        }
2548
                    }
2549
                }
2550
            }
2551
        }
2552
    }
2553
 
2554
    # Go through all instances with parameter lists and try to resolve names parameter
2555
    #  
2556
    foreach $m (sort (keys %{$self->{modules}})) {
2557
        foreach $inst (@{$self->{modules}{$m}{instances}}) {
2558
            if ($inst->{parameters}) {
2559
                if ( exists( $self->{modules}{$inst->{module}}) ) {
2560
                    my $mp=$self->{modules}{$inst->{module}};
2561
                    foreach my $p (sort (keys %{$inst->{parameters}})){
2562
                        last if ( $p !~ m/^[0-9]+$/ );
2563
                        my $pn = $mp->{parameter_order}[$p];
2564
                        if ($pn) {
2565
                            $inst->{parameters}{$pn} =
2566
                                $inst->{parameters}{$p};
2567
                            delete($inst->{parameters}{$p});
2568
                            print "$inst->{parameters}{$pn}{file}:".
2569
                                "$inst->{parameters}{$pn}{line}: ".
2570
                                "Resolved $p to $pn = $inst->{parameters}{$pn}{value}\n"
2571
                                  if $debug;
2572
                        }
2573
                        else {
2574
                            $self->_add_warning("$inst->{parameters}{$p}{file}:".
2575
                                        "$inst->{parameters}{$p}{line} ".
2576
                                        "could not resolve parameter number $p to name");
2577
                        }
2578
                    }
2579
                }
2580
            }
2581
        }
2582
    }
2583
 
2584
    # Go through all the modules and each signal inside
2585
    #  looking at whether the signal is connected to any outputs
2586
    #   (set the a_line on the first one if it is not already set)
2587
    #  Also, when you see a signal connected to an input (and that
2588
    #   submod is only instantiated once) reach down into the submod
2589
    #   and set the i_line of that signal, so that clicking on the
2590
    #   input can pop you up to the line that input is driven in
2591
    #   one of the instantiations
2592
    foreach $m (sort (keys %{$self->{modules}})) {
2593
        print " Finding port connections in $m\n" if $debug;
2594
        foreach $sig (sort (keys %{$self->{modules}{$m}{signals}})) {
2595
            print "   checking signal $sig\n" if $debug;
2596
            $sigp = $self->{modules}{$m}{signals}{$sig};
2597
 
2598
            foreach $port_con (@{$sigp->{port_con}}) {
2599
                if ( exists( $self->{modules}{$port_con->{module}}) ) {
2600
                    print "    connection to $port_con->{module}\n" if $debug;
2601
                    $m2 = $self->{modules}{$port_con->{module}};
2602
                    if (exists( $m2->{signals}{$port_con->{port}})) {
2603
                        push(@{$m2->{signals}{$port_con->{port}}{con_to}},
2604
                             { signal => $sig , module => $m , inst => $port_con->{inst}});
2605
                        if ( ($m2->{signals}{$port_con->{port}}{type} eq
2606
                              'output') &&
2607
                            ($sigp->{a_line} == -1)) {
2608
                            $sigp->{driven_by_port}=1;
2609
                            $sigp->{a_line} = $port_con->{line};
2610
                            $sigp->{a_file} = $port_con->{file};
2611
                            _add_anchor($self->{files}{$port_con->{file}}{anchors},
2612
                                       $port_con->{line},'');
2613
                        }
2614
                        elsif ($m2->{signals}{$port_con->{port}}{type} eq
2615
                               'input') {
2616
                            $m2->{signals}{$port_con->{port}}{driven_by_port}=1;
2617
                            if (scalar(@{$m2->{inst_by}}) &&
2618
                                ($m2->{signals}{$port_con->{port}}{i_line}==-1)) {
2619
                                $m2->{signals}{$port_con->{port}}{i_line}=
2620
                                  $port_con->{line};
2621
                                $m2->{signals}{$port_con->{port}}{i_file}=
2622
                                  $port_con->{file};
2623
                                _add_anchor($self->{files}{$port_con->{file}}{anchors},
2624
                                           $port_con->{line},'');
2625
                                print "    set i_line $port_con->{port} ".
2626
                                    "$port_con->{file}:$port_con->{line}\n" if $debug;
2627
                            }
2628
                        }
2629
                    }
2630
                }
2631
            }
2632
        }
2633
    }
2634
 
2635
    # find all signal sources
2636
    foreach $m (sort (keys %{$self->{modules}})) {
2637
        print " Finding signal sources in $m\n" if $debug;
2638
        foreach $sig (sort (keys %{$self->{modules}{$m}{signals}})) {
2639
            $sigp = $self->{modules}{$m}{signals}{$sig};
2640
            next if $sigp->{source}{checked};
2641
            print "   finding signal source for $sig of $m\n" if $debug;
2642
            $sigp->{source} = $self->_find_signal_source($sigp);
2643
        }
2644
    }
2645
 
2646
    # propagate the posedge, negedge stuff up the hierarchy
2647
    foreach $m (sort (keys %{$self->{modules}})) {
2648
        # only do the recursion for top level modules
2649
        if ( 0== @{$self->{modules}{$m}{inst_by}} ) {
2650
            $self->_prop_edges($m);
2651
        }
2652
    }
2653
 
2654
    # get included_by information
2655
    foreach $f ( sort (keys %{$self->{files}} )) {
2656
        foreach $i ($self->get_files_includes($f)) {
2657
            if (exists $self->{files}{$i}) {
2658
                push( @{$self->{files}{$i}{included_by}} , $f );
2659
            }
2660
        }
2661
    }
2662
}
2663
 
2664
sub _find_signal_source {
2665
    my ($self,$sigp) = @_;
2666
    my ($con_to,$port_con,$ret_val);
2667
 
2668
    if ($sigp->{source}{checked}) {
2669
        print "     source already found\n" if $debug;
2670
        $ret_val = $sigp->{source};
2671
    }
2672
    else {
2673
        $ret_val =  { checked => 1, file => '' , line => '' };
2674
        if (exists($sigp->{driven_by_port})) {
2675
            print "     drive by port\n" if $debug;
2676
            foreach $con_to (@{$sigp->{con_to}}) {
2677
#               if ($self->{modules}{$con_to->{module}}{signals}{$con_to->{signal}}{type} eq 'input') {
2678
                if ($sigp->{type} eq 'input') {
2679
                    print "       following input $con_to->{signal} $con_to->{module} $con_to->{inst}\n" if $debug;
2680
                    if (!exists($self->{modules}{$con_to->{module}}{signals}{$con_to->{signal}}{i_line})) { die "Error: $con_to->{signal} does not exist $!"; }
2681
                    $ret_val = $self->_find_signal_source(
2682
                                              $self->{modules}{$con_to->{module}}{signals}{$con_to->{signal}});
2683
                }
2684
            }
2685
            foreach $port_con (@{$sigp->{port_con}}) {
2686
                if (exists ($self->{modules}{$port_con->{module}})) {
2687
                    if (exists($self->{modules}{$port_con->{module}}{signals}{$port_con->{port}})) {
2688
                        if ($self->{modules}{$port_con->{module}}{signals}{$port_con->{port}}{type} eq 'output') {
2689
                            print "       following output $port_con->{port} $port_con->{module} $port_con->{inst}\n" if $debug;
2690
                            $ret_val = $self->_find_signal_source(
2691
                                                          $self->{modules}{$port_con->{module}}{signals}{$port_con->{port}});
2692
                        }
2693
                    }
2694
                    else {
2695
                        $self->_add_warning("$port_con->{file}:$port_con->{line}:".
2696
                                    " Connection to nonexistent port ".
2697
                                    " $port_con->{port} of module $port_con->{module}");
2698
                    }
2699
                }
2700
            }
2701
        }
2702
        else {
2703
            if ($sigp->{a_line}==-1) {
2704
                if ($sigp->{type} eq 'input') {
2705
                    print "     signal is an input not driven at higher level\n" if $debug;
2706
                    $ret_val =  { checked => 1, file => $sigp->{file} , line => $sigp->{line} };
2707
                }
2708
                else {
2709
                    print "     signal has unknown source\n" if $debug;
2710
                }
2711
            }
2712
            else {
2713
                print "     signal is driven in this module\n" if $debug;
2714
                $ret_val =  { checked => 1 , file => $sigp->{a_file} , line => $sigp->{a_line} };
2715
            }
2716
        }
2717
    }
2718
 
2719
    $sigp->{source} = $ret_val;
2720
    return $ret_val;
2721
}
2722
 
2723
###############################################################################
2724
# Propagate posedge and negedge attributes of signals up the hierarchy
2725
#
2726
sub _prop_edges {
2727
    my ($self,$m) = @_;
2728
    my ($imod,@inst,$sig,$sigp,$port_con,$m2);
2729
 
2730
    print "Prop_edges $m\n" if $debug;
2731
 
2732
    for ( ($imod) = $self->get_first_instantiation($m) ;
2733
          $imod;
2734
          ($imod) = $self->get_next_instantiation()) {
2735
        push(@inst,$imod) if (exists( $self->{modules}{$imod}));
2736
    }
2737
    foreach $imod (@inst) { $self->_prop_edges($imod); }
2738
 
2739
    # Propagate all the edges up the hierarchy
2740
    foreach $sig (sort (keys %{$self->{modules}{$m}{signals}})) {
2741
        print "   checking signal $sig\n" if $debug;
2742
        $sigp = $self->{modules}{$m}{signals}{$sig};
2743
 
2744
        foreach $port_con (@{$sigp->{port_con}}) {
2745
            if ( exists( $self->{modules}{$port_con->{module}}) ) {
2746
                print "    connection to $port_con->{module}\n" if $debug;
2747
                $m2 = $self->{modules}{$port_con->{module}};
2748
                if (exists( $m2->{signals}{$port_con->{port}})) {
2749
                    print "Propagating posedge on $sig from $port_con->{module} to $m\n"
2750
                        if ($debug && (!$sigp->{posedge})  && $m2->{signals}{$port_con->{port}}{posedge});
2751
                    $sigp->{posedge} |= $m2->{signals}{$port_con->{port}}{posedge};
2752
                    $sigp->{negedge} |= $m2->{signals}{$port_con->{port}}{negedge};
2753
                }
2754
            }
2755
        }
2756
    }
2757
}
2758
 
2759
 
2760
###############################################################################
2761
# given a source file name work out the file without the path
2762
#
2763
sub _ffile {
2764
    my ($sfile) = @_;
2765
 
2766
    $sfile =~ s/^.*[\/\\]//;
2767
 
2768
    return $sfile;
2769
}
2770
 
2771
sub _add_warning {
2772
    my ($self,$p) = @_;
2773
 
2774
    print "Warning:$p\n" if $debug;
2775
    push (@{$self->{problems}},"Warning:$p");
2776
}
2777
sub _add_confused {
2778
    my ($self,$p) = @_;
2779
 
2780
    print "Confused:$p\n" if $debug;
2781
    push (@{$self->{problems}},"Confused:$p");
2782
}
2783
 
2784
###############################################################################
2785
# 
2786
BEGIN {
2787
$baseEval = {
2788
  START => {
2789
    MODULE => '$rs->{t}={ type=>$match, line=>$line };',
2790
  },
2791
  MODULE => {
2792
    SIGNAL => '$rs->{t}={ type=>$match, range=>"", dimensions=>[], name=>"" , type2=>"",block=>0};',
2793
    # if you add to this also edit {AFTER_INST}{COMMA}
2794
    INST => '$rs->{t}={ mod=>$match, line=>$line, name=>"" , port=>0 ,
2795
                        params=>{}, param_number=>0 , portName=>"" , vids=>[]};',
2796
  },
2797
  MODULE_NAME => {
2798
    NAME => 'my $nState="MODULE_PPL";
2799
             my $type = $rs->{t}{type};  $rs->{t}=undef;',
2800
  },
2801
  IN_CONCAT => {
2802
    VID => 'push(@{$rs->{t}{vids}},{name=>$match,line=>$line}) if (exists($rs->{t}{vids}));',
2803
  },
2804
  IN_BRACKET => {
2805
    VID => 'IN_CONCAT:VID',
2806
  },
2807
  SCALARED_OR_VECTORED => {
2808
    TYPE => 'if ($match eq "reg") { $rs->{t}{type2} = "reg"; }'
2809
  },
2810
  SIGNAL_NAME => {
2811
    VID => '$rs->{t}{name}=$match; $rs->{t}{line}=$line;',
2812
  },
2813
  SIGNAL_AFTER_EQUALS => {
2814
    END => '$rs->{t}=undef;',
2815
  },
2816
  INST_PARAM_BRACKET => {
2817
    NO_BRACKET => '$self->_add_warning("$file:$line: possible missing brackets after \# in instantiation");',
2818
  },
2819
  INST_NAME => {
2820
    VID => '$rs->{t}{name}=$match;',
2821
  },
2822
  INST_PORTS => {
2823
    COMMA => '$rs->{t}{port}++;',
2824
  },
2825
  INST_PORT_NAME => {
2826
    NAME => '$rs->{t}{portName}=$match;
2827
             $rs->{t}{vids} = [];', # throw away any instance parameters picked up
2828
  },
2829
  INST_NAMED_PORT_CON => {
2830
    VID => 'push(@{$rs->{t}{vids}},{name=>$match,line=>$line});',
2831
  },
2832
  INST_NAMED_PORT_CON_AFTER => {
2833
    COMMA => 'if ($rs->{t}{portName} eq "") { $rs->{t}{portName}=$rs->{t}{port}++; }
2834
                 my @vids = @{$rs->{t}{vids}};
2835
                 my $portName = $rs->{t}{portName};
2836
                 $rs->{t}{portName}="";
2837
                 $rs->{t}{vids}=[];',
2838
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2839
  },
2840
  INST_NUMBERED_PORT => {
2841
    COMMA   => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2842
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2843
    VID => 'push(@{$rs->{t}{vids}},{name=>$match,line=>$line});',
2844
  },
2845
  AFTER_INST => {
2846
    SEMICOLON => '$rs->{t}=undef;',
2847
    COMMA     => '$rs->{t}{line}=$line;
2848
                  $rs->{t}{name}="";
2849
                  $rs->{t}{port}=0;
2850
                  $rs->{t}{portName}="";
2851
                  $rs->{t}{vids}=[];',
2852
  },
2853
  SIGNAL_AFTER_NAME => {
2854
    SEMICOLON => '$rs->{t}=undef;',
2855
  },
2856
  IN_EVENT_BRACKET => {
2857
    EDGE => '$rs->{t}={ type=>$match };',
2858
  },
2859
  IN_EVENT_BRACKET_EDGE => {
2860
    VID => 'my $edgeType = $rs->{t}{type}; $rs->{t}=undef;',
2861
  },
2862
  STMNT => {
2863
    ASSIGN_OR_TASK => '$rs->{t}={ vids=>[{name=>$match,line=>$line}]};',
2864
    HIER_ASSIGN_OR_TASK => '$rs->{t}={ vids=>[]};',
2865
    CONCAT             => '$rs->{t}={ vids=>[]};',
2866
  },
2867
  STMNT_ASSIGN_OR_TASK => { # copy of STMNT_ASSIGN
2868
    EQUALS    => 'my @vids = @{$rs->{t}{vids}}; $rs->{t}=undef;',
2869
# Revisit: this arc doesn't exist anymore - put this into smnt_semicolon
2870
#    SEMICOLON => '$rs->{t}=undef;', 
2871
    BRACKET   => '$rs->{t}=undef;',
2872
  },
2873
  STMNT_ASSIGN => { # copy of STMNT_ASSIGN_OR_TASK
2874
    EQUALS => 'STMNT_ASSIGN_OR_TASK:EQUALS',
2875
  },
2876
  IN_SIG_RANGE => {
2877
    END => '$rs->{t}{range}=$fromLastPos;',
2878
  },
2879
  IN_MEM_RANGE => {
2880
    END => 'push(@{$rs->{t}{dimensions}},$fromLastPos);',
2881
  },
2882
  ANSI_PORTS_TYPE => { # V2001 ansi ports
2883
    TYPE =>  '$rs->{t}={ type=>$match, range=>"", dimensions=>[], name=>"" , type2=>"",block=>0};',
2884
  },
2885
  ANSI_PORTS_TYPE2 => { # V2001 ansi ports
2886
    TYPE => 'if ($match eq "reg") { $rs->{t}{type2} = "reg"; }',
2887
  },
2888
  ANSI_PORTS_SIGNAL_NAME => { # V2001 ansi ports
2889
    VID => '$rs->{t}{name}=$match; $rs->{t}{line}=$line;',
2890
  },
2891
};
2892
 
2893
############################################################
2894
# debugEval
2895
############################################################
2896
$debugEval = {
2897
  ANSI_PORTS_SIGNAL_NAME => {
2898
    VID => 'print "Found $rs->{t}{type} $rs->{t}{name} $rs->{t}{range} [$line]\n";',
2899
  },
2900
  SIGNAL_NAME => {
2901
    VID => 'print "Found $rs->{t}{type} $rs->{t}{name} $rs->{t}{range} [$line]\n";',
2902
  },
2903
  INST_BRACKET => {
2904
    PORTS => 'print "found instance $rs->{t}{name} of $rs->{t}{mod} [$rs->{t}{line}]\n";',
2905
  },
2906
  INST_NAMED_PORT_CON_AFTER => {
2907
    COMMA => 'my @vidnames;
2908
            foreach my $vid (@vids) {push @vidnames,$vid->{name};}
2909
            print " Port $portName connected to ".join(",",@vidnames)."\n";',
2910
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2911
  },
2912
  INST_NUMBERED_PORT => {
2913
    COMMA   => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2914
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
2915
  },
2916
};
2917
 
2918
 
2919
############################################################
2920
# rvpEval
2921
############################################################
2922
 
2923
$rvpEval = {
2924
  MODULE => {
2925
    ENDMODULE => 'if ((($rs->{p}{type} eq "primitive")&&($match ne "endprimitive"))||
2926
                         (($rs->{p}{type} ne "primitive")&&($match eq "endprimitive"))){
2927
                     $self->_add_warning("$file:$line: module of type".
2928
                                 " $rs->{p}{type} ended by $match");
2929
                  }
2930
                  $rs->{modules}{$rs->{module}}{end} = $line;
2931
                  $rs->{module}   = "";
2932
                  $rs->{files}{$file}{contexts}{$line}{value}= { name=>"",type=>"" };
2933
                  $rs->{p}= undef;',
2934
    PARAM => '$rs->{t} = { ptype => $match };', # parameter of localparam
2935
  },
2936
  MODULE_NAME => {
2937
    NAME => 'if (exists($rs->{modules}{$match})) {
2938
                 $nState = "IGNORE_MODULE";
2939
                 $rs->{modules}{$match}{duplicate} = 1;
2940
                 $self->_add_warning("$file:$line ignoring new definition of ".
2941
                          "module $match, previous was at ".
2942
                          "$rs->{modules}{$match}{file}:$rs->{modules}{$match}{line})");
2943
             }
2944
             else {
2945
               $rs->{module}=$match;
2946
               _init_module($rs->{modules},$rs->{module},$file,$line,$type);
2947
               $rs->{files}{$file}{modules}{$rs->{module}} = $rs->{modules}{$rs->{module}};
2948
               _add_anchor($rs->{files}{$file}{anchors},$line,$rs->{module});
2949
               $rs->{files}{$file}{contexts}{$line}{value}= $rs->{p}= $rs->{modules}{$rs->{module}};
2950
               $rs->{files}{$file}{contexts}{$line}{module_start}= $rs->{module};
2951
             }',
2952
  },
2953
  MODULE_PORTS => {
2954
    VID => 'push(@{$rs->{p}{port_order}},$match);',
2955
  },
2956
  FUNCTION => {
2957
    NAME => '$rs->{function}=$match;
2958
                      $self->_init_t_and_f($rs->{modules}{$rs->{module}},"function",
2959
                      $rs->{function},$file,$line,$rs->{module}."_".$rs->{function});
2960
                      _add_anchor($rs->{files}{$file}{anchors},$line,$rs->{module}."_".$rs->{function});
2961
                      $rs->{files}{$file}{contexts}{$line}{value}= $rs->{p}= $rs->{modules}{$rs->{module}}{t_and_f}{$rs->{function}};',
2962
  },
2963
  TASK => {
2964
    NAME => '$rs->{task}=$match;
2965
                      $self->_init_t_and_f($rs->{modules}{$rs->{module}},"task",
2966
                                   $rs->{task},$file,$line,$rs->{module}. "_" .$rs->{task});
2967
                      _add_anchor($rs->{files}{$file}{anchors},$line,$rs->{module}. "_" . $rs->{task});
2968
                      $rs->{files}{$file}{contexts}{$line}{value}= $rs->{p}= $rs->{modules}{$rs->{module}}{t_and_f}{$rs->{task}};',
2969
  },
2970
  ENDTASK => {
2971
    ENDTASK => '$rs->{modules}{$rs->{module}}{t_and_f}{$rs->{task}}{end} = $line;
2972
                $rs->{task}="";
2973
                $rs->{files}{$file}{contexts}{$line}{value}= $rs->{p}= $rs->{modules}{$rs->{module}};',
2974
  },
2975
  T_SIGNAL => {
2976
     SIGNAL => '$rs->{t}={ type=>$match, range=>"", dimensions=>[], name=>"" , type2=>"" , block=>0};',
2977
     ENDTASK => 'ENDTASK:ENDTASK',
2978
     PARAM => 'MODULE:PARAM', # not realy needed yet because T/F parameters are ignored
2979
  },
2980
  ENDFUNCTION => {
2981
      ENDFUNCTION => '$rs->{modules}{$rs->{module}}{t_and_f}{$rs->{function}}{end} = $line;
2982
                     $rs->{function}="";
2983
                     $rs->{files}{$file}{contexts}{$line}{value}= $rs->{p}= $rs->{modules}{$rs->{module}};',
2984
  },
2985
  F_SIGNAL => {
2986
     SIGNAL => '$rs->{t}={ type=>$match, range=>"", dimensions=>[], name=>"" , type2=>"",block=>0};',
2987
     ENDFUNCTION => 'ENDFUNCTION:ENDFUNCTION',
2988
     PARAM => 'MODULE:PARAM', # not realy needed yet because T/F parameters are ignored
2989
  },
2990
  BLOCK_SIGNAL => {
2991
     SIGNAL => '$rs->{t}={ type=>$match, range=>"", dimensions=>[], name=>"" , type2=>"" , block=>1};',
2992
  },
2993
  PARAM_NAME => {
2994
    NAME => 'if ( ($rs->{function} eq "") && ($rs->{task} eq "")) { # ignore parameters in tasks and functions
2995
              $rs->{t}= { file => $file, line => $line , value => "" ,
2996
                          ptype => $rs->{t}{ptype}}; # ptype is same as the last one
2997
              push(@{$rs->{p}{parameter_order}}, $match)
2998
                    unless ($rs->{t}{ptype} eq "localparam");
2999
              $rs->{p}{parameters}{$match}=$rs->{t};
3000
              _add_anchor($rs->{files}{$file}{anchors},$line,""); }',
3001
  },
3002
  PPL_PARAM => {
3003
     PARAM => '$rs->{t} = { ptype => "parameter" };', # this can't be a localparam
3004
  },
3005
  PPL_NAME => {
3006
     NAME => 'PARAM_NAME:NAME',
3007
  },
3008
  PARAM_AFTER_EQUALS => {
3009
    COMMA     => '$rs->{t}{value} = $fromLastPos;',
3010
    SEMICOLON => 'PARAM_AFTER_EQUALS:COMMA',
3011
  },
3012
  PPL_AFTER_EQUALS => {
3013
     COMMA   => 'PARAM_AFTER_EQUALS:COMMA',
3014
     END     => 'PARAM_AFTER_EQUALS:COMMA',
3015
  },
3016
  ASSIGN => {
3017
    VID => 'if ( exists($rs->{p}{signals}{$match}) &&
3018
                              ($rs->{p}{signals}{$match}{a_line} == -1)) {
3019
               $rs->{p}{signals}{$match}{a_line} = $line;
3020
               $rs->{p}{signals}{$match}{a_file} = $file;
3021
               _add_anchor($rs->{files}{$file}{anchors},$line,"");
3022
            }',
3023
  },
3024
  SIGNAL_NAME => { # note skip signals local to a block ({block}==1)
3025
    VID => 'if ($rs->{t}{block} != 1) {
3026
              $self->_init_signal($rs->{p}{signals},$match,$rs->{t}{type},$rs->{t}{type2},
3027
                        $rs->{t}{range},$file,$line,1,$rs->{t}{dimensions})
3028
               && _add_anchor($rs->{files}{$file}{anchors},$line,"");
3029
            }',
3030
  },
3031
  SIGNAL_AFTER_NAME => { # don't assign a_line for reg at definition, as this is 
3032
                         #   only the initial value
3033
    ASSIGN => 'if ($rs->{t}{block} != 1) {
3034
                if ( $rs->{p}{signals}{$rs->{t}{name}}{type} ne "reg" ) {
3035
                  $rs->{p}{signals}{$rs->{t}{name}}{a_line}=$rs->{t}{line};
3036
                  $rs->{p}{signals}{$rs->{t}{name}}{a_file}=$file;
3037
                  _add_anchor($rs->{files}{$file}{anchors},$rs->{t}{line},"");
3038
                }
3039
               }',
3040
  },
3041
  INST_PARAM_VALUE => {
3042
    # Note: the code is nearly the same in INST_PARAM_VALUE:COMMA,
3043
    #   and INST_PARAM_BRACKET:NO_BRACKET, but the first uses $fromLastPos
3044
    #   and the second uses $match to capture the parameter value
3045
    COMMA => 'my $inst_num= $#{$rs->{p}{instances}};
3046
              $rs->{t}{params}{$rs->{t}{param_number}} =
3047
                     { file => $file , line => $line , value => $fromLastPos };
3048
              $rs->{t}{param_number}++;',
3049
    END   => 'INST_PARAM_VALUE:COMMA',
3050
  },
3051
  INST_PARAM_BRACKET => {
3052
    # Note: the code is nearly the same in INST_PARAM_VALUE:COMMA,
3053
    #   and INST_PARAM_BRACKET:NO_BRACKET, but the first uses $fromLastPos
3054
    #   and the second uses $match to capture the parameter value
3055
    NO_BRACKET => 'my $inst_num= $#{$rs->{p}{instances}};
3056
              $rs->{t}{params}{$rs->{t}{param_number}} =
3057
                     { file => $file , line => $line , value => $match };
3058
              $rs->{t}{param_number}++;',
3059
  },
3060
  INST_BRACKET => {
3061
    PORTS => '$rs->{unres_mod}{$rs->{t}{mod}}=$rs->{t}{mod};
3062
              $rs->{files}{$file}{instance_lines}{$rs->{t}{line}} = $rs->{t}{mod};
3063
              push( @{$rs->{p}{instances}} , { module => $rs->{t}{mod} ,
3064
                                               inst_name => $rs->{t}{name} ,
3065
                                               file => $file,
3066
                                               line => $rs->{t}{line},
3067
                                               parameters => $rs->{t}{params},
3068
                                               connections => {} });
3069
              _add_anchor($rs->{files}{$file}{anchors},$rs->{t}{line},
3070
                         $rs->{module}."_".$rs->{t}{name});',
3071
  },
3072
  INST_NAMED_PORT_CON_AFTER => {
3073
    COMMA =>   'my $inst_num= $#{$rs->{p}{instances}};
3074
              $rs->{p}{instances}[$inst_num]{connections}{$portName}=$fromLastPos;
3075
              if ($portName =~ /^[0-9]/ ) { # clear named_ports flag if port is a number
3076
                 $rs->{p}{named_ports} = 0;
3077
              }
3078
              else { # remove the bracket from the end if a named port
3079
                 $rs->{p}{instances}[$inst_num]{connections}{$portName}=~s/\)\s*$//s;
3080
              }
3081
              foreach my $s (@vids) {
3082
                $self->_init_signal($rs->{p}{signals},$s->{name},"wire","","",$file,$s->{line},0,$rs->{t}{dimensions})
3083
                    && _add_anchor($rs->{files}{$file}{anchors},$s->{line},"");
3084
                 push( @{$rs->{p}{signals}{$s->{name}}{port_con}},
3085
                        { port   => $portName ,
3086
                          line   => $s->{line},
3087
                          file   => $file,
3088
                          module => $rs->{t}{mod} ,
3089
                          inst   => $rs->{t}{name} });
3090
              }',
3091
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
3092
  },
3093
  INST_NUMBERED_PORT => {
3094
    COMMA   => 'INST_NAMED_PORT_CON_AFTER:COMMA',
3095
    BRACKET => 'INST_NAMED_PORT_CON_AFTER:COMMA',
3096
  },
3097
  IN_EVENT_BRACKET_EDGE => {
3098
    VID => 'if (exists($rs->{p}{signals}{$match})) {
3099
               $rs->{p}{signals}{$match}{$edgeType}=1; };',
3100
  },
3101
 
3102
  STMNT_ASSIGN_OR_TASK => { # copy of STMNT_ASSIGN
3103
    EQUALS => 'foreach my $s (@vids) {
3104
                 my $sigp = undef;
3105
                 if ( exists($rs->{p}{signals}{$s->{name}} )) {
3106
                      $sigp = $rs->{p}{signals}{$s->{name}};
3107
                 }
3108
                 elsif ( exists($rs->{p}{m_signals}) &&
3109
                         exists($rs->{p}{m_signals}{$s->{name}}) ) {
3110
                      $sigp = $rs->{p}{m_signals}{$s->{name}};
3111
                 }
3112
                 if (defined($sigp) && ($sigp->{a_line}==-1)) {
3113
                      $sigp->{a_line}=$s->{line};
3114
                      $sigp->{a_file}=$file;
3115
                      _add_anchor($rs->{files}{$file}{anchors},$s->{line},"");
3116
                 }
3117
               }',
3118
  },
3119
  STMNT_ASSIGN => { # copy of STMNT_ASSIGN_OR_TASK
3120
    EQUALS => 'STMNT_ASSIGN_OR_TASK:EQUALS',
3121
  },
3122
  ANSI_PORTS_SIGNAL_NAME => { # V2001 ansi ports
3123
    VID => '$self->_init_signal($rs->{p}{signals},$match,$rs->{t}{type},$rs->{t}{type2},
3124
                        $rs->{t}{range},$file,$line,1,$rs->{t}{dimensions});
3125
            push(@{$rs->{p}{port_order}},$match) if exists $rs->{p}{port_order};
3126
            _add_anchor($rs->{files}{$file}{anchors},$line,"");',
3127
  },
3128
};
3129
 
3130
############################################################
3131
# language definition
3132
############################################################
3133
 
3134
$vid_vnum_or_string =
3135
[ { arcName=> 'HVID',   regexp=> '$HVID', nextState=> ['$ps->{curState}'] ,}, # hier id
3136
  { arcName=> 'VID',    regexp=> '$VID' , nextState=> ['$ps->{curState}'] ,},
3137
  { arcName=> 'NUMBER', regexp=> '$VNUM', nextState=> ['$ps->{curState}'] ,},
3138
  { arcName=> 'STRING', regexp=> '\\"',   nextState=> ['IN_STRING','$ps->{curState}'],},
3139
];
3140
 
3141
$languageDef =
3142
[
3143
 {
3144
 stateName =>     'START',
3145
 confusedNextState => 'START',
3146
 search =>
3147
  [
3148
   { arcName   => 'MODULE' ,        regexp => '\b(?:module|macromodule|primitive)\b',
3149
     nextState => ['MODULE_NAME'] ,},
3150
   { arcName   => 'CONFIG',        regexp => '\bconfig\b', # V2001
3151
     nextState => ['CONFIG'] , },
3152
   { arcName   => 'LIBRARY',        regexp => '\blibrary\b', # V2001
3153
     nextState => ['LIBRARY'] , },
3154
  ],
3155
 },
3156
 {
3157
 stateName =>     'MODULE',
3158
 confusedNextState => 'MODULE',
3159
 search =>
3160
  [
3161
   { arcName   => 'ENDMODULE' ,     regexp => '\b(?:end(?:module|primitive))\b',
3162
     nextState => ['START'] ,  },
3163
   { arcName   => 'FUNCTION',       regexp => '\bfunction\b',
3164
     nextState => ['FUNCTION'] , },
3165
   { arcName   => 'TASK',           regexp => '\btask\b',
3166
     nextState => ['TASK'] ,  },
3167
   { arcName   => 'PARAM',      regexp => '\b(?:parameter|localparam)\b', # v2001: localparm
3168
     nextState => ['PARAM_TYPE','MODULE'] ,  },
3169
   { arcName   => 'SPECIFY',        regexp => '\bspecify\b',
3170
     nextState => ['SPECIFY'] , },
3171
   { arcName   => 'TABLE',          regexp => '\btable\b',
3172
     nextState => ['TABLE'] ,  },
3173
   { arcName   => 'EVENT_DECLARATION' ,    regexp => '\bevent\b' ,
3174
     nextState => ['EVENT_DECLARATION'] ,  },
3175
   { arcName   => 'DEFPARAM' ,       regexp => '\bdefparam\b' ,
3176
     nextState => ['DEFPARAM'] , },
3177
   { arcName   => 'GATE' ,           regexp => "$verilog_gatetype_regexp" ,
3178
     nextState => ['GATE'] ,   },
3179
   { arcName   => 'ASSIGN' ,         regexp => '\bassign\b' ,
3180
     nextState => ['ASSIGN'] , },
3181
   { arcName   => 'SIGNAL' ,         regexp => "$verilog_sigs_regexp" ,
3182
     nextState => ['DRIVE_STRENGTH','MODULE'] , },
3183
   { arcName   => 'INITIAL_OR_ALWAYS', regexp => '\b(?:initial|always)\b' ,
3184
     nextState => ['STMNT','MODULE'] , },
3185
   { arcName   => 'GENERATE',       regexp => '\bgenerate\b', # V2001
3186
     nextState => ['GENERATE'] , },
3187
 
3188
 
3189
   { arcName   => 'INST',          regexp    => '$VID' ,
3190
     nextState => ['INST_PARAM'] , },
3191
   # don't put any more states here because $VID matches almost anything
3192
   ],
3193
 },################ END OF MODULE STATE
3194
 {
3195
 stateName =>     'MODULE_NAME',
3196
 search =>   # $nState is usually MODULE_PPL, but is set to
3197
             #   IGNORE_MODULE when a duplicate module is found
3198
  [ { arcName   => 'NAME',  regexp => '$VID' , nextState => ['$nState'] , }, ],
3199
 },
3200
 {
3201
 stateName =>     'IGNORE_MODULE' ,  # just look for endmodule
3202
 allowAnything => 1,
3203
 search => [
3204
   { arcName   => 'ENDMODULE' , regexp    => '\bendmodule\b',
3205
     nextState => ['START'], },
3206
   @$vid_vnum_or_string,
3207
  ],
3208
 },
3209
 {
3210
 stateName =>     'MODULE_PPL' ,  # v2001 module_parameter_port_list (A.1.3)
3211
 failNextState => ['MODULE_PORTS'],
3212
 search => [ { regexp    => '#',  nextState => ['PPL_BRACKET'], }, ],
3213
 },
3214
 {
3215
 stateName =>     'MODULE_PORTS' ,  # just look for signals until ;
3216
 allowAnything => 1,
3217
 search => [
3218
   { arcName   => 'TYPE' , regexp    => '\b(?:input|output|inout)\b',  # V2001 ansi ports
3219
     nextState => ['ANSI_PORTS_TYPE','MODULE'], resetPos => 1, },
3220
   { arcName   => 'END', regexp    => ';' , nextState => ['MODULE'] , },
3221
   @$vid_vnum_or_string,
3222
  ],
3223
 },
3224
 {
3225
 stateName =>     'FUNCTION' ,
3226
 search => [
3227
    { arcName => 'RANGE', regexp => '\[', nextState => ['IN_RANGE','FUNCTION'] , },
3228
    { arcName => 'TYPE',  regexp => '\b(?:real|integer|time|realtime)\b',
3229
      nextState => ['FUNCTION'] ,  },
3230
    { arcName => 'SIGNED', regexp => '\bsigned\b' ,nextState => ['FUNCTION'] ,  }, # V2001
3231
    { arcName => 'AUTO',   regexp => '\bautomatic\b' ,nextState => ['FUNCTION'] ,  }, # V2001
3232
    { arcName => 'NAME',  regexp => '$VID' , nextState => ['FUNCTION_AFTER_NAME'] ,
3233
    },
3234
   ],
3235
 },
3236
 {
3237
 stateName =>     'FUNCTION_AFTER_NAME' ,
3238
 search => [
3239
    { arcName => 'SEMICOLON', regexp => ';', nextState => ['F_SIGNAL'] , },
3240
    { arcName => 'BRACKET',  regexp => '\(' ,   # V2001
3241
      nextState => ['ANSI_PORTS_TYPE','F_SIGNAL'] ,  },
3242
  ],
3243
 },
3244
 {
3245
 stateName =>     'TASK' ,
3246
 search => [
3247
   { arcName => 'AUTO', regexp => '\bautomatic\b', nextState => ['TASK'],}, # V2001
3248
   { arcName => 'NAME', regexp => '$VID', nextState => ['TASK_AFTER_NAME'],},],
3249
 },
3250
 {
3251
 stateName =>     'TASK_AFTER_NAME' ,
3252
 search => [
3253
    { arcName => 'SEMICOLON', regexp => ';', nextState => ['T_SIGNAL'] , },
3254
    { arcName => 'BRACKET',  regexp => '\(' ,   # V2001
3255
      nextState => ['ANSI_PORTS_TYPE','T_SIGNAL'] ,  },
3256
  ],
3257
 },
3258
 {
3259
 stateName =>     'T_SIGNAL' ,
3260
 failNextState => ['STMNT','ENDTASK'],
3261
 search => [
3262
   { arcName   => 'ENDTASK',        regexp => '\bendtask\b',
3263
     nextState => ['MODULE'] , },
3264
   { arcName   => 'SIGNAL' ,         regexp => "$verilog_sigs_regexp" ,
3265
     nextState => ['DRIVE_STRENGTH','T_SIGNAL'] , },
3266
   { arcName   => 'PARAM',      regexp => '\b(?:parameter|localparam)\b', # v2001: localparm
3267
     nextState => ['PARAM_TYPE','T_SIGNAL'] ,  },
3268
   ],
3269
 },
3270
 {
3271
 stateName =>     'ENDTASK',
3272
 search => [
3273
   { arcName   => 'ENDTASK',        regexp => '\bendtask\b',
3274
     nextState => ['MODULE'] , },
3275
   ],
3276
 },
3277
 {
3278
 stateName =>     'F_SIGNAL' ,
3279
 failNextState => ['STMNT','ENDFUNCTION'],
3280
 search => [
3281
   { arcName   => 'ENDFUNCTION',     regexp => '\bendfunction\b',
3282
     nextState => ['MODULE'] , },
3283
   { arcName   => 'SIGNAL' ,         regexp => "$verilog_sigs_regexp" ,
3284
     nextState => ['DRIVE_STRENGTH','F_SIGNAL'] , },
3285
   { arcName   => 'PARAM',      regexp => '\b(?:parameter|localparam)\b', # v2001: localparm
3286
     nextState => ['PARAM_TYPE','F_SIGNAL'] ,  },
3287
   ],
3288
 },
3289
 {
3290
 stateName =>     'ENDFUNCTION',
3291
 search => [
3292
   { arcName   => 'ENDFUNCTION',     regexp => '\bendfunction\b',
3293
     nextState => ['MODULE'] , },
3294
   ],
3295
 },
3296
 {
3297
 stateName =>     'PARAM_TYPE',
3298
 failNextState => ['PARAM_NAME'],
3299
 search => [
3300
    { arcName   => 'RANGE', regexp    => '\[' ,
3301
      nextState => ['IN_RANGE','PARAM_NAME'] , },
3302
    { arcName   => 'SIGNED', regexp    => '\bsigned\b' ,
3303
      nextState => ['PARAM_TYPE'] , },  # may be followed by a range
3304
    { arcName   => 'OTHER', regexp    => '\b(?:integer|real|realtime|time)\b' ,
3305
      nextState => ['PARAM_NAME'] , },
3306
   ],
3307
 },
3308
 {
3309
 stateName =>     'PARAM_NAME',
3310
 search => [
3311
    { arcName   => 'NAME',  regexp    => '$VID' ,
3312
      nextState => ['PARAMETER_EQUAL','PARAM_AFTER_EQUALS'] , },
3313
   ],
3314
 },
3315
 {
3316
 stateName =>     'PARAMETER_EQUAL',
3317
  search => [ { regexp    => '=' , storePos => 1, }, ]
3318
 },
3319
 {
3320
 stateName =>     'PARAM_AFTER_EQUALS',
3321
 allowAnything => 1,
3322
 search =>
3323
  [
3324 48 alirezamon
   { arcName   => 'CONCAT',      regexp    => '\{' ,
3325 16 alirezamon
     nextState => ['IN_CONCAT','PARAM_AFTER_EQUALS'] ,  },
3326
   { arcName   => 'COMMA',       regexp    => ',' ,
3327
     nextState => ['PARAM_NAME'] ,    },
3328
   { arcName   => 'SEMICOLON',   regexp    => ';' , },
3329
   @$vid_vnum_or_string,
3330
  ]
3331
 },
3332
 {
3333
 stateName =>     'IN_CONCAT',
3334
 allowAnything => 1,
3335
 search =>
3336
  [
3337 48 alirezamon
   { arcName   => 'CONCAT' ,   regexp    => '\{' ,
3338 16 alirezamon
     nextState => ['IN_CONCAT','IN_CONCAT'] ,     },
3339
   { arcName   => 'END' ,      regexp    => '}' , }, # pop up
3340
   @$vid_vnum_or_string,
3341
  ]
3342
 },
3343
 {
3344
 stateName =>     'IN_RANGE',
3345
 allowAnything => 1,
3346
 search =>
3347
  [
3348
   { arcName   => 'RANGE' , regexp    => '\[' ,
3349
     nextState => ['IN_RANGE','IN_RANGE'] , },
3350
   { arcName   => 'END' ,   regexp    => '\]' , }, # pop up
3351
   @$vid_vnum_or_string,
3352
  ]
3353
 },
3354
 {
3355
 stateName =>     'IN_SIG_RANGE', # just like in range, but stores
3356
 allowAnything => 1,
3357
 search =>
3358
  [
3359
   { arcName   => 'RANGE' , regexp    => '\[' ,
3360
     nextState => ['IN_SIG_RANGE','IN_SIG_RANGE'] , },
3361
   { arcName   => 'END' ,   regexp    => '\]' , }, # pop up
3362
   @$vid_vnum_or_string,
3363
  ]
3364
 },
3365
 {
3366
 stateName =>     'IN_MEM_RANGE', # just like in range, but stores
3367
 allowAnything => 1,
3368
 search =>
3369
  [
3370
   { arcName   => 'RANGE' , regexp    => '\[' ,
3371
     nextState => ['IN_MEM_RANGE','IN_MEM_RANGE'] , },
3372
   { arcName   => 'END' ,   regexp    => '\]' , }, # pop up
3373
   @$vid_vnum_or_string,
3374
  ]
3375
 },
3376
 {
3377
 stateName =>     'IN_BRACKET',
3378
 allowAnything => 1,
3379
 search =>
3380
  [
3381
   { arcName   => 'BRACKET' ,  regexp    => '\(' ,
3382
     nextState => ['IN_BRACKET','IN_BRACKET'] ,   },
3383
   { arcName   => 'END' ,      regexp    => '\)' ,  }, # pop up
3384
   @$vid_vnum_or_string,
3385
  ]
3386
 },
3387
 {
3388
 stateName =>     'IN_STRING',
3389
 allowAnything => 1,
3390
 search =>
3391
  [ # note: put \" in regexp so that emacs colouring doesn't get confused
3392
   { arcName   => 'ESCAPED_QUOTE' ,  regexp => '\\\\\\"' , # match \"
3393
     nextState => ['IN_STRING'] , },
3394
   # match \\ (to make sure that \\" does not match \"
3395
   { arcName   => 'ESCAPE' ,         regexp => '\\\\\\\\' ,
3396
     nextState => ['IN_STRING'] , },
3397
   { arcName   => 'END' ,            regexp => '\\"' , }, # match " and pop up
3398
  ]
3399
 },
3400
 {
3401
 stateName =>     'SPECIFY',
3402
 allowAnything => 1,
3403
 search => [ { regexp => '\bendspecify\b' , nextState => ['MODULE'] ,},
3404
               @$vid_vnum_or_string,],
3405
 },
3406
 {
3407
 stateName =>     'TABLE',
3408
 allowAnything => 1,
3409
 search => [ { regexp => '\bendtable\b'   , nextState => ['MODULE'] ,},
3410
             @$vid_vnum_or_string,],
3411
 },
3412
 {
3413
 stateName =>     'EVENT_DECLARATION' ,  # just look for ;
3414
 allowAnything => 1,
3415
 search => [ {  regexp    => ';' ,    nextState => ['MODULE'] , },
3416
             @$vid_vnum_or_string,],
3417
 },
3418
 {
3419
 stateName =>     'DEFPARAM' ,  # just look for ;
3420
 allowAnything => 1,
3421
 search => [ {  regexp    => ';' ,    nextState => ['MODULE'] , },
3422
             @$vid_vnum_or_string,],
3423
 },
3424
 {
3425
  # REVISIT: could find signal driven by gate here (is output always the first one??)
3426
 stateName =>     'GATE' ,
3427
 allowAnything => 1,
3428
 search => [ {  regexp    => ';' ,    nextState => ['MODULE'] , },
3429
             @$vid_vnum_or_string,],
3430
 },
3431
 {
3432
 stateName =>     'ASSIGN',
3433
 allowAnything => 1,
3434
 search =>
3435
  [
3436
   { arcName   => 'RANGE' ,   regexp    => '\[' ,
3437
     nextState => ['IN_RANGE','ASSIGN'] ,      },
3438
   { arcName   => 'EQUALS' ,  regexp    => '=' ,
3439
     nextState => ['ASSIGN_AFTER_EQUALS'] ,    },
3440
   @$vid_vnum_or_string,
3441
  ]
3442
 },
3443
 {
3444
 stateName =>     'ASSIGN_AFTER_EQUALS' ,
3445
 allowAnything => 1,
3446
  search =>
3447
   [
3448
    { arcName=>'COMMA',     regexp => ',',
3449
      nextState => ['ASSIGN'],},
3450 48 alirezamon
    { arcName=>'CONCAT',    regexp => '\{',
3451 16 alirezamon
      nextState => ['IN_CONCAT','ASSIGN_AFTER_EQUALS'],},
3452
    # don't get confused by function calls (which can also contain commas)
3453
    {   arcName=>'BRACKET',   regexp => '\(',
3454
        nextState => ['IN_BRACKET','ASSIGN_AFTER_EQUALS'],},
3455
    {   arcName=>'END',       regexp => ';',
3456
        nextState => ['MODULE'],},
3457
    @$vid_vnum_or_string,
3458
   ],
3459
 },
3460
 {
3461
 stateName =>     'DRIVE_STRENGTH',  # signal defs - drive strength or charge strength
3462
 failNextState => ['SCALARED_OR_VECTORED'],
3463
 search => [ { regexp => '\(', nextState => ['IN_BRACKET','SCALARED_OR_VECTORED'],}],
3464
 },
3465
 { # REVISIT: V2001 - the name of this is misleading now
3466
 stateName =>     'SCALARED_OR_VECTORED',  # for signal defs
3467
 failNextState => ['SIGNAL_RANGE'],
3468
 search => [ { regexp => '\b(?:scalared|vectored)\b', nextState => ['SIGNAL_RANGE'],},
3469
             { arcName => 'TYPE' , regexp => "$verilog_sigs_regexp", # V2001
3470
               nextState => ['SCALARED_OR_VECTORED'],},
3471
             { regexp => '\b(?:signed)\b', nextState => ['SCALARED_OR_VECTORED'],},], # V2001
3472
 },
3473
 {
3474
 stateName =>     'SIGNAL_RANGE',          # for signal defs
3475
  failNextState => ['SIGNAL_DELAY'],
3476
 search => [ { regexp => '\[', nextState => ['IN_SIG_RANGE','SIGNAL_DELAY'],
3477
               storePos => 1,}, ],
3478
 },
3479
 {
3480
 stateName =>     'SIGNAL_DELAY',          # for signal defs
3481
 failNextState => ['SIGNAL_NAME'],
3482
 search => [ { regexp => '\#', nextState => ['DELAY_VALUE','SIGNAL_NAME'],},  ],
3483
 },
3484
 {
3485
 stateName =>     'SIGNAL_NAME',           # for signal defs
3486
  search => [ { arcName   => 'VID' , regexp    => '$VID',
3487
               nextState => ['SIGNAL_AFTER_NAME'], }, ],
3488
 },
3489
 { # for signal defs
3490
 stateName =>     'SIGNAL_AFTER_NAME',
3491
 search =>
3492
  [
3493
   { regexp => ',',  nextState => ['SIGNAL_NAME'],},
3494
   { regexp => '\[', nextState => ['IN_MEM_RANGE','SIGNAL_AFTER_NAME'],
3495
     storePos => 1 , }, # memories
3496
   { arcName => 'SEMICOLON' , regexp => ';',},  # pop up
3497
   { arcName => 'ASSIGN',     regexp => '=', nextState => ['SIGNAL_AFTER_EQUALS'],}
3498
  ],
3499
 },
3500
 {
3501
 stateName =>     'SIGNAL_AFTER_EQUALS' ,
3502
 allowAnything => 1,
3503
 search =>
3504
   [
3505
    { regexp => ',',    nextState => ['SIGNAL_NAME'],},
3506 48 alirezamon
    { regexp => '\{',    nextState => ['IN_CONCAT','SIGNAL_AFTER_EQUALS'],},
3507 16 alirezamon
    { regexp => '\(',   nextState => ['IN_BRACKET','SIGNAL_AFTER_EQUALS'],},
3508
    { arcName => 'END', regexp => ';', }, # pop up
3509
    @$vid_vnum_or_string,
3510
   ],
3511
 },
3512
 {
3513
 stateName =>     'INST_PARAM',
3514
 failNextState => ['INST_NAME'],
3515
 search => [ { regexp => '\#', nextState=> ['INST_PARAM_BRACKET'],},],
3516
 },
3517
 {
3518
 stateName =>     'INST_PARAM_BRACKET',
3519
 search => [ { arcName => 'BRACKET' ,
3520
               regexp => '\(',
3521
               storePos => 1,
3522
               nextState=> ['INST_PARAM_VALUE'],},
3523
             # this is here to catch and illegal case which DC accepts
3524
             { arcName => 'NO_BRACKET' ,
3525
               regexp => '($VID|$VNUM)',
3526
               nextState=> ['INST_NAME'],}, ],
3527
 },
3528
 {
3529
 stateName =>     'INST_PARAM_VALUE',
3530
 allowAnything => 1,
3531
 search => [
3532
   { regexp => '\(', nextState=> ['IN_BRACKET','INST_PARAM_VALUE'],},
3533
   { regexp => '\[', nextState => ['IN_RANGE','INST_PARAM_VALUE'],},
3534
   { regexp => '\{', nextState => ['IN_CONCAT','INST_PARAM_VALUE'],},
3535
   { arcName => 'COMMA' ,
3536
     regexp => ',',
3537
     storePos => 1,
3538
     nextState=> ['INST_PARAM_VALUE'],},
3539
   { arcName => 'END' ,
3540
     regexp => '\)',
3541
     nextState=> ['INST_NAME'],},
3542
  ],
3543
 },
3544
 {
3545
 stateName =>     'INST_NAME',
3546
 failNextState => ['INST_BRACKET'],
3547
 search =>
3548
  [
3549
   { arcName   => 'VID' ,       regexp => '$VID',
3550
     nextState => ['INST_RANGE'],      },
3551
  ],
3552
 },
3553
 {
3554
 stateName =>     'INST_NO_NAME' ,
3555
 allowAnything => 1,
3556
 search => [ { regexp => ';' , }, @$vid_vnum_or_string,],
3557
 },
3558
 {
3559
 stateName =>     'INST_RANGE',
3560
 failNextState => ['INST_BRACKET'],
3561
 search => [ { regexp => '\[', nextState => ['IN_RANGE','INST_BRACKET'],}, ],
3562
 },
3563
 {
3564
 stateName =>     'INST_BRACKET',
3565
 search => [ { arcName => 'PORTS' , regexp => '\(', nextState => ['INST_PORTS'],},],
3566
 },
3567
 {
3568
 stateName =>     'INST_PORTS',
3569
 failNextState => ['INST_NUMBERED_PORT'],
3570
 failStorePos => 1,
3571
 search =>
3572
  [
3573
   { arcName => 'COMMA', regexp => ',',   nextState => ['INST_PORTS'], },
3574
   { regexp => '\.',  nextState => ['INST_PORT_NAME'],  },
3575
   { regexp => '\)',  nextState => ['AFTER_INST'], },
3576
  ],
3577
 },
3578
 {
3579
 stateName =>     'INST_PORT_NAME',
3580
 search => [ { arcName   => 'NAME' , regexp => '$VID',
3581
               nextState => ['INST_NAMED_PORT_BRACKET','INST_NAMED_PORT_CON',
3582
                             'INST_NAMED_PORT_CON_AFTER'], }, ],
3583
 },
3584
 {
3585
   stateName => 'INST_NAMED_PORT_BRACKET',
3586
   search => [ { regexp => '\(' , storePos => 1, },]
3587
 },
3588
 {
3589
 stateName =>     'INST_NAMED_PORT_CON',
3590
 allowAnything => 1,
3591
 search =>
3592
  [
3593
   { regexp => '\[' , nextState => ['IN_RANGE','INST_NAMED_PORT_CON'] , },
3594
   { regexp => '\{' , nextState => ['IN_CONCAT','INST_NAMED_PORT_CON'] , },
3595
   { regexp => '\(' ,
3596
     nextState => ['INST_NAMED_PORT_CON','INST_NAMED_PORT_CON'], },
3597
   { arcName => 'END', regexp    => '\)' , },   # pop up 
3598
   @$vid_vnum_or_string,
3599
  ]
3600
 },
3601
 {
3602
 stateName =>     'INST_NAMED_PORT_CON_AFTER',
3603
 search =>
3604
  [
3605
   { arcName => 'BRACKET', regexp => '\)' ,
3606
     nextState => ['AFTER_INST']},
3607
   { arcName => 'COMMA' ,  regexp => ',' ,
3608
     nextState => ['INST_DOT']},
3609
  ]
3610
 },
3611
 { stateName => 'INST_DOT',
3612
   search =>
3613
    [
3614
     { regexp => '\.' , nextState => ['INST_PORT_NAME']},
3615
     { regexp => ','  , nextState => ['INST_DOT']},   # blank port
3616
    ]
3617
 },
3618
 {
3619
 stateName =>     'INST_NUMBERED_PORT',
3620
 allowAnything => 1,
3621
 search =>
3622
  [
3623
   { regexp => '\[', nextState => ['IN_RANGE','INST_NUMBERED_PORT'],},
3624
   { regexp => '\{', nextState => ['IN_CONCAT','INST_NUMBERED_PORT'],},
3625
   { regexp => '\(', nextState => ['IN_BRACKET','INST_NUMBERED_PORT'],},
3626
   { arcName => 'BRACKET' , regexp => '\)', nextState => ['AFTER_INST'], },
3627
   { arcName => 'COMMA' ,   regexp => ',' , nextState => ['INST_NUMBERED_PORT'],
3628
     storePos => 1, },
3629
     @$vid_vnum_or_string,
3630
  ]
3631
 },
3632
 { stateName => 'AFTER_INST',
3633
   search => [
3634
    { arcName => 'SEMICOLON', regexp => ';', nextState => ['MODULE'], },
3635
    { arcName => 'COMMA',     regexp => ',', nextState => ['INST_NAME'], },
3636
   ]
3637
 },
3638
 {
3639
 stateName =>     'STMNT',
3640
 search =>
3641
  [
3642
   { arcName   => 'IF',                     regexp => '\bif\b' ,
3643
     nextState => ['BRACKET','IN_BRACKET','STMNT','MAYBE_ELSE'] ,},
3644
   { arcName   => 'REPEAT_WHILE_FOR_WAIT',  regexp => '\b(?:repeat|while|for|wait)\b' ,
3645
     nextState => ['BRACKET','IN_BRACKET','STMNT'] ,  },
3646
   { arcName   => 'FOREVER',                regexp => '\bforever\b' ,
3647
     nextState => ['STMNT'] , },
3648
   { arcName   => 'CASE',                   regexp => '\bcase[xz]?\b' ,
3649
     nextState => ['BRACKET','IN_BRACKET','CASE_ITEM'] , },
3650
   { arcName   => 'BEGIN',                  regexp => '\bbegin\b' ,
3651
     nextState => ['BLOCK_NAME','IN_SEQ_BLOCK'] , },
3652
   { arcName   => 'FORK',                   regexp => '\bfork\b' ,
3653
     nextState => ['BLOCK_NAME','IN_PAR_BLOCK'] , },
3654
   { arcName   => 'DELAY',                  regexp => '\#' ,
3655
     nextState => ['DELAY_VALUE','STMNT'] , },
3656
   { arcName   => 'EVENT_CONTROL',          regexp => '\@' ,
3657
     nextState => ['EVENT_CONTROL'] , },
3658
   { arcName   => 'SYSTEM_TASK',            regexp    => '\$$VID' ,
3659
     nextState => ['SYSTEM_TASK'] , },
3660
   { arcName   => 'DISABLE_ASSIGN_DEASSIGN_FORCE_RELEASE',
3661
     regexp    => '\b(?:disable|assign|deassign|force|release)\b',
3662
     nextState => ['STMNT_JUNK_TO_SEMICOLON'] , }, # just throw stuff away
3663
   # a assignment to a hierarchical thing mustn't collect the vid
3664
   #  like a normal assign as hierarchical nets/signals will confuse downstream code
3665
   { arcName   => 'HIER_ASSIGN_OR_TASK',           regexp => '$HVID' ,
3666
     nextState => ['STMNT_ASSIGN_OR_TASK'] , },
3667
   { arcName   => 'ASSIGN_OR_TASK',        regexp => '$VID' ,
3668
     nextState => ['STMNT_ASSIGN_OR_TASK'] , },
3669 48 alirezamon
   { arcName   => 'CONCAT',                regexp => '\{' ,
3670 16 alirezamon
     nextState => ['IN_CONCAT','STMNT_ASSIGN'] ,  },
3671
   { arcName   => 'NULL',                  regexp => ';' ,
3672
     }, # pop up
3673
   { arcName   => 'POINTY_THING',          regexp    => '->' , # not sure what this is!
3674
     nextState => ['POINTY_THING_NAME'] ,  },
3675
  ],
3676
 },
3677
 {
3678
 stateName =>     'MAYBE_ELSE',
3679
 failNextState => [] , # don't get confused, just pop the stack for the next state
3680
 search => [{ arcName => 'ELSE', regexp => '\belse\b' , nextState => ['STMNT'],},]
3681
 },
3682
 {
3683
 stateName =>     'BLOCK_NAME',
3684
 failNextState => [] , # don't get confused, just pop the stack for the next state
3685
 search => [{ arcName => 'COLON', regexp    => ':' ,
3686
              nextState => ['BLOCK_NAME_AFTER_COLON'] ,},]
3687
 },
3688
 {
3689
 stateName =>     'BLOCK_NAME_AFTER_COLON',
3690
 search => [ { arcName   => 'VID', regexp => '$VID' , nextState => ['BLOCK_SIGNAL'],}, ]
3691
 },
3692
 {
3693
 stateName =>     'BLOCK_SIGNAL' ,
3694
 failNextState => [], # don't get confused, just pop the stack for the next state
3695
 search => [
3696
   { arcName   => 'SIGNAL' ,         regexp => "$verilog_sigs_regexp" ,
3697
     nextState => ['DRIVE_STRENGTH','BLOCK_SIGNAL'] , },
3698
   ],
3699
 },
3700
 
3701
 
3702
 {
3703
 stateName =>     'IN_SEQ_BLOCK',
3704
 failNextState => ['STMNT','IN_SEQ_BLOCK'] ,
3705
 search => [{ arcName   => 'END', regexp    => '\bend\b' , }, ]
3706
 },
3707
 {
3708
 stateName =>     'IN_PAR_BLOCK',
3709
 failNextState => ['STMNT','IN_PAR_BLOCK'] ,
3710
 search => [{ arcName   => 'JOIN', regexp => '\bjoin\b' , }, ]
3711
 },
3712
 {
3713
 stateName =>     'DELAY_VALUE',
3714
 search =>
3715
  [{ arcName => 'NUMBER',  regexp => '$VNUM', nextState => ['DELAY_COLON1'] },
3716
   { arcName => 'ID',      regexp => '$VID',  nextState => ['DELAY_COLON1'], },
3717
   { arcName => 'BRACKET', regexp => '\(',    nextState => ['IN_BRACKET','DELAY_COLON1'],},]
3718
 },
3719
 {
3720
 stateName =>     'DELAY_COLON1',
3721
 failNextState => [] , # popup
3722
 search => [{ arcName   => 'COLON', regexp => ':' , nextState => ['DELAY_VALUE2'] },]
3723
 },
3724
 {
3725
 stateName =>     'DELAY_VALUE2',
3726
 search =>
3727
  [{ arcName => 'NUMBER',  regexp => '$VNUM', nextState => ['DELAY_COLON2'] },
3728
   { arcName => 'ID',      regexp => '$VID',  nextState => ['DELAY_COLON2'], },
3729
   { arcName => 'BRACKET', regexp => '\(',    nextState => ['IN_BRACKET','DELAY_COLON2'],},]
3730
 },
3731
 {
3732
 stateName =>     'DELAY_COLON2',
3733
 search => [{ arcName   => 'COLON', regexp => ':' , nextState => ['DELAY_VALUE3'] },]
3734
 },
3735
 {
3736
 stateName =>     'DELAY_VALUE3',
3737
 search =>
3738
  [{ arcName => 'NUMBER',  regexp => '$VNUM', },
3739
   { arcName => 'ID',      regexp => '$VID',  },
3740
   { arcName => 'BRACKET', regexp => '\(',  nextState => ['IN_BRACKET'],}, ]
3741
 },
3742
 {
3743
 stateName =>     'EVENT_CONTROL',
3744
 search =>
3745
  [
3746
   { arcName => 'ID',      regexp => '(?:$HVID|$VID)', nextState => ['STMNT'], },
3747
   { arcName => 'STAR',    regexp => '\*', nextState => ['STMNT'], }, # V2001
3748
   { arcName => 'BRACKET', regexp => '\(',
3749
     nextState => ['IN_EVENT_BRACKET','STMNT'], },
3750
  ]
3751
 },
3752
 {
3753
 stateName =>     'IN_EVENT_BRACKET',
3754
 allowAnything => 1,
3755
 search =>
3756
  [
3757
   # must go before vid_vnum_or_string as posedge and negedge look like VIDs
3758
   { arcName => 'EDGE' ,           regexp    => '\b(?:posedge|negedge)\b' ,
3759
     nextState => ['IN_EVENT_BRACKET_EDGE'] , },
3760
   { arcName   => 'BRACKET' ,      regexp    => '\(' ,
3761
     nextState => ['IN_EVENT_BRACKET','IN_EVENT_BRACKET'] , },
3762
   { arcName => 'STAR',    regexp => '\*', nextState => ['IN_EVENT_BRACKET'], }, # V2001
3763
   { arcName   => 'END' ,          regexp    => '\)' , }, # popup
3764
   @$vid_vnum_or_string,
3765
  ]
3766
 },
3767
 { # in theory there could be an expression here, I just take the first VID
3768
 stateName =>     'IN_EVENT_BRACKET_EDGE',
3769
 failNextState => ['IN_EVENT_BRACKET'] ,
3770
 search => [{ arcName => 'VID', regexp => '$VID', nextState => ['IN_EVENT_BRACKET'],},],
3771
 },
3772
 {
3773
 stateName =>     'STMNT_ASSIGN_OR_TASK',
3774
 failNextState => ['STMNT_SEMICOLON'],
3775
 search =>
3776
  [
3777
   { arcName => 'EQUALS',          regexp => '[<]?=',
3778
     nextState => ['STMNT_JUNK_TO_SEMICOLON'], },
3779
   { arcName => 'RANGE',           regexp => '\[',
3780
     nextState => ['IN_RANGE','STMNT_ASSIGN'],},
3781
   { arcName => 'BRACKET',         regexp => '\(',     # task with params
3782
     nextState => ['IN_BRACKET','STMNT_SEMICOLON'],  },
3783
  ]
3784
 },
3785
 {
3786
 stateName =>     'STMNT_ASSIGN',
3787
 search =>
3788
  [
3789
   { arcName => 'EQUALS', regexp => '[<]?=',
3790
     nextState => ['STMNT_JUNK_TO_SEMICOLON'],},
3791
   { arcName => 'RANGE',           regexp => '\[',
3792
     nextState => ['IN_RANGE','STMNT_ASSIGN'],},
3793
  ],
3794
 },
3795
 {
3796
 stateName =>     'SYSTEM_TASK',
3797
 failNextState => ['STMNT_SEMICOLON'],
3798
 search =>
3799
  [
3800
   { arcName => 'BRACKET',           regexp => '\(',
3801
     nextState => ['IN_BRACKET','STMNT_SEMICOLON'], },    ],
3802
 },
3803
 {
3804
 stateName =>     'POINTY_THING_NAME',
3805
 search => [{ arcName => 'VID', regexp => '(?:$HVID|$VID)', nextState => ['STMNT_SEMICOLON'], }, ],
3806
 },
3807
 {
3808
 stateName =>     'CASE_ITEM',
3809
 allowAnything => 1,
3810
 search =>
3811
  [
3812
   { arcName => 'END',             regexp => '\bendcase\b',  },
3813
   { arcName => 'COLON',           regexp => ':',
3814
     nextState => ['STMNT','CASE_ITEM'], },
3815
   { arcName => 'DEFAULT',         regexp => '\bdefault\b',
3816
     nextState => ['MAYBE_COLON','STMNT','CASE_ITEM'], },
3817
   # don't get confused by colons in ranges
3818
   { arcName => 'RANGE',           regexp => '\[',
3819
     nextState => ['IN_RANGE','CASE_ITEM'], },
3820
    @$vid_vnum_or_string,
3821
  ],
3822
 },
3823
 {
3824
 stateName =>     'MAYBE_COLON',
3825
 failNextState => [],
3826
 search => [ { regexp    => ':' , }, ]
3827
 },
3828
 { # look for ;  but also allow the ending of a statement with an end 
3829
   #   even though it is not really legal (verilog seems to accept it, so I do too)
3830
 stateName =>     'STMNT_JUNK_TO_SEMICOLON' ,
3831
 allowAnything => 1,
3832
 search => [
3833
             { regexp => ';' , },
3834
             # popup and reset pos to  before the end/join cope with nosemicolon case
3835
             { regexp => '\b(?:end|join|endtask|endfunction)\b' , resetPos => 1, },
3836
             @$vid_vnum_or_string,
3837
           ],
3838
 },
3839
 {
3840
 stateName => 'STMNT_SEMICOLON',
3841
 search => [ { regexp => ';'  , },
3842
             # popup and reset pos to  before the end/join cope with nosemicolon case
3843
             { regexp => '\b(?:end|join|endtask|endfunction)\b' , resetPos => 1, },
3844
           ],
3845
 },
3846
 { stateName => 'BRACKET',   search => [ { regexp => '\(' , },] },
3847
 { stateName => 'SEMICOLON', search => [ { regexp => ';'  , },] },
3848
 # V2001
3849
 {
3850
 stateName =>     'CONFIG',
3851
 allowAnything => 1,
3852
 search => [ { regexp => '\bendconfig\b' , nextState => ['START'] ,},
3853
               @$vid_vnum_or_string,],
3854
 },
3855
 {
3856
 stateName =>     'LIBRARY' ,  # just look for ;
3857
 allowAnything => 1,
3858
 search => [ {  regexp    => ';' ,    nextState => ['START'] , },
3859
             @$vid_vnum_or_string,],
3860
 },
3861
 {
3862
 stateName =>     'GENERATE',
3863
 allowAnything => 1,
3864
 search => [ { regexp => '\bendgenerate\b' , nextState => ['MODULE'] ,},
3865
               @$vid_vnum_or_string,],
3866
 },
3867
 
3868
 
3869
 
3870
 { # V2001 ansi module ports
3871
 stateName =>     'ANSI_PORTS_TYPE',
3872
 failNextState => ['ANSI_PORTS_TYPE2'],
3873
 search => [ { arcName => 'TYPE' , regexp => '\b(?:input|output|inout)\b',
3874
               nextState => ['ANSI_PORTS_TYPE2'],},
3875
             # a null list. note this is only possible for a task or function
3876
             #  (a null module port list can't look like an ansi port list)
3877
             #  but it is not legal acording to the BNF. I allow it any way.
3878
             { regexp => '\)', nextState => ['SEMICOLON'], },
3879
             ],
3880
 },
3881
 { # V2001 ansi module ports
3882
 stateName =>     'ANSI_PORTS_TYPE2',
3883
 failNextState => ['ANSI_PORTS_SIGNAL_RANGE'],
3884
 search => [ { arcName => 'TYPE' , regexp => "$verilog_sigs_regexp",
3885
               nextState => ['ANSI_PORTS_TYPE2'],},
3886
             { regexp => '\b(?:signed)\b', nextState => ['ANSI_PORTS_TYPE2'],},],
3887
 },
3888
 { # V2001 ansi module ports
3889
 stateName =>     'ANSI_PORTS_SIGNAL_RANGE',          # for signal defs
3890
  failNextState => ['ANSI_PORTS_SIGNAL_NAME'],
3891
 search => [ { regexp => '\[', nextState => ['IN_SIG_RANGE','ANSI_PORTS_SIGNAL_NAME'],
3892
               storePos => 1,}, ],
3893
 },
3894
 { # V2001 ansi module ports
3895
 stateName =>     'ANSI_PORTS_SIGNAL_NAME',
3896
  search => [
3897
   { arcName   => 'TYPE' , regexp    => '\b(?:input|output|inout)\b',
3898
     nextState => ['ANSI_PORTS_TYPE'], resetPos => 1, },
3899
   { arcName   => 'VID' , regexp    => '$VID',
3900
     nextState => ['ANSI_PORTS_SIGNAL_AFTER_NAME'], },
3901
  ],
3902
 },
3903
 { # V2001 ansi module ports
3904
 stateName =>     'ANSI_PORTS_SIGNAL_AFTER_NAME',
3905
 search =>
3906
  [
3907
   { regexp => ',',  nextState => ['ANSI_PORTS_SIGNAL_NAME'],},
3908
   { regexp => '\[', nextState => ['IN_MEM_RANGE','ANSI_PORTS_SIGNAL_AFTER_NAME'],}, # memories
3909
   { regexp => '\)', nextState => ['SEMICOLON'], } # semicolon, then pop up
3910
  ],
3911
 },
3912
 { # v2001 module_parameter_port_list (A.1.3)
3913
 stateName =>     'PPL_BRACKET' ,
3914
 search => [ { regexp    => '\(',  nextState => ['PPL_PARAM'], }, ],
3915
 },
3916
 { # v2001 module_parameter_port_list (A.1.3)
3917
 stateName =>     'PPL_PARAM' ,
3918
 search => [ { arcName=>'PARAM', regexp=>'\bparameter\b', nextState => ['PPL_TYPE'],},],
3919
 },
3920
 { # v2001 module_parameter_port_list (A.1.3)
3921
 stateName =>     'PPL_TYPE',
3922
 failNextState => ['PPL_NAME'],
3923
 search => [
3924
    { arcName   => 'RANGE', regexp    => '\[' ,
3925
      nextState => ['IN_RANGE','PPL_NAME'] , },
3926
    { arcName   => 'SIGNED', regexp    => '\bsigned\b' ,
3927
      nextState => ['PPL_TYPE'] , },  # may be followed by a range
3928
    { arcName   => 'OTHER', regexp    => '\b(?:integer|real|realtime|time)\b' ,
3929
      nextState => ['PPL_NAME'] , },
3930
   ],
3931
 },
3932
 { # v2001 module_parameter_port_list (A.1.3)
3933
 stateName =>     'PPL_NAME',
3934
 search => [
3935
    { arcName   => 'NAME',  regexp    => '$VID' ,
3936
      nextState => ['PARAMETER_EQUAL','PPL_AFTER_EQUALS'] , },
3937
   ],
3938
 },
3939
 { # v2001 module_parameter_port_list (A.1.3)
3940
 stateName =>     'PPL_AFTER_EQUALS',
3941
 allowAnything => 1,
3942
 search =>
3943
  [
3944 48 alirezamon
   { arcName   => 'CONCAT',      regexp    => '\{' ,
3945 16 alirezamon
     nextState => ['IN_CONCAT','PPL_AFTER_EQUALS'] ,  },
3946
   { arcName   => 'BRACKET',      regexp    => '\(' ,
3947
     nextState => ['IN_BRACKET','PPL_AFTER_EQUALS'] ,  },
3948
   { arcName   => 'COMMA',       regexp    => ',' ,
3949
     nextState => ['PPL_PARAM_OR_NAME'] ,    },
3950
   { arcName   => 'END',       regexp    => '\)' ,
3951
     nextState => ['MODULE_PORTS'] ,    },
3952
   @$vid_vnum_or_string,
3953
  ]
3954
 },
3955
 { # v2001 module_parameter_port_list (A.1.3)
3956
 stateName =>     'PPL_PARAM_OR_NAME' ,
3957
 failNextState => ['PPL_NAME'],
3958
 search => [ { regexp    => '\bparameter\b',  nextState => ['PPL_TYPE'], }, ],
3959
 },
3960
];
3961
}
3962
 
3963
 
3964
############################################################
3965
# make the parser, and return it as a string
3966
############################################################
3967
 
3968
 
3969
sub _make_parser {
3970
    my ($evalDefs,$genDebugCode) = @_;
3971
 
3972
    _check_data_structures($evalDefs);
3973
 
3974
    my $perlCode; # the perl code we are making
3975
 
3976
    my $debugPrint =  $genDebugCode ? 'print "---- $ps->{curState} $file:$line (".pos($code).")\\n" if defined $ps->{curState} && defined pos($code);':'';
3977
#    vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
3978
    $perlCode .= <<EOF;
3979
sub _parse_line {
3980
 
3981
  my (\$self,\$code,\$file,\$line,\$ps,\$rs) = \@_;
3982
 
3983
  if (!exists(\$ps->{curState})){
3984
      \$ps->{curState} = undef;
3985
      \$ps->{prevState}= undef;
3986
      \$ps->{nextStateStack}= ["START"];
3987
      \$ps->{storing}= 0;
3988
      \$ps->{stored}= "";
3989
      \$ps->{confusedNextState}= "START";
3990
  }
3991
 
3992
  my \$storePos = -1;
3993
  my \$lastPos = 0;
3994
  my \$posMark;
3995
  my \$fromLastPos;
3996
  PARSE_LINE_LOOP: while (1) {
3997
 
3998
    \$lastPos = pos(\$code) if (defined(pos(\$code)));
3999
 
4000
    if ( \$code =~ m/\\G\\s*\\Z/gs ) {
4001
        last PARSE_LINE_LOOP;
4002
    }
4003
    else {
4004
        pos(\$code) = \$lastPos;
4005
    }
4006
 
4007
    \$code =~ m/\\G\\s*/gs ; # skip any whitespace
4008
 
4009
    \$ps->{prevState} = \$ps->{curState};
4010
    \$ps->{curState} = pop(\@{\$ps->{nextStateStack}}) or
4011
        die "Error: No next state after \$ps->{prevState} ".
4012
            "\$file line \$line :\n \$code";
4013
    $debugPrint
4014
 
4015
    goto \$ps->{curState};
4016
    die \"Confused: Bad state \$ps->{curState}\";
4017
 
4018
    CONFUSED:
4019
        \$posMark = '';
4020
        # make the position marker: tricky because code can contain tabs
4021
        #  which we want to match in the blank space before the ^
4022
        \$posMark = substr(\$code,0,\$lastPos);
4023
        \$posMark =~ tr/\t/ /c ; # turn anything that isn't a tab into a space
4024
        \$posMark .= "^" ;
4025
        if (substr(\$code,length(\$code)-1,1) ne "\\n") { \$posMark="\\n".\$posMark; }
4026
        \$self->_add_confused("\$file:\$line: in state \$ps->{prevState}:\\n".
4027
                    "\$code".\$posMark);
4028
        \@{\$ps->{nextStateStack}} = (\$ps->{confusedNextState});
4029
       return; # ignore the rest of the line
4030
EOF
4031
#    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
4032
 
4033
 
4034
  foreach my $state (@$languageDef) {
4035
      my $stateName = $state->{stateName};
4036
      my $allowAnything    = exists($state->{allowAnything}) && $state->{allowAnything};
4037
      my $re = $allowAnything ? '' : '\G'; # allowAnything==0 forces a match 
4038
      #  where we left off last time
4039
      $perlCode.= "    $stateName:\n";
4040
 
4041
      if (exists($state->{confusedNextState})) {
4042
          $perlCode.= "      \$ps->{confusedNextState}=\"$state->{confusedNextState}\";\n";
4043
      }
4044
 
4045
      if (exists($state->{search})) {
4046
          my @searchTerms=();
4047
          foreach my $search (@{$state->{search}}) {
4048
              push @searchTerms, $search->{regexp};
4049
          }
4050
          $re .= "(?:(". join(")|(",@searchTerms)."))";
4051
 
4052
          my $failNextState='';
4053
 
4054
          if (exists($state->{failNextState})) {
4055
              if (scalar(@{$state->{failNextState}}) != 0) {
4056
                  $failNextState="\"".
4057
                      join('","',reverse(@{$state->{failNextState}})).
4058
                          "\"";
4059
              }
4060
              # else leave it set at nothing - means just popup
4061
          }
4062
          else {
4063
              $failNextState='"CONFUSED"';
4064
          }
4065
          $perlCode.= "        if (\$code =~ m/$re/gos) {\n";
4066
 
4067
          my $elsif2="if";
4068
          my $i=0;
4069
          foreach my $search (@{$state->{search}}) {
4070
              $i++;
4071
 
4072
              my $arcName = exists($search->{arcName}) ? $search->{arcName} : '';
4073
 
4074
              $perlCode.= "          $elsif2 (defined(\$$i)) {\n";
4075
              if ($genDebugCode) {
4076
                  $perlCode.="           print \"----  -$arcName (\$$i)->\\n\";\n";
4077
                  $perlCode.="           \$takenArcs->{'$stateName'}{$i}++;\n";
4078
              }
4079
              $elsif2="elsif";
4080
              if (exists($search->{resetPos}) && $search->{resetPos}) {
4081
                  $perlCode.="           pos(\$code)=pos(\$code)-length(\$$i);\n";
4082
              }
4083
              if (exists($search->{arcName})) {
4084
                  $perlCode.=  # "            " . 
4085
                      _make_eval_code($evalDefs,$stateName,
4086
                                   $search->{arcName},$i,$genDebugCode);
4087
              }
4088
              if (exists $search->{nextState}) {
4089
                  $perlCode.= "       push (\@{\$ps->{nextStateStack}}, \"".
4090
                      join('","',reverse(@{$search->{nextState}}))."\");\n";
4091
              }
4092
              if (exists($search->{storePos}) && $search->{storePos}) {
4093
                  $perlCode.= "       \$ps->{storing} == 0 or\n";
4094
                  $perlCode.= "            die \"Setting storing ".
4095
                      "flag when it is already set: $stateName:$arcName\";\n";
4096
                  $perlCode.= "       \$storePos       = pos(\$code);\n";
4097
                  $perlCode.= "       \$ps->{storing}  = 1;\n";
4098
                  $perlCode.= "       \$ps->{stored}   = '';\n";
4099
              }
4100
              $perlCode.= "       }\n";
4101
          }
4102
          $perlCode.= "      }\n";
4103
 
4104
          if ($allowAnything) {
4105
              $perlCode.= "      else { ".
4106
                  "push(\@{\$ps->{nextStateStack}},\"$stateName\"); last  PARSE_LINE_LOOP; }\n";
4107
          }
4108
          else {
4109
              $perlCode.= "      else {\n";
4110
              if (exists($state->{failStorePos}) && $state->{failStorePos}) {
4111
                  $perlCode.= "       \$ps->{storing} == 0 or\n";
4112
                  $perlCode.= "            die \"Setting storing ".
4113
                      "flag when it is already set: $stateName:fail\";\n";
4114
                  #NB:uses lastPos here because there was no match, so can't 
4115
                  #  use pos(code)
4116
                  $perlCode.= "       \$storePos       = \$lastPos;\n";
4117
                  $perlCode.= "       \$ps->{storing}  = 1;\n";
4118
                  $perlCode.= "       \$ps->{stored}   = '';\n";
4119
              }
4120
              if ($failNextState) {
4121
                  $perlCode.="push(\@{\$ps->{nextStateStack}},$failNextState);";
4122
              }
4123
              $perlCode.= " pos(\$code)=\$lastPos; }\n";
4124
          }
4125
      }
4126
      $perlCode.= "    next PARSE_LINE_LOOP;\n";
4127
  }
4128
  $perlCode.= "  }\n";
4129
  $perlCode.= "  if (\$storePos!=-1) { \$ps->{stored}=substr(\$code,\$storePos);}\n";
4130
  $perlCode.= "  elsif ( \$ps->{storing} ) {   \$ps->{stored} .= \$code; }\n";
4131
  $perlCode.= "}\n";
4132
 
4133
  return $perlCode;
4134
}
4135
 
4136
sub _make_eval_code {
4137
    my ($evalDefs,$stateName,$arcName,$matchNo,$genDebugCode) = @_;
4138
 
4139
    my $eval='';
4140
 
4141
    foreach my $evalDef (@$evalDefs) {
4142
 
4143
        if (exists($evalDef->{$stateName}{$arcName})) {
4144
            if ( $evalDef->{$stateName}{$arcName} =~ m/^(\w+?):(\w+?)$/ ) {
4145
                $eval.=$evalDef->{$1}{$2};
4146
            }
4147
            else {
4148
                $eval.=$evalDef->{$stateName}{$arcName};
4149
            }
4150
            $eval.="\n";
4151
        }
4152
    }
4153
    # replace $match variable with the actual number of the match
4154
    $eval=~ s/\$match/\$$matchNo/g;
4155
 
4156
    # if fromLastPos is used then generate the code to work it out
4157
    if ($eval =~ /\$fromLastPos/) {
4158
        my $e;
4159
        $e .= "\$ps->{storing}==1 or die \"fromLastPos used and storing was not set\";\n";
4160
        $e .= "if (\$storePos==-1) {\n"; # on another line
4161
        $e .= "   \$fromLastPos=\$ps->{stored}."; # what was before
4162
        $e .= "       substr(\$code,0,pos(\$code)-length(\$$matchNo));\n"; # some of this line
4163
        $e .= "}\n";
4164
        $e .= "else {\n";
4165
        $e .= "   \$fromLastPos=substr(\$code,\$storePos,pos(\$code)".
4166
            "-\$storePos-length(\$$matchNo));\n";
4167
        $e .= "}\n";
4168
        $e .= "\$ps->{storing}=0;\n";
4169
        $e .= "\$ps->{stored}='';\n";
4170
        $eval = $e . $eval;
4171
 
4172
    }
4173
    return $eval;
4174
}
4175
 
4176
sub _check_end_state {
4177
  my ($self,$file,$line,$ps) = @_;
4178
 
4179
  if (!exists($ps->{curState})){
4180
      # parse_line was never called, file only contained comments, defines etc
4181
      return;
4182
  }
4183
  $ps->{prevState} = $ps->{curState};
4184
  $ps->{curState} = pop(@{$ps->{nextStateStack}}) or
4185
      $self->_add_confused("$file:$line:".
4186
                          "No next state after $ps->{prevState} at EOF");
4187
 
4188
  if ($ps->{curState} ne 'START') {
4189
      $self->_add_confused("$file:$line:".
4190
                          " at EOF in state $ps->{curState}".
4191
                          (($ps->{curState} eq 'CONFUSED')?
4192
                                           ",prevState was $ps->{prevState}":""));
4193
  }
4194
  if (@{$ps->{nextStateStack}}) {
4195
      $self->_add_confused("$file:$line:".
4196
                          " at EOF, state stack not empty: ".
4197
                          join(" ",@{$ps->{nextStateStack}}));
4198
  }
4199
 
4200
  # at the moment I don't check these:
4201
  # $ps->{storing}= 0;  
4202
  # $ps->{stored}= "";
4203
 
4204
}
4205
 
4206
sub _check_data_structures {
4207
    my ($evalDefs) = @_;
4208
 
4209
    my %stateNames;
4210
    my %statesUnused;
4211
 
4212
    foreach my $sp (@$languageDef) {
4213
        die "Not hash!" unless ref($sp) eq "HASH";
4214
        if (!exists($sp->{stateName})) {  die "State without name!"; }
4215
        die "Duplicate state$sp->{stateName}" if exists $stateNames{$sp->{stateName}};
4216
        $stateNames{$sp->{stateName}} = $sp;
4217
    }
4218
 
4219
    %statesUnused = %stateNames;
4220
    # check language def first
4221
    foreach my $sp (@$languageDef) {
4222
        my %t = %$sp;
4223
        if (!exists($sp->{search})) {  die "State without search!"; }
4224
        die "search $sp->{stateName} not array" unless ref($t{search}) eq "ARRAY";
4225
        my %arcNames;
4226
        foreach my $arc (@{$sp->{search}}) {
4227
            my %a = %$arc;
4228
            die "arc without regexp in $sp->{stateName}" unless exists $a{regexp};
4229
            delete $a{regexp};
4230
            if (exists($a{nextState})) {
4231
                die "nextState not array"  unless ref($a{nextState}) eq "ARRAY";
4232
                foreach my $n (@{$a{nextState}}) {
4233
                    next if ($n =~ m/^\$/); #can't check variable ones
4234
                    die "Bad Next state $n"
4235
                        unless exists $stateNames{$n};
4236
                    delete($statesUnused{$n}) if exists $statesUnused{$n};
4237
                }
4238
                delete $a{nextState};
4239
            }
4240
            if (exists($a{arcName})) {
4241
                die "Duplicate arc $a{arcName}" if exists $arcNames{$a{arcName}};
4242
                $arcNames{$a{arcName}} = 1;
4243
                delete $a{arcName};
4244
            }
4245
            delete $a{resetPos};
4246
            delete $a{storePos};
4247
            foreach my $k (sort (keys %a)) {
4248
                die "Bad key $k in arc of state $t{stateName}";
4249
            }
4250
        }
4251
        delete $t{stateName};
4252
        delete $t{search};
4253
        delete $t{allowAnything} if exists $t{allowAnything};
4254
 
4255
        if (exists($t{confusedNextState})) {
4256
            die "Bad Next confused state $t{confusedNextState}"
4257
                unless exists $stateNames{$t{confusedNextState}};
4258
            delete $t{confusedNextState};
4259
        }
4260
 
4261
        foreach my $n (@{$t{failNextState}}) {
4262
            next if ($n =~ m/^\$/); #can't check variable ones
4263
            die "Bad Next fail state $n"
4264
                unless exists $stateNames{$n};
4265
            delete($statesUnused{$n}) if exists $statesUnused{$n};
4266
        }
4267
        delete $t{failNextState} if exists $t{failNextState};
4268
        delete $t{failStorePos}  if exists $t{failStorePos};
4269
        foreach my $k (sort (keys %t)) {
4270
            die "Bad key $k in languageDef state $sp->{stateName}";
4271
        }
4272
    }
4273
 
4274
    # REVISIT: MODULE PORTS looks like it is unused because it is got to
4275
    #  by setting $nState - should have a flag in language def that turns
4276
    #  off this check on a per state basis.
4277
    foreach my $state (sort (keys %statesUnused)) {
4278
        #die "State $state was not used";
4279
        print "Warning: State $state looks like it was not used\n" if $debug;
4280
    }
4281
 
4282
    foreach my $evalDef (@$evalDefs) {
4283
        foreach my $state (sort (keys %$evalDef)) {
4284
            if (!exists($stateNames{$state})) {
4285
                die "Couldn't find state $state";
4286
            }
4287
            my $statep = $stateNames{$state};
4288
 
4289
            foreach my $arc (sort (keys %{$evalDef->{$state}})) {
4290
                my $found = 0;
4291
                foreach my $s (@{$statep->{search}}) {
4292
                    if (exists($s->{arcName}) && ($s->{arcName} eq $arc)) {
4293
                        $found=1;
4294
                        last;
4295
                    }
4296
                }
4297
                if ($found == 0) {
4298
                    die "No arc $arc in state $state";
4299
                }
4300
                if ( $evalDef->{$state}{$arc} =~ m/^(\w+?):(\w+?)$/ ) {
4301
                    die "No code found for $evalDef->{$state}{$arc}"
4302
                        unless exists $evalDef->{$1}{$2};
4303
                }
4304
            }
4305
        }
4306
    }
4307
}
4308
 
4309
 
4310
sub _check_coverage {
4311
 
4312
    print "\n\nCoverage Information:\n";
4313
    foreach my $sp (@$languageDef) {
4314
        if (!exists($takenArcs->{$sp->{stateName}})) {
4315
            print " State $sp->{stateName}: no arcs take (except fail maybe)\n";
4316
        }
4317
        else {
4318
            my $i=0;
4319
            foreach my $arc (@{$sp->{search}}) {
4320
                $i++;
4321
                if (!exists( $takenArcs->{$sp->{stateName}}{$i} )) {
4322
                    my $arcName = $i;
4323
                    $arcName = $arc->{arcName} if exists $arc->{arcName};
4324
                    print " Arc $arcName of $sp->{stateName} was never taken\n";
4325
                }
4326
            }
4327
        }
4328
    }
4329
}
4330
 
4331
 
4332
###########################################################################
4333
 
4334
# when doing require or use we must return 1
4335
1;
4336
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.