[p5sagit/p5-mst-13.2.git] / ext / B / t / assembler.t

#!./perl -w

=pod

=head1 TEST FOR B::Assembler.pm AND B::Disassembler.pm

=head2 Description

The general idea is to test by assembling a choice set of assembler
instructions, then disassemble them, and check that we've completed the
round trip. Also, error checking of Assembler.pm is tested by feeding
it assorted errors.

Since Assembler.pm likes to assemble a file, we comply by writing a
text file. This file contains three sections:

  testing operand categories
  use each opcode
  erronous assembler instructions

An "operand category" is identified by the suffix of the PUT_/GET_
subroutines as shown in the C<%Asmdata::insn_data> initialization, e.g.
opcode C<ldsv> has operand category C<svindex>:

   insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];

Because Disassembler.pm also assumes input from a file, we write the
resulting object code to a file. And disassembled output is written to
yet another text file which is then compared to the original input.
(Erronous assembler instructions still generate code, but this is not
written to the object file; therefore disassembly bails out at the first
instruction in error.)

All files are kept in memory by using TIEHASH.


=head2 Caveats

An error where Assembler.pm and Disassembler.pm agree but Assembler.pm
generates invalid object code will not be detected.

Due to the way this test has been set up, failure of a single test
could cause all subsequent tests to fail as well: After an unexpected
assembler error no output is written, and disassembled lines will be
out of sync for all lines thereafter.

Not all possibilities for writing a valid operand value can be tested
because disassembly results in a uniform representation.


=head2 Maintenance

New opcodes are added automatically.

