File Coverage

blib/lib/CPU/Z80/Assembler/Macro.pm
Criterion Covered Total %
statement 110 122 90.1
branch 53 68 77.9
condition 15 21 71.4
subroutine 15 15 100.0
pod 8 8 100.0
total 201 234 85.9


line stmt bran cond sub pod time code
1             # $Id$
2              
3             package CPU::Z80::Assembler::Macro;
4              
5             #------------------------------------------------------------------------------
6              
7             =head1 NAME
8              
9             CPU::Z80::Assembler::Macro - Macro pre-processor for the Z80 assembler
10              
11             =cut
12              
13             #------------------------------------------------------------------------------
14              
15 31     31   188 use strict;
  31         51  
  31         790  
16 31     31   129 use warnings;
  31         52  
  31         718  
17              
18 31     31   144 use CPU::Z80::Assembler::Parser;
  31         55  
  31         526  
19 31     31   124 use Iterator::Simple::Lookahead;
  31         51  
  31         172  
20 31     31   838 use Asm::Preproc::Token;
  31         72  
  31         178  
21              
22             our $VERSION = '2.25';
23              
24             #------------------------------------------------------------------------------
25             # Class::Struct cannot be used with Exporter
26             #use Class::Struct (
27             # name => '$', # macro name
28             # params => '@', # list of macro parameter names
29             # locals => '%', # list of macro local labels
30             # tokens => '@', # list of macro tokens
31             #);
32 21     21 1 70 sub new { my($class, %args) = @_;
33             return bless [
34             $args{name},
35             $args{params} || [],
36             $args{locals} || {},
37 21   50     264 $args{tokens} || []
      50        
      50        
38             ], $class;
39             }
40 18 50   18 1 75 sub name { defined($_[1]) ? $_[0][0] = $_[1] : $_[0][0] }
41 41 100   41 1 190 sub params { defined($_[1]) ? $_[0][1] = $_[1] : $_[0][1] }
42 38 100   38 1 177 sub locals { defined($_[1]) ? $_[0][2] = $_[1] : $_[0][2] }
43 35 100   35 1 192 sub tokens { defined($_[1]) ? $_[0][3] = $_[1] : $_[0][3] }
44              
45             #------------------------------------------------------------------------------
46              
47             =head1 SYNOPSIS
48              
49             use CPU::Z80::Assembler::Macro;
50              
51             my $macro = CPU::Z80::Assembler::Macro->new(
52             name => $name,
53             params => \@params_names,
54             locals => \%local_labels,
55             tokens => \@token_list);
56             $macro->parse_body($input);
57             $macro->expand_macro($input);
58              
59             =head1 DESCRIPTION
60              
61             This module provides a macro pre-processor to parse macro definition statements,
62             and expand macro calls in the token stream. Both the input and output streams
63             are L objects returning sequences
64             of tokens.
65              
66             The object created by new() describes one macro. It is used during the parse phase
67             to define the macro object while reading the input token stream.
68              
69             =head1 EXPORTS
70              
71             None.
72              
73             =head1 FUNCTIONS
74              
75             =head2 new
76              
77             Creates a new macro definition object, see L.
78              
79             =head2 name
80              
81             Get/set the macro name.
82              
83             =head2 params
84              
85             Get/set the formal parameter names list.
86              
87             =head2 locals
88              
89             Get/set the list of local macro labels, stored as a hash.
90              
91             =head2 tokens
92              
93             Get/set the list of tokens in the macro definition.
94              
95             =cut
96              
97             #------------------------------------------------------------------------------
98              
99             =head2 parse_body
100              
101             This method is called with the token input stream pointing at the first token
102             after the macro parameter list, i.e. the '{' or ':' or "\n" character.
103              
104             It parses the macro body, leaving the input stream after the last token of the
105             macro definition ('endm' or closing '}'), with all the "\n" characters of the
106             macro defintion pre-pended, and filling in locals() and tokens().
107              
108             =cut
109              
110             #------------------------------------------------------------------------------
111              
112             sub parse_body {
113 21     21 1 58 my($self, $input) = @_;
114 21         40 my $token;
115            
116             # skip {
117             my $opened_brace;
118 21 50       54 defined($token = $input->peek)
119             or Asm::Preproc::Token->error_at($token, "macro body not found");
120 21 100       1577 if ($token->type eq '{') {
    50          
121 20         227 $input->next;
122 20         742 $opened_brace++;
123             }
124             elsif ($token->type =~ /^[:\n]$/) {
125             # OK, macro body follows on next line
126             }
127             else {
128 0         0 $token->error("unexpected '". $token->type ."'");
129             }
130            
131             # retrieve tokens
132 21         86 my @macro_tokens;
133             my @line_tokens;
134 21         0 my %locals;
135              
136             # need to note all the labels in the macro,
137             # i.e. NAME after statement end
138 21         42 my $last_stmt_end = 1;
139              
140 21         36 my $parens = 0;
141 21         63 while (defined($token = $input->peek)) {
142 226         21536 my $type = $token->type;
143 226 50 100     2643 if ($type eq "{") {
    100          
    100          
    100          
144 0         0 $parens++;
145 0         0 push @macro_tokens, $token;
146 0         0 $input->next;
147             }
148             elsif ($type eq "endm") {
149 1 50       8 $opened_brace
150             and $token->error("expected \"}\"");
151 0         0 $input->next; # skip delimiter
152 0         0 last;
153             }
154             elsif ($type eq "}") {
155 19 50       67 if ($parens > 0) {
156 0         0 $parens--;
157 0         0 push @macro_tokens, $token;
158 0         0 $input->next;
159             }
160             else {
161 19 50       93 $input->next if $opened_brace; # skip delimiter
162 19         634 last;
163             }
164             }
165             elsif ($type eq "NAME" && $last_stmt_end) { # local label
166 8         26 $locals{$token->value}++;
167 8         105 push @macro_tokens, $token;
168 8         26 $input->next;
169             }
170             else {
171 198         358 push @macro_tokens, $token;
172 198 100       408 push @line_tokens, $token if $type eq "\n";
173             # save new-lines for listing
174 198         417 $input->next;
175             }
176 206         7460 $last_stmt_end = ($type =~ /^[:\n]$/);
177             }
178 20 100       311 defined($token)
179             or Asm::Preproc::Token->error_at($token, "macro body not finished");
180 19 50       57 ($parens == 0)
181             or $token->error("Unmatched braces");
182            
183             # prepend all seen LINE tokens in input
184 19         64 $input->unget(@line_tokens);
185            
186 19         657 $self->tokens(\@macro_tokens);
187 19         60 $self->locals(\%locals);
188             }
189              
190             #------------------------------------------------------------------------------
191              
192             =head2 expand_macro
193              
194             This method is called with the input stream pointing at the first token
195             after the macro name in a macro call. It parses the macro arguments, if any
196             and expands the macro call, inserting the expanded tokens in the input stream.
197              
198             =cut
199              
200             #------------------------------------------------------------------------------
201              
202             sub expand_macro {
203 23     23 1 55 my($self, $input) = @_;
204 23         43 our $instance++; # unique ID for local labels
205            
206 23         54 my $start_token = $input->peek; # for error messages
207 23 50       548 defined($start_token) or die; # must have at least a "\n"
208            
209 23         67 my $args = $self->parse_macro_arguments($input);
210            
211             # compute token expansion
212 16         26 my $macro_stream = Iterator::Simple::Lookahead->new(@{$self->tokens});
  16         44  
213             my $expand_stream = Iterator::Simple::Lookahead->new(
214             sub {
215 218     218   16901 for(;;) {
216 218         429 my $token = $macro_stream->next;
217 218 100       16762 defined($token) or return undef; # end of expansion
218            
219 202         425 $token = $token->clone; # make a copy
220 202         9025 $token->line($start_token->line); # set the line of invocation
221            
222 202 100       7959 if ($token->type eq 'NAME') {
223 34         305 my $name = $token->value;
224 34 100       385 if (exists $args->{$name}) {
    50          
225 15         25 my @tokens = @{$args->{$name}}; # expansion of the name
  15         40  
226 15         72 return sub {shift @tokens}; # insert a new iterator to return
  32         1848  
227             # these - $macro_stream->unget();
228             # would allow recursive expansion
229             # of arg names - not intended
230             }
231             elsif (exists $self->locals->{$name}) {
232 19         79 $token->value("_macro_".$instance."_".$name);
233 19         182 return $token;
234             }
235             else {
236 0         0 return $token;
237             }
238             }
239             else {
240 168         1495 return $token;
241             }
242             }
243 16         716 });
244            
245             # prepend the expanded stream in the input
246 16         548 $input->unget($expand_stream);
247             }
248              
249             #------------------------------------------------------------------------------
250              
251             =head2 parse_macro_arguments
252              
253             This method is called with the input stream pointing at the first token
254             after the macro name in a macro call. It parses the macro arguments, leaves
255             the input stream after the macro call, and returns an hash reference mapping
256             formal argument names to list of tokens in the actual parameters.
257              
258             The arguments are list of tokens separated by ','. An argument can be enclosed
259             in braces '{' '}' to allow ',' to be passed - the braces are not part of the argument
260             value.
261              
262             =cut
263              
264             #------------------------------------------------------------------------------
265              
266             sub parse_macro_arguments {
267 23     23 1 48 my($self, $input) = @_;
268 23         44 my %args;
269             my $token;
270            
271 23         40 my @params = @{$self->params}; # formal parameters
  23         47  
272 23         97 for (my $i = 0; $i < @params; $i++) {
273 22         342 my $param = $params[$i];
274 22         50 $token = $input->peek;
275 22 100 66     1193 defined($token) && $token->type !~ /^[:\n,]$/
276             or Asm::Preproc::Token->error_at($token,
277             "expected value for macro parameter $param");
278 20         271 my @arg = $self->_parse_argument($input);
279 19         58 $args{$param} = \@arg;
280            
281 19 100       70 if ($i != $#params) { # expect a comma
282 10         29 $token = $input->peek;
283 10 100 66     253 defined($token) && $token->type eq ','
284             or Asm::Preproc::Token->error_at($token,
285             "expected \",\" after macro parameter $param");
286 9         115 $input->next;
287             }
288             }
289            
290             # expect end of statement, keep input at end of statement marker
291 19         50 $token = $input->peek;
292 19 100 66     445 (!defined($token) || $token->type =~ /^[:\n]$/)
293             or Asm::Preproc::Token->error_at($token, "too many macro arguments");
294            
295 16         197 return \%args;
296             }
297              
298             #------------------------------------------------------------------------------
299             # @tokens = _parse_argument($input)
300             # Extract the sequence of input tokens from $input into @tokens up to and
301             # not including the delimiter token
302             sub _parse_argument {
303 20     20   46 my($class, $input) = @_;
304 20         37 my $token;
305              
306             # retrieve tokens
307             my @tokens;
308 20         31 my $parens = 0;
309 20         34 my $opened_brace;
310 20         59 while (defined($token = $input->peek)) {
311 47         3092 my $type = $token->type;
312 47 100 100     578 if ($type =~ /^[:\n,]$/ && $parens == 0) {
    100          
    100          
313 19         39 last;
314             }
315             elsif ($type eq '{') {
316 2         5 $parens++;
317 2 50       9 push(@tokens, $token) if $opened_brace++;
318 2         8 $input->next;
319             }
320             elsif ($type eq '}') {
321 1 50       5 if ($parens > 0) {
322 1         3 $parens--;
323 1 50       4 push(@tokens, $token) if --$opened_brace;
324 1         5 $input->next;
325             }
326             else {
327 0 0       0 $input->next if $opened_brace; # skip delimiter
328 0         0 last;
329             }
330             }
331             else {
332 25         50 push(@tokens, $token);
333 25         57 $input->next;
334             }
335             }
336 20 100       295 Asm::Preproc::Token->error_at($token, "unmatched braces")
337             if $parens != 0;
338              
339 19         56 return @tokens;
340             }
341              
342             #------------------------------------------------------------------------------
343              
344             =head1 SYNTAX
345              
346             =head2 Macros
347              
348             Macros are created thus. This example creates an "instruction" called MAGIC
349             that takes two parameters:
350              
351             MACRO MAGIC param1, param2 {
352             LD param1, 0
353             BIT param2, L
354             label = 0x1234
355             ... more real instructions go here.
356             }
357              
358             Within the macro, param1, param2 etc will be replaced with whatever
359             parameters you pass to the macro. So, for example, this:
360              
361             MAGIC HL, 2
362              
363             Is the same as:
364              
365             LD HL, 0
366             BIT 2, L
367             ...
368              
369             Any labels that you define inside a macro are local to that macro. Actually
370             they're not but they get renamed to _macro_NN_... so that they
371             effectively *are* local.
372              
373             There is an alternative syntax, for compatibility with other assemblers, with exactly the
374             same effect.
375              
376             MACRO MAGIC param1, param2
377             LD param1, 0
378             BIT param2, L
379             label = 0x1234
380             ... more real instructions go here.
381             ENDM
382              
383             A ',' can be passed as part of a macro argument, by enclosing the arguments between {braces}.
384              
385             MACRO PAIR x {
386             LD x
387             }
388             PAIR {A,B}
389              
390             expands to:
391              
392             LD A,B
393              
394             =head1 BUGS and FEEDBACK
395              
396             See L.
397              
398             =head1 SEE ALSO
399              
400             L
401             L
402              
403             =head1 AUTHORS, COPYRIGHT and LICENCE
404              
405             See L.
406              
407             =cut
408              
409             #------------------------------------------------------------------------------
410              
411             1;