|
@@ -73,7 +73,10 @@ sub FETCH {
|
73
|
73
|
my $raw = substr ( ${$self->{data}},
|
74
|
74
|
( $self->{offset} + $self->{fields}->{$key}->{offset} ),
|
75
|
75
|
$self->{fields}->{$key}->{length} );
|
76
|
|
- return unpack ( $self->{fields}->{$key}->{pack}, $raw );
|
|
76
|
+ my $unpack = ( ref $self->{fields}->{$key}->{unpack} ?
|
|
77
|
+ $self->{fields}->{$key}->{unpack} :
|
|
78
|
+ sub { unpack ( $self->{fields}->{$key}->{pack}, shift ); } );
|
|
79
|
+ return &$unpack ( $raw );
|
77
|
80
|
}
|
78
|
81
|
|
79
|
82
|
sub STORE {
|
|
@@ -82,7 +85,10 @@ sub STORE {
|
82
|
85
|
my $value = shift;
|
83
|
86
|
|
84
|
87
|
croak "Nonexistent field \"$key\"" unless $self->EXISTS ( $key );
|
85
|
|
- my $raw = pack ( $self->{fields}->{$key}->{pack}, $value );
|
|
88
|
+ my $pack = ( ref $self->{fields}->{$key}->{pack} ?
|
|
89
|
+ $self->{fields}->{$key}->{pack} :
|
|
90
|
+ sub { pack ( $self->{fields}->{$key}->{pack}, shift ); } );
|
|
91
|
+ my $raw = &$pack ( $value );
|
86
|
92
|
substr ( ${$self->{data}},
|
87
|
93
|
( $self->{offset} + $self->{fields}->{$key}->{offset} ),
|
88
|
94
|
$self->{fields}->{$key}->{length} ) = $raw;
|
|
@@ -168,6 +174,36 @@ use constant PNP_SIGNATURE => '$PnP';
|
168
|
174
|
our @EXPORT_OK = qw ( ROM_SIGNATURE PCI_SIGNATURE PNP_SIGNATURE );
|
169
|
175
|
our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
|
170
|
176
|
|
|
177
|
+use constant JMP_SHORT => 0xeb;
|
|
178
|
+use constant JMP_NEAR => 0xe9;
|
|
179
|
+
|
|
180
|
+sub pack_init {
|
|
181
|
+ my $dest = shift;
|
|
182
|
+
|
|
183
|
+ # Always create a near jump; it's simpler
|
|
184
|
+ if ( $dest ) {
|
|
185
|
+ return pack ( "CS", JMP_NEAR, ( $dest - 6 ) );
|
|
186
|
+ } else {
|
|
187
|
+ return pack ( "CS", 0, 0 );
|
|
188
|
+ }
|
|
189
|
+}
|
|
190
|
+
|
|
191
|
+sub unpack_init {
|
|
192
|
+ my $instr = shift;
|
|
193
|
+
|
|
194
|
+ # Accept both short and near jumps
|
|
195
|
+ ( my $jump, my $offset ) = unpack ( "CS", $instr );
|
|
196
|
+ if ( $jump == JMP_SHORT ) {
|
|
197
|
+ return ( $offset + 5 );
|
|
198
|
+ } elsif ( $jump == JMP_NEAR ) {
|
|
199
|
+ return ( $offset + 6 );
|
|
200
|
+ } elsif ( $jump == 0 ) {
|
|
201
|
+ return 0;
|
|
202
|
+ } else {
|
|
203
|
+ croak "Unrecognised jump instruction in init vector\n";
|
|
204
|
+ }
|
|
205
|
+}
|
|
206
|
+
|
171
|
207
|
=pod
|
172
|
208
|
|
173
|
209
|
=item C<< new () >>
|
|
@@ -187,7 +223,11 @@ sub new {
|
187
|
223
|
fields => {
|
188
|
224
|
signature => { offset => 0x00, length => 0x02, pack => "S" },
|
189
|
225
|
length => { offset => 0x02, length => 0x01, pack => "C" },
|
|
226
|
+ # "init" is part of a jump instruction
|
|
227
|
+ init => { offset => 0x03, length => 0x03,
|
|
228
|
+ pack => \&pack_init, unpack => \&unpack_init },
|
190
|
229
|
checksum => { offset => 0x06, length => 0x01, pack => "C" },
|
|
230
|
+ bofm_header => { offset => 0x14, length => 0x02, pack => "S" },
|
191
|
231
|
undi_header => { offset => 0x16, length => 0x02, pack => "S" },
|
192
|
232
|
pci_header => { offset => 0x18, length => 0x02, pack => "S" },
|
193
|
233
|
pnp_header => { offset => 0x1a, length => 0x02, pack => "S" },
|