1# $Id$ 2 3package CPU::Z80::Assembler::List; 4 5#------------------------------------------------------------------------------ 6 7=head1 NAME 8 9CPU::Z80::Assembler::List - Assembly listing output class 10 11=cut 12 13#------------------------------------------------------------------------------ 14 15use strict; 16use warnings; 17 18use Text::Tabs; 19use Iterator::Simple::Lookahead; 20use CPU::Z80::Assembler; 21 22our $VERSION = '2.18'; 23 24use Class::Struct ( 25 output => '$', # output file handle for the list 26 input => '$', # input lines or iterators passed to z80asm 27 28 _line_stream => '$', # input line stream with whole program 29 _address => '$', # output address 30 31 _current_line => '$', # line of the current opcode(s) 32 _current_address => '$', # address of the current opcode(s) 33 _current_bytes => '$', # all bytes of all opcodes of _current_line 34); 35 36#------------------------------------------------------------------------------ 37 38=head1 SYNOPSIS 39 40 use CPU::Z80::Assembler::List; 41 my $lst = CPU::Z80::Assembler::List->new(input => $asm_input, output => \*STDOUT); 42 $lst->add($line, $address, $bytes); 43 $lst->flush(); 44 45=head1 DESCRIPTION 46 47This module handles the output of the assembly listing file. 48It is fead with each assembled opcode and generates the full 49assembly list file on the given output handle. 50 51If output is undef, does not generate any output. 52 53=head1 EXPORTS 54 55Nothing. 56 57=head1 FUNCTIONS 58 59=head2 new 60 61 my $lst = CPU::Z80::Assembler::List->new(input => $asm_input, output => \*STDOUT); 62 63Creates a new object, see L<Class::Struct|Class::Struct>. 64 65=head2 input 66 67input is the input as passed to z80asm, i.e. list of text lines to parse or iterators 68that return text lines to parse. 69 70=head2 output 71 72output is the output file handle to receive the listing file. It can be an open 73file for writing, or one of the standard output file handles. 74 75If output is undefined, no output is generated. 76 77=cut 78 79#------------------------------------------------------------------------------ 80 81=head2 add 82 83 $self->add($line, $address, $bytes); 84 85Adds a new opcode to the output listing. Receives the opcode L<Asm::Preproc::Line|Asm::Preproc::Line>, 86address and bytes. Generates the output lines including this new opcode. 87 88The output is held in an internal buffer until an opcode for the next line is passed to a 89subsequent add() call. 90 91The last output line 92is only output on flush() or DESTROY() 93 94=cut 95 96#------------------------------------------------------------------------------ 97 98sub add { my($self, $opcode_line, $address, $bytes) = @_; 99 my $output = $self->output; 100 if ($output) { 101 if ($self->_current_line && $self->_current_line != $opcode_line) { 102 $self->flush(); # different line 103 } 104 105 if (! $self->_current_line) { # new or different line 106 $self->_current_line($opcode_line); 107 $self->_current_address($address); 108 $self->_current_bytes($bytes); 109 } 110 else { # same line as last 111 $self->_current_bytes($self->_current_bytes . $bytes); 112 } 113 } 114} 115 116#------------------------------------------------------------------------------ 117 118=head2 flush 119 120 $self->flush(); 121 122Dumps the current line to the output. Called on DESTROY(). 123 124=cut 125 126#------------------------------------------------------------------------------ 127 128sub flush { my($self) = @_; 129 my $output = $self->output; 130 if ($output && $self->_current_line) { 131 132 # print all input lines up to the current position 133 my $rewind_count; 134 my $line; 135 for (;;) { 136 while (! defined($self->_line_stream) || 137 ! defined($line = $self->_line_stream->next)) { 138 $rewind_count++; # end of input, rewind 139 die "Cannot find $line in list" if $rewind_count > 1; 140 # assert input is OK 141 $self->_line_stream(CPU::Z80::Assembler::z80preprocessor( 142 @{$self->input})); 143 } 144 145 last if $line == $self->_current_line; # found current line 146 print $output $self->_format_line($self->_address, $line), "\n"; 147 } 148 149 print $output $self->_format_line($self->_current_address, $self->_current_line); 150 for (split(//, $self->_current_bytes)) { 151 print $output sprintf("%02X ", ord($_)); 152 } 153 print $output "\n"; 154 155 $self->_address($self->_current_address); 156 $self->_current_line(undef); 157 $self->_current_address(undef); 158 $self->_current_bytes(undef); 159 } 160} 161 162sub DESTROY { my($self) = @_; 163 $self->flush(); 164} 165 166#------------------------------------------------------------------------------ 167 168sub _format_line { my($self, $address, $line) = @_; 169 $address ||= 0; 170 my $text = $line->text; 171 $text = expand($text); # untabify 172 $text =~ s/\s+$//; 173 substr($text, 34) = ' ...' if(length($text) > 37); 174 return sprintf("0x%04X: %-38s | ", $address, $text); 175} 176