File Coverage

blib/lib/Verilog/Language.pm
Criterion Covered Total %
statement 138 250 55.2
branch 68 130 52.3
condition 33 50 66.0
subroutine 14 18 77.7
pod 14 14 100.0
total 267 462 57.7


line stmt bran cond sub pod time code
1             # See copyright, etc in below POD section.
2             ######################################################################
3              
4             =pod
5              
6             =head1 NAME
7              
8             Verilog::Language - Verilog language utilities
9              
10             =head1 SYNOPSIS
11              
12             use Verilog::Language;
13              
14             $result = Verilog::Language::is_keyword("wire"); # true
15             $result = Verilog::Language::is_compdirect("`notundef"); # false
16             $result = Verilog::Language::number_value("4'b111"); # 8
17             $result = Verilog::Language::number_bits("32'h1b"); # 32
18             $result = Verilog::Language::number_signed("1'sh1"); # 1
19             @vec = Verilog::Language::split_bus("[31,5:4]"); # 31, 5, 4
20             @vec = Verilog::Language::split_bus_nocomma("[31:29]"); # 31, 30, 29
21             $result = Verilog::Language::strip_comments("a/*b*/c"); # ac
22              
23             =head1 DESCRIPTION
24              
25             Verilog::Language provides general utilities for using the Verilog
26             Language, such as parsing numbers or determining what keywords exist.
27             General functions will be added as needed.
28              
29             =head1 FUNCTIONS
30              
31             =over 4
32              
33             =item Verilog::Language::is_keyword($symbol_string)
34              
35             Return true if the given symbol string is a Verilog reserved keyword.
36             Value indicates the language standard as per the `begin_keywords macro,
37             '1364-1995', '1364-2001', '1364-2005', '1800-2005', '1800-2009',
38             '1800-2012', '1800-2017' or 'VAMS'.
39              
40             =item Verilog::Language::is_compdirect($symbol_string)
41              
42             Return true if the given symbol string is a Verilog compiler directive.
43              
44             =item Verilog::Language::is_gateprim($symbol_string)
45              
46             Return true if the given symbol is a built in gate primitive; for example
47             "buf", "xor", etc.
48              
49             =item Verilog::Language::language_keywords($year)
50              
51             Returns a hash for keywords for given language standard year, where the
52             value of the hash is the standard in which it was defined.
53              
54             =item Verilog::Language::language_standard($year)
55              
56             Sets the language standard to indicate what are keywords. If undef, all
57             standards apply. The year is indicates the language standard as per the
58             `begin_keywords macro, '1364-1995', '1364-2001', '1364-2005', '1800-2005'
59             '1800-2009', '1800-2012' or '1800-2017'.
60              
61             =item Verilog::Language::language_maximum
62              
63             Returns the greatest language currently standardized, presently
64             '1800-2017'.
65              
66             =item Verilog::Language::number_bigint($number_string)
67              
68             Return the numeric value of a Verilog value stored as a Math::BigInt, or
69             undef if incorrectly formed. You must 'use Math::BigInt' yourself before
70             calling this function. Note bigints do not have an exact size, so NOT of a
71             Math::BigInt may return a different value than verilog. See also
72             number_value and number_bitvector.
73              
74             =item Verilog::Language::number_bits($number_string)
75              
76             Return the number of bits in a value string, or undef if incorrectly
77             formed, _or_ not specified.
78              
79             =item Verilog::Language::number_bitvector($number_string)
80              
81             Return the numeric value of a Verilog value stored as a Bit::Vector, or
82             undef if incorrectly formed. You must 'use Bit::Vector' yourself before
83             calling this function. The size of the Vector will be that returned by
84             number_bits.
85              
86             =item Verilog::Language::number_signed($number_string)
87              
88             Return true if the Verilog value is signed, else undef.
89              
90             =item Verilog::Language::number_value($number_string)
91              
92             Return the numeric value of a Verilog value, or undef if incorrectly
93             formed. It ignores any signed Verilog attributes, but is is returned as a
94             perl signed integer, so it may fail for over 31 bit values. See also
95             number_bigint and number_bitvector.
96              
97             =item Verilog::Language::split_bus($bus)
98              
99             Return a list of expanded arrays. When passed a string like
100             "foo[5:1:2,10:9]", it will return a array with ("foo[5]", "foo[3]", ...).
101             It correctly handles connectivity expansion also, so that "x[1:0] = y[3:0]"
102             will get intuitive results.
103              
104             =item Verilog::Language::split_bus_nocomma($bus)
105              
106             As with split_bus, but faster. Only supports simple decimal colon
107             separated array specifications, such as "foo[3:0]".
108              
109             =item Verilog::Language::strip_comments($text)
110              
111             Return text with any // or /**/ comments stripped, correctly handing quoted
112             strings. Newlines will be preserved in this process.
113              
114             =back
115              
116             =head1 DISTRIBUTION
117              
118             Verilog-Perl is part of the L free Verilog EDA
119             software tool suite. The latest version is available from CPAN and from
120             L.
121              
122             Copyright 2000-2021 by Wilson Snyder. This package is free software; you
123             can redistribute it and/or modify it under the terms of either the GNU
124             Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
125              
126             =head1 AUTHORS
127              
128             Wilson Snyder
129              
130             =head1 SEE ALSO
131              
132             L,
133             L
134             L,
135             L,
136             L
137              
138             And the LVerilog-Mode package for Emacs.
139              
140             =cut
141             ######################################################################
142              
143             package Verilog::Language;
144             require 5.000;
145             require Exporter;
146              
147 15     15   277255 use strict;
  15         63  
  15         577  
