File Coverage

blib/lib/CPU/Z80/Disassembler/Format.pm
Criterion Covered Total %
statement 27 27 100.0
branch 10 10 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 6 6 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1             package CPU::Z80::Disassembler::Format;
2              
3             #------------------------------------------------------------------------------
4              
5             =head1 NAME
6              
7             CPU::Z80::Disassembler::Format - Format output of disassembler
8              
9             =cut
10              
11             #------------------------------------------------------------------------------
12              
13 11     11   811 use strict;
  11         45  
  11         324  
14 11     11   67 use warnings;
  11         26  
  11         519  
15              
16             our $VERSION = '1.01';
17              
18             #------------------------------------------------------------------------------
19              
20             =head1 SYNOPSYS
21              
22             use CPU::Z80::Disassembler::Format;
23             print format_hex($x), format_hex2($x), format_hex4($x); format_bin8($x);
24             print format_dis($x), format_str($x);
25              
26             =head1 DESCRIPTION
27              
28             Exports functions to format output values in the disassembler listing.
29              
30             =head1 EXPORTS
31              
32             Exports all functions by default.
33              
34             =head1 FUNCTIONS
35              
36             =cut
37             #------------------------------------------------------------------------------
38 11     11   62 use Exporter 'import';
  11         45  
  11         4562  
39             our @EXPORT = qw( format_hex format_hex2 format_hex4
40             format_bin8
41             format_dis format_str );
42             #------------------------------------------------------------------------------
43              
44             =head2 format_hex
45              
46             Returns the string representation of a value in hexadecimal..
47              
48             =cut
49              
50             #------------------------------------------------------------------------------
51             sub format_hex {
52 1159 100   1159 1 16043 $_[0] < 0 ? sprintf("-\$%02X", -$_[0]) : sprintf("\$%02X", $_[0]);
53             }
54             #------------------------------------------------------------------------------
55              
56             =head2 format_hex2
57              
58             Returns the string representation of a byte in hexadecimal as $HH.
59              
60             =cut
61              
62             #------------------------------------------------------------------------------
63             sub format_hex2 {
64 53779     53779 1 191583 sprintf("\$%02X", $_[0] & 0xFF)
65             }
66             #------------------------------------------------------------------------------
67              
68             =head2 format_hex4
69              
70             Returns the string representation of a word in hexadecimal as $HHHH.
71              
72             =cut
73              
74             #------------------------------------------------------------------------------
75             sub format_hex4 {
76 16765     16765 1 162217 sprintf("\$%04X", $_[0] & 0xFFFF)
77             }
78             #------------------------------------------------------------------------------
79              
80             =head2 format_bin8
81              
82             Returns the string representation of a word in binary as %01010101.
83              
84             =cut
85              
86             #------------------------------------------------------------------------------
87             sub format_bin8 {
88 773     773 1 3092 my($val) = @_;
89              
90 773         1134 my $sign = '';
91 773 100       1527 if ($val < 0) {
92 1         9 $val = -$val;
93 1         6 $sign = '-';
94             }
95              
96 773         1090 my $digits = '';
97 773   100     2046 while ($val != 0 || length($digits) < 8) {
98 6185 100       11370 $digits = (($val & 1) ? '1' : '0') . $digits;
99 6185         14750 $val >>= 1;
100             }
101            
102 773         4005 return $sign.'%'.$digits;
103             }
104             #------------------------------------------------------------------------------
105              
106             =head2 format_dis
107              
108             Returns the string representation of a signed byte in hexadecimal as +$HH, -$HH or
109             empty string for zero.
110              
111             =cut
112              
113             #------------------------------------------------------------------------------
114             sub format_dis {
115 1206     1206 1 2639 my($arg) = @_;
116 1206 100       4651 $arg < 0 ? '-'.format_hex(-$arg) :
    100          
117             $arg > 0 ? '+'.format_hex( $arg) :
118             '';
119             }
120             #------------------------------------------------------------------------------
121              
122             =head2 format_str
123              
124             Returns the string representation of an assembly string: double-quoted, all
125             double-quotes inside are escaped.
126              
127             =cut
128              
129             #------------------------------------------------------------------------------
130             sub format_str {
131 220     220 1 448 my($str) = @_;
132 220         501 $str =~ s/(["\\])/\\$1/g;
133 220         1188 return '"'.$str.'"';
134             }
135             #------------------------------------------------------------------------------
136              
137             =head1 BUGS, FEEDBACK, AUTHORS, COPYRIGHT and LICENCE
138              
139             See L.
140              
141             =cut
142              
143             1;