A new operand category will cause this program to die ("no operand list
for XXX"). The cure is to add suitable entries to C<%goodlist> and
C<%badlist>. (Since the data in Asmdata.pm is autogenerated, it may also
happen that the corresponding assembly or disassembly subroutine is
missing.) Note that an empty array as a C<%goodlist> entry means that
opcodes of the operand category do not take an operand (and therefore the
corresponding entry in C<%badlist> should have one). An C<undef> entry
in C<%badlist> means that any value is acceptable (and thus there is no
way to cause an error).

Set C<$dbg> to debug this test.

=cut

package VirtFile;
use strict;

# Note: This is NOT a general purpose package. It implements
# sequential text and binary file i/o in a rather simple form.

sub TIEHANDLE($;$){
    my( $class, $data ) = @_;
    my $obj = { data => defined( $data ) ? $data : '',
                pos => 0 };
    return bless( $obj, $class );
}

sub PRINT($@){
    my( $self ) = shift;
    $self->{data} .= join( '', @_ );
}

sub WRITE($$;$$){
    my( $self, $buf, $len, $offset ) = @_;
    unless( defined( $len ) ){
	$len = length( $buf );
        $offset = 0;
    }
    unless( defined( $offset ) ){
        $offset = 0;
    }
    $self->{data} .= substr( $buf, $offset, $len );
    return $len;
}


sub GETC($){
    my( $self ) = @_;
    return undef() if $self->{pos} >= length( $self->{data} );
    return substr( $self->{data}, $self->{pos}++, 1 );
}

sub READLINE($){
    my( $self ) = @_;
    return undef() if $self->{pos} >= length( $self->{data} );
    my $lfpos = index( $self->{data}, "\n", $self->{pos} );
    if( $lfpos < 0 ){
        $lfpos = length( $self->{data} );
    }
    my $pos = $self->{pos};
    $self->{pos} = $lfpos + 1;
    return substr( $self->{data}, $pos, $self->{pos} - $pos );
}

sub READ($@){
    my $self = shift();
    my $bufref = \$_[0];
    my( undef, $len, $offset ) = @_;
    if( $offset ){
        die( "offset beyond end of buffer\n" )
          if ! defined( $$bufref ) || $offset > length( $$bufref );
    } else {
        $$bufref = '';
        $offset = 0;
    }
    my $remlen = length( $self->{data} ) - $self->{pos};
    $len = $remlen if $remlen < $len;
    return 0 unless $len;
    substr( $$bufref, $offset, $len ) =
      substr( $self->{data}, $self->{pos}, $len );
    $self->{pos} += $len;
    return $len;
}

sub TELL($){
    my $self = shift();
    return $self->{pos};
}

sub CLOSE($){
    my( $self ) = @_;
    $self->{pos} = 0;
}

1;

package main;

use strict;
use Test::More;
use Config qw(%Config);

BEGIN {
  if (($Config{'extensions'} !~ /\bByteLoader\b/) ){
    print "1..0 # Skip -- Perl configured without ByteLoader module\n";
    exit 0;
  }
}

use B::Asmdata      qw( %insn_data );
use B::Assembler    qw( &assemble_fh );
use B::Disassembler qw( &disassemble_fh &get_header );

my( %opsByType, @code2name );
my( $lineno, $dbg, $firstbadline, @descr );
$dbg = 0; # debug switch

# $SIG{__WARN__} handler to catch Assembler error messages
#
my $warnmsg;
sub catchwarn($){
    $warnmsg = $_[0];
    print "error: $warnmsg\n" if $dbg;
}

# Callback for writing assembled bytes. This is where we check
# that we do get an error.
#
sub putobj($){
    if( ++$lineno >= $firstbadline ){
        ok( $warnmsg && $warnmsg =~ /^\d+:\s/, $descr[$lineno] );
        undef( $warnmsg );
    } else {
        my $l = syswrite( OBJ, $_[0] );
    }
}

# Callback for writing a disassembled statement.
#
sub putdis(@){
    my $line = join( ' ', @_ );
    ++$lineno;
    print DIS "$line\n";
    printf "%5d %s\n", $lineno, $line if $dbg;
}

# Generate assembler instructions from a hash of operand types: each
# existing entry contains a list of good or bad operand values. The
# corresponding opcodes can be found in %opsByType.
#
sub gen_type($$$){
    my( $href, $descref, $text ) = @_;
    for my $odt ( sort( keys( %opsByType ) ) ){
        my $opcode = $opsByType{$odt}->[0];
	my $sel = $odt;
	$sel =~ s/^GET_//;
	die( "no operand list for $sel\n" ) unless exists( $href->{$sel} );
        if( defined( $href->{$sel} ) ){
            if( @{$href->{$sel}} ){
		for my $od ( @{$href->{$sel}} ){
		    ++$lineno;
                    $descref->[$lineno] = "$text: $code2name[$opcode] $od";
		    print ASM "$code2name[$opcode] $od\n";
		    printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
		}
	    } else {
		++$lineno;
                $descref->[$lineno] = "$text: $code2name[$opcode]";
		print ASM "$code2name[$opcode]\n";
		printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
	    }
	}
    }
}

# Interesting operand values
#
my %goodlist = (
comment_t   => [ '"a comment"' ],  # no \n
none        => [],
svindex     => [ 0x7fffffff, 0 ],
opindex     => [ 0x7fffffff, 0 ],
pvindex     => [ 0x7fffffff, 0 ],
U32         => [ 0xffffffff, 0 ],
U8          => [ 0xff, 0 ],
PV          => [ '""', '"a string"', ],
I32         => [ -0x80000000, 0x7fffffff ],
IV64        => [ '0x000000000', '0x0ffffffff', '0x000000001' ], # disass formats  0x%09x
IV          => $Config{ivsize} == 4 ?
               [ -0x80000000, 0x7fffffff ] :
               [ '0x000000000', '0x0ffffffff', '0x000000001' ],
NV          => [ 1.23456789E3 ],
U16         => [ 0xffff, 0 ],
pvcontents  => [],
strconst    => [ '""', '"another string"' ], # no NUL
op_tr_array => [ join( ',', 256, 0..255 ) ],
PADOFFSET   => undef,
long        => undef,
	      );

# Erronous operand values
#
my %badlist = (
comment_t   => [ '"multi-line\ncomment"' ],  # no \n
none        => [ '"spurious arg"'  ],
svindex     => [ 0xffffffff * 2, -1 ],
opindex     => [ 0xffffffff * 2, -2 ],
pvindex     => [ 0xffffffff * 2, -3 ],
U32         => [ 0xffffffff * 2, -4 ],
U16         => [ 0x5ffff, -5 ],
U8          => [ 0x6ff, -6 ],
PV          => [ 'no quote"' ],
I32         => [ -0x80000001, 0x80000000 ],
IV64        => undef, # PUT_IV64 doesn't check - no integrity there
IV          => $Config{ivsize} == 4 ?
               [ -0x80000001, 0x80000000 ] : undef,
NV          => undef, # PUT_NV accepts anything - it shouldn't, real-ly
pvcontents  => [ '"spurious arg"' ],
strconst    => [  'no quote"',  '"with NUL '."\0".' char"' ], # no NUL
op_tr_array => undef, # op_pv_tr is no longer exactly 256 shorts
PADOFFSET   => undef,
long	     => undef,
	      );


# Determine all operand types from %Asmdata::insn_data
#
for my $opname ( keys( %insn_data ) ){
    my ( $opcode, $put, $getname ) = @{$insn_data{$opname}};
    push( @{$opsByType{$getname}}, $opcode );
    $code2name[$opcode] = $opname;
}


# Write instruction(s) for correct operand values each operand type class
#
$lineno = 0;
tie( *ASM, 'VirtFile' );
gen_type( \%goodlist, \@descr, 'round trip' );

# Write one instruction for each opcode.
#
for my $opcode ( 0..$#code2name ){
    next unless defined( $code2name[$opcode] );
    my $sel = $insn_data{$code2name[$opcode]}->[2];
    $sel =~ s/^GET_//;
    die( "no operand list for $sel\n" ) unless exists( $goodlist{$sel} );
    if( defined( $goodlist{$sel} ) ){
        ++$lineno;
        if( @{$goodlist{$sel}} ){
            my $od = $goodlist{$sel}[0];
            $descr[$lineno] = "round trip: $code2name[$opcode] $od";
            print ASM "$code2name[$opcode] $od\n";
            printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
        } else {
            $descr[$lineno] = "round trip: $code2name[$opcode]";
            print ASM "$code2name[$opcode]\n";
            printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
	}
    }
} 

# Write instruction(s) for incorrect operand values each operand type class
#
$firstbadline = $lineno + 1;
gen_type( \%badlist, \@descr, 'asm error' );

# invalid opcode is an odd-man-out ;-)
#
++$lineno;
$descr[$lineno] = "asm error: Gollum";
print ASM "Gollum\n";
printf "%5d %s\n", $lineno, 'Gollum' if $dbg;

close( ASM );

# Now that we have defined all of our tests: plan
#
plan( tests => $lineno );
print "firstbadline=$firstbadline\n" if $dbg;

# assemble (guard against warnings and death from assembly errors)
#
$SIG{'__WARN__'} = \&catchwarn;

$lineno = -1; # account for the assembly header
tie( *OBJ, 'VirtFile' );
eval { assemble_fh( \*ASM, \&putobj ); };
print "eval: $@" if $dbg;
close( ASM );
close( OBJ );
$SIG{'__WARN__'} = 'DEFAULT';

# disassemble
#
print "--- disassembling ---\n" if $dbg;
$lineno = 0;
tie( *DIS, 'VirtFile' );
disassemble_fh( \*OBJ, \&putdis );
close( OBJ );
close( DIS );

# get header (for debugging only)
#
if( $dbg ){
    my( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder ) =
        get_header();
    printf "Magic:        0x%08x\n", $magic;
    print  "Architecture: $archname\n";
    print  "Byteloader V: $blversion\n";
    print  "ivsize:       $ivsize\n";
    print  "ptrsize:      $ptrsize\n";
    print  "Byteorder:    $byteorder\n";
}

# check by comparing files line by line
#
print "--- checking ---\n" if $dbg;
$lineno = 0;
my( $asmline, $disline );
while( defined( $asmline = <ASM> ) ){
    $disline = <DIS>;
    ++$lineno;
    last if $lineno eq $firstbadline; # bail out where errors begin
    ok( $asmline eq $disline, $descr[$lineno] );
    printf "%5d %s\n", $lineno, $asmline if $dbg;
}
close( ASM );
close( DIS );

__END__
Commit	Line	Data
f4abc3e7	1	#!./perl -w
	2
	3	=pod
	4
	5	=head1 TEST FOR B::Assembler.pm AND B::Disassembler.pm
	6
	7	=head2 Description
	8
	9	The general idea is to test by assembling a choice set of assembler
	10	instructions, then disassemble them, and check that we've completed the
	11	round trip. Also, error checking of Assembler.pm is tested by feeding
	12	it assorted errors.
	13
	14	Since Assembler.pm likes to assemble a file, we comply by writing a
	15	text file. This file contains three sections:
	16
	17	testing operand categories
	18	use each opcode
	19	erronous assembler instructions
	20
	21	An "operand category" is identified by the suffix of the PUT_/GET_
	22	subroutines as shown in the C<%Asmdata::insn_data> initialization, e.g.
	23	opcode C<ldsv> has operand category C<svindex>:
	24
	25	insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
	26
	27	Because Disassembler.pm also assumes input from a file, we write the
	28	resulting object code to a file. And disassembled output is written to
	29	yet another text file which is then compared to the original input.
	30	(Erronous assembler instructions still generate code, but this is not
	31	written to the object file; therefore disassembly bails out at the first
	32	instruction in error.)
	33
	34	All files are kept in memory by using TIEHASH.
	35
	36
	37	=head2 Caveats
	38
	39	An error where Assembler.pm and Disassembler.pm agree but Assembler.pm
	40	generates invalid object code will not be detected.
	41
	42	Due to the way this test has been set up, failure of a single test
	43	could cause all subsequent tests to fail as well: After an unexpected
	44	assembler error no output is written, and disassembled lines will be
	45	out of sync for all lines thereafter.
	46
	47	Not all possibilities for writing a valid operand value can be tested
	48	because disassembly results in a uniform representation.
	49
	50
	51	=head2 Maintenance
	52
	53	New opcodes are added automatically.
	54
	55	A new operand category will cause this program to die ("no operand list
	56	for XXX"). The cure is to add suitable entries to C<%goodlist> and
	57	C<%badlist>. (Since the data in Asmdata.pm is autogenerated, it may also
	58	happen that the corresponding assembly or disassembly subroutine is
	59	missing.) Note that an empty array as a C<%goodlist> entry means that
	60	opcodes of the operand category do not take an operand (and therefore the
	61	corresponding entry in C<%badlist> should have one). An C<undef> entry
	62	in C<%badlist> means that any value is acceptable (and thus there is no
	63	way to cause an error).
	64
65	Set C<$dbg> to debug this test.
66
67	=cut
68
69	package VirtFile;
70	use strict;
71
72	# Note: This is NOT a general purpose package. It implements
73	# sequential text and binary file i/o in a rather simple form.
74
75	sub TIEHANDLE($;$){
76	my( $class, $data ) = @_;
77	my $obj = { data => defined( $data ) ? $data : '',
78	pos => 0 };
79	return bless( $obj, $class );
80	}
81
82	sub PRINT($@){
83	my( $self ) = shift;
84	$self->{data} .= join( '', @_ );
85	}
86
87	sub WRITE($$;$$){
88	my( $self, $buf, $len, $offset ) = @_;
89	unless( defined( $len ) ){
90	$len = length( $buf );
91	$offset = 0;
92	}
93	unless( defined( $offset ) ){
94	$offset = 0;
95	}
96	$self->{data} .= substr( $buf, $offset, $len );
97	return $len;
98	}
99
100
101	sub GETC($){
102	my( $self ) = @_;
103	return undef() if $self->{pos} >= length( $self->{data} );
104	return substr( $self->{data}, $self->{pos}++, 1 );
105	}
106
107	sub READLINE($){
108	my( $self ) = @_;
109	return undef() if $self->{pos} >= length( $self->{data} );
110	my $lfpos = index( $self->{data}, "\n", $self->{pos} );
111	if( $lfpos < 0 ){
112	$lfpos = length( $self->{data} );
113	}
114	my $pos = $self->{pos};
115	$self->{pos} = $lfpos + 1;
116	return substr( $self->{data}, $pos, $self->{pos} - $pos );
117	}
118
119	sub READ($@){
120	my $self = shift();
121	my $bufref = \$_[0];
122	my( undef, $len, $offset ) = @_;
123	if( $offset ){
124	die( "offset beyond end of buffer\n" )
125	if ! defined( $$bufref ) \|\| $offset > length( $$bufref );
126	} else {
127	$$bufref = '';
128	$offset = 0;
129	}
130	my $remlen = length( $self->{data} ) - $self->{pos};
131	$len = $remlen if $remlen < $len;
132	return 0 unless $len;
133	substr( $$bufref, $offset, $len ) =
134	substr( $self->{data}, $self->{pos}, $len );
135	$self->{pos} += $len;
136	return $len;
137	}
138
139	sub TELL($){
140	my $self = shift();
141	return $self->{pos};
142	}
143
144	sub CLOSE($){
145	my( $self ) = @_;
146	$self->{pos} = 0;
147	}
148
149	1;
150
151	package main;
152
153	use strict;
154	use Test::More;
155	use Config qw(%Config);
156
ff924b36	157	BEGIN {
	158	if (($Config{'extensions'} !~ /\bByteLoader\b/) ){
	159	print "1..0 # Skip -- Perl configured without ByteLoader module\n";
	160	exit 0;
	161	}
	162	}
	163
f4abc3e7	164	use B::Asmdata qw( %insn_data );
	165	use B::Assembler qw( &assemble_fh );
	166	use B::Disassembler qw( &disassemble_fh &get_header );
	167
	168	my( %opsByType, @code2name );
	169	my( $lineno, $dbg, $firstbadline, @descr );
	170	$dbg = 0; # debug switch
	171
	172	# $SIG{__WARN__} handler to catch Assembler error messages
	173	#
	174	my $warnmsg;
	175	sub catchwarn($){
	176	$warnmsg = $_[0];
	177	print "error: $warnmsg\n" if $dbg;
	178	}
	179
	180	# Callback for writing assembled bytes. This is where we check
	181	# that we do get an error.
	182	#
	183	sub putobj($){
	184	if( ++$lineno >= $firstbadline ){
	185	ok( $warnmsg && $warnmsg =~ /^\d+:\s/, $descr[$lineno] );
	186	undef( $warnmsg );
	187	} else {
	188	my $l = syswrite( OBJ, $_[0] );
	189	}
	190	}
	191
	192	# Callback for writing a disassembled statement.
	193	#
	194	sub putdis(@){
	195	my $line = join( ' ', @_ );
	196	++$lineno;
	197	print DIS "$line\n";
	198	printf "%5d %s\n", $lineno, $line if $dbg;
	199	}
	200
	201	# Generate assembler instructions from a hash of operand types: each
	202	# existing entry contains a list of good or bad operand values. The
	203	# corresponding opcodes can be found in %opsByType.
	204	#
	205	sub gen_type($$$){
	206	my( $href, $descref, $text ) = @_;
e53790c1	207	for my $odt ( sort( keys( %opsByType ) ) ){
f4abc3e7	208	my $opcode = $opsByType{$odt}->[0];
	209	my $sel = $odt;
	210	$sel =~ s/^GET_//;
	211	die( "no operand list for $sel\n" ) unless exists( $href->{$sel} );
	212	if( defined( $href->{$sel} ) ){
	213	if( @{$href->{$sel}} ){
	214	for my $od ( @{$href->{$sel}} ){
	215	++$lineno;
	216	$descref->[$lineno] = "$text: $code2name[$opcode] $od";
	217	print ASM "$code2name[$opcode] $od\n";
	218	printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
	219	}
	220	} else {
	221	++$lineno;
	222	$descref->[$lineno] = "$text: $code2name[$opcode]";
	223	print ASM "$code2name[$opcode]\n";
	224	printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
	225	}
	226	}
	227	}
	228	}
	229
	230	# Interesting operand values
	231	#
	232	my %goodlist = (
	233	comment_t => [ '"a comment"' ], # no \n
	234	none => [],
	235	svindex => [ 0x7fffffff, 0 ],
	236	opindex => [ 0x7fffffff, 0 ],
	237	pvindex => [ 0x7fffffff, 0 ],
	238	U32 => [ 0xffffffff, 0 ],
	239	U8 => [ 0xff, 0 ],
	240	PV => [ '""', '"a string"', ],
	241	I32 => [ -0x80000000, 0x7fffffff ],
	242	IV64 => [ '0x000000000', '0x0ffffffff', '0x000000001' ], # disass formats 0x%09x
	243	IV => $Config{ivsize} == 4 ?
	244	[ -0x80000000, 0x7fffffff ] :
	245	[ '0x000000000', '0x0ffffffff', '0x000000001' ],
	246	NV => [ 1.23456789E3 ],
	247	U16 => [ 0xffff, 0 ],
	248	pvcontents => [],
	249	strconst => [ '""', '"another string"' ], # no NUL
566ece03	250	op_tr_array => [ join( ',', 256, 0..255 ) ],
ca337316	251	PADOFFSET => undef,
53897bd5	252	long => undef,
f4abc3e7	253	);
	254
	255	# Erronous operand values
	256	#
	257	my %badlist = (
	258	comment_t => [ '"multi-line\ncomment"' ], # no \n
	259	none => [ '"spurious arg"' ],
	260	svindex => [ 0xffffffff * 2, -1 ],
	261	opindex => [ 0xffffffff * 2, -2 ],
	262	pvindex => [ 0xffffffff * 2, -3 ],
	263	U32 => [ 0xffffffff * 2, -4 ],
	264	U16 => [ 0x5ffff, -5 ],
	265	U8 => [ 0x6ff, -6 ],
	266	PV => [ 'no quote"' ],
	267	I32 => [ -0x80000001, 0x80000000 ],
	268	IV64 => undef, # PUT_IV64 doesn't check - no integrity there
	269	IV => $Config{ivsize} == 4 ?
	270	[ -0x80000001, 0x80000000 ] : undef,
	271	NV => undef, # PUT_NV accepts anything - it shouldn't, real-ly
	272	pvcontents => [ '"spurious arg"' ],
	273	strconst => [ 'no quote"', '"with NUL '."\0".' char"' ], # no NUL
566ece03	274	op_tr_array => undef, # op_pv_tr is no longer exactly 256 shorts
ca337316	275	PADOFFSET => undef,
53897bd5	276	long => undef,
f4abc3e7	277	);
	278
	279
	280	# Determine all operand types from %Asmdata::insn_data
	281	#
	282	for my $opname ( keys( %insn_data ) ){
	283	my ( $opcode, $put, $getname ) = @{$insn_data{$opname}};
	284	push( @{$opsByType{$getname}}, $opcode );
	285	$code2name[$opcode] = $opname;
	286	}
	287
	288
	289	# Write instruction(s) for correct operand values each operand type class
	290	#
	291	$lineno = 0;
	292	tie( *ASM, 'VirtFile' );
	293	gen_type( \%goodlist, \@descr, 'round trip' );
	294
	295	# Write one instruction for each opcode.
	296	#
	297	for my $opcode ( 0..$#code2name ){
	298	next unless defined( $code2name[$opcode] );
	299	my $sel = $insn_data{$code2name[$opcode]}->[2];
	300	$sel =~ s/^GET_//;
	301	die( "no operand list for $sel\n" ) unless exists( $goodlist{$sel} );
	302	if( defined( $goodlist{$sel} ) ){
	303	++$lineno;
	304	if( @{$goodlist{$sel}} ){
	305	my $od = $goodlist{$sel}[0];
	306	$descr[$lineno] = "round trip: $code2name[$opcode] $od";
	307	print ASM "$code2name[$opcode] $od\n";
	308	printf "%5d %s %s\n", $lineno, $code2name[$opcode], $od if $dbg;
	309	} else {
	310	$descr[$lineno] = "round trip: $code2name[$opcode]";
	311	print ASM "$code2name[$opcode]\n";
	312	printf "%5d %s\n", $lineno, $code2name[$opcode] if $dbg;
	313	}
	314	}
	315	}
	316
	317	# Write instruction(s) for incorrect operand values each operand type class
	318	#
	319	$firstbadline = $lineno + 1;
	320	gen_type( \%badlist, \@descr, 'asm error' );
	321
	322	# invalid opcode is an odd-man-out ;-)
	323	#
	324	++$lineno;
	325	$descr[$lineno] = "asm error: Gollum";
	326	print ASM "Gollum\n";
	327	printf "%5d %s\n", $lineno, 'Gollum' if $dbg;
	328
	329	close( ASM );
	330
	331	# Now that we have defined all of our tests: plan
	332	#
	333	plan( tests => $lineno );
	334	print "firstbadline=$firstbadline\n" if $dbg;
	335
	336	# assemble (guard against warnings and death from assembly errors)
	337	#
	338	$SIG{'__WARN__'} = \&catchwarn;
	339
	340	$lineno = -1; # account for the assembly header
341	tie( *OBJ, 'VirtFile' );
342	eval { assemble_fh( \*ASM, \&putobj ); };
343	print "eval: $@" if $dbg;
344	close( ASM );
345	close( OBJ );
346	$SIG{'__WARN__'} = 'DEFAULT';
347
348	# disassemble
349	#
350	print "--- disassembling ---\n" if $dbg;
351	$lineno = 0;
352	tie( *DIS, 'VirtFile' );
353	disassemble_fh( \*OBJ, \&putdis );
354	close( OBJ );
355	close( DIS );
356
357	# get header (for debugging only)
358	#
359	if( $dbg ){
360	my( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder ) =
361	get_header();
362	printf "Magic: 0x%08x\n", $magic;
363	print "Architecture: $archname\n";
364	print "Byteloader V: $blversion\n";
365	print "ivsize: $ivsize\n";
366	print "ptrsize: $ptrsize\n";
367	print "Byteorder: $byteorder\n";
368	}
369
370	# check by comparing files line by line
371	#
372	print "--- checking ---\n" if $dbg;
373	$lineno = 0;
374	my( $asmline, $disline );
375	while( defined( $asmline = <ASM> ) ){
376	$disline = <DIS>;
377	++$lineno;
378	last if $lineno eq $firstbadline; # bail out where errors begin
379	ok( $asmline eq $disline, $descr[$lineno] );
380	printf "%5d %s\n", $lineno, $asmline if $dbg;
381	}
382	close( ASM );
383	close( DIS );
384
385	__END__