Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # ========== Copyright Header Begin ========================================== |
2 | # | |
3 | # OpenSPARC T2 Processor File: BitFieldTie.pm | |
4 | # Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved | |
5 | # 4150 Network Circle, Santa Clara, California 95054, U.S.A. | |
6 | # | |
7 | # * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. | |
8 | # | |
9 | # This program is free software; you can redistribute it and/or modify | |
10 | # it under the terms of the GNU General Public License as published by | |
11 | # the Free Software Foundation; version 2 of the License. | |
12 | # | |
13 | # This program is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | # GNU General Public License for more details. | |
17 | # | |
18 | # You should have received a copy of the GNU General Public License | |
19 | # along with this program; if not, write to the Free Software | |
20 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
21 | # | |
22 | # For the avoidance of doubt, and except that if any non-GPL license | |
23 | # choice is available it will apply instead, Sun elects to use only | |
24 | # the General Public License version 2 (GPLv2) at this time for any | |
25 | # software where a choice of GPL license versions is made | |
26 | # available with the language indicating that GPLv2 or any later version | |
27 | # may be used, or where a choice of which version of the GPL is applied is | |
28 | # otherwise unspecified. | |
29 | # | |
30 | # Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, | |
31 | # CA 95054 USA or visit www.sun.com if you need additional information or | |
32 | # have any questions. | |
33 | # | |
34 | # ========== Copyright Header End ============================================ | |
35 | package BitFieldTie; | |
36 | ||
37 | use 5.008; | |
38 | use strict; | |
39 | use warnings; | |
40 | ||
41 | require Exporter; | |
42 | ||
43 | use Bit::Vector; | |
44 | use Carp; | |
45 | ||
46 | our @ISA = qw(Exporter); | |
47 | use overload '""' => \&stringify; | |
48 | ||
49 | # Items to export into callers namespace by default. Note: do not export | |
50 | # names by default without a very good reason. Use EXPORT_OK instead. | |
51 | # Do not simply export all your public functions/methods/constants. | |
52 | ||
53 | # This allows declaration use BitFieldTie ':all'; | |
54 | # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK | |
55 | # will save memory. | |
56 | our %EXPORT_TAGS = ( 'all' => [ qw( | |
57 | ||
58 | ) ] ); | |
59 | ||
60 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | |
61 | ||
62 | our @EXPORT = qw( | |
63 | ||
64 | ); | |
65 | ||
66 | our $VERSION = '1.09'; | |
67 | ||
68 | ############################################################################# | |
69 | ############################################################################# | |
70 | ||
71 | sub TIEHASH { | |
72 | my $class = shift; | |
73 | my $size = shift; # if an object, tie it | |
74 | my $hexstring = shift; | |
75 | ||
76 | my $obj; | |
77 | if(defined $size and ref $size and $size->isa('BitFieldTie')) { | |
78 | $obj = $size; | |
79 | undef $size; | |
80 | undef $hexstring; | |
81 | } | |
82 | ||
83 | my $this; | |
84 | if(defined $obj) { | |
85 | $this = $obj; | |
86 | } else { | |
87 | $this = {}; | |
88 | bless $this, (ref($class) || $class); | |
89 | ||
90 | $this->set($size, $hexstring); | |
91 | } | |
92 | ||
93 | ||
94 | return $this; | |
95 | } | |
96 | ||
97 | ############################################################################# | |
98 | ||
99 | sub FETCH { | |
100 | my $this = shift; | |
101 | my $key = shift; | |
102 | ||
103 | my ($start, $stop) = $this->parse_key($key); | |
104 | my $size = $stop-$start+1; | |
105 | confess "Cannot use a chunk size > 32 bits\n" if $size > 32; | |
106 | return $this->{bv}->Chunk_Read($size, $start); | |
107 | } | |
108 | ||
109 | ############################################################################# | |
110 | ||
111 | sub STORE { | |
112 | my $this = shift; | |
113 | my $key = shift; | |
114 | my $val = shift; | |
115 | ||
116 | my ($start, $stop) = $this->parse_key($key); | |
117 | my $size = $stop-$start+1; | |
118 | confess "Cannot use a chunk size > 32 bits\n" if $size > 32; | |
119 | confess "BitFieldTie: stop not defined\n" unless defined $stop; | |
120 | confess "BitFieldTie: value not defined\n" unless defined $val; | |
121 | ||
122 | $val = hex($val) if $val =~ /^\s*0[xX]/; | |
123 | ||
124 | eval { | |
125 | $this->{bv}->Chunk_Store($size,$start,$val); | |
126 | }; | |
127 | confess $@ if $@; | |
128 | } | |
129 | ||
130 | ############################################################################# | |
131 | ############################################################################# | |
132 | ||
133 | sub new { | |
134 | my $class = shift; | |
135 | my $size = shift; # if an object, clone it | |
136 | my $hexstring = shift; | |
137 | ||
138 | if(ref $class) { | |
139 | my $this = $class->clone(); | |
140 | return $this; | |
141 | } | |
142 | ||
143 | my $obj; | |
144 | if(defined $size and ref $size and $size->isa('BitFieldTie')) { | |
145 | $obj = $size; | |
146 | undef $size; | |
147 | undef $hexstring; | |
148 | } | |
149 | ||
150 | my $this; | |
151 | if(defined $obj) { | |
152 | $this = $obj->clone(); | |
153 | } else { | |
154 | $this = {}; | |
155 | bless $this, (ref($class) || $class); | |
156 | ||
157 | $this->set($size, $hexstring); | |
158 | } | |
159 | ||
160 | ||
161 | return $this; | |
162 | } | |
163 | ||
164 | ############################################################################# | |
165 | ||
166 | sub new_dec { | |
167 | my $class = shift; | |
168 | my $size = shift; # if an object, clone it | |
169 | my $decimal = shift; | |
170 | ||
171 | if(ref $class) { | |
172 | my $this = $class->clone(); | |
173 | return $this; | |
174 | } | |
175 | ||
176 | my $obj; | |
177 | if(defined $size and ref $size and $size->isa('BitFieldTie')) { | |
178 | $obj = $size; | |
179 | undef $size; | |
180 | undef $decimal; | |
181 | } | |
182 | ||
183 | my $this; | |
184 | if(defined $obj) { | |
185 | $this = $obj->clone(); | |
186 | } else { | |
187 | $this = {}; | |
188 | bless $this, (ref($class) || $class); | |
189 | ||
190 | $this->set_dec($size, $decimal); | |
191 | } | |
192 | ||
193 | ||
194 | return $this; | |
195 | } | |
196 | ||
197 | ############################################################################# | |
198 | ||
199 | sub parse_key { | |
200 | my $this = shift; | |
201 | my $key = shift; | |
202 | ||
203 | my ($start, $stop); | |
204 | ($start, $stop) = $key =~ /(\d+)(?:\:(\d+))?/; | |
205 | $stop = $start unless defined $stop; | |
206 | confess "Badly formatted key ($key).\n" unless defined $start; | |
207 | ||
208 | if($stop < $start) { | |
209 | ($start, $stop) = ($stop, $start); | |
210 | } | |
211 | ||
212 | return ($start, $stop); | |
213 | } | |
214 | ||
215 | ############################################################################# | |
216 | ||
217 | sub stringify { | |
218 | my $this = shift; | |
219 | my $s; | |
220 | eval { | |
221 | $s = $this->{bv}->to_Hex(); | |
222 | }; | |
223 | confess $@ if $@; | |
224 | $s =~ tr/[A-F]/[a-f]/; | |
225 | return $s; | |
226 | } | |
227 | ||
228 | ############################################################################# | |
229 | ||
230 | sub clone { | |
231 | my $this = shift; | |
232 | my $new = {}; | |
233 | bless $new, (ref $this); | |
234 | eval { | |
235 | $new->{bv} = $this->{bv}->Clone(); | |
236 | }; | |
237 | confess $@ if $@; | |
238 | ||
239 | return $new; | |
240 | } | |
241 | ||
242 | ############################################################################# | |
243 | ||
244 | sub extract { | |
245 | my $this = shift; | |
246 | my $start = shift; | |
247 | my $stop = shift; | |
248 | ||
249 | $stop = $start unless defined $stop; | |
250 | ||
251 | ($start, $stop) = ($stop, $start) if ($start > $stop); | |
252 | ||
253 | my $size = $stop-$start+1; | |
254 | confess "Cannot use a chunk size > 32 bits\n" if $size > 32; | |
255 | return $this->{bv}->Chunk_Read($size, $start); | |
256 | } | |
257 | ||
258 | ############################################################################# | |
259 | ||
260 | sub store { | |
261 | my $this = shift; | |
262 | my $start = shift; | |
263 | my $stop = shift; | |
264 | my $val = shift; | |
265 | ||
266 | confess "BitFieldTie: store(\$start, \$stop, \$value) missing start\n" | |
267 | unless defined $start; | |
268 | confess "BitFieldTie: store(\$start, \$stop, \$value) missing stop\n" | |
269 | unless defined $stop; | |
270 | confess "BitFieldTie: store(\$start, \$stop, \$value) missing value\n" | |
271 | unless defined $val; | |
272 | ($start, $stop) = ($stop, $start) if ($start > $stop); | |
273 | ||
274 | my $size = $stop-$start+1; | |
275 | confess "Cannot use a chunk size > 32 bits\n" if $size > 32; | |
276 | confess "BitFieldTie: stop not defined\n" unless defined $stop; | |
277 | confess "BitFieldTie: value not defined\n" unless defined $val; | |
278 | ||
279 | $val = hex($val) if $val =~ /^\s*0[xX]/; | |
280 | ||
281 | eval { | |
282 | $this->{bv}->Chunk_Store($size,$start,$val); | |
283 | }; | |
284 | confess $@ if $@; | |
285 | ||
286 | } | |
287 | ||
288 | ############################################################################# | |
289 | ||
290 | sub left_shift { | |
291 | my $this = shift; | |
292 | my $numbits = shift; | |
293 | eval { | |
294 | $this->{bv}->Move_Left($numbits); | |
295 | }; | |
296 | confess $@ if $@; | |
297 | } | |
298 | ||
299 | ############################################################################# | |
300 | ||
301 | sub right_shift { | |
302 | my $this = shift; | |
303 | my $numbits = shift; | |
304 | eval { | |
305 | $this->{bv}->Move_Right($numbits); | |
306 | }; | |
307 | confess $@ if $@; | |
308 | } | |
309 | ||
310 | ############################################################################# | |
311 | ||
312 | sub divide { | |
313 | my $this = shift; | |
314 | my $that = shift; | |
315 | my $remainder = shift; | |
316 | ||
317 | my $that_bv = $that; | |
318 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
319 | $that_bv = $that->{bv}; | |
320 | } else { | |
321 | eval { | |
322 | $that_bv = $this->{bv}->Clone(); | |
323 | $that_bv->from_Dec($that); | |
324 | }; | |
325 | confess $@ if $@; | |
326 | } | |
327 | ||
328 | if(not defined $remainder) { | |
329 | eval { | |
330 | $remainder = Bit::Vector->new_Dec($this->{bv}->Size(), 0); | |
331 | }; | |
332 | confess $@ if $@; | |
333 | } elsif($remainder->isa('BitFieldTie')) { | |
334 | $remainder = $remainder->{bv}; | |
335 | } | |
336 | ||
337 | eval { | |
338 | $this->{bv}->Divide($this->{bv}, $that_bv, $remainder); | |
339 | }; | |
340 | confess $@ if $@; | |
341 | } | |
342 | ||
343 | ############################################################################# | |
344 | ||
345 | sub subtract { | |
346 | my $this = shift; | |
347 | my $that = shift; | |
348 | ||
349 | my $that_bv = $that; | |
350 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
351 | $that_bv = $that->{bv}; | |
352 | } else { | |
353 | eval { | |
354 | $that_bv = $this->{bv}->Clone(); | |
355 | $that_bv->from_Dec($that); | |
356 | }; | |
357 | confess $@ if $@; | |
358 | } | |
359 | ||
360 | eval { | |
361 | $this->{bv}->subtract($this->{bv}, $that_bv, 0); | |
362 | }; | |
363 | confess $@ if $@; | |
364 | } | |
365 | ||
366 | ############################################################################# | |
367 | ||
368 | sub add { | |
369 | my $this = shift; | |
370 | my $that = shift; | |
371 | ||
372 | my $that_bv = $that; | |
373 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
374 | $that_bv = $that->{bv}; | |
375 | } else { | |
376 | eval { | |
377 | $that_bv = $this->{bv}->Clone(); | |
378 | $that_bv->from_Dec($that); | |
379 | }; | |
380 | confess $@ if $@; | |
381 | } | |
382 | ||
383 | eval { | |
384 | $this->{bv}->add($this->{bv}, $that_bv, 0); | |
385 | }; | |
386 | confess $@ if $@; | |
387 | } | |
388 | ||
389 | ############################################################################# | |
390 | ||
391 | sub multiply { | |
392 | my $this = shift; | |
393 | my $that = shift; | |
394 | ||
395 | my $that_bv = $that; | |
396 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
397 | $that_bv = $that->{bv}; | |
398 | } else { | |
399 | eval { | |
400 | $that_bv = $this->{bv}->Clone(); | |
401 | $that_bv->from_Dec($that); | |
402 | }; | |
403 | confess $@ if $@; | |
404 | } | |
405 | ||
406 | eval { | |
407 | $this->{bv}->Multiply($this->{bv}, $that_bv); | |
408 | }; | |
409 | confess $@ if $@; | |
410 | } | |
411 | ||
412 | ############################################################################# | |
413 | ||
414 | sub compare { | |
415 | my $this = shift; | |
416 | my $that = shift; | |
417 | ||
418 | my $that_bv = $that; | |
419 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
420 | $that_bv = $that->{bv}; | |
421 | } else { | |
422 | eval { | |
423 | $that_bv = $this->{bv}->Clone(); | |
424 | $that_bv->from_Dec($that); | |
425 | }; | |
426 | confess $@ if $@; | |
427 | } | |
428 | ||
429 | my $result; | |
430 | eval { | |
431 | $result = Bit::Vector::Compare($this->{bv}, $that_bv); | |
432 | }; | |
433 | confess $@ if $@; | |
434 | return $result; | |
435 | } | |
436 | ||
437 | ############################################################################# | |
438 | ||
439 | sub ucompare { | |
440 | my $this = shift; | |
441 | my $that = shift; | |
442 | ||
443 | my $that_bv = $that; | |
444 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
445 | $that_bv = $that->{bv}; | |
446 | } else { | |
447 | eval { | |
448 | $that_bv = $this->{bv}->Clone(); | |
449 | $that_bv->from_Dec($that); | |
450 | }; | |
451 | confess $@ if $@; | |
452 | } | |
453 | ||
454 | my $result; | |
455 | my $hthis = $this->{bv}->to_Hex(); | |
456 | my $hthat = $that_bv->to_Hex(); | |
457 | eval { | |
458 | $result = Bit::Vector::Lexicompare($this->{bv}, $that_bv); | |
459 | }; | |
460 | confess $@ if $@; | |
461 | return $result; | |
462 | } | |
463 | ||
464 | ############################################################################# | |
465 | ||
466 | sub bitwise_and { | |
467 | my $this = shift; | |
468 | my $that = shift; | |
469 | ||
470 | my $that_bv = $that; | |
471 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
472 | $that_bv = $that->{bv}; | |
473 | } | |
474 | eval { | |
475 | $this->{bv}->Intersection($this->{bv}, $that_bv); | |
476 | }; | |
477 | confess $@ if $@; | |
478 | } | |
479 | ||
480 | ############################################################################# | |
481 | ||
482 | sub bitwise_or { | |
483 | my $this = shift; | |
484 | my $that = shift; | |
485 | ||
486 | my $that_bv = $that; | |
487 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
488 | $that_bv = $that->{bv}; | |
489 | } | |
490 | eval { | |
491 | $this->{bv}->Union($this->{bv}, $that_bv); | |
492 | }; | |
493 | confess $@ if $@; | |
494 | } | |
495 | ||
496 | ############################################################################# | |
497 | ||
498 | sub bitwise_xor { | |
499 | my $this = shift; | |
500 | my $that = shift; | |
501 | ||
502 | my $that_bv = $that; | |
503 | if(ref $that_bv and $that_bv->isa('BitFieldTie')) { | |
504 | $that_bv = $that->{bv}; | |
505 | } | |
506 | eval { | |
507 | $this->{bv}->ExclusiveOr($this->{bv}, $that_bv); | |
508 | }; | |
509 | confess $@ if $@; | |
510 | } | |
511 | ||
512 | ############################################################################# | |
513 | ||
514 | sub bitwise_not { | |
515 | my $this = shift; | |
516 | ||
517 | eval { | |
518 | $this->{bv}->Flip(); | |
519 | }; | |
520 | confess $@ if $@; | |
521 | } | |
522 | ||
523 | ############################################################################# | |
524 | ||
525 | sub clear { | |
526 | my $this = shift; | |
527 | ||
528 | eval { | |
529 | $this->{bv}->Empty(); | |
530 | }; | |
531 | confess $@ if $@; | |
532 | } | |
533 | ||
534 | ############################################################################# | |
535 | ||
536 | sub set { | |
537 | my $this = shift; | |
538 | my $size = shift; | |
539 | my $hexstring = shift; | |
540 | ||
541 | $size = 64 unless defined $size; | |
542 | confess "Size ($size) must be positive!\n" if($size < 0); | |
543 | ||
544 | eval { | |
545 | ||
546 | if(defined $hexstring) { | |
547 | $hexstring =~ s/^0[xX]//; | |
548 | $this->{bv} = Bit::Vector->new_Hex($size, "$hexstring"); | |
549 | } else { | |
550 | $this->{bv} = Bit::Vector->new($size); | |
551 | } | |
552 | }; | |
553 | if($@) { | |
554 | confess "set(size=$size, string=\"$hexstring\"): $@\n"; | |
555 | } | |
556 | } | |
557 | ||
558 | ############################################################################# | |
559 | ||
560 | sub set_dec { | |
561 | my $this = shift; | |
562 | my $size = shift; | |
563 | my $decimal = shift; | |
564 | ||
565 | $size = 64 unless defined $size; | |
566 | confess "Size ($size) must be positive!\n" if($size < 0); | |
567 | ||
568 | eval { | |
569 | ||
570 | if(defined $decimal) { | |
571 | $this->{bv} = Bit::Vector->new_Dec($size, "$decimal"); | |
572 | } else { | |
573 | $this->{bv} = Bit::Vector->new($size); | |
574 | } | |
575 | }; | |
576 | if($@) { | |
577 | confess "set_dec(size=$size, string=\"$decimal\"): $@\n"; | |
578 | } | |
579 | } | |
580 | ||
581 | ############################################################################# | |
582 | ||
583 | sub size { | |
584 | my $this = shift; | |
585 | my $size = shift; | |
586 | ||
587 | eval { | |
588 | if(defined $size) { | |
589 | $this->{bv}->Resize($size); | |
590 | } | |
591 | }; | |
592 | if($@) { | |
593 | confess "size($size): $@\n"; | |
594 | } | |
595 | ||
596 | return $this->{bv}->Size(); | |
597 | } | |
598 | ||
599 | ############################################################################# | |
600 | ||
601 | 1; | |
602 | __END__ | |
603 | # Below is stub documentation for your module. You'd better edit it! | |
604 | ||
605 | =head1 NAME | |
606 | ||
607 | BitFieldTie - Tie interface for bitfield operations | |
608 | ||
609 | =head1 SYNOPSIS | |
610 | ||
611 | use BitFieldTie; # or use TRELoad 'BitFieldTie'; | |
612 | ||
613 | tie %num, 'BitFieldTie'; | |
614 | ||
615 | $num{'31:0'} = hex('0x1234'); | |
616 | $num{'63:32'} = hex('0xabcd'); | |
617 | ||
618 | print "low byte is $num{'7:0'}\n"; | |
619 | print "MSB is $num{63}\n"; | |
620 | ||
621 | my $obj = tied %num; # get object | |
622 | print "Num is $obj\n"; # object prints as hex num | |
623 | ||
624 | ||
625 | =head1 ABSTRACT | |
626 | ||
627 | This is a thin wrapper for Bit::Vector that presents a tie interface for | |
628 | bit vectors. The bit vector itself can be of arbitrary size, but the | |
629 | chunk size (the size of an individual bit field) is limited to 32 bits. | |
630 | ||
631 | =head1 DESCRIPTION | |
632 | ||
633 | This module allows users to access bit fields with a hash interface. | |
634 | ||
635 | =head2 Introduction | |
636 | ||
637 | This module provides two components. The first is a class, | |
638 | BitFieldTie, that allows users to manipulate bit vectors of arbitrary | |
639 | size using object methods. The second is a tie interface. When a | |
640 | hash is tied to a BitFieldTie object, a hash interface can be used to | |
641 | set or exampine bit ranges in the vector. | |
642 | ||
643 | =head2 Hash Interface | |
644 | ||
645 | This subsection describes using the tied hash interface. | |
646 | ||
647 | =head3 Setting up a bitfield | |
648 | ||
649 | When you tie a hash to this module, the hash becomes a representation | |
650 | of bitfields of a number. By default, a 64-bit integer is created and | |
651 | initialized to zero. You can provide optional arguments to the tie | |
652 | command to set a different size and initial value, as in: | |
653 | ||
654 | tie %num, 'BitFieldTie', 32, '0x1234abcd'; | |
655 | ||
656 | The first optional agument is the size in bits, and the second is the | |
657 | initial value IN HEX. | |
658 | ||
659 | =head3 Using a bitfield | |
660 | ||
661 | You can then access fields of the hash. Hash keys can either be a | |
662 | single number for single-bit access, or a range in the form of | |
663 | E<lt>highE<gt>:E<lt>lowE<gt>. The values in the hash are integers, so | |
664 | for istance aftre the above initialization, the value of $num{'3:0'} | |
665 | would be 13 (decimal for 0xd). The hash provides both read and write | |
666 | access. B<The major restriction is that the size of the bit range | |
667 | (i.e., high-low+1) cannot exceed 32-bits.> To access larger ranges, | |
668 | you need to break it up into separate accesses. The main reason for | |
669 | that restriction is that if the module allowed larger chunks, it could | |
670 | not use integers to represent bit fields and performance would suffer | |
671 | considerably. | |
672 | ||
673 | =head3 Printing the bitfield | |
674 | ||
675 | Unfortunately, the tied-hash mechanism does not lend itself to object | |
676 | methods to do un-hash-like things like pretty-printing. You must | |
677 | therefore use the object interface, and there is a little bit of | |
678 | syntax involved. | |
679 | ||
680 | $obj = tied %num; | |
681 | ||
682 | This sets $obj to the underlying object for the tied hash. The object | |
683 | does know how to print itself (among other things). | |
684 | ||
685 | print "Num is $obj\n"; | |
686 | ||
687 | The above statement will print %num as a hexidecimal number. | |
688 | ||
689 | You can also interpolate the hash directly with a little bit of funny | |
690 | syntax: | |
691 | ||
692 | print "Num is @{[tied %num]}\n"; | |
693 | ||
694 | This is just a clever perl hack to do the same thing without explictly | |
695 | referencing $obj. | |
696 | ||
697 | =head2 Object interface | |
698 | ||
699 | Objects of type BitFieldTie can be created in 3 ways. The first is if | |
700 | a hash is tied to a BitFieldTie object, but no object is specified (as | |
701 | is the case in the previous examples), one will be created. This | |
702 | object can then be referenced by using the 'tied' operator on the | |
703 | hash, as shown in the previous section. | |
704 | ||
705 | Objects can also be created with the new() or clone() methods, as | |
706 | described in the section on Object Methods. | |
707 | ||
708 | Once an object is created, it can be easily manipulated as shown in | |
709 | the next section. | |
710 | ||
711 | =head3 Math with Bitfields | |
712 | ||
713 | BitFieldTie ties a hash object to an object. This allows you to use | |
714 | convenient hash syntax to access bit fields. To do math, however, you | |
715 | need to manipulate the object directly. The perl builtin-function | |
716 | tied will give you the object associated with a tied hash. | |
717 | ||
718 | my %v1; | |
719 | tie %v1, 'BitFieldTie', 64, '0x0000ffff0000cccc'; | |
720 | ||
721 | my $v1 = tied %v1; | |
722 | ||
723 | The above code creates a new 64-bit number tied to the hash %v1. The | |
724 | underlying object is assigned to $v1. Say we had a similar definition | |
725 | for v2: | |
726 | ||
727 | my %v2; | |
728 | tie %v2, 'BitFieldTie', 64, '0xffff333300003333'; | |
729 | my $v2 = tied %v2; | |
730 | ||
731 | You can still access bitfields using hash syntax on %v1 and %v2. You | |
732 | can now also call object methods on $v1 and $v2. For instance: | |
733 | ||
734 | $v2->bitwise_and($v1); | |
735 | print "$v2"; | |
736 | ||
737 | The above prints: "0000333300000000". Keep in mind that as mentioned | |
738 | above, when you convert an underlying BitFieldTie object to a string | |
739 | (as in the print statement), the string is a hexadecimal | |
740 | representation of the number. | |
741 | ||
742 | =head3 Object methods | |
743 | ||
744 | The following are the object methods that BitFieldTie objects respond to. | |
745 | ||
746 | =over 4 | |
747 | ||
748 | =item new($size, $hexstring) OR new($obj) | |
749 | ||
750 | Class method that creates a new object and returns it. Arguments are | |
751 | optional, if a $size and/or $hexstring is specified, it works just as | |
752 | the argument list to tie. If an object is provided, that object is | |
753 | cloned, and the clone is returned. | |
754 | ||
755 | new() can also be called as an object method. So the following two | |
756 | statements are identical (assuming $obj is a BitFieldTie): | |
757 | ||
758 | $new = $obj->new(); | |
759 | $new = BitFieldTie->new($obj); | |
760 | ||
761 | =item new_dec($size, $decimal) | |
762 | ||
763 | Same as new, except that the second argument is treated as a decimal | |
764 | argument, instead of a hex string. | |
765 | ||
766 | =item clone() | |
767 | ||
768 | Returns a new BitFieldTie object that is identical to the old one | |
769 | EXCEPT that it is not tied to any hash. | |
770 | ||
771 | =item stringify() | |
772 | ||
773 | Returns hexadecimal object as a string. This is called automatically | |
774 | when you include a BitFieldTie object in double-quotes. | |
775 | ||
776 | =item extract($hi, $low) | |
777 | ||
778 | Returns the specified bit range from the object as an integer. Since | |
779 | the return value is an integer, the size (i.e., $hi - $low + 1) must | |
780 | be <= 32. | |
781 | ||
782 | =item store($hi, $low, $value) | |
783 | ||
784 | Stores the $value (an integer!) in the specified bit range in the | |
785 | object. Since the return value is an integer, the size (i.e., $hi - | |
786 | $low + 1) must be <= 32. Also, the $value must be an integer, not a string. | |
787 | ||
788 | =item clear() | |
789 | ||
790 | Sets all bits in the bit vector to 0. | |
791 | ||
792 | =item size(), size($numbits) | |
793 | ||
794 | Sets/Gets the size (in bits) of the number, depending on whether or | |
795 | not an argument is given. | |
796 | ||
797 | =item left_shift($numbits) | |
798 | ||
799 | Left shifts the number. | |
800 | ||
801 | =item right_shift($numbits) | |
802 | ||
803 | Right shifts the number. | |
804 | ||
805 | =item bitwise_and($obj) | |
806 | ||
807 | Does a bitwise and between the calling object and $obj. Stores the | |
808 | result in the calling object. For example: | |
809 | ||
810 | $v1->bitwise_and($v2); | |
811 | ||
812 | has the C equivalent of: | |
813 | ||
814 | v1 &= v2; | |
815 | ||
816 | =item bitwise_or($obj) | |
817 | ||
818 | Same as bitwise_and, except it performs an OR function. | |
819 | ||
820 | =item bitwise_xor($obj) | |
821 | ||
822 | Same as bitwise_and and bitwise_or, except it performs an XOR function. | |
823 | ||
824 | =item bitwise_not() | |
825 | ||
826 | Flips every bit in the number. | |
827 | ||
828 | =item divide($obj, $remainder) | |
829 | ||
830 | Divides the calling object by $obj and stores the result in the | |
831 | calling object (i.e., /=). $remainder is initialized to the | |
832 | remainder. $obj can be an integer, in which case an object the same | |
833 | size as the calling object is created for it. | |
834 | ||
835 | ||
836 | =item multiply($obj) | |
837 | ||
838 | Multiplies the calling object by $obj and stores the result in the | |
839 | calling object (i.e., *=). $obj can be an integer, in which | |
840 | case an object the same size as the calling object is created for it. | |
841 | ||
842 | ||
843 | =item add($obj) | |
844 | ||
845 | Adds $obj to the calling object. $obj can be an integer, in which | |
846 | case an object the same size as the calling object is created for it. | |
847 | ||
848 | =item subtract($obj) | |
849 | ||
850 | Subtracts $obj from the calling object. $obj can be an integer, in which | |
851 | case an object the same size as the calling object is created for it. | |
852 | ||
853 | =item compare($obj) | |
854 | ||
855 | Does a comparison on the calling object and $obj (which may be an | |
856 | integer). Returns -1 if the calling object is smaller, 0 if they are | |
857 | equal, and 1 if the calling object is greater that $obj. Both the | |
858 | calling object and $obj are treated as SIGNED integers for the | |
859 | purposes of comparison. | |
860 | ||
861 | =item ucompare($obj) | |
862 | ||
863 | Same as compare, but the calling object and $obj are treated as | |
864 | UNSIGNED integers. | |
865 | ||
866 | =back | |
867 | ||
868 | =head2 Tying an Existing Object to a Hash | |
869 | ||
870 | If you create a BitFieldTie object with new() or clone(), it begins | |
871 | life not tied to any hash. You can manipulate it with object methods, | |
872 | but if you want to access bit fields with hash syntax, you will need | |
873 | to tie it to a hash first. Here is an example | |
874 | ||
875 | my $obj = BitFieldTie->new(64, '0xdeadbeefcafe0123'); | |
876 | tie %h, 'BitFieldTie', $obj; | |
877 | ||
878 | The contents of $h{'15:0'} would then be hex('0123'); | |
879 | ||
880 | ||
881 | =head2 EXPORT | |
882 | ||
883 | None. Object modules do not export any symbols. | |
884 | ||
885 | =head1 SEE ALSO | |
886 | ||
887 | Bit::Vector(3). | |
888 | ||
889 | =cut |