projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perlmod / Linux-x86_64 / Bit / Vector / Overload.pm
CommitLineData
86530b38
AT		 1
2###############################################################################
3## ##
4## Copyright (c) 2000 - 2004 by Steffen Beyer. ##
5## All rights reserved. ##
6## ##
7## This package is free software; you can redistribute it ##
8## and/or modify it under the same terms as Perl itself. ##
9## ##
10###############################################################################
11
12package Bit::Vector::Overload;
13
14use strict;
15use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
16
17use Bit::Vector;
18
19require Exporter;
20
21@ISA = qw(Exporter Bit::Vector);
22
23@EXPORT = qw();
24
25@EXPORT_OK = qw();
26
27$VERSION = '6.4';
28
29package Bit::Vector;
30
31use Carp::Clan '^Bit::Vector\b';
32
33use overload
34 '""' => '_stringify',
35 'bool' => '_boolean',
36 '!' => '_not_boolean',
37 '~' => '_complement',
38 'neg' => '_negate',
39 'abs' => '_absolute',
40 '.' => '_concat',
41 'x' => '_xerox',
42 '<<' => '_shift_left',
43 '>>' => '_shift_right',
44 '|' => '_union',
45 '&' => '_intersection',
46 '^' => '_exclusive_or',
47 '+' => '_add',
48 '-' => '_sub',
49 '*' => '_mul',
50 '/' => '_div',
51 '%' => '_mod',
52 '**' => '_pow',
53 '.=' => '_assign_concat',
54 'x=' => '_assign_xerox',
55 '<<=' => '_assign_shift_left',
56 '>>=' => '_assign_shift_right',
57 '|=' => '_assign_union',
58 '&=' => '_assign_intersection',
59 '^=' => '_assign_exclusive_or',
60 '+=' => '_assign_add',
61 '-=' => '_assign_sub',
62 '*=' => '_assign_mul',
63 '/=' => '_assign_div',
64 '%=' => '_assign_mod',
65 '**=' => '_assign_pow',
66 '++' => '_increment',
67 '--' => '_decrement',
68 'cmp' => '_lexicompare', # also enables lt, le, gt, ge, eq, ne
69 '<=>' => '_compare',
70 '==' => '_equal',
71 '!=' => '_not_equal',
72 '<' => '_less_than',
73 '<=' => '_less_equal',
74 '>' => '_greater_than',
75 '>=' => '_greater_equal',
76 '=' => '_clone',
77'fallback' => undef;
78
79$CONFIG[0] = 0;
80$CONFIG[1] = 0;
81$CONFIG[2] = 0;
82
83# Configuration:
84#
85# 0 = Scalar Input: 0 = Bit Index (default)
86# 1 = from_Hex
87# 2 = from_Bin
88# 3 = from_Dec
89# 4 = from_Enum
90#
91# 1 = Operator Semantics: 0 = Set Ops (default)
92# 1 = Arithmetic Ops
93#
94# Affected Operators: "+" "-" "*"
95# "<" "<=" ">" ">="
96# "abs"
97#
98# 2 = String Output: 0 = to_Hex() (default)
99# 1 = to_Bin()
100# 2 = to_Dec()
101# 3 = to_Enum()
102
103sub Configuration
104{
105 my(@commands);
106 my($assignment);
107 my($which,$value);
108 my($m0,$m1,$m2,$m3,$m4);
109 my($result);
110 my($ok);
111
112 if (@_ > 2)
113 {
114 croak('Usage: $oldconfig = Bit::Vector->Configuration( [ $newconfig ] );');
115 }
116 $result = "Scalar Input = ";
117 if ($CONFIG[0] == 4) { $result .= "Enumeration"; }
118 elsif ($CONFIG[0] == 3) { $result .= "Decimal"; }
119 elsif ($CONFIG[0] == 2) { $result .= "Binary"; }
120 elsif ($CONFIG[0] == 1) { $result .= "Hexadecimal"; }
121 else { $result .= "Bit Index"; }
122 $result .= "\nOperator Semantics = ";
123 if ($CONFIG[1] == 1) { $result .= "Arithmetic Operators"; }
124 else { $result .= "Set Operators"; }
125 $result .= "\nString Output = ";
126 if ($CONFIG[2] == 3) { $result .= "Enumeration"; }
127 elsif ($CONFIG[2] == 2) { $result .= "Decimal"; }
128 elsif ($CONFIG[2] == 1) { $result .= "Binary"; }
129 else { $result .= "Hexadecimal"; }
130 shift if (@_ > 0);
131 if (@_ > 0)
132 {
133 $ok = 1;
134 @commands = split(/[,;:|\/\n&+-]/, $_[0]);
135 foreach $assignment (@commands)
136 {
137 if ($assignment =~ /^\s*$/) { } # ignore empty lines
138 elsif ($assignment =~ /^([A-Za-z\s]+)=([A-Za-z\s]+)$/)
139 {
140 $which = $1;
141 $value = $2;
142 $m0 = 0;
143 $m1 = 0;
144 $m2 = 0;
145 if ($which =~ /\bscalar|\binput|\bin\b/i) { $m0 = 1; }
146 if ($which =~ /\boperator|\bsemantic|\bops\b/i) { $m1 = 1; }
147 if ($which =~ /\bstring|\boutput|\bout\b/i) { $m2 = 1; }
148 if ($m0 && !$m1 && !$m2)
149 {
150 $m0 = 0;
151 $m1 = 0;
152 $m2 = 0;
153 $m3 = 0;
154 $m4 = 0;
155 if ($value =~ /\bbit\b|\bindex|\bindice/i) { $m0 = 1; }
156 if ($value =~ /\bhex/i) { $m1 = 1; }
157 if ($value =~ /\bbin/i) { $m2 = 1; }
158 if ($value =~ /\bdec/i) { $m3 = 1; }
159 if ($value =~ /\benum/i) { $m4 = 1; }
160 if ($m0 && !$m1 && !$m2 && !$m3 && !$m4) { $CONFIG[0] = 0; }
161 elsif (!$m0 && $m1 && !$m2 && !$m3 && !$m4) { $CONFIG[0] = 1; }
162 elsif (!$m0 && !$m1 && $m2 && !$m3 && !$m4) { $CONFIG[0] = 2; }
163 elsif (!$m0 && !$m1 && !$m2 && $m3 && !$m4) { $CONFIG[0] = 3; }
164 elsif (!$m0 && !$m1 && !$m2 && !$m3 && $m4) { $CONFIG[0] = 4; }
165 else { $ok = 0; last; }
166 }
167 elsif (!$m0 && $m1 && !$m2)
168 {
169 $m0 = 0;
170 $m1 = 0;
171 if ($value =~ /\bset\b/i) { $m0 = 1; }
172 if ($value =~ /\barithmetic/i) { $m1 = 1; }
173 if ($m0 && !$m1) { $CONFIG[1] = 0; }
174 elsif (!$m0 && $m1) { $CONFIG[1] = 1; }
175 else { $ok = 0; last; }
176 }
177 elsif (!$m0 && !$m1 && $m2)
178 {
179 $m0 = 0;
180 $m1 = 0;
181 $m2 = 0;
182 $m3 = 0;
183 if ($value =~ /\bhex/i) { $m0 = 1; }
184 if ($value =~ /\bbin/i) { $m1 = 1; }
185 if ($value =~ /\bdec/i) { $m2 = 1; }
186 if ($value =~ /\benum/i) { $m3 = 1; }
187 if ($m0 && !$m1 && !$m2 && !$m3) { $CONFIG[2] = 0; }
188 elsif (!$m0 && $m1 && !$m2 && !$m3) { $CONFIG[2] = 1; }
189 elsif (!$m0 && !$m1 && $m2 && !$m3) { $CONFIG[2] = 2; }
190 elsif (!$m0 && !$m1 && !$m2 && $m3) { $CONFIG[2] = 3; }
191 else { $ok = 0; last; }
192 }
193 else { $ok = 0; last; }
194 }
195 else { $ok = 0; last; }
196 }
197 unless ($ok)
198 {
199 croak('configuration string syntax error');
200 }
201 }
202 return($result);
203}
204
205sub _error
206{
207 my($name,$code) = @_;
208 my($text);
209
210 if ($code == 0)
211 {
212 $text = $@;
213 $text =~ s!\s+! !g;
214 $text =~ s!\s+at\s.*$!!;
215 $text =~ s!^(?:Bit::Vector::)?[a-zA-Z0-9_]+\(\):\s*!!i;
216 $text =~ s!\s+$!!;
217 }
218 elsif ($code == 1) { $text = 'illegal operand type'; }
219 elsif ($code == 2) { $text = 'illegal reversed operands'; }
220 else { croak('unexpected internal error - please contact author'); }
221 $text .= " in overloaded ";
222 if (length($name) > 5) { $text .= "$name operation"; }
223 else { $text .= "'$name' operator"; }
224 croak($text);
225}
226
227sub _vectorize_
228{
229 my($vector,$scalar) = @_;
230
231 if ($CONFIG[0] == 4) { $vector->from_Enum($scalar); }
232 elsif ($CONFIG[0] == 3) { $vector->from_Dec ($scalar); }
233 elsif ($CONFIG[0] == 2) { $vector->from_Bin ($scalar); }
234 elsif ($CONFIG[0] == 1) { $vector->from_Hex ($scalar); }
235 else { $vector->Bit_On ($scalar); }
236}
237
238sub _scalarize_
239{
240 my($vector) = @_;
241
242 if ($CONFIG[2] == 3) { return( $vector->to_Enum() ); }
243 elsif ($CONFIG[2] == 2) { return( $vector->to_Dec () ); }
244 elsif ($CONFIG[2] == 1) { return( $vector->to_Bin () ); }
245 else { return( $vector->to_Hex () ); }
246}
247
248sub _fetch_operand
249{
250 my($object,$argument,$flag,$name,$build) = @_;
251 my($operand);
252
253 if ((defined $argument) && ref($argument) && (ref($argument) !~ /^[A-Z]+$/))
254 {
255 eval
256 {
257 if ($build && (defined $flag))
258 {
259 $operand = $argument->Clone();
260 }
261 else { $operand = $argument; }
262 };
263 if ($@) { &_error($name,0); }
264 }
265 elsif ((defined $argument) && (!ref($argument)))
266 {
267 eval
268 {
269 $operand = $object->Shadow();
270 &_vectorize_($operand,$argument);
271 };
272 if ($@) { &_error($name,0); }
273 }
274 else { &_error($name,1); }
275 return($operand);
276}
277
278sub _check_operand
279{
280 my($argument,$flag,$name) = @_;
281
282 if ((defined $argument) && (!ref($argument)))
283 {
284 if ((defined $flag) && $flag) { &_error($name,2); }
285 }
286 else { &_error($name,1); }
287}
288
289sub _stringify
290{
291 my($vector) = @_;
292 my($name) = 'string interpolation';
293 my($result);
294
295 eval
296 {
297 $result = &_scalarize_($vector);
298 };
299 if ($@) { &_error($name,0); }
300 return($result);
301}
302
303sub _boolean
304{
305 my($object) = @_;
306 my($name) = 'boolean test';
307 my($result);
308
309 eval
310 {
311 $result = $object->is_empty();
312 };
313 if ($@) { &_error($name,0); }
314 return(! $result);
315}
316
317sub _not_boolean
318{
319 my($object) = @_;
320 my($name) = 'negated boolean test';
321 my($result);
322
323 eval
324 {
325 $result = $object->is_empty();
326 };
327 if ($@) { &_error($name,0); }
328 return($result);
329}
330
331sub _complement
332{
333 my($object) = @_;
334 my($name) = '~';
335 my($result);
336
337 eval
338 {
339 $result = $object->Shadow();
340 $result->Complement($object);
341 };
342 if ($@) { &_error($name,0); }
343 return($result);
344}
345
346sub _negate
347{
348 my($object) = @_;
349 my($name) = 'unary minus';
350 my($result);
351
352 eval
353 {
354 $result = $object->Shadow();
355 $result->Negate($object);
356 };
357 if ($@) { &_error($name,0); }
358 return($result);
359}
360
361sub _absolute
362{
363 my($object) = @_;
364 my($name) = 'abs()';
365 my($result);
366
367 eval
368 {
369 if ($CONFIG[1] == 1)
370 {
371 $result = $object->Shadow();
372 $result->Absolute($object);
373 }
374 else
375 {
376 $result = $object->Norm();
377 }
378 };
379 if ($@) { &_error($name,0); }
380 return($result);
381}
382
383sub _concat
384{
385 my($object,$argument,$flag) = @_;
386 my($name) = '.';
387 my($result);
388
389 $name .= '=' unless (defined $flag);
390 if ((defined $argument) && ref($argument) && (ref($argument) !~ /^[A-Z]+$/))
391 {
392 eval
393 {
394 if (defined $flag)
395 {
396 if ($flag) { $result = $argument->Concat($object); }
397 else { $result = $object->Concat($argument); }
398 }
399 else
400 {
401 $object->Interval_Substitute($argument,0,0,0,$argument->Size());
402 $result = $object;
403 }
404 };
405 if ($@) { &_error($name,0); }
406 return($result);
407 }
408 elsif ((defined $argument) && (!ref($argument)))
409 {
410 eval
411 {
412 if (defined $flag)
413 {
414 if ($flag) { $result = $argument . &_scalarize_($object); }
415 else { $result = &_scalarize_($object) . $argument; }
416 }
417 else
418 {
419 if ($CONFIG[0] == 2) { $result = $object->new( length($argument) ); }
420 elsif ($CONFIG[0] == 1) { $result = $object->new( length($argument) << 2 ); }
421 else { $result = $object->Shadow(); }
422 &_vectorize_($result,$argument);
423 $object->Interval_Substitute($result,0,0,0,$result->Size());
424 $result = $object;
425 }
426 };
427 if ($@) { &_error($name,0); }
428 return($result);
429 }
430 else { &_error($name,1); }
431}
432
433sub _xerox # (in Brazil, a photocopy is called a "xerox")
434{
435 my($object,$argument,$flag) = @_;
436 my($name) = 'x';
437 my($result);
438 my($offset);
439 my($index);
440 my($size);
441
442 $name .= '=' unless (defined $flag);
443 &_check_operand($argument,$flag,$name);
444 eval
445 {
446 $size = $object->Size();
447 if (defined $flag)
448 {
449 $result = $object->new($size * $argument);
450 $offset = 0;
451 $index = 0;
452 }
453 else
454 {
455 $result = $object;
456 $result->Resize($size * $argument);
457 $offset = $size;
458 $index = 1;
459 }
460 for ( ; $index < $argument; $index++, $offset += $size )
461 {
462 $result->Interval_Copy($object,$offset,0,$size);
463 }
464 };
465 if ($@) { &_error($name,0); }
466 return($result);
467}
468
469sub _shift_left
470{
471 my($object,$argument,$flag) = @_;
472 my($name) = '<<';
473 my($result);
474
475 $name .= '=' unless (defined $flag);
476 &_check_operand($argument,$flag,$name);
477 eval
478 {
479 if (defined $flag)
480 {
481 $result = $object->Clone();
482 $result->Insert(0,$argument);
483# $result->Move_Left($argument);
484 }
485 else
486 {
487# $object->Move_Left($argument);
488 $object->Insert(0,$argument);
489 $result = $object;
490 }
491 };
492 if ($@) { &_error($name,0); }
493 return($result);
494}
495
496sub _shift_right
497{
498 my($object,$argument,$flag) = @_;
499 my($name) = '>>';
500 my($result);
501
502 $name .= '=' unless (defined $flag);
503 &_check_operand($argument,$flag,$name);
504 eval
505 {
506 if (defined $flag)
507 {
508 $result = $object->Clone();
509 $result->Delete(0,$argument);
510# $result->Move_Right($argument);
511 }
512 else
513 {
514# $object->Move_Right($argument);
515 $object->Delete(0,$argument);
516 $result = $object;
517 }
518 };
519 if ($@) { &_error($name,0); }
520 return($result);
521}
522
523sub _union_
524{
525 my($object,$operand,$flag) = @_;
526
527 if (defined $flag)
528 {
529 $operand->Union($object,$operand);
530 return($operand);
531 }
532 else
533 {
534 $object->Union($object,$operand);
535 return($object);
536 }
537}
538
539sub _union
540{
541 my($object,$argument,$flag) = @_;
542 my($name) = '|';
543 my($operand);
544
545 $name .= '=' unless (defined $flag);
546 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
547 eval
548 {
549 $operand = &_union_($object,$operand,$flag);
550 };
551 if ($@) { &_error($name,0); }
552 return($operand);
553}
554
555sub _intersection_
556{
557 my($object,$operand,$flag) = @_;
558
559 if (defined $flag)
560 {
561 $operand->Intersection($object,$operand);
562 return($operand);
563 }
564 else
565 {
566 $object->Intersection($object,$operand);
567 return($object);
568 }
569}
570
571sub _intersection
572{
573 my($object,$argument,$flag) = @_;
574 my($name) = '&';
575 my($operand);
576
577 $name .= '=' unless (defined $flag);
578 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
579 eval
580 {
581 $operand = &_intersection_($object,$operand,$flag);
582 };
583 if ($@) { &_error($name,0); }
584 return($operand);
585}
586
587sub _exclusive_or
588{
589 my($object,$argument,$flag) = @_;
590 my($name) = '^';
591 my($operand);
592
593 $name .= '=' unless (defined $flag);
594 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
595 eval
596 {
597 if (defined $flag)
598 {
599 $operand->ExclusiveOr($object,$operand);
600 }
601 else
602 {
603 $object->ExclusiveOr($object,$operand);
604 $operand = $object;
605 }
606 };
607 if ($@) { &_error($name,0); }
608 return($operand);
609}
610
611sub _add
612{
613 my($object,$argument,$flag) = @_;
614 my($name) = '+';
615 my($operand);
616
617 $name .= '=' unless (defined $flag);
618 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
619 eval
620 {
621 if ($CONFIG[1] == 1)
622 {
623 if (defined $flag)
624 {
625 $operand->add($object,$operand,0);
626 }
627 else
628 {
629 $object->add($object,$operand,0);
630 $operand = $object;
631 }
632 }
633 else
634 {
635 $operand = &_union_($object,$operand,$flag);
636 }
637 };
638 if ($@) { &_error($name,0); }
639 return($operand);
640}
641
642sub _sub
643{
644 my($object,$argument,$flag) = @_;
645 my($name) = '-';
646 my($operand);
647
648 $name .= '=' unless (defined $flag);
649 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
650 eval
651 {
652 if ($CONFIG[1] == 1)
653 {
654 if (defined $flag)
655 {
656 if ($flag) { $operand->subtract($operand,$object,0); }
657 else { $operand->subtract($object,$operand,0); }
658 }
659 else
660 {
661 $object->subtract($object,$operand,0);
662 $operand = $object;
663 }
664 }
665 else
666 {
667 if (defined $flag)
668 {
669 if ($flag) { $operand->Difference($operand,$object); }
670 else { $operand->Difference($object,$operand); }
671 }
672 else
673 {
674 $object->Difference($object,$operand);
675 $operand = $object;
676 }
677 }
678 };
679 if ($@) { &_error($name,0); }
680 return($operand);
681}
682
683sub _mul
684{
685 my($object,$argument,$flag) = @_;
686 my($name) = '*';
687 my($operand);
688
689 $name .= '=' unless (defined $flag);
690 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
691 eval
692 {
693 if ($CONFIG[1] == 1)
694 {
695 if (defined $flag)
696 {
697 $operand->Multiply($object,$operand);
698 }
699 else
700 {
701 $object->Multiply($object,$operand);
702 $operand = $object;
703 }
704 }
705 else
706 {
707 $operand = &_intersection_($object,$operand,$flag);
708 }
709 };
710 if ($@) { &_error($name,0); }
711 return($operand);
712}
713
714sub _div
715{
716 my($object,$argument,$flag) = @_;
717 my($name) = '/';
718 my($operand);
719 my($temp);
720
721 $name .= '=' unless (defined $flag);
722 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
723 eval
724 {
725 $temp = $object->Shadow();
726 if (defined $flag)
727 {
728 if ($flag) { $operand->Divide($operand,$object,$temp); }
729 else { $operand->Divide($object,$operand,$temp); }
730 }
731 else
732 {
733 $object->Divide($object,$operand,$temp);
734 $operand = $object;
735 }
736 };
737 if ($@) { &_error($name,0); }
738 return($operand);
739}
740
741sub _mod
742{
743 my($object,$argument,$flag) = @_;
744 my($name) = '%';
745 my($operand);
746 my($temp);
747
748 $name .= '=' unless (defined $flag);
749 $operand = &_fetch_operand($object,$argument,$flag,$name,1);
750 eval
751 {
752 $temp = $object->Shadow();
753 if (defined $flag)
754 {
755 if ($flag) { $temp->Divide($operand,$object,$operand); }
756 else { $temp->Divide($object,$operand,$operand); }
757 }
758 else
759 {
760 $temp->Divide($object,$operand,$object);
761 $operand = $object;
762 }
763 };
764 if ($@) { &_error($name,0); }
765 return($operand);
766}
767
768sub _pow
769{
770 my($object,$argument,$flag) = @_;
771 my($name) = '**';
772 my($operand,$result);
773
774 $name .= '=' unless (defined $flag);
775 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
776 eval
777 {
778 if (defined $flag)
779 {
780 $result = $object->Shadow();
781 if ($flag) { $result->Power($operand,$object); }
782 else { $result->Power($object,$operand); }
783 }
784 else
785 {
786 $object->Power($object,$operand);
787 $result = $object;
788 }
789 };
790 if ($@) { &_error($name,0); }
791 return($result);
792}
793
794sub _assign_concat
795{
796 my($object,$argument) = @_;
797
798 return( &_concat($object,$argument,undef) );
799}
800
801sub _assign_xerox
802{
803 my($object,$argument) = @_;
804
805 return( &_xerox($object,$argument,undef) );
806}
807
808sub _assign_shift_left
809{
810 my($object,$argument) = @_;
811
812 return( &_shift_left($object,$argument,undef) );
813}
814
815sub _assign_shift_right
816{
817 my($object,$argument) = @_;
818
819 return( &_shift_right($object,$argument,undef) );
820}
821
822sub _assign_union
823{
824 my($object,$argument) = @_;
825
826 return( &_union($object,$argument,undef) );
827}
828
829sub _assign_intersection
830{
831 my($object,$argument) = @_;
832
833 return( &_intersection($object,$argument,undef) );
834}
835
836sub _assign_exclusive_or
837{
838 my($object,$argument) = @_;
839
840 return( &_exclusive_or($object,$argument,undef) );
841}
842
843sub _assign_add
844{
845 my($object,$argument) = @_;
846
847 return( &_add($object,$argument,undef) );
848}
849
850sub _assign_sub
851{
852 my($object,$argument) = @_;
853
854 return( &_sub($object,$argument,undef) );
855}
856
857sub _assign_mul
858{
859 my($object,$argument) = @_;
860
861 return( &_mul($object,$argument,undef) );
862}
863
864sub _assign_div
865{
866 my($object,$argument) = @_;
867
868 return( &_div($object,$argument,undef) );
869}
870
871sub _assign_mod
872{
873 my($object,$argument) = @_;
874
875 return( &_mod($object,$argument,undef) );
876}
877
878sub _assign_pow
879{
880 my($object,$argument) = @_;
881
882 return( &_pow($object,$argument,undef) );
883}
884
885sub _increment
886{
887 my($object) = @_;
888 my($name) = '++';
889 my($result);
890
891 eval
892 {
893 $result = $object->increment();
894 };
895 if ($@) { &_error($name,0); }
896 return($result);
897}
898
899sub _decrement
900{
901 my($object) = @_;
902 my($name) = '--';
903 my($result);
904
905 eval
906 {
907 $result = $object->decrement();
908 };
909 if ($@) { &_error($name,0); }
910 return($result);
911}
912
913sub _lexicompare
914{
915 my($object,$argument,$flag) = @_;
916 my($name) = 'cmp';
917 my($operand);
918 my($result);
919
920 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
921 eval
922 {
923 if ((defined $flag) && $flag)
924 {
925 $result = $operand->Lexicompare($object);
926 }
927 else
928 {
929 $result = $object->Lexicompare($operand);
930 }
931 };
932 if ($@) { &_error($name,0); }
933 return($result);
934}
935
936sub _compare
937{
938 my($object,$argument,$flag) = @_;
939 my($name) = '<=>';
940 my($operand);
941 my($result);
942
943 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
944 eval
945 {
946 if ((defined $flag) && $flag)
947 {
948 $result = $operand->Compare($object);
949 }
950 else
951 {
952 $result = $object->Compare($operand);
953 }
954 };
955 if ($@) { &_error($name,0); }
956 return($result);
957}
958
959sub _equal
960{
961 my($object,$argument,$flag) = @_;
962 my($name) = '==';
963 my($operand);
964 my($result);
965
966 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
967 eval
968 {
969 $result = $object->equal($operand);
970 };
971 if ($@) { &_error($name,0); }
972 return($result);
973}
974
975sub _not_equal
976{
977 my($object,$argument,$flag) = @_;
978 my($name) = '!=';
979 my($operand);
980 my($result);
981
982 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
983 eval
984 {
985 $result = $object->equal($operand);
986 };
987 if ($@) { &_error($name,0); }
988 return(! $result);
989}
990
991sub _less_than
992{
993 my($object,$argument,$flag) = @_;
994 my($name) = '<';
995 my($operand);
996 my($result);
997
998 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
999 eval
1000 {
1001 if ($CONFIG[1] == 1)
1002 {
1003 if ((defined $flag) && $flag)
1004 {
1005 $result = ($operand->Compare($object) < 0);
1006 }
1007 else
1008 {
1009 $result = ($object->Compare($operand) < 0);
1010 }
1011 }
1012 else
1013 {
1014 if ((defined $flag) && $flag)
1015 {
1016 $result = ((!$operand->equal($object)) &&
1017 ($operand->subset($object)));
1018 }
1019 else
1020 {
1021 $result = ((!$object->equal($operand)) &&
1022 ($object->subset($operand)));
1023 }
1024 }
1025 };
1026 if ($@) { &_error($name,0); }
1027 return($result);
1028}
1029
1030sub _less_equal
1031{
1032 my($object,$argument,$flag) = @_;
1033 my($name) = '<=';
1034 my($operand);
1035 my($result);
1036
1037 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
1038 eval
1039 {
1040 if ($CONFIG[1] == 1)
1041 {
1042 if ((defined $flag) && $flag)
1043 {
1044 $result = ($operand->Compare($object) <= 0);
1045 }
1046 else
1047 {
1048 $result = ($object->Compare($operand) <= 0);
1049 }
1050 }
1051 else
1052 {
1053 if ((defined $flag) && $flag)
1054 {
1055 $result = $operand->subset($object);
1056 }
1057 else
1058 {
1059 $result = $object->subset($operand);
1060 }
1061 }
1062 };
1063 if ($@) { &_error($name,0); }
1064 return($result);
1065}
1066
1067sub _greater_than
1068{
1069 my($object,$argument,$flag) = @_;
1070 my($name) = '>';
1071 my($operand);
1072 my($result);
1073
1074 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
1075 eval
1076 {
1077 if ($CONFIG[1] == 1)
1078 {
1079 if ((defined $flag) && $flag)
1080 {
1081 $result = ($operand->Compare($object) > 0);
1082 }
1083 else
1084 {
1085 $result = ($object->Compare($operand) > 0);
1086 }
1087 }
1088 else
1089 {
1090 if ((defined $flag) && $flag)
1091 {
1092 $result = ((!$object->equal($operand)) &&
1093 ($object->subset($operand)));
1094 }
1095 else
1096 {
1097 $result = ((!$operand->equal($object)) &&
1098 ($operand->subset($object)));
1099 }
1100 }
1101 };
1102 if ($@) { &_error($name,0); }
1103 return($result);
1104}
1105
1106sub _greater_equal
1107{
1108 my($object,$argument,$flag) = @_;
1109 my($name) = '>=';
1110 my($operand);
1111 my($result);
1112
1113 $operand = &_fetch_operand($object,$argument,$flag,$name,0);
1114 eval
1115 {
1116 if ($CONFIG[1] == 1)
1117 {
1118 if ((defined $flag) && $flag)
1119 {
1120 $result = ($operand->Compare($object) >= 0);
1121 }
1122 else
1123 {
1124 $result = ($object->Compare($operand) >= 0);
1125 }
1126 }
1127 else
1128 {
1129 if ((defined $flag) && $flag)
1130 {
1131 $result = $object->subset($operand);
1132 }
1133 else
1134 {
1135 $result = $operand->subset($object);
1136 }
1137 }
1138 };
1139 if ($@) { &_error($name,0); }
1140 return($result);
1141}
1142
1143sub _clone
1144{
1145 my($object) = @_;
1146 my($name) = 'automatic duplication';
1147 my($result);
1148
1149 eval
1150 {
1151 $result = $object->Clone();
1152 };
1153 if ($@) { &_error($name,0); }
1154 return($result);
1155}
1156
11571;
1158
1159__END__
1160
Full OpenSPARC design & verification tarball including full HDL.