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