148 15     15   74 use vars qw($VERSION %Keyword %Keywords %Compdirect $Standard %Gateprim);
  15         26  
  15         1086  
149 15     15   86 use Carp;
  15         26  
  15         55541  
150              
151             ######################################################################
152             #### Configuration Section
153              
154             $VERSION = '3.476';
155              
156             ######################################################################
157             #### Internal Variables
158              
159             foreach my $kwd (qw(
160             always and assign begin buf bufif0 bufif1 case
161             casex casez cmos deassign default defparam
162             disable else end endcase endfunction endmodule
163             endprimitive endspecify endtable endtask event
164             for force forever fork function highz0
165             highz1 if initial inout input integer join large
166             macromodule medium module nand negedge
167             nmos nor not notif0 notif1 or output parameter
168             pmos posedge primitive pull0 pull1 pulldown
169             pullup rcmos real realtime reg release repeat
170             rnmos rpmos rtran rtranif0 rtranif1 scalared
171             small specify strength strong0 strong1
172             supply0 supply1 table task time tran tranif0
173             tranif1 tri tri0 tri1 triand trior trireg
174             vectored wait wand weak0 weak1 while wire wor
175             xnor xor
176             )) { $Keywords{'1364-1995'}{$kwd} = '1364-1995'; }
177              
178             foreach my $kwd (qw(
179             automatic cell config design edge endconfig endgenerate
180             generate genvar ifnone incdir include instance liblist
181             library localparam
182             noshowcancelled pulsestyle_ondetect pulsestyle_onevent
183             showcancelled signed specparam unsigned use
184             )) { $Keywords{'1364-2001'}{$kwd} = '1364-2001'; }
185              
186             foreach my $kwd (qw(
187             uwire
188             )) { $Keywords{'1364-2005'}{$kwd} = '1364-2005'; }
189              
190             foreach my $kwd (qw(
191             alias always_comb always_ff always_latch assert assume
192             before bind bins binsof bit break byte chandle class
193             clocking const constraint context continue cover
194             covergroup coverpoint cross dist do endclass endclocking
195             endgroup endinterface endpackage endprogram endproperty
196             endsequence enum expect export extends extern final
197             first_match foreach forkjoin iff ignore_bins
198             illegal_bins import inside int interface intersect
199             join_any join_none local logic longint matches modport
200             new null package packed priority program property
201             protected pure rand randc randcase randsequence ref
202             return sequence shortint shortreal solve static string
203             struct super tagged this throughout timeprecision
204             timeunit type typedef union unique var virtual void
205             wait_order wildcard with within
206             )) { $Keywords{'1800-2005'}{$kwd} = '1800-2005'; }
207              
208             foreach my $kwd (qw(
209             accept_on checker endchecker eventually global implies
210             let nexttime reject_on restrict s_always s_eventually
211             s_nexttime s_until s_until_with strong sync_accept_on
212             sync_reject_on unique0 until until_with untyped weak
213             )) { $Keywords{'1800-2009'}{$kwd} = '1800-2009'; }
214              
215             foreach my $kwd (qw(
216             implements nettype interconnect soft
217             )) { $Keywords{'1800-2012'}{$kwd} = '1800-2012'; }
218              
219             foreach my $kwd (qw(
220             )) { $Keywords{'1800-2017'}{$kwd} = '1800-2017'; }
221              
222             foreach my $kwd (qw(
223             above abs absdelay abstol ac_stim access acos acosh
224             aliasparam analog analysis asin asinh assert atan atan2
225             atanh branch ceil connect connectmodule connectrules
226             continuous cos cosh cross ddt ddt_nature ddx discipline
227             discrete domain driver_update endconnectrules
228             enddiscipline endnature endparamset exclude exp
229             final_step flicker_noise floor flow from ground hypot
230             idt idt_nature idtmod inf initial_step laplace_nd
231             laplace_np laplace_zd laplace_zp last_crossing limexp
232             ln log max merged min nature net_resolution noise_table
233             paramset potential pow resolveto sin sinh slew split
234             sqrt string tan tanh timer transition units white_noise
235             wreal zi_nd zi_np zi_zd zi_zp
236             )) { $Keywords{'VAMS'}{$kwd} = 'VAMS'; }
237              
238             foreach my $kwd (
239             # Speced
240             "`celldefine",
241             "`define", # Preprocessor
242             "`else", # Preprocessor
243             "`endcelldefine",
244             "`endif", # Preprocessor
245             "`ifdef", # Preprocessor
246             "`include", # Preprocessor
247             "`nounconnected_drive",
248             "`resetall",
249             "`timescale",
250             "`unconnected_drive",
251             "`undef", # Preprocessor
252             "`undefineall", # Preprocessor
253              
254             # Commercial Extensions
255             "`accelerate", # Verilog-XL compatibility
256             "`autoexpand_vectornets", # Verilog-XL compatibility
257             "`default_decay_time", # Verilog spec - delays only
258             "`default_trireg_strength", # Verilog spec
259             "`delay_mode_distributed", # Verilog spec - delays only
260             "`delay_mode_path", # Verilog spec - delays only
261             "`delay_mode_unit", # Verilog spec - delays only
262             "`delay_mode_zero", # Verilog spec - delays only
263             "`disable_portfaults", # Verilog-XL compatibility
264             "`enable_portfaults", # Verilog-XL compatibility
265             "`endprotect", # Many tools - pre encryption
266             "`endprotected", # Many tools - post encryption
267             "`expand_vectornets", # Verilog-XL compatibility
268             "`noaccelerate", # Verilog-XL compatibility
269             "`noexpand_vectornets", # Verilog-XL compatibility
270             "`noremove_gatenames", # Verilog-XL compatibility
271             "`noremove_netnames", # Verilog-XL compatibility
272             "`nosuppress_faults", # Verilog-XL compatibility
273             "`nounconnected_drive", # Verilog-XL compatibility
274             "`portcoerce", # Verilog-XL compatibility
275             "`protect", # Many tools - pre encryption
276             "`protected", # Many tools - post encryption
277             "`remove_gatenames", # Verilog-XL compatibility
278             "`remove_netnames", # Verilog-XL compatibility
279             "`suppress_faults", # Verilog-XL compatibility
280             ) { $Keywords{$kwd}{'1364-1995'} = $Compdirect{$kwd} = '1364-1995'; }
281              
282             foreach my $kwd (
283             "`default_nettype", "`elsif", "`undef", "`ifndef",
284             "`file", "`line",
285             ) { $Keywords{$kwd}{'1364-2001'} = $Compdirect{$kwd} = '1364-2001'; }
286              
287             foreach my $kwd (
288             "`pragma",
289             ) { $Keywords{$kwd}{'1364-2005'} = $Compdirect{$kwd} = '1364-2005'; }
290              
291             foreach my $kwd (
292             "`default_discipline", "`default_transition",
293             ) { $Keywords{$kwd}{'1364-2005'} = $Compdirect{$kwd} = '1364-2005'; }
294              
295             language_standard(language_maximum()); # Default standard
296              
297             foreach my $kwd (qw(
298             and buf bufif0 bufif1 cmos nand nmos nor not notif0
299             notif1 or pmos pulldown pullup rcmos rnmos rpmos rtran
300             rtranif0 rtranif1 tran tranif0 tranif1 xnor xor
301             )) { $Gateprim{$kwd} = '1364-1995'; }
302              
303             ######################################################################
304             #### Keyword utilities
305              
306             sub language_maximum {
307 16     16 1 88 return "1800-2017";
308             }
309              
310             sub _language_kwd_hash {
311 22     22   34 my $standard = shift;
312 22         42 my @subsets;
313 22 100 66     624 if ($standard eq '1995' || $standard eq '1364-1995') {
    100 66        
    100 66        
    100 66        
    100 33        
    100          
    50          
    0          
314 1         3 $Standard = '1364-1995';
315 1         3 @subsets = ('1364-1995');
316             } elsif ($standard eq '2001' || $standard eq '1364-2001' || $standard eq '1364-2001-noconfig') {
317 1         21 $Standard = '1364-2001';
318 1         4 @subsets = ('1364-2001',
319             '1364-1995');
320             } elsif ($standard eq '1364-2005') {
321 1         2 $Standard = '1364-2005';
322 1         4 @subsets = ('1364-2005',
323             '1364-2001', '1364-1995');
324             } elsif ($standard eq 'sv31' || $standard eq '1800-2005') {
325 1         2 $Standard = '1800-2005';
326 1         4 @subsets = ('1800-2005',
327             '1364-2005', '1364-2001', '1364-1995');
328             } elsif ($standard eq '1800-2009') {
329 1         3 $Standard = '1800-2009';
330 1         5 @subsets = ('1800-2009', '1800-2005',
331             '1364-2005', '1364-2001', '1364-1995');
332             } elsif ($standard eq '1800-2012') {
333 1         3 $Standard = '1800-2012';
334 1         4 @subsets = ('1800-2012', '1800-2009', '1800-2005',
335             '1364-2005', '1364-2001', '1364-1995');
336             } elsif ($standard eq 'latest' || $standard eq '1800-2017') {
337 16         39 $Standard = '1800-2017';
338 16         80 @subsets = ('1800-2017', '1800-2012', '1800-2009', '1800-2005',
339             '1364-2005', '1364-2001', '1364-1995');
340             } elsif ($standard =~ /^V?AMS/) {
341 0         0 $Standard = 'VAMS';
342 0         0 @subsets = ('VAMS',
343             '1364-2005', '1364-2001', '1364-1995');
344             } else {
345 0         0 croak "%Error: Verilog::Language::language_standard passed bad value: $standard,";
346             }
347             # Update keyword list to present language
348             # (We presume the language_standard rarely changes, so it's faster to compute the list.)
349 22         51 my %keywords = ();
350 22         52 foreach my $ss (@subsets) {
351 133         153 foreach my $kwd (%{$Keywords{$ss}}) {
  133         1259  
352 10098         13161 $keywords{$kwd} = $ss;
353             }
354             }
355 22         2443 return %keywords;
356             }
357              
358             sub language_standard {
359 974     974 1 1521 my $standard = shift;
360 974 100       2041 if (defined $standard) {
361 22         70 %Keyword = _language_kwd_hash($standard);
362             }
363 974         4437 return $Standard;
364             }
365              
366             sub language_keywords {
367 0   0 0 1 0 my $standard = shift || $Standard;
368 0         0 return _language_kwd_hash($standard);
369             }
370              
371             sub is_keyword {
372 1713     1713 1 2851 my $symbol = shift;
373 1713         5686 return ($Keyword{$symbol});
374             }
375              
376             sub is_compdirect {
377 1     1 1 3 my $symbol = shift;
378 1         7 return ($Compdirect{$symbol});
379             }
380              
381             sub is_gateprim {
382 34     34 1 57 my $symbol = shift;
383 34         145 return ($Gateprim{$symbol});
384             }
385              
386             ######################################################################
387             #### String utilities
388              
389             sub strip_comments {
390 4 50   4 1 25 return $_[0] if $_[0] !~ m!/!s; # Fast path
391 4         8 my $text = shift;
392             # Spec says that // has no special meaning inside /**/
393 4         10 my $quote; my $olcmt; my $cmt;
  4         0  
394 4         7 my $out = "";
395 4         26 while ($text =~ m!(.*?)(//|/\*|\*/|\n|\"|$)!sg) {
396 20 100 100     64 $out .= $1 if !$olcmt && !$cmt;
397 20         32 my $t = $2;
398 20 100 100     152 if ($2 eq '"') {
    100 100        
    100 100        
    100 100        
    100 100        
399 2         3 $out .= $t;
400 2         8 $quote = ! $quote;
401             } elsif (!$quote && !$olcmt && $t eq '/*') {
402 3         12 $cmt = 1;
403             } elsif (!$quote && !$cmt && $t eq '//') {
404 1         5 $olcmt = 1;
405             } elsif ($cmt && $t eq '*/') {
406 3         10 $cmt = 0;
407             } elsif ($t eq "\n") {
408 1         2 $olcmt = 0;
409 1         4 $out .= $t;
410             } else {
411 10 100 100     50 $out .= $t if !$olcmt && !$cmt;
412             }
413             }
414 4         18 return $out;
415             }
416              
417             ######################################################################
418             #### Numeric utilities
419              
420             sub number_bits {
421 3     3 1 8 my $number = shift;
422 3 100       19 if ($number =~ /^\s*([0-9]+)\s*\'/i) {
423 2         11 return $1;
424             }
425 1         6 return undef;
426             }
427              
428             sub number_signed {
429 1     1 1 3 my $number = shift;
430 1 50       8 if ($number =~ /\'\s*s/i) {
431 1         4 return 1;
432             }
433 0         0 return undef;
434             }
435              
436             sub number_value {
437 18     18 1 647 my $number = shift;
438 18         41 $number =~ s/[_ ]//g;
439 18 100 100     140 if ($number =~ /\'s?h([0-9a-f]+)$/i) {
    100          
    100          
    100          
440 2         12 return (hex ($1));
441             }
442             elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
443 1         7 return (oct ($1));
444             }
445             elsif ($number =~ /\'s?b([0-1]+)$/i) {
446 4         7 my $val = 0;
447 4         10 $number = $1;
448 4         14 foreach my $bit (split(//, $number)) {
449 8 100       22 $val = ($val<<1) | ($bit=='1'?1:0);
450             }
451 4         18 return ($val);
452             }
453             elsif ($number =~ /\'s?d?([0-9]+)$/i
454             || $number =~ /^(-?[0-9]+)$/i) {
455 8         26 return ($1);
456             }
457 3         9 return undef;
458             }
459              
460             sub number_bigint {
461 0     0 1 0 my $number = shift;
462 0         0 $number =~ s/[_ ]//g;
463 0 0 0     0 if ($number =~ /\'s?h([0-9a-f]+)$/i) {
    0          
    0          
    0          
464 0         0 return (Math::BigInt->new("0x".$1));
465             }
466             elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
467 0         0 my $digits = $1;
468 0         0 my $vec = Math::BigInt->new();
469 0         0 my $len = length($digits);
470 0         0 my $bit = 0;
471 0         0 for (my $index=$len-1; $index>=0; $index--, $bit+=3) {
472 0         0 my $digit = substr($digits,$index,1);
473 0         0 my $val = Math::BigInt->new($digit);
474 0         0 $val = $val->blsft($bit,2);
475 0         0 $vec->bior($val);
476             }
477 0         0 return ($vec);
478             }
479             elsif ($number =~ /\'s?b([0-1]+)$/i) {
480 0         0 return (Math::BigInt->new("0b".$1));
481             }
482             elsif ($number =~ /\'s?d?0*([0-9]+)$/i
483             || $number =~ /^0*([0-9]+)$/i) {
484 0         0 return (Math::BigInt->new($1));
485             }
486 0         0 return undef;
487             }
488              
489             sub number_bitvector {
490 0     0 1 0 my $number = shift;
491 0         0 $number =~ s/[_ ]//g;
492 0   0     0 my $bits = number_bits($number) || 32;
493 0 0 0     0 if ($number =~ /\'s?h([0-9a-f]+)$/i) {
    0          
    0          
    0          
494 0         0 return (Bit::Vector->new_Hex($bits,$1));
495             }
496             elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
497 0         0 my $digits = $1;
498 0         0 my $vec = Bit::Vector->new($bits);
499 0         0 my $len = length($digits);
500 0         0 my $bit = 0;
501 0         0 for (my $index=$len-1; $index>=0; $index--, $bit+=3) {
502 0         0 my $digit = substr($digits,$index,1);
503 0 0       0 $vec->Bit_On($bit+2) if ($digit & 4);
504 0 0       0 $vec->Bit_On($bit+1) if ($digit & 2);
505 0 0       0 $vec->Bit_On($bit+0) if ($digit & 1);
506             }
507 0         0 return ($vec);
508             }
509             elsif ($number =~ /\'s?b([0-1]+)$/i) {
510 0         0 return (Bit::Vector->new_Bin($bits,$1));
511             }
512             elsif ($number =~ /\'s?d?([0-9]+)$/i
513             || $number =~ /^([0-9]+)$/i) {
514 0         0 return (Bit::Vector->new_Dec($bits,$1));
515             }
516 0         0 return undef;
517             }
518              
519             ######################################################################
520             #### Signal utilities
521              
522             sub split_bus {
523 4     4 1 597 my $bus = shift;
524 4 100       33 if ($bus !~ /\[/) {
    100          
525             # Fast case: No bussing
526 1         5 return $bus;
527             } elsif ($bus =~ /^([^\[]+\[)([0-9]+):([0-9]+)(\][^\]]*)$/) {
528             # Middle speed case: Simple max:min
529 1         2 my $bit;
530 1         2 my @vec = ();
531 1 50       5 if ($2 >= $3) {
532 0         0 for ($bit = $2; $bit >= $3; $bit --) {
533 0         0 push @vec, $1 . $bit . $4;
534             }
535             } else {
536 1         7 for ($bit = $2; $bit <= $3; $bit ++) {
537 2         10 push @vec, $1 . $bit . $4;
538             }
539             }
540 1         5 return @vec;
541             } else {
542             # Complex case: x:y:z,p,... etc
543             # Do full parsing
544 2         4 my @pretext = (); # [brnum]
545 2         4 my @expanded = (); # [brnum][bitoccurance]
546 2         3 my $inbra = 0;
547 2         3 my $brnum = 0;
548 2         3 my ($beg,$end,$step);
549 2         15 foreach (split (/([:\]\[,])/, $bus)) {
550 24 100       47 if (/^\[/) {
551 3         5 $inbra = 1;
552 3         5 $pretext[$brnum] .= $_;
553             }
554 24 100       34 if (!$inbra) {
555             # Not in bracket, just remember text
556 5         7 $pretext[$brnum] .= $_;
557 5         8 next;
558             }
559 19 100       41 if (/[\],]/) {
    100          
560 4 50       9 if (defined $beg) {
561             # End of bus piece
562             #print "Got seg $beg $end $step\n";
563 4         5 my $bit;
564 4 50       6 if ($beg >= $end) {
565 4         9 for ($bit = $beg; $bit >= $end; $bit -= $step) {
566 15         14 push @{$expanded[$brnum]}, $bit;
  15         33  
567             }
568             } else {
569 0         0 for ($bit = $beg; $bit <= $end; $bit += $step) {
570 0         0 push @{$expanded[$brnum]}, $bit;
  0         0  
571             }
572             }
573             }
574 4         5 $beg = undef;
575             # Now what?
576 4 100       11 if (/^\]/) {
    50          
577 3         4 $inbra = 0;
578 3         3 $brnum++;
579 3         6 $pretext[$brnum] .= $_;
580             }
581             elsif (/,/) {
582 1         2 $inbra = 1;
583             }
584             } elsif (/:/) {
585 4         13 $inbra++;
586             }
587             else {
588 11 100       21 if ($inbra == 1) { # Begin value
    100          
    50          
589 7         13 $beg = $end = number_value($_); # [2'b11:2'b00] is legal
590 7         9 $step = 1;
591             } elsif ($inbra == 2) { # End value
592 3         5 $end = number_value($_); # [2'b11:2'b00] is legal
593             } elsif ($inbra == 3) { # Middle value
594 1         2 $step = number_value($_); # [2'b11:2'b00] is legal
595             }
596             # Else ignore extra colons
597             }
598             }
599              
600             # Determine max size of any bracket expansion array
601 2         4 my $br;
602 2         3 my $max_size = $#{$expanded[0]};
  2         3  
603 2         5 for ($br=1; $br<$brnum; $br++) {
604 1         2 my $len = $#{$expanded[$br]};
  1         1  
605 1 50       3 if ($len < 0) {
606 0         0 push @{$expanded[$br]}, "";
  0         0  
607 0         0 $len = 0;
608             }
609 1 50       3 $max_size = $len if $max_size < $len;
610             }
611              
612 2         3 my $i;
613 2         4 my @vec = ();
614 2         14 for ($i=0; $i<=$max_size; $i++) {
615 12         16 $bus = "";
616 12         18 for ($br=0; $br<$brnum; $br++) {
617             #print "i $i br $br >", $pretext[$br],"<\n";
618 20         23 $bus .= $pretext[$br] . $expanded[$br][$i % (1+$#{$expanded[$br]})];
  20         47  
619             }
620 12         14 $bus .= $pretext[$br]; # Trailing stuff
621 12         20 push @vec, $bus;
622             }
623 2         12 return @vec;
624             }
625             }
626              
627             sub split_bus_nocomma {
628             # Faster version of split_bus
629 0     0 1   my $bus = shift;
630 0 0         if ($bus !~ /:/) {
    0          
631             # Fast case: No bussing
632 0           return $bus;
633             } elsif ($bus =~ /^([^\[]+\[)([0-9]+):([0-9]+)(\][^\]]*)$/) {
634             # Middle speed case: Simple max:min
635 0           my $bit;
636 0           my @vec = ();
637 0 0         if ($2 >= $3) {
638 0           for ($bit = $2; $bit >= $3; $bit --) {
639 0           push @vec, $1 . $bit . $4;
640             }
641             } else {
642 0           for ($bit = $2; $bit <= $3; $bit ++) {
643 0           push @vec, $1 . $bit . $4;
644             }
645             }
646 0           return @vec;
647             } else {
648             # Complex case: x:y etc
649             # Do full parsing
650 0           my @pretext = (); # [brnum]
651 0           my @expanded = (); # [brnum][bitoccurance]
652 0           my $inbra = 0;
653 0           my $brnum = 0;
654 0           my ($beg,$end);
655 0           foreach (split (/([:\]\[])/, $bus)) {
656 0 0         if (/^\[/) {
657 0           $inbra = 1;
658 0           $pretext[$brnum] .= $_;
659             }
660 0 0         if (!$inbra) {
661             # Not in bracket, just remember text
662 0           $pretext[$brnum] .= $_;
663 0           next;
664             }
665 0 0         if (/[\]]/) {
    0          
666 0 0         if (defined $beg) {
667             # End of bus piece
668             #print "Got seg $beg $end\n";
669 0           my $bit;
670 0 0         if ($beg >= $end) {
671 0           for ($bit = $beg; $bit >= $end; $bit--) {
672 0           push @{$expanded[$brnum]}, $bit;
  0            
673             }
674             } else {
675 0           for ($bit = $beg; $bit <= $end; $bit++) {
676 0           push @{$expanded[$brnum]}, $bit;
  0            
677             }
678             }
679             }
680 0           $beg = undef;
681             # Now what?
682 0 0         if (/^\]/) {
683 0           $inbra = 0;
684 0           $brnum++;
685 0           $pretext[$brnum] .= $_;
686             }
687             } elsif (/:/) {
688 0           $inbra++;
689             }
690             else {
691 0 0         if ($inbra == 1) { # Begin value
    0          
692 0           $beg = $end = $_;
693             } elsif ($inbra == 2) { # End value
694 0           $end = $_;
695             }
696             # Else ignore extra colons
697             }
698             }
699              
700             # Determine max size of any bracket expansion array
701 0           my $br;
702 0           my $max_size = $#{$expanded[0]};
  0            
703 0           for ($br=1; $br<$brnum; $br++) {
704 0           my $len = $#{$expanded[$br]};
  0            
705 0 0         if ($len < 0) {
706 0           push @{$expanded[$br]}, "";
  0            
707 0           $len = 0;
708             }
709 0 0         $max_size = $len if $max_size < $len;
710             }
711              
712 0           my $i;
713 0           my @vec = ();
714 0           for ($i=0; $i<=$max_size; $i++) {
715 0           $bus = "";
716 0           for ($br=0; $br<$brnum; $br++) {
717             #print "i $i br $br >", $pretext[$br],"<\n";
718 0           $bus .= $pretext[$br] . $expanded[$br][$i % (1+$#{$expanded[$br]})];
  0            
719             }
720 0           $bus .= $pretext[$br]; # Trailing stuff
721 0           push @vec, $bus;
722             }
723 0           return @vec;
724             }
725             }
726              
727             ######################################################################
728             #### Package return
729             1;