?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
struct / union in initializer, RFE #901.
[sdcc.git] / sdcc / support / scripts / z80-disasm.pl
blobb6d446bf0ed64ee963a9c848ad9d38b0a5e85b3d
1 #!/usr/bin/perl -w
2
3 =back
4
5 Copyright (C) 2013-2016, Molnar Karoly <molnarkaroly@users.sf.net>
6
7 This software is provided 'as-is', without any express or implied
8 warranty. In no event will the authors be held liable for any damages
9 arising from the use of this software.
10
11 Permission is granted to anyone to use this software for any purpose,
12 including commercial applications, and to alter it and redistribute it
13 freely, subject to the following restrictions:
14
15 1. The origin of this software must not be misrepresented; you must not
16 claim that you wrote the original software. If you use this software
17 in a product, an acknowledgment in the product documentation would be
18 appreciated but is not required.
19
20 2. Altered source versions must be plainly marked as such, and must not be
21 misrepresented as being the original software.
22
23 3. This notice may not be removed or altered from any source distribution.
24
25 ================================================================================
26
27 This program disassembles the hex files. It assumes that the hex file
28 contains Z80 instructions.
29
30 Proposal for use: ./z80-disasm.pl program.hex > program.dasm
31
32 $Id$
33 =cut
34
35 use strict;
36 use warnings;
37 no if $] >= 5.018, warnings => "experimental::smartmatch"; # perl 5.16
38 use 5.12.0; # when (regex)
39
40 use constant FALSE => 0;
41 use constant TRUE => 1;
42
43 use constant TAB_LENGTH => 8;
44
45 ################################################################################
46
47 use constant INHX8M => 0;
48 use constant INHX32 => 2;
49
50 use constant INHX_DATA_REC => 0;
51 use constant INHX_EOF_REC => 1;
52 use constant INHX_EXT_LIN_ADDR_REC => 4;
53
54 use constant EMPTY => -1;
55
56 use constant COUNT_SIZE => 2;
57 use constant ADDR_SIZE => 4;
58 use constant TYPE_SIZE => 2;
59 use constant BYTE_SIZE => 2;
60 use constant CRC_SIZE => 2;
61 use constant HEADER_SIZE => (COUNT_SIZE + ADDR_SIZE + TYPE_SIZE);
62 use constant MIN_LINE_LENGTH => (HEADER_SIZE + CRC_SIZE);
63
64 use constant Z80_ROM_SIZE => 0x10000;
65
66 ################################################################################
67
68 my $PROGRAM = 'z80-disasm.pl';
69
70 my $border0 = ('-' x 99);
71 my $border1 = ('#' x 99);
72 my $border2 = ('.' x 39);
73
74 my @default_paths =
75 (
76 '/usr/share/sdcc/include/z180',
77 '/usr/local/share/sdcc/include/z180'
78 );
79
80 my $default_include_path = '';
81 my $include_path = '';
82 my $hex_file = '';
83 my $map_file = '';
84 my $map_readed = FALSE;
85 my $header_file = '';
86 my $name_list = '';
87
88 my $verbose = 0;
89 my $gen_assembly_code = FALSE;
90 my $no_explanations = FALSE;
91 my $find_lost_labels = FALSE;
92
93 my @rom = ();
94 my $rom_size = Z80_ROM_SIZE;
95 my %const_areas_by_address = (); # From the command line parameters.
96
97 my %const_blocks_by_address = ();
98
99 my %ram_blocks_by_address = ();
100 my %ram_names_by_address = ();
101
102 =back
103 The structure of one element of the %io_by_address hash:
104
105 {
106 NAME => '',
107 REF_COUNT => 0
108 }
109 =cut
110
111 my %io_by_address = ();
112
113 # Sizes of the instructions.
114
115 use constant IPREFIX_DD => -1;
116 use constant IPREFIX_ED => -2;
117 use constant IPREFIX_FD => -3;
118
119 my @instruction_sizes_ =
120 (
121 # 0 1 2 3 4 5 6 7 8 9 A B C D E F
122
123 1, 3, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, # 00
124 2, 3, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 2, 1, # 10
125 2, 3, 3, 1, 1, 1, 2, 1, 2, 1, 3, 1, 1, 1, 2, 1, # 20
126 2, 3, 3, 1, 1, 1, 2, 1, 2, 1, 3, 1, 1, 1, 2, 1, # 30
127 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 40
128 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 50
129 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 60
130 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 70
131 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 80
132 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 90
133 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # A0
134 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # B0
135 1, 1, 3, 3, 3, 1, 2, 1, 1, 1, 3, 2, 3, 3, 2, 1, # C0
136 1, 1, 3, 2, 3, 1, 2, 1, 1, 1, 3, 2, 3,IPREFIX_DD, 2, 1, # D0 -1: DD
137 1, 1, 3, 1, 3, 1, 2, 1, 1, 1, 3, 1, 3,IPREFIX_ED, 2, 1, # E0 -2: ED
138 1, 1, 3, 1, 3, 1, 2, 1, 1, 1, 3, 1, 3,IPREFIX_FD, 2, 1 # F0 -3: FD
139 );
140
141 my @instruction_sizes_DDFD =
142 (
143 # 0 1 2 3 4 5 6 7 8 9 A B C D E F
144
145 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, # 00
146 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, # 10
147 0, 4, 4, 2, 2, 2, 3, 0, 0, 2, 4, 2, 2, 2, 3, 0, # 20
148 0, 0, 0, 0, 3, 3, 4, 0, 0, 2, 0, 0, 0, 0, 0, 0, # 30
149 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # 40
150 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # 50
151 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, 2, 2, 3, 2, # 60
152 3, 3, 3, 3, 3, 3, 0, 3, 0, 0, 0, 0, 2, 2, 3, 0, # 70
153 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # 80
154 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # 90
155 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # A0
156 0, 0, 0, 0, 2, 2, 3, 0, 0, 0, 0, 0, 2, 2, 3, 0, # B0
157 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, # C0 4: CB
158 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # D0
159 0, 2, 0, 2, 0, 2, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, # E0
160 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0 # F0
161 );
162
163 my @instruction_sizes_ED =
164 (
165 # 0 1 2 3 4 5 6 7 8 9 A B C D E F
166
167 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 00
168 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 10
169 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 20
170 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 30
171 2, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2, 2, 2, # 40
172 2, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2, 2, 2, # 50
173 2, 2, 2, 4, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2, 2, 2, # 60
174 2, 2, 2, 4, 2, 2, 2, 0, 2, 2, 2, 4, 2, 2, 2, 0, # 70
175 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 80
176 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 90
177 2, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, # A0
178 2, 2, 2, 2, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, # B0
179 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # C0
180 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # D0
181 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # E0
182 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 # F0
183 );
184
185 my $prev_is_jump;
186
187 use constant SILENT0 => 0;
188 use constant SILENT1 => 1;
189
190 my $decoder_silent_level;
191
192 use constant RAM_ALIGN_SIZE => 3;
193 use constant EXPL_ALIGN_SIZE => 5;
194 use constant STAT_ALIGN_SIZE => 6;
195 use constant TBL_COLUMNS => 8;
196
197 =back
198 The structure of one element of the %blocks_by_address hash:
199
200 {
201 TYPE => 0,
202 ADDR => 0,
203 SIZE => 0,
204 LABEL => {
205 TYPE => 0,
206 NAME => '',
207 PRINTED => FALSE,
208 CALL_COUNT => 0,
209 JUMP_COUNT => 0
210 },
211 REF_COUNT => 0
212 }
213 =cut
214
215 use constant BLOCK_INSTR => 0;
216 use constant BLOCK_RAM => 1;
217 use constant BLOCK_CONST => 2;
218 use constant BLOCK_EMPTY => 3;
219
220 use constant BL_TYPE_NONE => -1;
221 use constant BL_TYPE_SUB => 0;
222 use constant BL_TYPE_LABEL => 1;
223 use constant BL_TYPE_JTABLE => 2;
224 use constant BL_TYPE_VARIABLE => 3;
225 use constant BL_TYPE_CONST => 4;
226
227 my %label_names =
228 (
229 eval BL_TYPE_SUB => 'Function_',
230 eval BL_TYPE_LABEL => 'Label_',
231 eval BL_TYPE_JTABLE => 'Jumptable_',
232 eval BL_TYPE_VARIABLE => 'Variable_',
233 eval BL_TYPE_CONST => 'Constant_'
234 );
235
236 my %empty_blocks_by_address = ();
237 my %blocks_by_address = ();
238 my %labels_by_address = ();
239 my $max_label_addr = 0;
240
241 my %interrupts_by_address =
242 (
243 0x0000 => 'System_init',
244 0x0008 => 'Interrupt_08',
245 0x0010 => 'Interrupt_10',
246 0x0018 => 'Interrupt_18',
247 0x0020 => 'Interrupt_20',
248 0x0028 => 'Interrupt_28',
249 0x0030 => 'Interrupt_30',
250 0x0038 => 'Interrupt_38'
251 );
252
253 my %control_characters =
254 (
255 0x00 => '\0',
256 0x07 => '\a',
257 0x08 => '\b',
258 0x09 => '\t',
259 0x0A => '\n',
260 0x0C => '\f',
261 0x0D => '\r',
262 0x1B => '\e',
263 0x7F => '^?'
264 );
265
266 use constant INST_LD_HL => 0x21;
267 use constant INST_ADD_HL_DE => 0x19;
268 use constant INST_JP => 0xC3;
269 use constant INST_JP_HL => 0xE9;
270 use constant INST_JP_CC => 0xC2; # mask: 0xC7
271 use constant INST_JR => 0x18;
272 use constant INST_JR_CC => 0x20; # mask: 0xE7
273 use constant INST_DJNZ => 0x10;
274 use constant INST_CALL => 0xCD;
275 use constant INST_CALL_CC => 0xC4; # mask: 0xC7
276 use constant INST_RET => 0xC9;
277 use constant INST_RETI => 0x4D; # with 0xED prefix
278 use constant INST_RETN => 0x45; # with 0xED prefix
279
280 my $dcd_address = 0;
281 my $dcd_instr_size = 0;
282 my $dcd_instr = 0;
283 my $dcd_instr_x = 0;
284 my $dcd_instr_y = 0;
285 my $dcd_instr_z = 0;
286 my $dcd_instr_p = 0;
287 my $dcd_instr_q = 0;
288 my $dcd_parm0 = 0;
289 my $dcd_parm1 = 0;
290 my $dcd_parm2 = 0;
291
292 my $table_header = '';
293 my $table_border = '';
294
295 ################################################################################
296 ################################################################################
297
298 my %pp_defines = (); # Value of definitions.
299
300 my @pp_conditions = ();
301 my @pp_else_conditions = ();
302 my $pp_level = 0; # Shows the lowest level.
303 my $embed_level;
304
305 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
306 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
307 #@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@
308 #@@@@@@@@@@@@@@@@@@@@@@@ This a simple preprocessor. @@@@@@@@@@@@@@@@@@@@@@@@@
309 #@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@
310 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
311 # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
312
313 # Examines that the parameter is defined or not defined.
314
315 sub _defined($)
316 {
317 return defined($pp_defines{$_[0]});
318 }
319
320 #-------------------------------------------------------------------------------
321
322 # Records a definition.
323
324 sub define($)
325 {
326 my ($Name) = ($_[0] =~ /^(\S+)/op);
327 my $Body = ${^POSTMATCH};
328
329 $Body =~ s/^\s+//o;
330
331 die "define(): This definition already exists: \"$Name\"\n" if (_defined($Name));
332
333 # The definition is in fact unnecessary.
334 $pp_defines{$Name} = $Body;
335 }
336
337 #-------------------------------------------------------------------------------
338
339 # Delete a definition.
340
341 sub undefine($)
342 {
343 delete($pp_defines{$_[0]});
344 }
345
346 #-------------------------------------------------------------------------------
347
348 # Evaluation of the #if give a boolean value. This procedure preserves it.
349
350 sub if_condition($)
351 {
352 my $Val = $_[0];
353
354 push(@pp_conditions, $Val);
355 push(@pp_else_conditions, $Val);
356 ++$pp_level;
357 }
358
359 #-------------------------------------------------------------------------------
360
361 # Evaluation of the #else give a boolean value. This procedure preserves it.
362
363 sub else_condition($$)
364 {
365 my ($File, $Line_number) = @_;
366
367 die "else_condition(): The ${Line_number}th line of $File there is a #else, but does not belong him #if.\n" if ($pp_level <= 0);
368
369 my $last = $#pp_conditions;
370
371 if ($last > 0 && $pp_conditions[$last - 1])
372 {
373 $pp_conditions[$last] = ($pp_else_conditions[$#pp_else_conditions]) ? FALSE : TRUE;
374 }
375 else
376 {
377 $pp_conditions[$last] = FALSE;
378 }
379 }
380
381 #-------------------------------------------------------------------------------
382
383 # Closes a logical unit which starts with a #if.
384
385 sub endif_condition($$)
386 {
387 my ($File, $Line_number) = @_;
388
389 die "endif_condition(): The ${Line_number}th line of $File there is a #endif, but does not belong him #if.\n" if ($pp_level <= 0);
390
391 pop(@pp_conditions);
392 pop(@pp_else_conditions);
393 --$pp_level;
394 }
395
396 #-------------------------------------------------------------------------------
397
398 sub reset_preprocessor()
399 {
400 %pp_defines = ();
401 @pp_conditions = ();
402 push(@pp_conditions, TRUE);
403 @pp_else_conditions = ();
404 push(@pp_else_conditions, FALSE);
405 $pp_level = 0;
406 }
407
408 #-------------------------------------------------------------------------------
409
410 # This the preprocessor.
411
412 sub run_preprocessor($$$$)
413 {
414 my ($Fname, $Function, $Line, $Line_number) = @_;
415
416 if ($Line =~ /^#\s*ifdef\s+(\S+)$/o)
417 {
418 if ($pp_conditions[$#pp_conditions])
419 {
420 # The ancestor is valid, therefore it should be determined that
421 # the descendants what kind.
422
423 if_condition(_defined($1));
424 }
425 else
426 {
427 # The ancestor is invalid, so the descendants will invalid also.
428
429 if_condition(FALSE);
430 }
431 }
432 elsif ($Line =~ /^#\s*ifndef\s+(\S+)$/o)
433 {
434 if ($pp_conditions[$#pp_conditions])
435 {
436 # The ancestor is valid, therefore it should be determined that
437 # the descendants what kind.
438
439 if_condition(! _defined($1));
440 }
441 else
442 {
443 # The ancestor is invalid, so the descendants will invalid also.
444
445 if_condition(FALSE);
446 }
447 }
448 elsif ($Line =~ /^#\s*else/o)
449 {
450 else_condition($Fname, $Line_number);
451 }
452 elsif ($Line =~ /^#\s*endif/o)
453 {
454 endif_condition($Fname, $Line_number);
455 }
456 elsif ($Line =~ /^#\s*define\s+(.+)$/o)
457 {
458 # This level is valid, so it should be recorded in the definition.
459
460 define($1) if ($pp_conditions[$#pp_conditions]);
461 }
462 elsif ($Line =~ /^#\s*undef\s+(.+)$/o)
463 {
464 # This level is valid, so it should be deleted in the definition.
465
466 undefine($1) if ($pp_conditions[$#pp_conditions]);
467 }
468 elsif ($pp_conditions[$#pp_conditions])
469 {
470 # This is a valid line. (The whole magic is in fact therefore there is.)
471
472 $Function->($Line);
473 }
474 }
475
476 ################################################################################
477 ################################################################################
478 ################################################################################
479
480 sub basename($)
481 {
482 return ($_[0] =~ /([^\/]+)$/) ? $1 : '';
483 }
484
485 #-------------------------------------------------------------------------------
486
487 sub param_exist($$)
488 {
489 die "This option \"$_[0]\" requires a parameter.\n" if ($_[1] > $#ARGV);
490 }
491
492 #-------------------------------------------------------------------------------
493
494 sub Log
495 {
496 return if (pop(@_) > $verbose);
497 foreach (@_) { print STDERR $_; }
498 print STDERR "\n";
499 }
500
501 #-------------------------------------------------------------------------------
502
503 sub str2int($)
504 {
505 my $Str = $_[0];
506
507 return hex($1) if ($Str =~ /^0x([[:xdigit:]]+)$/io);
508 return int($Str) if ($Str =~ /^-?\d+$/o);
509
510 die "str2int(): This string not integer: \"$Str\"";
511 }
512
513 #-------------------------------------------------------------------------------
514
515 #
516 # Before print, formats the $Text.
517 #
518
519 sub align($$)
520 {
521 my ($Text, $Tab_count) = @_;
522 my ($al, $ct);
523
524 $ct = $Text;
525 1 while $ct =~ s/\t/' ' x (TAB_LENGTH - ($-[0] % TAB_LENGTH))/e;
526 $al = $Tab_count - (int(length($ct) / TAB_LENGTH));
527
528 # One space will surely becomes behind it.
529 if ($al < 1)
530 {
531 return "$Text ";
532 }
533 else
534 {
535 return ($Text . ("\t" x $al));
536 }
537 }
538
539 #-------------------------------------------------------------------------------
540
541 #
542 # Multiple file test.
543 #
544
545 sub is_file_ok($)
546 {
547 my $File = $_[0];
548
549 if (! -e $File)
550 {
551 print STDERR "$PROGRAM: Not exists -> \"$File\"\n";
552 exit(1);
553 }
554
555 if (! -f $File)
556 {
557 print STDERR "$PROGRAM: Not file -> \"$File\"\n";
558 exit(1);
559 }
560
561 if (! -r $File)
562 {
563 print STDERR "$PROGRAM: Can not read -> \"$File\"\n";
564 exit(1);
565 }
566
567 if (! -s $File)
568 {
569 print STDERR "$PROGRAM: Empty file -> \"$File\"\n";
570 exit(1);
571 }
572 }
573
574 #-------------------------------------------------------------------------------
575
576 #
577 # Initializes the @rom array.
578 #
579
580 sub init_mem($$)
581 {
582 my ($Start, $End) = @_;
583
584 @rom[$Start .. $End] = ((EMPTY) x ($End - $Start + 1));
585 }
586
587 #-------------------------------------------------------------------------------
588
589 #
590 # Store values of the $Code to $AddrRef address.
591 #
592
593 sub store_code($$)
594 {
595 my ($Code, $AddrRef) = @_;
596
597 if ($$AddrRef >= $rom_size)
598 {
599 printf STDERR "Warning, this address (0x%04X) outside the code area (0x%04X)!\n", $$AddrRef, $rom_size - 1;
600 }
601
602 Log(sprintf("rom[0x%08X] = 0x%02X", $$AddrRef, $Code), 9);
603 $rom[$$AddrRef++] = $Code;
604 }
605
606 #-------------------------------------------------------------------------------
607
608 #
609 # Reads contents of the $Hex.
610 #
611
612 sub read_hex($)
613 {
614 my $Hex = $_[0];
615 my $addr_H = 0;
616 my $format = INHX32;
617 my $line_num = 0;
618
619 if (! open(IN, '<', $Hex))
620 {
621 print STDERR "$PROGRAM : Could not open. -> \"$Hex\"\n";
622 exit(1);
623 }
624
625 while (<IN>)
626 {
627 chomp;
628 s/\r$//o;
629 ++$line_num;
630
631 my $len = length() - 1;
632
633 if ($len < MIN_LINE_LENGTH)
634 {
635 close(IN);
636 print STDERR "$PROGRAM: ${line_num}th line <- Shorter than %u character.\n", MIN_LINE_LENGTH;
637 exit(1);
638 }
639
640 Log("$..(1) (\"$_\") length() = " . length(), 7);
641
642 my $bytecount = int(($len - MIN_LINE_LENGTH) / BYTE_SIZE);
643
644 my $binrec = pack('H*', substr($_, 1));
645
646 if (unpack('%8C*', $binrec) != 0)
647 {
648 close(IN);
649 print STDERR "$PROGRAM: $Hex <- Crc error. (${line_num}th line \"$_\").\n";
650 exit(1);
651 }
652
653 my ($count, $addr, $type, $bytes) = unpack('CnCX4Cx3/a', $binrec);
654
655 my @codes = unpack('C*', $bytes);
656
657 Log(sprintf("$..(2) (\"$_\") count = $count, bytecount = $bytecount, addr = 0x%04X, type = $type", $addr), 7);
658
659 if ($type == INHX_EOF_REC)
660 {
661 last;
662 }
663 elsif ($type == INHX_EXT_LIN_ADDR_REC)
664 {
665 $addr_H = unpack('n', $bytes); # big-endian
666
667 Log(sprintf("$..(3) (\"$_\") addr_H = 0x%04X\n", $addr_H), 7);
668
669 $format = INHX32;
670 Log('format = INHX32', 7);
671 next;
672 }
673 elsif ($type != INHX_DATA_REC)
674 {
675 close(IN);
676 printf STDERR "$PROGRAM: $Hex <- Unknown type of record: 0x%02X (${line_num}th line \"$_\").\n", $type;
677 exit(1);
678 }
679
680 if ($bytecount == $count) # INHX32
681 {
682 if ($format == INHX8M)
683 {
684 close(IN);
685 print STDERR "$PROGRAM: $Hex <- Mixed format of file (${line_num}th line \"$_\").\n";
686 exit(1);
687 }
688
689 my $addr32 = ($addr_H << 16) | $addr;
690
691 map { store_code($_, \$addr32) } @codes;
692 }
693 elsif ($bytecount == ($count * BYTE_SIZE)) # INHX8M
694 {
695 if ($format == INHX32)
696 {
697 close(IN);
698 print STDERR "$PROGRAM: $Hex <- Mixed format of file (${line_num}th line \"$_\").\n";
699 exit(1);
700 }
701
702 map { store_code($_, \$addr) } @codes;
703 }
704 else
705 {
706 close(IN);
707 print STDERR "$PROGRAM: $Hex <- Wrong format of file (${line_num}th line \"$_\").\n";
708 exit(1);
709 }
710 } # while (<IN>)
711
712 close(IN);
713 }
714
715 #-------------------------------------------------------------------------------
716
717 #
718 # Determines that the $Address belongs to a constant.
719 #
720
721 sub is_constant($)
722 {
723 my $Address = $_[0];
724
725 foreach (sort {$a <=> $b} keys(%const_areas_by_address))
726 {
727 return TRUE if ($_ <= $Address && $Address <= $const_areas_by_address{$_});
728 last if ($_ > $Address);
729 }
730
731 foreach (sort {$a <=> $b} keys(%const_blocks_by_address))
732 {
733 return TRUE if ($_ <= $Address && $Address <= $const_blocks_by_address{$_});
734 last if ($_ > $Address);
735 }
736
737 return FALSE;
738 }
739
740 #-------------------------------------------------------------------------------
741
742 #
743 # Determines that the $Address belongs to a empty area.
744 #
745
746 sub is_empty($)
747 {
748 my $Address = $_[0];
749
750 foreach (sort {$a <=> $b} keys(%empty_blocks_by_address))
751 {
752 return TRUE if ($_ <= $Address && $Address <= $empty_blocks_by_address{$_});
753 last if ($_ > $Address);
754 }
755
756 return FALSE;
757 }
758
759 #-------------------------------------------------------------------------------
760
761 #
762 # Creates a const block.
763 #
764
765 sub add_const_area($$)
766 {
767 $const_areas_by_address{$_[0]} = $_[1];
768 }
769
770 #-------------------------------------------------------------------------------
771
772 #
773 # Creates a new block, or modifies one.
774 #
775
776 sub add_block($$$$$)
777 {
778 my ($Address, $Type, $Size, $LabelType, $LabelName) = @_;
779 my ($block, $label, $end);
780
781 $end = $Address + $Size - 1;
782
783 if (! defined($blocks_by_address{$Address}))
784 {
785 $label = {
786 TYPE => $LabelType,
787 NAME => $LabelName,
788 PRINTED => FALSE,
789 CALL_COUNT => 0,
790 JUMP_COUNT => 0
791 };
792
793 $blocks_by_address{$Address} = {
794 TYPE => $Type,
795 ADDR => $Address,
796 SIZE => $Size,
797 LABEL => $label,
798 REF_COUNT => 0
799 };
800
801 given ($Type)
802 {
803 when (BLOCK_INSTR)
804 {
805 if ($LabelType != BL_TYPE_NONE)
806 {
807 $labels_by_address{$Address} = $label;
808 $max_label_addr = $Address if ($max_label_addr < $Address);
809 }
810 }
811
812 when (BLOCK_RAM)
813 {
814 if ($LabelType != BL_TYPE_NONE)
815 {
816 $labels_by_address{$Address} = $label;
817 $max_label_addr = $Address if ($max_label_addr < $Address);
818 }
819
820 $ram_blocks_by_address{$Address} = $end if ($Size > 0);
821 }
822
823 when (BLOCK_CONST)
824 {
825 if ($LabelType != BL_TYPE_NONE)
826 {
827 $labels_by_address{$Address} = $label;
828 $max_label_addr = $Address if ($max_label_addr < $Address);
829 }
830
831 $const_blocks_by_address{$Address} = $end if ($Size > 0);
832 }
833
834 when (BLOCK_EMPTY)
835 {
836 # At empty area, can not be label.
837
838 $label->{TYPE} = BL_TYPE_NONE;
839 $label->{NAME} = '';
840 $empty_blocks_by_address{$Address} = $end if ($Size > 0);
841 }
842
843 default
844 {
845 printf STDERR "add_block(0x%04X): Unknown block type!\n", $Address;
846 exit(1);
847 }
848 } # given ($Type)
849 } # if (! defined($blocks_by_address{$Address}))
850 else
851 {
852 $block = $blocks_by_address{$Address};
853 $label = $block->{LABEL};
854 $block->{TYPE} = $Type;
855 $block->{SIZE} = $Size if ($Size > 0);
856 $label->{NAME} = $LabelName if ($label->{NAME} eq '' && $LabelName ne '');
857
858 given ($Type)
859 {
860 when (BLOCK_INSTR)
861 {
862 if ($LabelType != BL_TYPE_NONE)
863 {
864 $label->{TYPE} = $LabelType;
865 $labels_by_address{$Address} = $label;
866 $max_label_addr = $Address if ($max_label_addr < $Address);
867 }
868 }
869
870 when (BLOCK_RAM)
871 {
872 if ($LabelType != BL_TYPE_NONE)
873 {
874 $label->{TYPE} = $LabelType;
875 $labels_by_address{$Address} = $label;
876 $max_label_addr = $Address if ($max_label_addr < $Address);
877 }
878
879 $ram_blocks_by_address{$Address} = $end if ($Size > 0);
880 }
881
882 when (BLOCK_CONST)
883 {
884 if ($LabelType != BL_TYPE_NONE)
885 {
886 $label->{TYPE} = $LabelType;
887 $labels_by_address{$Address} = $label;
888 $max_label_addr = $Address if ($max_label_addr < $Address);
889 }
890
891 $const_blocks_by_address{$Address} = $end if ($Size > 0);
892 }
893
894 when (BLOCK_EMPTY)
895 {
896 # At empty area, can not be label.
897
898 $label->{TYPE} = BL_TYPE_NONE;
899 $label->{NAME} = '';
900 $empty_blocks_by_address{$Address} = $end if ($Size > 0);
901 }
902 } # given ($Type)
903 }
904
905 return $label;
906 }
907
908 #-------------------------------------------------------------------------------
909
910 #
911 # Store address entry of a procedure.
912 #
913
914 sub add_func_label($$$)
915 {
916 my ($Address, $Name, $Map_mode) = @_;
917 my $label;
918
919 if ($Address < 0)
920 {
921 Log(sprintf("add_func_label(): This address (0x%04X) negative!", $Address), 2);
922 return;
923 }
924
925 if (! $Map_mode)
926 {
927 if (! defined($blocks_by_address{$Address}))
928 {
929 Log(sprintf("add_func_label(): This address (0x%04X) does not shows an instruction!", $Address), 2);
930 return;
931 }
932 }
933
934 if (is_constant($Address) || is_empty($Address))
935 {
936 Log(sprintf("add_func_label(): This address (0x%04X) outside the code area!", $Address), 2);
937 return;
938 }
939
940 $label = add_block($Address, BLOCK_INSTR, 0, BL_TYPE_SUB, $Name);
941
942 if (! $Map_mode)
943 {
944 ++$label->{CALL_COUNT};
945 ++$blocks_by_address{$Address}->{REF_COUNT};
946 }
947 }
948
949 #-------------------------------------------------------------------------------
950
951 #
952 # Store a label.
953 #
954
955 sub add_jump_label($$$$$)
956 {
957 my ($TargetAddr, $Name, $Type, $SourceAddr, $Map_mode) = @_;
958 my ($label, $type);
959
960 if ($TargetAddr < 0)
961 {
962 Log(sprintf("add_jump_label(): This address (0x%04X) negative!", $TargetAddr), 2);
963 return;
964 }
965
966 if (! $Map_mode)
967 {
968 if (! defined($blocks_by_address{$TargetAddr}))
969 {
970 Log(sprintf("add_jump_label(): This address (0x%04X) does not shows an instruction!", $TargetAddr), 2);
971 return;
972 }
973 }
974
975 if (is_constant($TargetAddr) || is_empty($TargetAddr))
976 {
977 Log(sprintf("add_jump_label(): This address (0x%04X) outside the code area!", $TargetAddr), 2);
978 return;
979 }
980
981 if (defined($interrupts_by_address{$SourceAddr}))
982 {
983 $Type = BL_TYPE_SUB;
984 $Name = $interrupts_by_address{$SourceAddr} if ($Name eq '');
985 }
986
987 $label = add_block($TargetAddr, BLOCK_INSTR, 0, $Type, $Name);
988
989 if (! $Map_mode)
990 {
991 ++$label->{JUMP_COUNT};
992 ++$blocks_by_address{$TargetAddr}->{REF_COUNT};
993 }
994 }
995
996 #-------------------------------------------------------------------------------
997
998 #
999 # Store a variable name.
1000 #
1001
1002 sub add_ram($$$)
1003 {
1004 my ($Address, $Name, $Map_mode) = @_;
1005
1006 return if ($Address == EMPTY);
1007
1008 if ($Address < 0)
1009 {
1010 Log(sprintf("add_ram(): This address (0x%04X) negative!", $Address), 2);
1011 return;
1012 }
1013
1014 add_block($Address, BLOCK_RAM, 1, BL_TYPE_VARIABLE, $Name);
1015
1016 ++$blocks_by_address{$Address}->{REF_COUNT} if (! $Map_mode);
1017 }
1018
1019 #-------------------------------------------------------------------------------
1020
1021 #
1022 # Store a I/O port name.
1023 #
1024
1025 sub add_io($$$)
1026 {
1027 my ($Address, $Name, $Map_mode) = @_;
1028 my $io;
1029
1030 return if ($Address == EMPTY);
1031
1032 if (! defined($io = $io_by_address{$Address}))
1033 {
1034 $io_by_address{$Address} = {
1035 NAME => $Name,
1036 REF_COUNT => ($Map_mode) ? 0 : 1
1037 };
1038 }
1039 else
1040 {
1041 ++$io->{REF_COUNT} if (! $Map_mode);
1042 }
1043 }
1044
1045 ################################################################################
1046 ################################################################################
1047
1048 use constant MAP_NULL => 0;
1049 use constant MAP_BORDER => 1;
1050 use constant MAP_AREA => 2;
1051 use constant MAP_CODE => 3;
1052 use constant MAP_DATA => 4;
1053
1054 #
1055 # If exists the map file, then extracts out of it the labels,
1056 # variables and some segments.
1057 #
1058
1059 sub read_map_file()
1060 {
1061 my $state;
1062
1063 return if ($map_file eq '');
1064
1065 $state = MAP_NULL;
1066
1067 if (! open(MAP, '<', $map_file))
1068 {
1069 print STDERR "$PROGRAM : Could not open. -> \"$map_file\"\n";
1070 exit(1);
1071 }
1072
1073 while (<MAP>)
1074 {
1075 chomp;
1076 s/\r$//o;
1077
1078 if ($state == MAP_NULL)
1079 {
1080 $state = MAP_BORDER if (/^Area\s+/io);
1081 }
1082 elsif ($state == MAP_BORDER)
1083 {
1084 $state = MAP_AREA if (/^-+\s+/o);
1085 }
1086 elsif ($state == MAP_AREA)
1087 {
1088 if (/^_CODE\s+/o)
1089 {
1090 $state = MAP_CODE;
1091 }
1092 elsif (/^_(DATA|INITIALIZED)\s+/o)
1093 {
1094 $state = MAP_DATA;
1095 }
1096 else
1097 {
1098 $state = MAP_NULL;
1099 }
1100 }
1101 elsif ($state == MAP_CODE)
1102 {
1103 if (/^.ASxxxx Linker\s+/io)
1104 {
1105 $state = MAP_NULL;
1106 }
1107 elsif (/^\s+([[:xdigit:]]+)\s+(\S+)/o)
1108 {
1109 # 00000180 _main main
1110 # 00000190 _main_end main
1111 # 000001A2 _puts conio
1112 # 000001B5 _puthex conio
1113 # 00000201 _puthex8 conio
1114
1115 add_func_label(hex($1), $2, TRUE);
1116 }
1117 } # elsif ($state == MAP_CODE)
1118 elsif ($state == MAP_DATA)
1119 {
1120 if (/^.ASxxxx Linker\s+/io)
1121 {
1122 $state = MAP_NULL;
1123 }
1124 elsif (/^\s*([[:xdigit:]]+)\s+(\S+)/o)
1125 {
1126 # 000006C6 _heap_top
1127 # 000006C8 _last_error
1128 # 000006C9 _old_isr
1129
1130 add_ram(hex($1), $2, TRUE);
1131 }
1132 } # elsif ($state == MAP_DATA)
1133 } # while (<MAP>)
1134
1135 $map_readed = TRUE;
1136 close(MAP);
1137 }
1138
1139 #-------------------------------------------------------------------------------
1140
1141 use constant NAMES_NULL => 0;
1142 use constant NAMES_RAM => 1;
1143 use constant NAMES_IO => 2;
1144 use constant NAMES_ROM => 3;
1145
1146 sub read_name_list()
1147 {
1148 my ($line, $addr, $name, $state);
1149
1150 return if ($name_list eq '');
1151
1152 if (! open(NAMES, '<', $name_list))
1153 {
1154 print STDERR "$PROGRAM : Could not open. -> \"$name_list\"\n";
1155 exit(1);
1156 }
1157
1158 $state = NAMES_NULL;
1159
1160 foreach (grep(! /^\s*$/o, <NAMES>))
1161 {
1162 chomp;
1163 s/\r$//o;
1164 s/^\s*|\s*$//go;
1165
1166 if (/^\[RAM\]$/io)
1167 {
1168 $state = NAMES_RAM;
1169 next;
1170 }
1171 elsif (/^\[IO\]$/io)
1172 {
1173 $state = NAMES_IO;
1174 next;
1175 }
1176 elsif (/^\[ROM\]$/io)
1177 {
1178 $state = NAMES_ROM;
1179 next;
1180 }
1181
1182 $line = $_;
1183
1184 given ($state)
1185 {
1186 when (NAMES_RAM)
1187 {
1188 if ($line =~ /^0x([[:xdigit:]]+)\s*:\s*(\S+)$/io)
1189 {
1190 add_ram(hex($1), $2, TRUE);
1191 }
1192 }
1193
1194 when (NAMES_IO)
1195 {
1196 if ($line =~ /^0x([[:xdigit:]]+)\s*:\s*(\S+)$/io)
1197 {
1198 add_io(hex($1), $2, TRUE);
1199 }
1200 }
1201
1202 when (NAMES_ROM)
1203 {
1204 if ($line =~ /^0x([[:xdigit:]]+)\s*:\s*(\S+)$/io)
1205 {
1206 add_jump_label(hex($1), $2, BL_TYPE_LABEL, EMPTY, TRUE);
1207 }
1208 }
1209 } # given ($state)
1210 } # foreach (grep(! /^\s*$/o, <NAMES>))
1211
1212 close(NAMES);
1213 }
1214
1215 #-------------------------------------------------------------------------------
1216
1217 #
1218 # There are some variables that are multi-byte. However, only
1219 # the LSB byte of having a name. This procedure gives a name
1220 # for the higher-significant bytes.
1221 #
1222
1223 sub fix_multi_byte_variables()
1224 {
1225 my ($block, $prev_addr, $prev_name, $name, $i, $var_size);
1226
1227 $prev_addr = EMPTY;
1228 $prev_name = '';
1229 foreach (sort {$a <=> $b} keys(%blocks_by_address))
1230 {
1231 $block = $blocks_by_address{$_};
1232 $name = $block->{LABEL}->{NAME};
1233
1234 if ($block->{TYPE} != BLOCK_RAM)
1235 {
1236 $prev_addr = EMPTY;
1237 $prev_name = '';
1238 next;
1239 }
1240
1241 $ram_names_by_address{$_} = $name;
1242
1243 if ($name eq '')
1244 {
1245 $prev_addr = EMPTY;
1246 $prev_name = '';
1247 next;
1248 }
1249
1250 if ($prev_addr != EMPTY)
1251 {
1252 $var_size = $_ - $prev_addr;
1253
1254 if ($var_size > 1)
1255 {
1256 # This is a multi-byte variable. Make the aliases.
1257
1258 for ($i = 1; $i < $var_size; ++$i)
1259 {
1260 $ram_names_by_address{$prev_addr + $i} = "($prev_name + $i)";
1261 }
1262
1263 $blocks_by_address{$prev_addr}->{SIZE} = $var_size;
1264 }
1265 }
1266
1267 $prev_addr = $_;
1268 $prev_name = $name;
1269 } # foreach (sort {$a <=> $b} keys(%blocks_by_address))
1270 }
1271
1272 #-------------------------------------------------------------------------------
1273
1274 sub fix_io_names()
1275 {
1276 my $i = 0;
1277
1278 foreach (sort {$a <=> $b} keys(%io_by_address))
1279 {
1280 next if ($io_by_address{$_}->{NAME} ne '');
1281
1282 $io_by_address{$_}->{NAME} = "io_$i";
1283 ++$i;
1284 }
1285 }
1286
1287 #-------------------------------------------------------------------------------
1288
1289 #
1290 # If there is left in yet so label that has no name, this here get one.
1291 #
1292
1293 sub add_names_labels()
1294 {
1295 my ($addr, $label, $fidx, $lidx, $jtidx, $cidx, $type);
1296
1297 $fidx = 0;
1298 $lidx = 0;
1299 $jtidx = 0;
1300 $cidx = 0;
1301
1302 for ($addr = 0; $addr <= $max_label_addr; ++$addr)
1303 {
1304 $label = $labels_by_address{$addr};
1305
1306 next if (! defined($label));
1307
1308 $type = $label->{TYPE};
1309
1310 next if ($type == BL_TYPE_NONE || (defined($label->{NAME}) && $label->{NAME} ne ''));
1311
1312 if ($type == BL_TYPE_SUB)
1313 {
1314 $label->{NAME} = sprintf("$label_names{$type}%03u", $fidx++);
1315 }
1316 elsif ($type == BL_TYPE_LABEL)
1317 {
1318 $label->{NAME} = sprintf("$label_names{$type}%03u", $lidx++);
1319 }
1320 elsif ($type == BL_TYPE_JTABLE)
1321 {
1322 $label->{NAME} = sprintf("$label_names{$type}%03u", $jtidx++);
1323 }
1324 elsif ($type == BL_TYPE_CONST)
1325 {
1326 $label->{NAME} = sprintf("$label_names{$type}%03u", $cidx++);
1327 }
1328 }
1329 }
1330
1331 ################################################################################
1332 ################################################################################
1333
1334 #
1335 # Expand a relative offset value.
1336 #
1337
1338 sub expand_offset($)
1339 {
1340 my $Offset = $_[0];
1341
1342 return ($Offset & 0x80) ? -(($Offset ^ 0xFF) + 1) : $Offset;
1343 }
1344
1345 #-------------------------------------------------------------------------------
1346
1347 #
1348 # Finds address of branchs and procedures.
1349 #
1350
1351 sub label_finder($$)
1352 {
1353 my ($Address, $BlockRef) = @_;
1354 my ($instr_size, $instr, $addr);
1355
1356 $instr_size = $BlockRef->{SIZE};
1357 $instr = $rom[$Address];
1358
1359 if ($instr == INST_JP)
1360 {
1361 # JP addr16 11000011 aaaaaaaa aaaaaaaa a7-a0 a15-a8 absolute address
1362
1363 $addr = ($rom[$Address + 2] << 8) | $rom[$Address + 1];
1364 add_jump_label($addr, '', BL_TYPE_LABEL, $Address, FALSE);
1365 }
1366 elsif (($instr & 0xC7) == INST_JP_CC)
1367 {
1368 # JP cc, addr16 11ccc010 aaaaaaaa aaaaaaaa a7-a0 a15-a8 absolute address
1369
1370 $addr = ($rom[$Address + 2] << 8) | $rom[$Address + 1];
1371 add_jump_label($addr, '', BL_TYPE_LABEL, $Address, FALSE);
1372 }
1373 elsif ($instr == INST_JR)
1374 {
1375 # JR rel 00011000 eeeeeee relative address
1376
1377 $addr = $Address + $instr_size + expand_offset($rom[$Address + 1]);
1378 add_jump_label($addr, '', BL_TYPE_LABEL, EMPTY, FALSE);
1379 }
1380 elsif (($instr & 0xE7) == INST_JR_CC)
1381 {
1382 # JR cc, rel 00100000 eeeeeee relative address
1383
1384 $addr = $Address + $instr_size + expand_offset($rom[$Address + 1]);
1385 add_jump_label($addr, '', BL_TYPE_LABEL, EMPTY, FALSE);
1386 }
1387 elsif ($instr == INST_DJNZ)
1388 {
1389 # DJNZ rel 00010000 eeeeeee relative address
1390
1391 $addr = $Address + $instr_size + expand_offset($rom[$Address + 1]);
1392 add_jump_label($addr, '', BL_TYPE_LABEL, EMPTY, FALSE);
1393 }
1394 elsif ($instr == INST_CALL)
1395 {
1396 # CALL addr16 11001101 aaaaaaaa aaaaaaaa a7-a0 a15-a8 absolute address
1397
1398 $addr = ($rom[$Address + 2] << 8) | $rom[$Address + 1];
1399 add_func_label($addr, '', FALSE);
1400 }
1401 elsif (($instr & 0xC7) == INST_CALL_CC)
1402 {
1403 # CALL cc, addr16 11ccc100 aaaaaaaa aaaaaaaa a7-a0 a15-a8 absolute address
1404
1405 $addr = ($rom[$Address + 2] << 8) | $rom[$Address + 1];
1406 add_func_label($addr, '', FALSE);
1407 }
1408 }
1409
1410 #-------------------------------------------------------------------------------
1411
1412 #
1413 # If exists a label name wich belong to the $Address, then returns it.
1414 # Otherwise, returns the address.
1415 #
1416
1417 sub label_name($)
1418 {
1419 my $Address = $_[0];
1420 my $label = $labels_by_address{$Address};
1421
1422 return ((defined($label) && $label->{NAME} ne '') ? $label->{NAME} : (sprintf '0x%04X', $Address));
1423 }
1424
1425 #-------------------------------------------------------------------------------
1426
1427 #
1428 # If exists a I/O port name wich belong to the $Address, then returns it.
1429 # Otherwise, returns the address.
1430 #
1431
1432 sub io_name($)
1433 {
1434 my $Address = $_[0];
1435 my $io = $io_by_address{$Address};
1436
1437 return ((defined($io) && $io->{NAME} ne '') ? $io->{NAME} : (sprintf '0x%02X', $Address));
1438 }
1439
1440 #-------------------------------------------------------------------------------
1441
1442 #
1443 # If exists a variable name wich belong to the $Address, then returns it.
1444 # Otherwise, returns the address.
1445 #
1446
1447 sub reg_name($$)
1448 {
1449 my ($Address, $StrRef) = @_;
1450 my ($ram, $str);
1451
1452 if (defined($ram = $ram_names_by_address{$Address}) && $ram ne '')
1453 {
1454 $str = sprintf "0x%04X", $Address;
1455 ${$StrRef} = "[$str]";
1456 $str = $ram;
1457 }
1458 else
1459 {
1460 $str = sprintf "0x%04X", $Address;
1461 ${$StrRef} = "[$str]";
1462 }
1463
1464 return $str;
1465 }
1466
1467 #-------------------------------------------------------------------------------
1468
1469 #
1470 # Auxiliary procedure of prints.
1471 #
1472
1473 sub print_3($$$)
1474 {
1475 my ($Instr, $Param, $Expl) = @_;
1476
1477 return if ($decoder_silent_level > SILENT0);
1478
1479 if ($no_explanations)
1480 {
1481 print(($Param ne '') ? "$Instr\t$Param\n" : "$Instr\n");
1482 }
1483 elsif ($Expl ne '')
1484 {
1485 print "$Instr\t" . align($Param, EXPL_ALIGN_SIZE) . "; $Expl\n";
1486 }
1487 else
1488 {
1489 print(($Param ne '') ? "$Instr\t$Param\n" : "$Instr\n");
1490 }
1491 }
1492
1493 #-------------------------------------------------------------------------------
1494
1495 #
1496 # If possible, returns the character.
1497 #
1498
1499 sub decode_char($)
1500 {
1501 my $Ch = $_[0];
1502
1503 if ($Ch >= ord(' ') && $Ch < 0x7F)
1504 {
1505 return sprintf " {'%c'}", $Ch;
1506 }
1507 elsif (defined($control_characters{$Ch}))
1508 {
1509 return " {'$control_characters{$Ch}'}";
1510 }
1511
1512 return '';
1513 }
1514
1515 #-------------------------------------------------------------------------------
1516
1517 #
1518 # Determines direction of jump.
1519 #
1520
1521 sub jump_direction($)
1522 {
1523 my $TargetAddr = $_[0];
1524 my ($str0, $str1, $str2);
1525
1526 $str0 = sprintf "0x%04X", $TargetAddr;
1527
1528 if ($dcd_address < $TargetAddr)
1529 {
1530 $str1 = '';
1531 $str2 = ' (forward)';
1532 }
1533 elsif ($dcd_address == $TargetAddr)
1534 {
1535 $str1 = ' (endless loop)';
1536 $str2 = '';
1537 }
1538 else
1539 {
1540 $str1 = '';
1541 $str2 = ' (backward)';
1542 }
1543
1544 return "$str2 hither: $str0$str1";
1545 }
1546
1547 #---------------------------------------------------------------------------------------------------
1548 #---------------------------------------------------------------------------------------------------
1549 #---------------------------------------------------------------------------------------------------
1550 #---------------------------------------------------------------------------------------------------
1551
1552 my @core_registers8 =
1553 (
1554 {
1555 NAME => 'B',
1556 EXPL => 'B'
1557 },
1558 {
1559 NAME => 'C',
1560 EXPL => 'C'
1561 },
1562 {
1563 NAME => 'D',
1564 EXPL => 'D'
1565 },
1566 {
1567 NAME => 'E',
1568 EXPL => 'E'
1569 },
1570 {
1571 NAME => 'H',
1572 EXPL => 'H'
1573 },
1574 {
1575 NAME => 'L',
1576 EXPL => 'L'
1577 },
1578 {
1579 NAME => '(HL)',
1580 EXPL => '[HL]'
1581 },
1582 {
1583 NAME => 'A',
1584 EXPL => 'A'
1585 }
1586 );
1587
1588 my @core_registers16a = ( 'BC', 'DE', 'HL', 'SP' );
1589 my @core_registers16b = ( 'BC', 'DE', 'HL', 'AF' );
1590 my @core_registers16c = ( 'BC', 'DE', 'IX', 'SP' );
1591
1592 my @CB_shift_instr =
1593 (
1594 {
1595 INSTR => 'rlc',
1596 EXPL => 'CF <- %s[7..0] <- %s.7'
1597 },
1598 {
1599 INSTR => 'rrc',
1600 EXPL => '%s.0 -> %s[7..0] -> CF'
1601 },
1602 {
1603 INSTR => 'rl',
1604 EXPL => 'CF <- %s[7..0] <- CF'
1605 },
1606 {
1607 INSTR => 'rr',
1608 EXPL => 'CF -> %s[7..0] -> CF'
1609 },
1610 {
1611 INSTR => 'sla',
1612 EXPL => 'CF <- %s[7..0] <- 0'
1613 },
1614 {
1615 INSTR => 'sra',
1616 EXPL => '%s.7 -> %s[7..0] -> CF'
1617 },
1618 {
1619 INSTR => 'sll',
1620 EXPL => 'CF <- %s[7..0] <- 1'
1621 },
1622 {
1623 INSTR => 'srl',
1624 EXPL => '0 -> %s[7..0] -> CF'
1625 }
1626 );
1627
1628 sub CB_prefix_decoder()
1629 {
1630 my ($str, $i_reg, $reg);
1631
1632 given ($dcd_instr_x)
1633 {
1634 when (0)
1635 {
1636 # RLC r CB xx 11001011 00000rrr
1637 # RRC r CB xx 11001011 00001rrr
1638 # RL r CB xx 11001011 00010rrr
1639 # RR r CB xx 11001011 00011rrr
1640 # SLA r CB xx 11001011 00100rrr
1641 # SRA r CB xx 11001011 00101rrr
1642 # SLL r CB xx 11001011 00110rrr
1643 # SRL r CB xx 11001011 00111rrr
1644 # xxyyyzzz
1645 if ($decoder_silent_level == SILENT0)
1646 {
1647 my $i_shift = $CB_shift_instr[$dcd_instr_y];
1648
1649 $i_reg = $core_registers8[$dcd_instr_z];
1650 $reg = $i_reg->{EXPL};
1651 if ($dcd_instr_y == 0)
1652 {
1653 $str = sprintf $i_shift->{EXPL}, $reg, $reg;
1654 }
1655 else
1656 {
1657 $str = sprintf $i_shift->{EXPL}, $reg;
1658 }
1659 print_3($i_shift->{INSTR}, $i_reg->{NAME}, $str);
1660 }
1661 }
1662
1663 when (1)
1664 {
1665 # BIT b, r CB 11001011 01bbbrrr
1666 # xxyyyzzz
1667
1668 if ($decoder_silent_level == SILENT0)
1669 {
1670 $i_reg = $core_registers8[$dcd_instr_z];
1671 print_3('bit', "$dcd_instr_y, $i_reg->{NAME}", "ZF = !$i_reg->{EXPL}.$dcd_instr_y");
1672 }
1673 }
1674
1675 when (2)
1676 {
1677 # RES b, r CB 11001011 10bbbrrr
1678 # xxyyyzzz
1679
1680 if ($decoder_silent_level == SILENT0)
1681 {
1682 $i_reg = $core_registers8[$dcd_instr_z];
1683 print_3('res', "$dcd_instr_y, $i_reg->{NAME}", "$i_reg->{EXPL}.$dcd_instr_y = 0");
1684 }
1685 }
1686
1687 default
1688 {
1689 # SET b, r CB 11001011 11bbbrrr
1690 # xxyyyzzz
1691
1692 if ($decoder_silent_level == SILENT0)
1693 {
1694 $i_reg = $core_registers8[$dcd_instr_z];
1695 print_3('set', "$dcd_instr_y, $i_reg->{NAME}", "$i_reg->{EXPL}.$dcd_instr_y = 1");
1696 }
1697 }
1698 } # given ($dcd_instr_x)
1699 }
1700
1701 #-------------------------------------------------------------------------------
1702
1703 #
1704 # $IndexReg: IX or IY
1705 #
1706
1707 sub DDFD_CB_prefix_decoder($)
1708 {
1709 my $IndexReg = $_[0];
1710 my $offset = expand_offset($dcd_parm1);
1711 my ($offs_str, $offs_expl, $i_reg);
1712
1713 if ($offset < 0)
1714 {
1715 $offs_str = "$offset($IndexReg)";
1716 $offs_expl = "[$IndexReg$offset]";
1717 }
1718 else
1719 {
1720 $offs_str = "$offset($IndexReg)";
1721 $offs_expl = "[${IndexReg}+$offset]";
1722 }
1723
1724 given ($dcd_instr_x)
1725 {
1726 =back
1727 r: 000 B
1728 001 C
1729 010 D
1730 011 E
1731 100 H
1732 101 L
1733 110 (HL)
1734 111 A
1735 =cut
1736 when (0)
1737 {
1738 if ($dcd_instr_z == 6)
1739 {
1740 # RLC (IX+d) DD CB dd 06 11011101 11001011 dddddddd 00000110 d: two's complement number
1741 # RLC (IY+d) FD CB dd 06 11111101 11001011 dddddddd 00000110 d: two's complement number
1742 # RRC (IX+d) DD CB dd 0E 11011101 11001011 dddddddd 00001110 d: two's complement number
1743 # RRC (IY+d) FD CB dd 0E 11111101 11001011 dddddddd 00001110 d: two's complement number
1744 # RL (IX+d) DD CB dd 16 11011101 11001011 dddddddd 00010110 d: two's complement number
1745 # RL (IY+d) FD CB dd 16 11111101 11001011 dddddddd 00010110 d: two's complement number
1746 # RR (IX+d) DD CB dd 1E 11011101 11001011 dddddddd 00011110 d: two's complement number
1747 # RR (IY+d) FD CB dd 1E 11111101 11001011 dddddddd 00011110 d: two's complement number
1748 # SLA (IX+d) DD CB dd 26 11011101 11001011 dddddddd 00100110 d: two's complement number
1749 # SLA (IY+d) FD CB dd 26 11111101 11001011 dddddddd 00100110 d: two's complement number
1750 # SRA (IX+d) DD CB dd 2E 11011101 11001011 dddddddd 00101110 d: two's complement number
1751 # SRA (IY+d) FD CB dd 2E 11111101 11001011 dddddddd 00101110 d: two's complement number
1752 # SLL (IX+d) DD CB dd 36 11011101 11001011 dddddddd 00110110 d: two's complement number
1753 # SLL (IY+d) FD CB dd 36 11111101 11001011 dddddddd 00110110 d: two's complement number
1754 # SRL (IX+d) DD CB dd 3E 11011101 11001011 dddddddd 00111110 d: two's complement number
1755 # SRL (IY+d) FD CB dd 3E 11111101 11001011 dddddddd 00111110 d: two's complement number
1756 # xxyyyzzz
1757
1758 if ($decoder_silent_level == SILENT0)
1759 {
1760 my $shift = $CB_shift_instr[$dcd_instr_y];
1761 my $str = sprintf $shift->{EXPL}, $offs_expl, $offs_expl;
1762
1763 print_3($shift->{INSTR}, $offs_str, $str);
1764 }
1765 }
1766 else
1767 {
1768 # LD r, RLC(IX+d) DD CB dd 0x 11011101 11001011 dddddddd 00000rrr d: two's complement number
1769 # LD r, RLC(IY+d) FD CB dd 0x 11111101 11001011 dddddddd 00000rrr d: two's complement number
1770 # LD r, RRC(IX+d) DD CB dd 0x 11011101 11001011 dddddddd 00001rrr d: two's complement number
1771 # LD r, RRC(IY+d) FD CB dd 0x 11111101 11001011 dddddddd 00001rrr d: two's complement number
1772 # LD r, RL(IX+d) DD CB dd 1x 11011101 11001011 dddddddd 00010rrr d: two's complement number
1773 # LD r, RL(IY+d) FD CB dd 1x 11111101 11001011 dddddddd 00010rrr d: two's complement number
1774 # LD r, RR(IX+d) DD CB dd 1x 11011101 11001011 dddddddd 00011rrr d: two's complement number
1775 # LD r, RR(IY+d) FD CB dd 1x 11111101 11001011 dddddddd 00011rrr d: two's complement number
1776 # LD r, SLA(IX+d) DD CB dd 2x 11011101 11001011 dddddddd 00100rrr d: two's complement number
1777 # LD r, SLA(IY+d) FD CB dd 2x 11111101 11001011 dddddddd 00100rrr d: two's complement number
1778 # LD r, SRA(IX+d) DD CB dd 2x 11011101 11001011 dddddddd 00101rrr d: two's complement number
1779 # LD r, SRA(IY+d) FD CB dd 2x 11111101 11001011 dddddddd 00101rrr d: two's complement number
1780 # LD r, SLL(IX+d) DD CB dd 3x 11011101 11001011 dddddddd 00110rrr d: two's complement number
1781 # LD r, SLL(IY+d) FD CB dd 3x 11111101 11001011 dddddddd 00110rrr d: two's complement number
1782 # LD r, SRL(IX+d) DD CB dd 3x 11011101 11001011 dddddddd 00111rrr d: two's complement number
1783 # LD r, SRL(IY+d) FD CB dd 3x 11111101 11001011 dddddddd 00111rrr d: two's complement number
1784 # xxyyyzzz
1785
1786 if ($decoder_silent_level == SILENT0)
1787 {
1788 my $shift = $CB_shift_instr[$dcd_instr_y];
1789 my $str = sprintf $shift->{EXPL}, $offs_expl, $offs_expl;
1790
1791 $i_reg = $core_registers8[$dcd_instr_z];
1792 print_3('ld', "$i_reg->{NAME}, $shift->{INSTR} $offs_str", "$i_reg->{EXPL} = $str");
1793 }
1794 }
1795 } # $dcd_instr_x == 0
1796
1797 when (1)
1798 {
1799 # BIT b, (IX+d) DD CB dd 4x 11011101 11001011 dddddddd 01bbbxxx d: two's complement number
1800 # BIT b, (IY+d) FD CB dd 4x 11111101 11001011 dddddddd 01bbbxxx d: two's complement number
1801 # xxyyyzzz
1802
1803 print_3('bit', "$dcd_instr_y, $offs_str", "ZF = !${offs_expl}.$dcd_instr_y");
1804 } # $dcd_instr_x == 1
1805
1806 when (2)
1807 {
1808 if ($dcd_instr_z == 6)
1809 {
1810 # RES b, (IX+d) DD CB dd xx 11011101 11001011 dddddddd 10bbb110 d: two's complement number
1811 # RES b, (IY+d) FD CB dd xx 11111101 11001011 dddddddd 10bbb110 d: two's complement number
1812 # xxyyyzzz
1813
1814 print_3('res', "$dcd_instr_y, $offs_str", "${offs_expl}.$dcd_instr_y = 0");
1815 }
1816 else
1817 {
1818 # LD r, RES b, (IX+d) DD CB dd xx 11011101 11001011 dddddddd 10bbbrrr d: two's complement number
1819 # LD r, RES b, (IY+d) FD CB dd xx 11111101 11001011 dddddddd 10bbbrrr d: two's complement number
1820 # xxyyyzzz
1821
1822 $i_reg = $core_registers8[$dcd_instr_z];
1823 print_3('ld', "$i_reg->{NAME}, res $dcd_instr_y, $offs_str", "${offs_expl}.$dcd_instr_y = 0; $i_reg->{NAME} = $offs_expl");
1824 }
1825 } # $dcd_instr_x == 2
1826
1827 default
1828 {
1829 if ($dcd_instr_z == 6)
1830 {
1831 # SET b, (IX+d) DD CB dd xx 11011101 11001011 dddddddd 11bbb110 d: two's complement number
1832 # SET b, (IY+d) FD CB dd xx 11111101 11001011 dddddddd 11bbb110 d: two's complement number
1833 # xxyyyzzz
1834
1835 print_3('set', "$dcd_instr_y, $offs_str", "${offs_expl}.$dcd_instr_y = 1");
1836 }
1837 else
1838 {
1839 # LD r, SET b, (IX+d) DD CB dd xx 11011101 11001011 dddddddd 11bbbrrr d: two's complement number
1840 # LD r, SET b, (IY+d) FD CB dd xx 11111101 11001011 dddddddd 11bbbrrr d: two's complement number
1841 # xxyyyzzz
1842
1843 $i_reg = $core_registers8[$dcd_instr_z];
1844 print_3('ld', "$i_reg->{NAME}, set $dcd_instr_y, $offs_str", "${offs_expl}.$dcd_instr_y = 1; $i_reg->{NAME} = $offs_expl");
1845 }
1846 }
1847 } # given ($dcd_instr_x)
1848 }
1849
1850 #-------------------------------------------------------------------------------
1851
1852 #
1853 # $IndexReg: IX or IY
1854 #
1855
1856 my @DDFD_instr =
1857 (
1858 {
1859 INSTR => 'add',
1860 EXPL => 'A +='
1861 },
1862 {
1863 INSTR => 'adc',
1864 EXPL => 'A += CF +'
1865 },
1866 {
1867 INSTR => 'sub',
1868 EXPL => 'A -='
1869 },
1870 {
1871 INSTR => 'sbc',
1872 EXPL => 'A -= CF +'
1873 },
1874 {
1875 INSTR => 'and',
1876 EXPL => 'A &='
1877 },
1878 {
1879 INSTR => 'xor',
1880 EXPL => 'A ^='
1881 },
1882 {
1883 INSTR => 'or',
1884 EXPL => 'A |='
1885 },
1886 {
1887 INSTR => 'cp',
1888 EXPL => 'A ?='
1889 }
1890 );
1891
1892 sub DDFD_prefix_decoder($)
1893 {
1894 my $IndexReg = $_[0];
1895 my ($addr, $offset, $offs_str, $offs_expl, $str);
1896
1897 if ($dcd_parm0 == 0xCB)
1898 {
1899 instruction_take_to_pieces($dcd_parm2);
1900 DDFD_CB_prefix_decoder($IndexReg);
1901 }
1902 else
1903 {
1904 instruction_take_to_pieces($dcd_parm0);
1905
1906 $offset = expand_offset($dcd_parm1);
1907
1908 if ($offset < 0)
1909 {
1910 $offs_str = "$offset($IndexReg)";
1911 $offs_expl = "[$IndexReg$offset]";
1912 }
1913 else
1914 {
1915 $offs_str = "$offset($IndexReg)";
1916 $offs_expl = "[${IndexReg}+$offset]";
1917 }
1918
1919 given ($dcd_instr_x)
1920 {
1921 when (0)
1922 {
1923 if ($dcd_instr_q == 1 && $dcd_instr_z == 1)
1924 {
1925 # ADD IX, rp DD 09 11011101 00rr1001
1926 # ADD IY, rp FD 09 11111101 00rr1001
1927 # xxppqzzz
1928 # rp: BC, DE, IX, SP
1929
1930 $str = $core_registers16c[$dcd_instr_p];
1931 print_3('add', "$IndexReg, $str", "$IndexReg += $str");
1932 }
1933 elsif ($dcd_instr_y == 4)
1934 {
1935 given ($dcd_instr_z)
1936 {
1937 when (1)
1938 {
1939 # LD IX, #nn DD 21 nn nn 11011101 00100001 a7-0 a15-8
1940 # LD IY, #nn FD 21 nn nn 11111101 00100001 a7-0 a15-8
1941 # xxyyyzzz
1942
1943 $str = sprintf '0x%04X', ($dcd_parm2 << 8) | $dcd_parm1;
1944 print_3('ld', "$IndexReg, #$str", "$IndexReg = $str");
1945 }
1946
1947 when (2)
1948 {
1949 # LD (nn), IX DD 22 nn nn 11011101 00100010 a7-0 a15-8
1950 # LD (nn), IY FD 22 nn nn 11111101 00100010 a7-0 a15-8
1951 # xxyyyzzz
1952
1953 $addr = ($dcd_parm2 << 8) | $dcd_parm1;
1954
1955 if ($decoder_silent_level == SILENT0)
1956 {
1957 my $name;
1958
1959 $str = reg_name($addr, \$name);
1960 print_3('ld', "($str), $IndexReg", "$name = $IndexReg");
1961 }
1962 elsif ($decoder_silent_level == SILENT1)
1963 {
1964 add_ram($addr, '', FALSE);
1965 }
1966 }
1967
1968 when (3)
1969 {
1970 # INC IX DD 23 11011101 00100011
1971 # INC IY FD 23 11111101 00100011
1972 # xxyyyzzz
1973
1974 print_3('inc', $IndexReg, "++$IndexReg");
1975 }
1976
1977 when (4)
1978 {
1979 # INC IXh DD 24 11011101 00100100
1980 # INC IYh FD 24 11111101 00100100
1981 # xxyyyzzz
1982
1983 print_3('inc', "${IndexReg}h", "++${IndexReg}.h");
1984 }
1985
1986 when (5)
1987 {
1988 # DEC IXh DD 25 11011101 00100101
1989 # DEC IYh FD 25 11111101 00100101
1990 # xxyyyzzz
1991
1992 print_3('dec', "${IndexReg}h", "--${IndexReg}.h");
1993 }
1994
1995 when (6)
1996 {
1997 # LD IXh, #n DD 26 nn 11011101 00100110 nnnnnnnn
1998 # LD IYh, #n FD 26 nn 11111101 00100110 nnnnnnnn
1999 # xxyyyzzz
2000
2001 my $char = decode_char($dcd_parm1);
2002
2003 $str = sprintf '0x%02X', $dcd_parm1;
2004 print_3('ld', "${IndexReg}h, #$str", "${IndexReg}.h = $str$char");
2005 }
2006 } # given ($dcd_instr_z)
2007 }
2008 elsif ($dcd_instr_y == 5)
2009 {
2010 given ($dcd_instr_z)
2011 {
2012 when (2)
2013 {
2014 # LD IX, (nn) DD 2A nn nn 11011101 00101010 a7-0 a15-8
2015 # LD IY, (nn) FD 2A nn nn 11111101 00101010 a7-0 a15-8
2016 # xxyyyzzz
2017
2018 $addr = ($dcd_parm2 << 8) | $dcd_parm1;
2019
2020 if ($decoder_silent_level == SILENT0)
2021 {
2022 my $name;
2023
2024 $str = reg_name($addr, \$name);
2025 print_3('ld', "$IndexReg, ($str)", "$IndexReg = $name");
2026 }
2027 elsif ($decoder_silent_level == SILENT1)
2028 {
2029 add_ram($addr, '', FALSE);
2030 }
2031 }
2032
2033 when (3)
2034 {
2035 # DEC IX DD 2B 11011101 00101011
2036 # DEC IY FD 2B 11111101 00101011
2037 # xxyyyzzz
2038
2039 print_3('dec', $IndexReg, "--$IndexReg");
2040 }
2041
2042 when (4)
2043 {
2044 # INC IXl DD 2C 11011101 00101100
2045 # INC IYl FD 2C 11111101 00101100
2046 # xxyyyzzz
2047
2048 print_3('inc', "${IndexReg}l", "++${IndexReg}.l");
2049 }
2050
2051 when (5)
2052 {
2053 # DEC IXl DD 2D 11011101 00101101
2054 # DEC IYl FD 2D 11111101 00101101
2055 # xxyyyzzz
2056
2057 print_3('dec', "${IndexReg}l", "--${IndexReg}.l");
2058 }
2059
2060 when (6)
2061 {
2062 # LD IXl, #n DD 2E nn 11011101 00101110 nnnnnnnn
2063 # LD IYl, #n FD 2E nn 11111101 00101110 nnnnnnnn
2064 # xxyyyzzz
2065
2066 my $char = decode_char($dcd_parm1);
2067
2068 $str = sprintf '0x%02X', $dcd_parm1;
2069 print_3('ld', "${IndexReg}l, #$str", "${IndexReg}.l = $str$char");
2070 }
2071 } # given ($dcd_instr_z)
2072 }
2073 elsif ($dcd_instr_y == 6)
2074 {
2075 given ($dcd_instr_z)
2076 {
2077 when (4)
2078 {
2079 # INC (IX+d) DD 34 dd 11011101 00110100 dddddddd d: two's complement number
2080 # INC (IY+d) FD 34 dd 11111101 00110100 dddddddd d: two's complement number
2081 # xxyyyzzz
2082
2083 print_3('inc', $offs_str, "++$offs_expl");
2084 }
2085
2086 when (5)
2087 {
2088 # DEC (IX+d) DD 35 dd 11011101 00110101 dddddddd d: two's complement number
2089 # DEC (IY+d) FD 35 dd 11111101 00110101 dddddddd d: two's complement number
2090 # xxyyyzzz
2091
2092 print_3('dec', $offs_str, "--$offs_expl");
2093 }
2094
2095 when (6)
2096 {
2097 # LD (IX+d), #n DD 36 dd nn 11011101 00110110 dddddddd nnnnnnnn d: two's complement number
2098 # LD (IY+d), #n FD 36 dd nn 11111101 00110110 dddddddd nnnnnnnn d: two's complement number
2099 # xxyyyzzz
2100
2101 my $char = decode_char($dcd_parm2);
2102
2103 $str = sprintf '0x%02X', $dcd_parm2;
2104 print_3('ld', "$offs_str, #$str", "$offs_expl = $str$char");
2105 }
2106 } # given ($dcd_instr_z)
2107 }
2108 } # $dcd_instr_x == 0
2109
2110 when (1)
2111 {
2112 given ($dcd_instr_y)
2113 {
2114 when ([0 .. 3])
2115 {
2116 given ($dcd_instr_z)
2117 {
2118 when (4)
2119 {
2120 # LD r, IXh DD 44 11011101 010rr100
2121 # LD r, IYh FD 44 11111101 010rr100
2122 # xxyyyzzz
2123 # r: B, C, D, E
2124
2125 $str = $core_registers8[$dcd_instr_y]->{NAME};
2126 print_3('ld', "$str, ${IndexReg}h", "$str = ${IndexReg}.h");
2127 }
2128
2129 when (5)
2130 {
2131
2132 # LD r, IXl DD 45 11011101 010rr101
2133 # LD r, IYl FD 45 11111101 010rr101
2134 # xxyyyzzz
2135 # r: B, C, D, E
2136
2137 $str = $core_registers8[$dcd_instr_y]->{NAME};
2138 print_3('ld', "$str, ${IndexReg}l", "$str = ${IndexReg}.l");
2139 }
2140
2141 when (6)
2142 {
2143
2144 # LD r, (IX+d) DD 46 dd 11011101 010rr110 dddddddd d: two's complement number
2145 # LD r, (IY+d) FD 46 dd 11111101 010rr110 dddddddd d: two's complement number
2146 # xxyyyzzz
2147 # r: B, C, D, E
2148
2149 $str = $core_registers8[$dcd_instr_y]->{NAME};
2150 print_3('ld', "$str, $offs_str", "$str = $offs_expl");
2151 }
2152 } # given ($dcd_instr_z)
2153 } # when ([0 .. 3])
2154
2155 when ([4, 5])
2156 {
2157 my $r = ($dcd_instr_y == 4) ? 'h' : 'l';
2158
2159 given ($dcd_instr_z)
2160 {
2161 when ([0 .. 3])
2162 {
2163 # LD IXh, B DD 60 11011101 011000rr
2164 # LD IYh, B FD 60 11111101 011000rr
2165 # LD IXh, C DD 61 11011101 01100001
2166 # LD IYh, C FD 61 11111101 01100001
2167 # LD IXh, D DD 62 11011101 01100010
2168 # LD IYh, D FD 62 11111101 01100010
2169 # LD IXh, E DD 63 11011101 01100011
2170 # LD IYh, E FD 63 11111101 01100011
2171 # xxyyyzzz
2172 # r: B, C, D, E
2173
2174 $str = $core_registers8[$dcd_instr_z]->{NAME};
2175 print_3('ld', "$IndexReg$r, $str", "$IndexReg$r = $str");
2176 }
2177
2178 when (4)
2179 {
2180 # LD IXh, IXh DD 64 11011101 01100100
2181 # LD IYh, IYh FD 64 11111101 01100100
2182 # xxyyyzzz
2183
2184 print_3('ld', "$IndexReg$r, {IndexReg}h", "$IndexReg$r = {IndexReg}.h");
2185 }
2186
2187 when (5)
2188 {
2189 # LD IXh, IXl DD 65 11011101 01100101
2190 # LD IYh, IYl FD 65 11111101 01100101
2191 # xxyyyzzz
2192
2193 print_3('ld', "$IndexReg$r, {IndexReg}l", "$IndexReg$r = {IndexReg}.l");
2194 }
2195
2196 when (6)
2197 {
2198 # LD H, (IX+d) DD 66 dd 11011101 01100110 dddddddd d: two's complement number
2199 # LD H, (IY+d) FD 66 dd 11111101 01100110 dddddddd d: two's complement number
2200 # xxyyyzzz
2201
2202 $str = uc($r);
2203 print_3('ld', "$str, $offs_str", "$str = $offs_expl");
2204 }
2205
2206 when (7)
2207 {
2208 # LD IXh, A DD 67 11011101 01100111
2209 # LD IYh, A FD 67 11111101 01100111
2210 # xxyyyzzz
2211
2212 print_3('ld', "$IndexReg$r, A", "$IndexReg$r = A");
2213 }
2214 } # given ($dcd_instr_z)
2215 } # when ([4, 5])
2216
2217 when (6)
2218 {
2219 # LD (IX+d), r DD 70 dd 11011101 01110rrr dddddddd d: two's complement number
2220 # LD (IY+d), r FD 70 dd 11111101 01110rrr dddddddd d: two's complement number
2221 # xxyyyzzz
2222 # r: B, C, D, E, H, L, -, A
2223
2224 $str = $core_registers8[$dcd_instr_z]->{NAME};
2225 print_3('ld', "$offs_str, $str", "$offs_expl = $str");
2226 }
2227
2228 default
2229 {
2230 given ($dcd_instr_z)
2231 {
2232 when (4)
2233 {
2234 # LD A, IXh DD 7C 11011101 01111100
2235 # LD A, IYh FD 7C 11111101 01111100
2236 # xxyyyzzz
2237
2238 print_3('ld', "A, ${IndexReg}h", "A = ${IndexReg}.h");
2239 }
2240
2241 when (5)
2242 {
2243 # LD A, IXl DD 7D 11011101 01111101
2244 # LD A, IYl FD 7D 11111101 01111101
2245 # xxyyyzzz
2246
2247 print_3('ld', "A, ${IndexReg}l", "A = ${IndexReg}.l");
2248 }
2249
2250 when (6)
2251 {
2252 # LD A, (IX+d) DD 7E dd 11011101 01111110 dddddddd d: two's complement number
2253 # LD A, (IY+d) FD 7E dd 11111101 01111110 dddddddd d: two's complement number
2254 # xxyyyzzz
2255
2256 print_3('ld', "A, $offs_str", "A = $offs_expl");
2257 }
2258 } # given ($dcd_instr_z)
2259 }
2260 } # given ($dcd_instr_y)
2261 } # $dcd_instr_x == 1
2262
2263 when (2)
2264 {
2265 given ($dcd_instr_z)
2266 {
2267 when (4)
2268 {
2269 # ADD A, IXh DD 84 11011101 10000100
2270 # ADD A, IYh FD 84 11111101 10000100
2271 # ADC A, IXh DD 8C 11011101 10001100
2272 # ADC A, IYh FD 8C 11111101 10001100
2273 # SUB A, IXh DD 94 11011101 10010100
2274 # SUB A, IYh FD 94 11111101 10010100
2275 # SBC A, IXh DD 9C 11011101 10011100
2276 # SBC A, IYh FD 9C 11111101 10011100
2277 # AND A, IXh DD A4 11011101 10100100
2278 # AND A, IYh FD A4 11111101 10100100
2279 # XOR A, IXh DD AC 11011101 10101100
2280 # XOR A, IYh FD AC 11111101 10101100
2281 # OR A, IXh DD B4 11011101 10110100
2282 # OR A, IYh FD B4 11111101 10110100
2283 # CP A, IXh DD BC 11011101 10111100
2284 # CP A, IYh FD BC 11111101 10111100
2285 # xxyyyzzz
2286
2287 my $i_arith = $DDFD_instr[$dcd_instr_y];
2288
2289 print_3($i_arith->{INSTR}, "A, ${IndexReg}h", "$i_arith->{EXPL} ${IndexReg}.h");
2290 }
2291
2292 when (5)
2293 {
2294 # ADD A, IXl DD 85 11011101 10000101
2295 # ADD A, IYl FD 85 11111101 10000101
2296 # ADC A, IXl DD 8D 11011101 10001101
2297 # ADC A, IYl FD 8D 11111101 10001101
2298 # SUB A, IXl DD 95 11011101 10010101
2299 # SUB A, IYl FD 95 11111101 10010101
2300 # SBC A, IXl DD 9D 11011101 10011101
2301 # SBC A, IYl FD 9D 11111101 10011101
2302 # AND A, IXl DD A5 11011101 10100101
2303 # AND A, IYl FD A5 11111101 10100101
2304 # XOR A, IXl DD AD 11011101 10101101
2305 # XOR A, IYl FD AD 11111101 10101101
2306 # OR A, IXl DD B5 11011101 10110101
2307 # OR A, IYl FD B5 11111101 10110101
2308 # CP A, IXl DD BD 11011101 10111101
2309 # CP A, IYl FD BD 11111101 10111101
2310 # xxyyyzzz
2311
2312 my $i_arith = $DDFD_instr[$dcd_instr_y];
2313
2314 print_3($i_arith->{INSTR}, "A, ${IndexReg}l", "$i_arith->{EXPL} ${IndexReg}.l");
2315 }
2316
2317 when (6)
2318 {
2319 # ADD A, (IX+d) DD 86 dd 11011101 10000110 dddddddd d: two's complement number
2320 # ADD A, (IY+d) FD 86 dd 11111101 10000110 dddddddd d: two's complement number
2321 # ADC A, (IX+d) DD 8E dd 11011101 10001110 dddddddd d: two's complement number
2322 # ADC A, (IY+d) FD 8E dd 11111101 10001110 dddddddd d: two's complement number
2323 # SUB A, (IX+d) DD 96 dd 11011101 10010110 dddddddd d: two's complement number
2324 # SUB A, (IY+d) FD 96 dd 11111101 10010110 dddddddd d: two's complement number
2325 # SBC A, (IX+d) DD 9E dd 11011101 10011110 dddddddd d: two's complement number
2326 # SBC A, (IY+d) FD 9E dd 11111101 10011110 dddddddd d: two's complement number
2327 # AND A, (IX+d) DD A6 dd 11011101 10100110 dddddddd d: two's complement number
2328 # AND A, (IY+d) FD A6 dd 11111101 10100110 dddddddd d: two's complement number
2329 # XOR A, (IX+d) DD AE dd 11011101 10101110 dddddddd d: two's complement number
2330 # XOR A, (IY+d) FD AE dd 11111101 10101110 dddddddd d: two's complement number
2331 # OR A, (IX+d) DD B6 dd 11011101 10110110 dddddddd d: two's complement number
2332 # OR A, (IY+d) FD B6 dd 11111101 10110110 dddddddd d: two's complement number
2333 # CP A, (IX+d) DD BE dd 11011101 10111110 dddddddd d: two's complement number
2334 # CP A, (IY+d) FD BE dd 11111101 10111110 dddddddd d: two's complement number
2335 # xxyyyzzz
2336
2337 my $i_arith = $DDFD_instr[$dcd_instr_y];
2338
2339 print_3($i_arith->{INSTR}, "A, $offs_str", "$i_arith->{EXPL} $offs_expl");
2340 }
2341 } # given ($dcd_instr_z)
2342 } # $dcd_instr_x == 2
2343
2344 default
2345 {
2346 given ($dcd_parm0)
2347 {
2348 when (0xE1)
2349 {
2350 # POP IX DD E1 11011101 11100001
2351 # POP IY FD E1 11111101 11100001
2352
2353 print_3('pop', $IndexReg, "${IndexReg}.l = [SP++]; ${IndexReg}.h = [SP++]");
2354 }
2355
2356 when (0xE3)
2357 {
2358 # EX (SP), IX DD E3 11011101 11100011
2359 # EX (SP), IY FD E3 11111101 11100011
2360
2361 print_3('ex', "(SP), $IndexReg", "[SP] <-> ${IndexReg}.l; [SP+1] <-> ${IndexReg}.h");
2362 }
2363
2364 when (0xE5)
2365 {
2366 # PUSH IX DD E5 11011101 11100101
2367 # PUSH IY FD E5 11111101 11100101
2368
2369 print_3('push', $IndexReg, "[--SP] = ${IndexReg}.h; [--SP] = ${IndexReg}.l");
2370 }
2371
2372 when (0xE9)
2373 {
2374 # JP (IX) DD E9 11011101 11101001
2375 # JP (IY) FD E9 11111101 11101001
2376
2377 print_3('jp', "($IndexReg)", "Jumps hither: [$IndexReg]");
2378 $prev_is_jump = TRUE;
2379 }
2380
2381 when (0xF9)
2382 {
2383 # LD SP, IX DD F9 11011101 11111001
2384 # LD SP, IY FD F9 11111101 11111001
2385
2386 print_3('ld', "SP, $IndexReg", "SP = $IndexReg");
2387 }
2388 } # given ($dcd_parm0)
2389 } # $dcd_instr_x == 3
2390 } # given ($dcd_instr_x)
2391 }
2392 }
2393
2394 #-------------------------------------------------------------------------------
2395
2396 my @block_instr =
2397 (
2398 [
2399 {
2400 INSTR => 'ldi',
2401 EXPL => '[DE++] = [HL++]; --BC'
2402 },
2403 {
2404 INSTR => 'cpi',
2405 EXPL => 'A ?= [HL++]; --BC'
2406 },
2407 {
2408 INSTR => 'ini',
2409 EXPL => '[HL++] = In{C}; --B'
2410 },
2411 {
2412 INSTR => 'outi',
2413 EXPL => 'Out{C} = [HL++]; --B'
2414 }
2415 ],
2416 [
2417 {
2418 INSTR => 'ldd',
2419 EXPL => '[DE--] = [HL--]; --BC'
2420 },
2421 {
2422 INSTR => 'cpd',
2423 EXPL => 'A ?= [HL--]; --BC'
2424 },
2425 {
2426 INSTR => 'ind',
2427 EXPL => '[HL--] = In{C}; --B'
2428 },
2429 {
2430 INSTR => 'outd',
2431 EXPL => 'Out{C} = [HL--]; --B'
2432 }
2433 ],
2434 [
2435 {
2436 INSTR => 'ldir',
2437 EXPL => '[DE++] = [HL++]; --BC; Exit this loop, then BC == 0.'
2438 },
2439 {
2440 INSTR => 'cpir',
2441 EXPL => 'A ?= [HL++]; --BC; Exit this loop, then BC == 0 or A == [HL].'
2442 },
2443 {
2444 INSTR => 'inir',
2445 EXPL => '[HL++] = In{C}; --B; Exit this loop, then B == 0.'
2446 },
2447 {
2448 INSTR => 'otir',
2449 EXPL => 'Out{C} = [HL++]; --B; Exit this loop, then B == 0.'
2450 }
2451 ],
2452 [
2453 {
2454 INSTR => 'lddr',
2455 EXPL => '[DE--] = [HL--]; --BC; Exit this loop, then BC == 0.'
2456 },
2457 {
2458 INSTR => 'cpdr',
2459 EXPL => 'A ?= [HL--]; --BC; Exit this loop, then BC == 0 or A == [HL].'
2460 },
2461 {
2462 INSTR => 'indr',
2463 EXPL => '[HL--] = In{C}; --B; Exit this loop, then B == 0.'
2464 },
2465 {
2466 INSTR => 'otdr',
2467 EXPL => 'Out{C} = [HL--]; --B; Exit this loop, then B == 0.'
2468 }
2469 ]
2470 );
2471
2472 sub ED_prefix_decoder()
2473 {
2474 my ($addr, $str, $i_reg, $reg);
2475
2476 instruction_take_to_pieces($dcd_parm0);
2477
2478 if ($dcd_instr_x == 1)
2479 {
2480 given ($dcd_instr_z)
2481 {
2482 when (0)
2483 {
2484 if ($decoder_silent_level == SILENT0)
2485 {
2486 $i_reg = $core_registers8[$dcd_instr_z];
2487
2488 if ($dcd_instr_y == 6)
2489 {
2490 # IN (C) ED 70 11101011 01110000
2491 # xxyyyzzz
2492
2493 print_3('in', '(C)', "$i_reg->{EXPL} = In{[C]}");
2494 }
2495 else
2496 {
2497 # IN r, (C) ED xx 11101011 01rrr000
2498 # xxyyyzzz
2499
2500 print_3('in', "$i_reg->{NAME}, (C)", "$i_reg->{EXPL} = In{[C]}");
2501 }
2502 }
2503 } # $dcd_instr_z == 0
2504
2505 when (1)
2506 {
2507 if ($decoder_silent_level == SILENT0)
2508 {
2509 $i_reg = $core_registers8[$dcd_instr_z];
2510
2511 if ($dcd_instr_y == 6)
2512 {
2513 # OUT (C) ED 71 11101101 01110001
2514 # xxyyyzzz
2515
2516 print_3('out', '(C)', "Out{[C]} = $i_reg->{EXPL}");
2517 }
2518 else
2519 {
2520 # OUT (C), r ED xx 11101101 01rrr001
2521 # xxyyyzzz
2522
2523 print_3('out', "(C), $i_reg->{NAME}", "Out{[C]} = $i_reg->{EXPL}");
2524 }
2525 }
2526 } # $dcd_instr_z == 1
2527
2528 when (2)
2529 {
2530 if ($dcd_instr_q == 0)
2531 {
2532 # SBC HL, pp ED x2 11101101 01pp0010
2533 # xxppqzzz
2534
2535 $str = $core_registers16a[$dcd_instr_p];
2536 print_3('sbc', "HL, $str", "HL -= $str + CF");
2537 }
2538 else
2539 {
2540 # ADC HL, pp ED xA 11101101 01pp1010
2541 # xxppqzzz
2542
2543 $str = $core_registers16a[$dcd_instr_p];
2544 print_3('adc', "HL, $str", "HL += $str + CF");
2545 }
2546 } # $dcd_instr_z == 2
2547
2548 when (3)
2549 {
2550 $addr = ($dcd_parm2 << 8) | $dcd_parm1;
2551
2552 if ($dcd_instr_q == 0)
2553 {
2554 # LD (nn), pp ED x3 aa aa 11101101 01pp0011 a7-0 a15-8
2555 # xxppqzzz
2556
2557 if ($decoder_silent_level == SILENT0)
2558 {
2559 my $name;
2560
2561 $reg = $core_registers16a[$dcd_instr_p];
2562 $str = reg_name($addr, \$name);
2563 print_3('ld', "($str), $reg", "$name = $reg");
2564 }
2565 elsif ($decoder_silent_level == SILENT1)
2566 {
2567 add_ram($addr, '', FALSE);
2568 }
2569 }
2570 else
2571 {
2572 # LD pp, (nn) ED xB aa aa 11101101 01pp1011 a7-0 a15-8
2573 # xxppqzzz
2574
2575 if ($decoder_silent_level == SILENT0)
2576 {
2577 my $name;
2578
2579 $reg = $core_registers16a[$dcd_instr_p];
2580 $str = reg_name($addr, \$name);
2581 print_3('ld', "$reg, ($str)", "$reg = $name");
2582 }
2583 elsif ($decoder_silent_level == SILENT1)
2584 {
2585 add_ram($addr, '', FALSE);
2586 }
2587 }
2588 } # $dcd_instr_z == 3
2589
2590 when (4)
2591 {
2592 # NEG ED xx 11101101 01xxx100
2593 # xxyyyzzz
2594
2595 print_3('neg', '', 'A = -A');
2596 } # $dcd_instr_z == 4
2597
2598 when (5)
2599 {
2600 if ($dcd_instr_y == 1)
2601 {
2602 # RETI ED 4D 11101101 01001101
2603 # xxyyyzzz
2604
2605 print_3('reti', '', 'PC.l = [SP++]; PC.h = [SP++]; End of maskable interrupt.');
2606 $prev_is_jump = TRUE;
2607 }
2608 else
2609 {
2610 # RETN ED xx 11101101 01xxx101
2611 # xxyyyzzz
2612
2613 print_3('retn', '', 'PC.l = [SP++]; PC.h = [SP++]; End of non-maskable interrupt.');
2614 $prev_is_jump = TRUE;
2615 }
2616 } # $dcd_instr_z == 5
2617
2618 when (6)
2619 {
2620 # IM n ED xx 11101101 01xxx110
2621 # xxyyyzzz
2622 # y: 0 - im 0
2623 # 1 - im 0
2624 # 2 - im 1
2625 # 3 - im 2
2626 # 4 - im 0
2627 # 5 - im 0
2628 # 6 - im 1
2629 # 7 - im 2
2630
2631 $dcd_instr_y &= 3;
2632 --$dcd_instr_y if ($dcd_instr_y);
2633
2634 print_3('im', $dcd_instr_y, "Interrupt mode ${dcd_instr_y}.");
2635 } # $dcd_instr_z == 6
2636
2637 when (7)
2638 {
2639 given ($dcd_instr_y)
2640 {
2641 when (0)
2642 {
2643 # LD I, A ED 47 11101101 01000111
2644 # xxyyyzzz
2645
2646 print_3('ld', 'I, A', 'I = A');
2647 }
2648
2649 when (1)
2650 {
2651 # LD R, A ED 4F 11101101 01001111
2652 # xxyyyzzz
2653
2654 print_3('ld', 'R, A', 'R = A');
2655 }
2656
2657 when (2)
2658 {
2659 # LD A, I ED 57 11101101 01010111
2660 # xxyyyzzz
2661
2662 print_3('ld', 'A, I', 'A = I');
2663 }
2664
2665 when (3)
2666 {
2667 # LD A, R ED 5F 11101101 01011111
2668 # xxyyyzzz
2669
2670 print_3('ld', 'A, R', 'A = R');
2671 }
2672
2673 when (4)
2674 {
2675 # RRD ED 67 11101101 01100111
2676 # xxyyyzzz
2677
2678 print_3('rrd', '', 'A[3..0] -> [HL][7..4] -> [HL][3..0] -> A[3..0]');
2679 }
2680
2681 when (5)
2682 {
2683 # RLD ED 6F 11101101 01101111
2684 # xxyyyzzz
2685
2686 print_3('rld', '', 'A[3..0] <- [HL][7..4] <- [HL][3..0] <- A[3..0]');
2687 }
2688
2689 default
2690 {
2691 # NOP ED 77 11101101 01110111
2692 # NOP ED 7F 11101101 01111111
2693 # xxyyyzzz
2694
2695 print_3('nop', '', 'No operation.');
2696 } # $dcd_instr_y == 6 || $dcd_instr_y == 7
2697 } # given ($dcd_instr_y)
2698 } # $dcd_instr_z == 7
2699 } # given ($dcd_instr_z)
2700 } # if ($dcd_instr_x == 1)
2701 elsif ($dcd_instr_x == 2 && $dcd_instr_y >= 4 && $dcd_instr_z <= 3)
2702 {
2703 # LDI ED A0 11101101 10100000
2704 # CPI ED A1 11101101 10100001
2705 # INI ED A2 11101101 10100010
2706 # OUTI ED A3 11101101 10100011
2707 # xxyyyzzz
2708
2709 # LDD ED A8 11101101 10101000
2710 # CPD ED A9 11101101 10101001
2711 # IND ED AA 11101101 10101010
2712 # OUTD ED AB 11101101 10101011
2713 # xxyyyzzz
2714
2715 # LDIR ED B0 11101101 10110000
2716 # CPIR ED B1 11101101 10110001
2717 # INIR ED B2 11101101 10110010
2718 # OTIR ED B3 11101101 10110011
2719 # xxyyyzzz
2720
2721 # LDDR ED B8 11101101 10111000
2722 # CPDR ED B9 11101101 10111001
2723 # INDR ED BA 11101101 10111010
2724 # OTDR ED BB 11101101 10111011
2725 # xxyyyzzz
2726
2727 my $i_block = $block_instr[$dcd_instr_y - 4][$dcd_instr_z];
2728
2729 print_3($i_block->{INSTR}, '', $i_block->{EXPL});
2730 }
2731 else
2732 {
2733 print_3('invalid instruction', '', '');
2734 }
2735 }
2736
2737 #-------------------------------------------------------------------------------
2738
2739 sub instruction_take_to_pieces($)
2740 {
2741 my $Instruction = $_[0];
2742
2743 $dcd_instr_x = ($Instruction >> 6) & 3;
2744 $dcd_instr_y = ($Instruction >> 3) & 7;
2745 $dcd_instr_z = $Instruction & 7;
2746 $dcd_instr_p = ($Instruction >> 4) & 3;
2747 $dcd_instr_q = ($Instruction >> 3) & 1;
2748 }
2749
2750 #-------------------------------------------------------------------------------
2751
2752 #
2753 # Decodes the $BlockRef.
2754 #
2755
2756 my @shift_instr =
2757 (
2758 {
2759 INSTR => 'rlca',
2760 EXPL => 'CF <- A[7..0] <- A.7'
2761 },
2762 {
2763 INSTR => 'rrca',
2764 EXPL => 'A.0 -> A[7..0] -> CF'
2765 },
2766 {
2767 INSTR => 'rla',
2768 EXPL => 'CF <- A[7..0] <- CF'
2769 },
2770 {
2771 INSTR => 'rra',
2772 EXPL => 'CF -> A[7..0] -> CF'
2773 },
2774 {
2775 INSTR => 'daa',
2776 EXPL => 'Conditionally decimal adjusts the Accumulator.'
2777 },
2778 {
2779 INSTR => 'cpl',
2780 EXPL => 'A = ~A'
2781 },
2782 {
2783 INSTR => 'scf',
2784 EXPL => 'CF = 1'
2785 },
2786 {
2787 INSTR => 'ccf',
2788 EXPL => 'CF = 0'
2789 }
2790 );
2791
2792 my @conditions =
2793 (
2794 {
2795 COND => 'NZ',
2796 EXPL => 'ZF == 0'
2797 },
2798 {
2799 COND => 'Z',
2800 EXPL => 'ZF == 1'
2801 },
2802 {
2803 COND => 'NC',
2804 EXPL => 'CF == 0'
2805 },
2806 {
2807 COND => 'C',
2808 EXPL => 'CF == 1'
2809 },
2810 {
2811 COND => 'PO',
2812 EXPL => 'PF == 0'
2813 },
2814 {
2815 COND => 'PE',
2816 EXPL => 'PF == 1'
2817 },
2818 {
2819 COND => 'P',
2820 EXPL => 'SF == 0'
2821 },
2822 {
2823 COND => 'M',
2824 EXPL => 'SF == 1'
2825 }
2826 );
2827
2828 sub instruction_decoder($$)
2829 {
2830 my ($Address, $BlockRef) = @_;
2831 my ($addr, $label, $invalid, $str);
2832
2833 $dcd_address = $Address;
2834 $dcd_instr_size = $BlockRef->{SIZE};
2835 $dcd_instr = $rom[$dcd_address];
2836 $label = $BlockRef->{LABEL};
2837
2838 if ($decoder_silent_level == SILENT0)
2839 {
2840 printf("0x%04X: %02X", $dcd_address, $dcd_instr) if (! $gen_assembly_code);
2841 }
2842
2843 $invalid = FALSE;
2844
2845 if ($dcd_instr_size == 1)
2846 {
2847 if ($decoder_silent_level == SILENT0)
2848 {
2849 print(($gen_assembly_code) ? "\t" : "\t\t");
2850 }
2851 }
2852 elsif ($dcd_instr_size == 2)
2853 {
2854 $dcd_parm0 = $rom[$dcd_address + 1];
2855 $invalid = TRUE if ($dcd_parm0 == EMPTY);
2856
2857 if ($decoder_silent_level == SILENT0)
2858 {
2859 if ($gen_assembly_code)
2860 {
2861 print "\t";
2862 }
2863 else
2864 {
2865 printf " %02X\t\t", $dcd_parm0;
2866 }
2867 }
2868 }
2869 elsif ($dcd_instr_size == 3)
2870 {
2871 $dcd_parm0 = $rom[$dcd_address + 1];
2872 $dcd_parm1 = $rom[$dcd_address + 2];
2873 $invalid = TRUE if ($dcd_parm0 == EMPTY || $dcd_parm1 == EMPTY);
2874
2875 if ($decoder_silent_level == SILENT0)
2876 {
2877 if ($gen_assembly_code)
2878 {
2879 print "\t";
2880 }
2881 else
2882 {
2883 printf " %02X %02X\t", $dcd_parm0, $dcd_parm1;
2884 }
2885 }
2886 }
2887 elsif ($dcd_instr_size == 4)
2888 {
2889 $dcd_parm0 = $rom[$dcd_address + 1];
2890 $dcd_parm1 = $rom[$dcd_address + 2];
2891 $dcd_parm2 = $rom[$dcd_address + 3];
2892 $invalid = TRUE if ($dcd_parm0 == EMPTY || $dcd_parm1 == EMPTY || $dcd_parm2 == EMPTY);
2893
2894 if ($decoder_silent_level == SILENT0)
2895 {
2896 if ($gen_assembly_code)
2897 {
2898 print "\t";
2899 }
2900 else
2901 {
2902 printf " %02X %02X %02X\t", $dcd_parm0, $dcd_parm1, $dcd_parm2;
2903 }
2904 }
2905 }
2906 else
2907 {
2908 printf STDERR "Internal error: The size of instruction (addr:0x%04X) is zero!", $dcd_address;
2909 exit(1);
2910 }
2911
2912 #
2913 # x y z
2914 # +---/ \---+ +------/ \------+ +------/ \------+
2915 # | | | | | |
2916 # | 7 6 | | 5 4 3 | | 2 1 0 |
2917 # +-----------------------------------------------+
2918 # | . | . | . | . | . | . | . | . |
2919 # +-----------------------------------------------+
2920 # | 5 4 | | 3 |
2921 # | | | |
2922 # +---\ /---+ +\ /+
2923 # p q
2924 #
2925
2926 $prev_is_jump = FALSE;
2927
2928 instruction_take_to_pieces($dcd_instr);
2929
2930 if ($dcd_instr_x == 0)
2931 {
2932 # x y z
2933 # +---/ \---+ +------/ \------+ +------/ \------+
2934 # | 7 6 | | 5 4 3 | | 2 1 0 |
2935 # +-----------------------------------------------+
2936 # | 0 | 0 | . | . | . | . | . | . |
2937 # +-----------------------------------------------+
2938 # | 5 4 | | 3 |
2939 # +---\ /---+ +\ /+
2940 # p q
2941
2942 given ($dcd_instr_z)
2943 {
2944 when (0)
2945 {
2946 # x y z
2947 # +---/ \---+ +------/ \------+ +------/ \------+
2948 # | 7 6 | | 5 4 3 | | 2 1 0 |
2949 # +-----------------------------------------------+
2950 # | 0 | 0 | . | . | . | 0 | 0 | 0 |
2951 # +-----------------------------------------------+
2952
2953 given ($dcd_instr_y)
2954 {
2955 when (0)
2956 {
2957 # NOP 00 00000000
2958 # xxyyyzzz
2959
2960 print_3('nop', '', 'No operation.');
2961 }
2962
2963 when (1)
2964 {
2965 # EX AF, AF' 08 00001000
2966 # xxyyyzzz
2967
2968 print_3('ex', "AF, AF'", "AF <-> AF'");
2969 }
2970
2971 when (2)
2972 {
2973 # DJNZ e 10 00010000 eeeeeeee e: two's complement number
2974 # xxyyyzzz
2975
2976 if ($decoder_silent_level == SILENT0)
2977 {
2978 my $addr = $dcd_address + 2 + expand_offset($dcd_parm0);
2979 my $target;
2980
2981 $str = label_name($addr);
2982 $target = jump_direction($addr);
2983 print_3('djnz', $str, "If (--B != 0) jumps$target");
2984 $prev_is_jump = TRUE;
2985 }
2986 }
2987
2988 when (3)
2989 {
2990 # JR e 18 00011000 eeeeeeee e: two's complement number
2991 # xxyyyzzz
2992
2993 if ($decoder_silent_level == SILENT0)
2994 {
2995 my $addr = $dcd_address + 2 + expand_offset($dcd_parm0);
2996 my $target;
2997
2998 $str = label_name($addr);
2999 $target = jump_direction($addr);
3000 print_3('jr', $str, "Jumps$target");
3001 $prev_is_jump = TRUE;
3002 }
3003 }
3004
3005 default
3006 {
3007 # 4-7
3008 # JR cc, e xx 00ccc000 eeeeeeee e: two's complement number
3009 # xxyyyzzz
3010
3011 if ($decoder_silent_level == SILENT0)
3012 {
3013 my $addr = $dcd_address + 2 + expand_offset($dcd_parm0);
3014 my $cond = $conditions[$dcd_instr_y - 4];
3015 my $target;
3016
3017 $str = label_name($addr);
3018 $target = jump_direction($addr);
3019 print_3('jr', "$cond->{COND}, $str", "Jumps if ($cond->{EXPL})$target");
3020 $prev_is_jump = TRUE;
3021 }
3022 }
3023 } # given ($dcd_instr_y)
3024 } # $dcd_instr_z == 0
3025
3026 when (1)
3027 {
3028 # x z
3029 # +---/ \---+ +------/ \------+
3030 # | 7 6 | | 2 1 0 |
3031 # +-----------------------------------------------+
3032 # | 0 | 0 | . | . | . | 0 | 0 | 1 |
3033 # +-----------------------------------------------+
3034 # | 5 4 | | 3 |
3035 # +---\ /---+ +\ /+
3036 # p q
3037
3038 if ($dcd_instr_q == 0)
3039 {
3040 # LD rp, #nn x1 00rr0001 nnnnnnnn nnnnnnnn
3041 # xxppqzzz
3042 # rp: BC, DE, HL, SP
3043
3044 my $r16 = $core_registers16a[$dcd_instr_p];
3045
3046 $str = sprintf '0x%04X', ($dcd_parm1 << 8) | $dcd_parm0;
3047 print_3('ld', "$r16, #$str", "$r16 = $str");
3048 }
3049 else
3050 {
3051 # ADD HL, rp x9 00rr1001
3052 # xxppqzzz
3053 # rp: BC, DE, HL, SP
3054
3055 $str = $core_registers16a[$dcd_instr_p];
3056 print_3('add', "HL, $str", "HL += $str");
3057 }
3058 } # $dcd_instr_z == 1
3059
3060 when (2)
3061 {
3062 # x y z
3063 # +---/ \---+ +------/ \------+ +------/ \------+
3064 # | 7 6 | | 5 4 3 | | 2 1 0 |
3065 # +-----------------------------------------------+
3066 # | 0 | 0 | . | . | . | 0 | 1 | 0 |
3067 # +-----------------------------------------------+
3068 # | 5 4 | | 3 |
3069 # +---\ /---+ +\ /+
3070 # p q
3071
3072 if ($dcd_instr_q == 0)
3073 {
3074 # x z
3075 # +---/ \---+ +------/ \------+
3076 # | 7 6 | | 2 1 0 |
3077 # +-----------------------------------------------+
3078 # | 0 | 0 | . | . | 0 | 0 | 1 | 0 |
3079 # +-----------------------------------------------+
3080 # | 5 4 | | 3 |
3081 # +---\ /---+ +\ /+
3082 # p q
3083
3084 given ($dcd_instr_p)
3085 {
3086 when (0)
3087 {
3088 # LD (BC), A 02 00000010
3089 # xxppqzzz
3090
3091 print_3('ld', '(BC), A', '[BC] = A');
3092 } # $dcd_instr_p == 0
3093
3094 when (1)
3095 {
3096 # LD (DE), A 12 00010010
3097 # xxppqzzz
3098
3099 print_3('ld', '(DE), A', '[DE] = A');
3100 } # $dcd_instr_p == 1
3101
3102 when (2)
3103 {
3104 # LD (nn), HL 22 00100010 nnnnnnnn nnnnnnnn
3105 # xxppqzzz
3106
3107 $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3108
3109 if ($decoder_silent_level == SILENT0)
3110 {
3111 my $name;
3112
3113 $str = reg_name($addr, \$name);
3114 print_3('ld', "($str), HL", "$name = HL");
3115 }
3116 elsif ($decoder_silent_level == SILENT1)
3117 {
3118 add_ram($addr, '', FALSE);
3119 }
3120 } # $dcd_instr_p == 2
3121
3122 when (3)
3123 {
3124 # LD (nn), A 32 00110010 nnnnnnnn nnnnnnnn
3125 # xxppqzzz
3126
3127 $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3128
3129 if ($decoder_silent_level == SILENT0)
3130 {
3131 my $name;
3132
3133 $str = reg_name($addr, \$name);
3134 print_3('ld', "($str), A", "$name = A");
3135 }
3136 elsif ($decoder_silent_level == SILENT1)
3137 {
3138 add_ram($addr, '', FALSE);
3139 }
3140 } # $dcd_instr_p == 3
3141 } # given ($dcd_instr_p)
3142 } # if ($dcd_instr_q == 0)
3143 else
3144 {
3145 # x z
3146 # +---/ \---+ +------/ \------+
3147 # | 7 6 | | 2 1 0 |
3148 # +-----------------------------------------------+
3149 # | 0 | 0 | . | . | 1 | 0 | 1 | 0 |
3150 # +-----------------------------------------------+
3151 # | 5 4 | | 3 |
3152 # +---\ /---+ +\ /+
3153 # p q
3154
3155 given ($dcd_instr_p)
3156 {
3157 when (0)
3158 {
3159 # LD A, (BC) 0A 00001010
3160 # xxppqzzz
3161
3162 print_3('ld', 'A, (BC)', 'A = [BC]');
3163 } # $dcd_instr_p == 0
3164
3165 when (1)
3166 {
3167 # LD A, (DE) 1A 00011010
3168 # xxppqzzz
3169
3170 print_3('ld', 'A, (DE)', 'A = [DE]');
3171 } # $dcd_instr_p == 1
3172
3173 when (2)
3174 {
3175 # LD HL, (nn) 2A 00101010 nnnnnnnn nnnnnnnn
3176 # xxppqzzz
3177
3178 $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3179
3180 if ($decoder_silent_level == SILENT0)
3181 {
3182 my $name;
3183
3184 $str = reg_name($addr, \$name);
3185 print_3('ld', "HL, ($str)", "HL = $name");
3186 }
3187 elsif ($decoder_silent_level == SILENT1)
3188 {
3189 add_ram($addr, '', FALSE);
3190 }
3191 } # $dcd_instr_p == 2
3192
3193 when (3)
3194 {
3195 # LD A, (nn) 3A 00111010 nnnnnnnn nnnnnnnn
3196 # xxppqzzz
3197
3198 $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3199
3200 if ($decoder_silent_level == SILENT0)
3201 {
3202 my $name;
3203
3204 $str = reg_name($addr, \$name);
3205 print_3('ld', "A, ($str)", "A = $name");
3206 }
3207 elsif ($decoder_silent_level == SILENT1)
3208 {
3209 add_ram($addr, '', FALSE);
3210 }
3211 } # $dcd_instr_p == 3
3212 } # given ($dcd_instr_p)
3213 }
3214 } # $dcd_instr_z == 2
3215
3216 when (3)
3217 {
3218 # x z
3219 # +---/ \---+ +------/ \------+
3220 # | 7 6 | | 2 1 0 |
3221 # +-----------------------------------------------+
3222 # | 0 | 0 | . | . | . | 0 | 1 | 1 |
3223 # +-----------------------------------------------+
3224 # | 5 4 | | 3 |
3225 # +---\ /---+ +\ /+
3226 # p q
3227
3228 if ($dcd_instr_q == 0)
3229 {
3230 # INC rp x3 00rr0011
3231 # xxppqzzz
3232 # rp: BC, DE, HL, SP
3233
3234 $str = $core_registers16a[$dcd_instr_p];
3235 print_3('inc', $str, "++$str");
3236 }
3237 else
3238 {
3239 # DEC rp x3 00rr1011
3240 # xxppqzzz
3241 # rp: BC, DE, HL, SP
3242
3243 $str = $core_registers16a[$dcd_instr_p];
3244 print_3('dec', $str, "--$str");
3245 }
3246 } # $dcd_instr_z == 3
3247
3248 when (4)
3249 {
3250 # x y z
3251 # +---/ \---+ +------/ \------+ +------/ \------+
3252 # | 7 6 | | 5 4 3 | | 2 1 0 |
3253 # +-----------------------------------------------+
3254 # | 0 | 0 | . | . | . | 1 | 0 | 0 |
3255 # +-----------------------------------------------+
3256
3257 # INC r xx 00rrr100
3258 # xxyyyzzz
3259 # r: B, C, D, E, H, L, (HL), A
3260
3261 if ($decoder_silent_level == SILENT0)
3262 {
3263 my $i_reg = $core_registers8[$dcd_instr_y];
3264
3265 print_3('inc', $i_reg->{NAME}, "++$i_reg->{EXPL}");
3266 }
3267 } # $dcd_instr_z == 4
3268
3269 when (5)
3270 {
3271 # x y z
3272 # +---/ \---+ +------/ \------+ +------/ \------+
3273 # | 7 6 | | 5 4 3 | | 2 1 0 |
3274 # +-----------------------------------------------+
3275 # | 0 | 0 | . | . | . | 1 | 0 | 1 |
3276 # +-----------------------------------------------+
3277
3278 # DEC r xx 00rrr101
3279 # xxyyyzzz
3280 # r: B, C, D, E, H, L, (HL), A
3281
3282 if ($decoder_silent_level == SILENT0)
3283 {
3284 my $i_reg = $core_registers8[$dcd_instr_y];
3285
3286 print_3('dec', $i_reg->{NAME}, "--$i_reg->{EXPL}");
3287 }
3288 } # $dcd_instr_z == 5
3289
3290 when (6)
3291 {
3292 # x y z
3293 # +---/ \---+ +------/ \------+ +------/ \------+
3294 # | 7 6 | | 5 4 3 | | 2 1 0 |
3295 # +-----------------------------------------------+
3296 # | 0 | 0 | . | . | . | 1 | 1 | 0 |
3297 # +-----------------------------------------------+
3298
3299 # LD r, #n 00rrr110 nnnnnnnn
3300 # xxyyyzzz
3301
3302 if ($decoder_silent_level == SILENT0)
3303 {
3304 my $i_reg = $core_registers8[$dcd_instr_y];
3305 my $char = decode_char($dcd_parm0);
3306
3307 $str = sprintf '0x%02X', $dcd_parm0;
3308 print_3('ld', "$i_reg->{NAME}, #$str", "$i_reg->{EXPL} = $str$char");
3309 }
3310 } # $dcd_instr_z == 6
3311
3312 when (7)
3313 {
3314 # x y z
3315 # +---/ \---+ +------/ \------+ +------/ \------+
3316 # | 7 6 | | 5 4 3 | | 2 1 0 |
3317 # +-----------------------------------------------+
3318 # | 0 | 0 | . | . | . | 1 | 1 | 1 |
3319 # +-----------------------------------------------+
3320
3321 # RLCA 07 00000111
3322 # RRCA 0F 00001111
3323 # RLA 17 00010111
3324 # RRA 1F 00011111
3325 # DAA 27 00100111
3326 # CPL 2F 00101111
3327 # SCF 37 00110111
3328 # CCF 3F 00111111
3329 # xxyyyzzz
3330
3331 my $s_instr = $shift_instr[$dcd_instr_y];
3332
3333 print_3($s_instr->{INSTR}, '', $s_instr->{EXPL});
3334 } # $dcd_instr_z == 7
3335 } # given ($dcd_instr_z)
3336 } # if ($dcd_instr_x == 0)
3337 elsif ($dcd_instr_x == 1)
3338 {
3339 # x y z
3340 # +---/ \---+ +------/ \------+ +------/ \------+
3341 # | 7 6 | | 5 4 3 | | 2 1 0 |
3342 # +-----------------------------------------------+
3343 # | 0 | 1 | . | . | . | . | . | . |
3344 # +-----------------------------------------------+
3345
3346 if ($dcd_instr_y == 6)
3347 {
3348 # x y z
3349 # +---/ \---+ +------/ \------+ +------/ \------+
3350 # | 7 6 | | 5 4 3 | | 2 1 0 |
3351 # +-----------------------------------------------+
3352 # | 0 | 1 | 1 | 1 | 0 | . | . | . |
3353 # +-----------------------------------------------+
3354
3355 # HALT 76 01110110
3356 # xxyyyzzz
3357
3358 print_3('halt', '', 'Suspends CPU.');
3359 }
3360 else
3361 {
3362 # x y z
3363 # +---/ \---+ +------/ \------+ +------/ \------+
3364 # | 7 6 | | 5 4 3 | | 2 1 0 |
3365 # +-----------------------------------------------+
3366 # | 0 | 1 | . | . | . | . | . | . |
3367 # +-----------------------------------------------+
3368
3369 # LD r, r' xx 01dddsss
3370 # xxyyyzzz
3371 # r: B, C, D, E, H, L, (HL), A
3372
3373 if ($decoder_silent_level == SILENT0)
3374 {
3375 my $i_rega = $core_registers8[$dcd_instr_y];
3376 my $i_regb = $core_registers8[$dcd_instr_z];
3377
3378 print_3('ld', "$i_rega->{NAME}, $i_regb->{NAME}", "$i_rega->{EXPL} = $i_regb->{EXPL}");
3379 }
3380 }
3381 } # elsif ($dcd_instr_x == 1)
3382 elsif ($dcd_instr_x == 2)
3383 {
3384 # x y z
3385 # +---/ \---+ +------/ \------+ +------/ \------+
3386 # | 7 6 | | 5 4 3 | | 2 1 0 |
3387 # +-----------------------------------------------+
3388 # | 1 | 0 | . | . | . | . | . | . |
3389 # +-----------------------------------------------+
3390
3391 # ADD A, r 8x 10000rrr
3392 # ADC A, r 8x 10001rrr
3393 # SUB A, r 9x 10010rrr
3394 # SBC A, r 9x 10011rrr
3395 # AND A, r Ax 10100rrr
3396 # XOR A, r Ax 10101rrr
3397 # OR A, r Bx 10110rrr
3398 # CP A, r Bx 10111rrr
3399 # xxyyyzzz
3400 # r: B, C, D, E, H, L, (HL), A
3401
3402 if ($decoder_silent_level == SILENT0)
3403 {
3404 my $i_arith = $DDFD_instr[$dcd_instr_y];
3405 my $i_reg = $core_registers8[$dcd_instr_z];
3406 my $str0 = ($dcd_instr_z == 7) ? ' (A = 0)' : '';
3407
3408 print_3($i_arith->{INSTR}, "A, $i_reg->{NAME}", "$i_arith->{EXPL} $i_reg->{EXPL}$str0");
3409 }
3410 }
3411 else # $dcd_instr_x == 3
3412 {
3413 # x y z
3414 # +---/ \---+ +------/ \------+ +------/ \------+
3415 # | 7 6 | | 5 4 3 | | 2 1 0 |
3416 # +-----------------------------------------------+
3417 # | 1 | 1 | . | . | . | . | . | . |
3418 # +-----------------------------------------------+
3419 # | 5 4 | | 3 |
3420 # +---\ /---+ +\ /+
3421 # p q
3422
3423 given ($dcd_instr_z)
3424 {
3425 when (0)
3426 {
3427 # x y z
3428 # +---/ \---+ +------/ \------+ +------/ \------+
3429 # | 7 6 | | 5 4 3 | | 2 1 0 |
3430 # +-----------------------------------------------+
3431 # | 1 | 1 | . | . | . | 0 | 0 | 0 |
3432 # +-----------------------------------------------+
3433
3434 # RET cc xx 11ccc000
3435 # xxyyyzzz
3436 # cc: NZ, Z, NC, C, PO, PE, P, M
3437
3438 my $cond = $conditions[$dcd_instr_y];
3439
3440 print_3('ret', $cond->{COND}, "If ($cond->{EXPL}) PC.l = [SP++]; PC.h = [SP++]");
3441 $prev_is_jump = TRUE;
3442 }
3443
3444 when (1)
3445 {
3446 # x y z
3447 # +---/ \---+ +------/ \------+ +------/ \------+
3448 # | 7 6 | | 5 4 3 | | 2 1 0 |
3449 # +-----------------------------------------------+
3450 # | 1 | 1 | . | . | . | 0 | 0 | 1 |
3451 # +-----------------------------------------------+
3452 # | 5 4 | | 3 |
3453 # +---\ /---+ +\ /+
3454 # p q
3455
3456 if ($dcd_instr_q == 0)
3457 {
3458 # x z
3459 # +---/ \---+ +------/ \------+
3460 # | 7 6 | | 2 1 0 |
3461 # +-----------------------------------------------+
3462 # | 1 | 1 | . | . | 0 | 0 | 0 | 1 |
3463 # +-----------------------------------------------+
3464 # | 5 4 | | 3 |
3465 # +---\ /---+ +\ /+
3466 # p q
3467
3468 # POP rp xx 11rr0001
3469 # xxppqzzz
3470 # rp: BC, DE, HL, AF
3471
3472 given ($dcd_instr_p)
3473 {
3474 when (0) { $str = 'C = [SP++]; B = [SP++]'; }
3475 when (1) { $str = 'E = [SP++]; D = [SP++]'; }
3476 when (2) { $str = 'L = [SP++]; H = [SP++]'; }
3477 when (3) { $str = 'F = [SP++]; A = [SP++]'; }
3478 }
3479
3480 print_3('pop', $core_registers16b[$dcd_instr_p], $str);
3481 }
3482 else
3483 {
3484 # x z
3485 # +---/ \---+ +------/ \------+
3486 # | 7 6 | | 2 1 0 |
3487 # +-----------------------------------------------+
3488 # | 1 | 1 | . | . | 1 | 0 | 0 | 1 |
3489 # +-----------------------------------------------+
3490 # | 5 4 | | 3 |
3491 # +---\ /---+ +\ /+
3492 # p q
3493
3494 given ($dcd_instr_p)
3495 {
3496 when (0)
3497 {
3498 # RET C9 11001001
3499 # xxppqzzz
3500
3501 print_3('ret', '', 'PC.l = [SP++]; PC.h = [SP++]');
3502 $prev_is_jump = TRUE;
3503 }
3504
3505 when (1)
3506 {
3507 # EXX D9 11011001
3508 # xxppqzzz
3509
3510 print_3('exx', '', "BC <-> BC'; DE <-> DE'; HL <-> HL'");
3511 }
3512
3513 when (2)
3514 {
3515 # JP (HL) E9 11101001
3516 # xxppqzzz
3517
3518 print_3('jp', '(HL)', 'Jumps to value of HL.');
3519 $prev_is_jump = TRUE;
3520 }
3521
3522 when (3)
3523 {
3524 # LD SP, HL F9 11111001
3525 # xxppqzzz
3526
3527 print_3('ld', 'SP, HL', 'SP = HL');
3528 }
3529 } # given ($dcd_instr_p)
3530 }
3531 } # $dcd_instr_z == 1
3532
3533 when (2)
3534 {
3535 # x y z
3536 # +---/ \---+ +------/ \------+ +------/ \------+
3537 # | 7 6 | | 5 4 3 | | 2 1 0 |
3538 # +-----------------------------------------------+
3539 # | 1 | 1 | . | . | . | 0 | 1 | 0 |
3540 # +-----------------------------------------------+
3541
3542 # JP cc, nn xx nn nn 11ccc010 a7-0 a15-8
3543 # xxyyyzzz
3544 # cc: NZ, Z, NC, C, PO, PE, P, M
3545
3546 if ($decoder_silent_level == SILENT0)
3547 {
3548 my $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3549 my $cond = $conditions[$dcd_instr_y];
3550 my $target;
3551
3552 $str = label_name($addr);
3553 $target = jump_direction($addr);
3554 print_3('jp', "$cond->{COND}, $str", "Jumps if ($cond->{EXPL})$target");
3555 $prev_is_jump = TRUE;
3556 }
3557 }
3558
3559 when (3)
3560 {
3561 # x y z
3562 # +---/ \---+ +------/ \------+ +------/ \------+
3563 # | 7 6 | | 5 4 3 | | 2 1 0 |
3564 # +-----------------------------------------------+
3565 # | 1 | 1 | . | . | . | 0 | 1 | 1 |
3566 # +-----------------------------------------------+
3567
3568 given ($dcd_instr_y)
3569 {
3570 when (0)
3571 {
3572 # JP nn 11000011 a7-0 a15-8
3573 # xxyyyzzz
3574
3575 if ($decoder_silent_level == SILENT0)
3576 {
3577 my $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3578 my $target;
3579
3580 $str = label_name($addr);
3581 $target = jump_direction($addr);
3582 print_3('jp', $str, "Jumps$target");
3583 $prev_is_jump = TRUE;
3584 }
3585 }
3586
3587 when (1)
3588 {
3589 instruction_take_to_pieces($dcd_parm0);
3590 CB_prefix_decoder();
3591 }
3592
3593 when (2)
3594 {
3595 # OUT (n), A D3 11010011 nnnnnnnn
3596 # xxyyyzzz
3597
3598 if ($decoder_silent_level == SILENT0)
3599 {
3600 my $io = sprintf '0x%02X', $dcd_parm0;
3601
3602 if ($gen_assembly_code)
3603 {
3604 print_3('out', "($io), A", "Out{$io} = A");
3605 }
3606 else
3607 {
3608 $str = io_name($dcd_parm0);
3609 print_3('out', "($str), A", "Out{$io} = A");
3610 }
3611 }
3612 elsif ($decoder_silent_level == SILENT1)
3613 {
3614 add_io($dcd_parm0, '', FALSE);
3615 }
3616 }
3617
3618 when (3)
3619 {
3620 # IN A, (n) DB 11011011 nnnnnnnn
3621 # xxyyyzzz
3622
3623 if ($decoder_silent_level == SILENT0)
3624 {
3625 my $io = sprintf '0x%02X', $dcd_parm0;
3626
3627 if ($gen_assembly_code)
3628 {
3629 print_3('in', "A, ($io)", "A = In{$io}");
3630 }
3631 else
3632 {
3633 $str = io_name($dcd_parm0);
3634 print_3('in', "A, ($str)", "A = In{$io}");
3635 }
3636 }
3637 elsif ($decoder_silent_level == SILENT1)
3638 {
3639 add_io($dcd_parm0, '', FALSE);
3640 }
3641 }
3642
3643 when (4)
3644 {
3645 # EX (SP), HL E3 11100011
3646 # xxyyyzzz
3647
3648 print_3('ex', '(SP), HL', "[SP] <-> L; [SP+1] <-> H");
3649 }
3650
3651 when (5)
3652 {
3653 # EX DE, HL EB 11101011
3654 # xxyyyzzz
3655
3656 print_3('ex', 'DE, HL', "E <-> L; D <-> H");
3657 }
3658
3659 when (6)
3660 {
3661 # DI F3 11110011
3662 # xxyyyzzz
3663
3664 print_3('di', '', 'Disable interrupts.');
3665 }
3666
3667 when (7)
3668 {
3669 # EI FB 11111011
3670 # xxyyyzzz
3671
3672 print_3('ei', '', 'Enable interrupts.');
3673 }
3674 } # given ($dcd_instr_y)
3675 } # $dcd_instr_z == 3
3676
3677 when (4)
3678 {
3679 # x y z
3680 # +---/ \---+ +------/ \------+ +------/ \------+
3681 # | 7 6 | | 5 4 3 | | 2 1 0 |
3682 # +-----------------------------------------------+
3683 # | 1 | 1 | . | . | . | 1 | 0 | 0 |
3684 # +-----------------------------------------------+
3685
3686 # CALL cc, nn xx nn nn 11ccc100 a7-0 a15-8
3687 # xxyyyzzz
3688 # cc: NZ, Z, NC, C, PO, PE, P, M
3689
3690 if ($decoder_silent_level == SILENT0)
3691 {
3692 my $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3693 my $cond = $conditions[$dcd_instr_y];
3694 my $target;
3695
3696 $str = label_name($addr);
3697 $target = jump_direction($addr);
3698 print_3('call', "$cond->{COND}, $str", "Calls ([--SP] = PC.h; [--SP] = PC.l) if ($cond->{EXPL})$target");
3699 }
3700 } # $dcd_instr_z == 4
3701
3702 when (5)
3703 {
3704 # x y z
3705 # +---/ \---+ +------/ \------+ +------/ \------+
3706 # | 7 6 | | 5 4 3 | | 2 1 0 |
3707 # +-----------------------------------------------+
3708 # | 1 | 1 | . | . | . | 1 | 0 | 1 |
3709 # +-----------------------------------------------+
3710 # | 5 4 | | 3 |
3711 # +---\ /---+ +\ /+
3712 # p q
3713
3714 if ($dcd_instr_q == 0)
3715 {
3716 # x z
3717 # +---/ \---+ +------/ \------+
3718 # | 7 6 | | 2 1 0 |
3719 # +-----------------------------------------------+
3720 # | 1 | 1 | . | . | 0 | 1 | 0 | 1 |
3721 # +-----------------------------------------------+
3722 # | 5 4 | | 3 |
3723 # +---\ /---+ +\ /+
3724 # p q
3725
3726 # PUSH rp xx 11rr0101
3727 # xxppqzzz
3728 # rp: BC, DE, HL, AF
3729
3730 given ($dcd_instr_p)
3731 {
3732 when (0) { $str = '[--SP] = B; [--SP] = C'; }
3733 when (1) { $str = '[--SP] = D; [--SP] = E'; }
3734 when (2) { $str = '[--SP] = H; [--SP] = L'; }
3735 when (3) { $str = '[--SP] = A; [--SP] = F'; }
3736 }
3737
3738 print_3('push', $core_registers16b[$dcd_instr_p], $str);
3739 }
3740 else
3741 {
3742 # x z
3743 # +---/ \---+ +------/ \------+
3744 # | 7 6 | | 2 1 0 |
3745 # +-----------------------------------------------+
3746 # | 1 | 1 | . | . | 1 | 1 | 0 | 1 |
3747 # +-----------------------------------------------+
3748 # | 5 4 | | 3 |
3749 # +---\ /---+ +\ /+
3750 # p q
3751
3752 given ($dcd_instr_p)
3753 {
3754 when (0)
3755 {
3756 # x z
3757 # +---/ \---+ +------/ \------+
3758 # | 7 6 | | 2 1 0 |
3759 # +-----------------------------------------------+
3760 # | 1 | 1 | 0 | 0 | 1 | 1 | 0 | 1 |
3761 # +-----------------------------------------------+
3762 # | 5 4 | | 3 |
3763 # +---\ /---+ +\ /+
3764 # p q
3765
3766 # CALL nn CD nn nn 11001101 a7-0 a15-8
3767 # xxyyyzzz
3768
3769 if ($decoder_silent_level == SILENT0)
3770 {
3771 my $addr = ($dcd_parm1 << 8) | $dcd_parm0;
3772 my $target;
3773
3774 $str = label_name($addr);
3775 $target = jump_direction($addr);
3776 print_3('call', $str, "Calls ([--SP] = PC.h; [--SP] = PC.l)$target");
3777 }
3778 }
3779
3780 when (1)
3781 {
3782 # x z
3783 # +---/ \---+ +------/ \------+
3784 # | 7 6 | | 2 1 0 |
3785 # +-----------------------------------------------+
3786 # | 1 | 1 | 0 | 1 | 1 | 1 | 0 | 1 |
3787 # +-----------------------------------------------+
3788 # | 5 4 | | 3 |
3789 # +---\ /---+ +\ /+
3790 # p q
3791
3792 DDFD_prefix_decoder('IX');
3793 }
3794
3795 when (2)
3796 {
3797 # x z
3798 # +---/ \---+ +------/ \------+
3799 # | 7 6 | | 2 1 0 |
3800 # +-----------------------------------------------+
3801 # | 1 | 1 | 1 | 0 | 1 | 1 | 0 | 1 |
3802 # +-----------------------------------------------+
3803 # | 5 4 | | 3 |
3804 # +---\ /---+ +\ /+
3805 # p q
3806
3807 ED_prefix_decoder();
3808 }
3809
3810 when (3)
3811 {
3812 # x z
3813 # +---/ \---+ +------/ \------+
3814 # | 7 6 | | 2 1 0 |
3815 # +-----------------------------------------------+
3816 # | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 1 |
3817 # +-----------------------------------------------+
3818 # | 5 4 | | 3 |
3819 # +---\ /---+ +\ /+
3820 # p q
3821
3822 DDFD_prefix_decoder('IY');
3823 }
3824 } # given ($dcd_instr_p)
3825 }
3826 } # $dcd_instr_z == 5
3827
3828 when (6)
3829 {
3830 # x y z
3831 # +---/ \---+ +------/ \------+ +------/ \------+
3832 # | 7 6 | | 5 4 3 | | 2 1 0 |
3833 # +-----------------------------------------------+
3834 # | 1 | 1 | . | . | . | 1 | 1 | 0 |
3835 # +-----------------------------------------------+
3836
3837 # ADD A, #n 11000110 nnnnnnnn
3838 # ADC A, #n 11001110 nnnnnnnn
3839 # SUB A, #n 11010110 nnnnnnnn
3840 # SBC A, #n 11011110 nnnnnnnn
3841 # AND A, #n 11100110 nnnnnnnn
3842 # XOR A, #n 11101110 nnnnnnnn
3843 # OR A, #n 11110110 nnnnnnnn
3844 # CP A, #n 11111110 nnnnnnnn
3845 # xxyyyzzz
3846
3847 my $i_arith = $DDFD_instr[$dcd_instr_y];
3848 my $num = sprintf '0x%02X', $dcd_parm0;
3849 my $char = decode_char($dcd_parm0);
3850 my $str0 = '';
3851
3852 $str0 = ' (A = A)' if ($dcd_instr_y == 0 && $dcd_parm0 == 0); # ADD A, 0
3853 $str0 = ' (A = A)' if ($dcd_instr_y == 2 && $dcd_parm0 == 0); # SUB A, 0
3854 $str0 = ' (A = A)' if ($dcd_instr_y == 4 && $dcd_parm0 == 0xFF); # AND A, 0xFF
3855 $str0 = ' (A = ~A)' if ($dcd_instr_y == 5 && $dcd_parm0 == 0xFF); # XOR A, 0xFF
3856 $str0 = ' (A = A)' if ($dcd_instr_y == 6 && $dcd_parm0 == 0); # OR A, 0
3857
3858 print_3($i_arith->{INSTR}, "A, #$num", "$i_arith->{EXPL} $num$char$str0");
3859 } # $dcd_instr_z == 6
3860
3861 when (7)
3862 {
3863 # x y z
3864 # +---/ \---+ +------/ \------+ +------/ \------+
3865 # | 7 6 | | 5 4 3 | | 2 1 0 |
3866 # +-----------------------------------------------+
3867 # | 1 | 1 | . | . | . | 1 | 1 | 1 |
3868 # +-----------------------------------------------+
3869
3870 # RST t xx 11ttt111
3871 # xxyyyzzz
3872 # t: 0 - 7
3873
3874 $addr = sprintf '0x%04X', $dcd_instr_y * 8;
3875 $str = sprintf '0x%02X', $dcd_instr_y * 8;
3876 print_3('rst', $str, "Calls interrupt: [--SP] = PC.h; [--SP] = PC.l; PC = $addr");
3877 } # $dcd_instr_z == 7
3878 } # given ($dcd_instr_z)
3879 } # $dcd_instr_x == 3
3880 }
3881
3882 ################################################################################
3883 ################################################################################
3884
3885 #
3886 # Reads the sfrs and bits from the $Line.
3887 #
3888
3889 sub process_header_line($)
3890 {
3891 my $Line = $_[0];
3892
3893 Log((' ' x $embed_level) . $Line, 5);
3894
3895 if ($Line =~ /^#\s*include\s+["<]\s*(\S+)\s*[">]$/o)
3896 {
3897 $embed_level += 4;
3898 &read_header("$include_path/$1");
3899 $embed_level -= 4;
3900 }
3901 elsif ($Line =~ /^__sfr\s+__at\s*(?:\(\s*)?0x([[:xdigit:]]+)(?:\s*\))?\s+([\w_]+)/io)
3902 {
3903 # __sfr __at (0x80) P0 ; /* PORT 0 */
3904
3905 add_ram(hex($1), $2, TRUE);
3906 }
3907 elsif ($Line =~ /^SFR\s*\(\s*([\w_]+)\s*,\s*0x([[:xdigit:]]+)\s*\)/io)
3908 {
3909 # SFR(P0, 0x80); // Port 0
3910
3911 add_ram(hex($2), $1, TRUE);
3912 }
3913 elsif ($Line =~ /^sfr\s+([\w_]+)\s*=\s*0x([[:xdigit:]]+)/io)
3914 {
3915 # sfr P1 = 0x90;
3916
3917 add_ram(hex($2), $1, TRUE);
3918 }
3919 }
3920
3921 #-------------------------------------------------------------------------------
3922
3923 #
3924 # Reads in a MCU.h file.
3925 #
3926
3927 sub read_header($)
3928 {
3929 my $Header = $_[0];
3930 my ($fh, $pre_comment, $comment, $line_number);
3931 my $head;
3932
3933 if (! open($fh, '<', $Header))
3934 {
3935 print STDERR "$PROGRAM: Could not open. -> \"$Header\"\n";
3936 exit(1);
3937 }
3938
3939 $head = ' ' x $embed_level;
3940
3941 Log("${head}read_header($Header) >>>>", 5);
3942
3943 $comment = FALSE;
3944 $line_number = 1;
3945 while (<$fh>)
3946 {
3947 chomp;
3948 s/\r$//o; # '\r'
3949
3950 # Filters off the C comments.
3951
3952 s/\/\*.*\*\///o; # /* ... */
3953 s/\/\/.*$//o; # // ...
3954 s/^\s*|\s*$//go;
3955
3956 if (/\/\*/o) # /*
3957 {
3958 $pre_comment = TRUE;
3959 s/\s*\/\*.*$//o;
3960 }
3961 elsif (/\*\//o) # */
3962 {
3963 $pre_comment = FALSE;
3964 $comment = FALSE;
3965 s/^.*\*\/\s*//o;
3966 }
3967
3968 if ($comment)
3969 {
3970 ++$line_number;
3971 next;
3972 }
3973
3974 $comment = $pre_comment if ($pre_comment);
3975
3976 if (/^\s*$/o)
3977 {
3978 ++$line_number;
3979 next;
3980 }
3981
3982 run_preprocessor($Header, \&process_header_line, $_, $line_number);
3983 ++$line_number;
3984 } # while (<$fh>)
3985
3986 Log("${head}<<<< read_header($Header)", 5);
3987 close($fh);
3988 }
3989
3990 #-------------------------------------------------------------------------------
3991
3992 #
3993 # Determines size of the $dcd_instr.
3994 #
3995
3996 sub determine_instr_size()
3997 {
3998 my $instr;
3999 my $size = $instruction_sizes_[$dcd_instr];
4000
4001 return $size if ($size >= 0);
4002
4003 $instr = $rom[$dcd_address + 1];
4004
4005 if ($size == IPREFIX_DD || $size == IPREFIX_FD)
4006 {
4007 return $instruction_sizes_DDFD[$instr];
4008 }
4009 elsif ($size == IPREFIX_ED)
4010 {
4011 return $instruction_sizes_ED[$instr];
4012 }
4013 else
4014 {
4015 return 0;
4016 }
4017 }
4018
4019 #-------------------------------------------------------------------------------
4020
4021 #
4022 # Among the blocks stows description of an instruction.
4023 #
4024
4025 sub add_instr_block($)
4026 {
4027 my $Address = $_[0];
4028 my ($instr_size, $invalid);
4029
4030 $dcd_address = $Address;
4031 $dcd_instr = $rom[$dcd_address];
4032 $invalid = FALSE;
4033
4034 $instr_size = determine_instr_size();
4035
4036 if ($instr_size == 0)
4037 {
4038 $instr_size = 1;
4039 add_block($Address, BLOCK_CONST, $instr_size, BL_TYPE_NONE, '');
4040 }
4041 else
4042 {
4043 if ($instr_size == 1)
4044 {
4045 $invalid = TRUE if ($dcd_instr == EMPTY);
4046 }
4047
4048 if ($instr_size == 2)
4049 {
4050 $invalid = TRUE if ($rom[$dcd_address + 1] == EMPTY);
4051 }
4052
4053 if ($instr_size == 3)
4054 {
4055 $invalid = TRUE if ($rom[$dcd_address + 2] == EMPTY);
4056 }
4057
4058 if ($instr_size == 4)
4059 {
4060 $invalid = TRUE if ($rom[$dcd_address + 3] == EMPTY);
4061 }
4062
4063 if ($invalid)
4064 {
4065 add_block($Address, BLOCK_CONST, $instr_size, BL_TYPE_NONE, '');
4066 }
4067 else
4068 {
4069 add_block($Address, BLOCK_INSTR, $instr_size, BL_TYPE_NONE, '');
4070 }
4071 }
4072
4073 return $instr_size;
4074 }
4075
4076 #-------------------------------------------------------------------------------
4077
4078 #
4079 # Splits the program into small blocks.
4080 #
4081
4082 sub split_code_to_blocks()
4083 {
4084 my ($i, $instr);
4085 my ($is_empty, $empty_begin);
4086 my ($is_const, $const_begin);
4087
4088 $is_empty = FALSE;
4089 $is_const = FALSE;
4090
4091 for ($i = 0; $i < $rom_size; )
4092 {
4093 $instr = $rom[$i];
4094
4095 if ($instr == EMPTY)
4096 {
4097 if (! $is_empty)
4098 {
4099 # The begin of the empty section.
4100
4101 if ($is_const)
4102 {
4103 # The end of the constant section.
4104
4105 add_block($const_begin, BLOCK_CONST, $i - $const_begin, BL_TYPE_NONE, '');
4106 $is_const = FALSE;
4107 }
4108
4109 $empty_begin = $i;
4110 $is_empty = TRUE;
4111 }
4112
4113 ++$i;
4114 } # if ($instr == EMPTY)
4115 elsif (is_constant($i))
4116 {
4117 if (! $is_const)
4118 {
4119 if ($is_empty)
4120 {
4121 # The end of the empty section.
4122
4123 add_block($empty_begin, BLOCK_EMPTY, $i - $empty_begin, BL_TYPE_NONE, '');
4124 $is_empty = FALSE;
4125 }
4126
4127 $const_begin = $i;
4128 $is_const = TRUE;
4129 }
4130
4131 ++$i;
4132 } # elsif (is_constant($i))
4133 else
4134 {
4135 if ($is_const)
4136 {
4137 # The end of the constant section.
4138
4139 add_block($const_begin, BLOCK_CONST, $i - $const_begin, BL_TYPE_NONE, '');
4140 $is_const = FALSE;
4141 }
4142
4143 if ($is_empty)
4144 {
4145 # The end of the empty section.
4146
4147 add_block($empty_begin, BLOCK_EMPTY, $i - $empty_begin, BL_TYPE_NONE, '');
4148 $is_empty = FALSE;
4149 }
4150
4151 $i += add_instr_block($i);
4152 }
4153 } # for ($i = 0; $i < $rom_size; )
4154
4155 if ($is_const)
4156 {
4157 add_block($const_begin, BLOCK_CONST, $i - $const_begin, BL_TYPE_NONE, '');
4158 }
4159
4160 if ($is_empty)
4161 {
4162 add_block($empty_begin, BLOCK_EMPTY, $i - $empty_begin, BL_TYPE_NONE, '');
4163 }
4164 }
4165
4166 #-------------------------------------------------------------------------------
4167
4168 #
4169 # Previously assess the code.
4170 #
4171
4172 sub preliminary_survey($)
4173 {
4174 $decoder_silent_level = $_[0];
4175 foreach (sort {$a <=> $b} keys(%blocks_by_address))
4176 {
4177 my $block = \%{$blocks_by_address{$_}};
4178
4179 next if ($block->{TYPE} != BLOCK_INSTR);
4180
4181 instruction_decoder($_, $block);
4182 }
4183 }
4184
4185 #-------------------------------------------------------------------------------
4186
4187 #
4188 # Finds address of branchs and procedures.
4189 #
4190
4191 sub find_labels_in_code()
4192 {
4193 foreach (sort {$a <=> $b} keys(%blocks_by_address))
4194 {
4195 my $block = \%{$blocks_by_address{$_}};
4196
4197 next if ($block->{TYPE} != BLOCK_INSTR);
4198
4199 label_finder($_, $block);
4200 }
4201 }
4202
4203 #-------------------------------------------------------------------------------
4204
4205 #
4206 # Finds lost address of branchs and procedures.
4207 #
4208
4209 sub find_lost_labels_in_code()
4210 {
4211 my ($block, $prev_block, $prev_addr, $label, $instr);
4212
4213 $prev_addr = EMPTY;
4214 $prev_block = undef;
4215 foreach (sort {$a <=> $b} keys(%blocks_by_address))
4216 {
4217 $block = \%{$blocks_by_address{$_}};
4218
4219 last if ($block->{TYPE} == BLOCK_RAM);
4220 next if ($block->{TYPE} != BLOCK_INSTR);
4221
4222 if ($prev_addr != EMPTY)
4223 {
4224 $instr = $rom[$prev_addr];
4225 $label = $block->{LABEL};
4226
4227 if (defined($label) && $label->{TYPE} == BL_TYPE_NONE)
4228 {
4229 # if ($instr == INST_RET || $instr == INST_RETI)
4230 if ($instr == INST_RET)
4231 {
4232 Log(sprintf("Lost function label at the 0x%04X address.", $_), 5);
4233 add_func_label($_, '', TRUE);
4234 }
4235 elsif ($instr == INST_JP || $instr == INST_JR || $instr == INST_JP_HL)
4236 {
4237 Log(sprintf("Lost jump label at the 0x%04X address.", $_), 5);
4238 add_jump_label($_, '', BL_TYPE_LABEL, EMPTY, TRUE);
4239 }
4240 }
4241 }
4242
4243 $prev_addr = $_;
4244 $prev_block = $block;
4245 }
4246 }
4247
4248 #-------------------------------------------------------------------------------
4249
4250 #
4251 # Jump tables looking for in the code.
4252 #
4253
4254 sub recognize_jump_tables_in_code()
4255 {
4256 my @blocks = ((undef) x 5);
4257 my @instrs = ((EMPTY) x 5);
4258 my ($addr);
4259
4260 foreach (sort {$a <=> $b} keys(%blocks_by_address))
4261 {
4262 shift(@instrs);
4263 push(@instrs, $rom[$_]);
4264
4265 shift(@blocks);
4266 push(@blocks, \%{$blocks_by_address{$_}});
4267
4268 next if (! defined($blocks[0]) || ! defined($blocks[4]));
4269 next if ($blocks[0]->{TYPE} != BLOCK_INSTR);
4270 next if ($blocks[1]->{TYPE} != BLOCK_INSTR);
4271 next if ($blocks[2]->{TYPE} != BLOCK_INSTR);
4272 next if ($blocks[3]->{TYPE} != BLOCK_INSTR);
4273 next if ($blocks[4]->{TYPE} != BLOCK_INSTR);
4274
4275 if ($blocks[0]->{SIZE} == 3 && $instrs[0] == INST_LD_HL &&
4276 $blocks[1]->{SIZE} == 1 && $instrs[1] == INST_ADD_HL_DE &&
4277 $blocks[2]->{SIZE} == 1 && $instrs[2] == INST_ADD_HL_DE &&
4278 $blocks[3]->{SIZE} == 1 &&
4279 (($instrs[3] == INST_ADD_HL_DE && $blocks[4]->{SIZE} == 1 && $instrs[4] == INST_JP_HL) ||
4280 $instrs[3] == INST_JP_HL))
4281 {
4282 =back
4283 0x019D: 21 A4 01 ld HL, #0x01A4 ; HL = 0x01A4
4284 0x01A0: 19 add HL, DE ; HL += DE
4285 0x01A1: 19 add HL, DE ; HL += DE
4286 0x01A2: 19 add HL, DE ; HL += DE
4287 0x01A3: E9 jp (HL) ; Jumps to value of HL.
4288
4289 0x01A4: C3 D4 01 jp Label_021 ; Jumps (forward) hither: 0x01D4
4290
4291 ----------------------------------------------------------------------------------------------------
4292
4293 0x019D: 21 A4 01 ld HL, #0x01A3 ; HL = 0x01A4
4294 0x01A0: 19 add HL, DE ; HL += DE
4295 0x01A1: 19 add HL, DE ; HL += DE
4296 0x01A2: E9 jp (HL) ; Jumps to value of HL.
4297
4298 0x01A3: 18 2F jr Label_021 ; Jumps (forward) hither: 0x01D4
4299 =cut
4300
4301 $addr = ($rom[$blocks[0]->{ADDR} + 2] << 8) | $rom[$blocks[0]->{ADDR} + 1];
4302 add_jump_label($addr, '', BL_TYPE_JTABLE, EMPTY, FALSE);
4303 }
4304 }
4305 }
4306
4307 #-------------------------------------------------------------------------------
4308
4309 #
4310 # Prints the global symbols.
4311 #
4312
4313 sub emit_globals($)
4314 {
4315 my $Assembly_mode = $_[0];
4316 my ($label, $cnt0, $cnt1, $str0, $str1);
4317
4318 return if (! scalar(keys(%labels_by_address)));
4319
4320 print ";$border0\n;\tPublic labels\n;$border0\n\n";
4321
4322 if ($Assembly_mode)
4323 {
4324 foreach (sort {$a <=> $b} keys(%labels_by_address))
4325 {
4326 $label = $labels_by_address{$_};
4327
4328 next if ($label->{TYPE} != BL_TYPE_SUB);
4329
4330 print "\t.globl\t$label->{NAME}\n";
4331 }
4332 }
4333 else
4334 {
4335 foreach (sort {$a <=> $b} keys(%labels_by_address))
4336 {
4337 $label = $labels_by_address{$_};
4338
4339 next if ($label->{TYPE} != BL_TYPE_SUB);
4340
4341 $str0 = sprintf "0x%04X", $_;
4342 $cnt0 = sprintf "%3u", $label->{CALL_COUNT};
4343 $cnt1 = sprintf "%3u", $label->{JUMP_COUNT};
4344 $str1 = ($label->{CALL_COUNT} || $label->{JUMP_COUNT}) ? "calls: $cnt0, jumps: $cnt1" : 'not used';
4345 print "${str0}:\t" . align($label->{NAME}, STAT_ALIGN_SIZE) . "($str1)\n";
4346 }
4347 }
4348
4349 print "\n";
4350 }
4351
4352 #-------------------------------------------------------------------------------
4353
4354 #
4355 # Prints the registers (variables).
4356 #
4357
4358 sub emit_ram_data()
4359 {
4360 my ($block, $first, $name, $next_addr, $size, $cnt, $str0, $str1);
4361
4362 return if (! scalar(keys(%ram_blocks_by_address)));
4363
4364 print ";$border0\n;\tRAM data\n;$border0\n\n";
4365
4366 $next_addr = EMPTY;
4367 foreach (sort {$a <=> $b} keys(%ram_blocks_by_address))
4368 {
4369 $block = $blocks_by_address{$_};
4370
4371 if ($block->{TYPE} != BLOCK_RAM)
4372 {
4373 $next_addr = EMPTY;
4374 next;
4375 }
4376
4377 next if ($next_addr != EMPTY && $_ < $next_addr);
4378
4379 $str0 = sprintf "0x%04X", $_;
4380 $cnt = sprintf "%3u", $block->{REF_COUNT};
4381 $str1 = ($block->{REF_COUNT}) ? "used $cnt times" : 'not used';
4382 $name = $ram_names_by_address{$_};
4383
4384 if (defined($name) && $name ne '')
4385 {
4386 $cnt = sprintf "%5u", $block->{SIZE};
4387 print "${str0}:\t" . align($name, STAT_ALIGN_SIZE) . "($cnt bytes) ($str1)\n";
4388 $next_addr = $_ + $block->{SIZE};
4389 }
4390 else
4391 {
4392 if ($map_readed)
4393 {
4394 print "${str0}:\t" . align("variable_$str0", STAT_ALIGN_SIZE) . "( 1 bytes) ($str1)\n";
4395 }
4396 else
4397 {
4398 print "${str0}:\t" . align("variable_$str0", STAT_ALIGN_SIZE) . "($str1)\n";
4399 }
4400
4401 $next_addr = $_ + 1;
4402 }
4403 } # foreach (sort {$a <=> $b} keys(%ram_blocks_by_address))
4404
4405 print "\n";
4406 }
4407
4408 #-------------------------------------------------------------------------------
4409
4410 #
4411 # Prints I/O ports.
4412 #
4413
4414 sub emit_io_ports()
4415 {
4416 my ($io, $cnt, $str0, $str1);
4417
4418 return if (! scalar(keys(%io_by_address)));
4419
4420 print ";$border0\n;\tI/O ports\n;$border0\n\n";
4421
4422 foreach (sort {$a <=> $b} keys(%io_by_address))
4423 {
4424 $io = $io_by_address{$_};
4425
4426 $str0 = sprintf "0x%02X", $_;
4427 $cnt = sprintf "%3u", $io->{REF_COUNT};
4428 $str1 = ($io->{REF_COUNT}) ? "used $cnt times" : 'not used';
4429
4430 if ($io->{NAME} ne '')
4431 {
4432 print "${str0}:\t" . align($io->{NAME}, STAT_ALIGN_SIZE) . "($str1)\n";
4433 }
4434 else
4435 {
4436 print "${str0}:\t" . align("port_$str0", STAT_ALIGN_SIZE) . "($str1)\n";
4437 }
4438 } # foreach (sort {$a <=> $b} keys(%io_by_address))
4439
4440 print "\n";
4441 }
4442
4443 #-------------------------------------------------------------------------------
4444
4445 #
4446 # Prints a label belonging to the $Address.
4447 #
4448
4449 sub print_label($)
4450 {
4451 my $Address = $_[0];
4452 my ($label, $type);
4453
4454 $label = $labels_by_address{$Address};
4455
4456 return FALSE if (! defined($label) || $label->{TYPE} == BL_TYPE_NONE);
4457
4458 $type = $label->{TYPE};
4459
4460 print "\n;$border0\n" if ($type == BL_TYPE_SUB);
4461
4462 printf "\n$label->{NAME}:\n\n";
4463 $label->{PRINTED} = TRUE;
4464 $prev_is_jump = FALSE;
4465 return TRUE;
4466 }
4467
4468 #-------------------------------------------------------------------------------
4469
4470 #
4471 # Prints a variable belonging to the $Address.
4472 #
4473
4474 sub print_variable($$)
4475 {
4476 my ($Address, $BlockRef) = @_;
4477 my ($name, $size, $str0, $str1);
4478
4479 $size = $BlockRef->{SIZE};
4480
4481 return if (! $size);
4482
4483 $name = $ram_names_by_address{$Address};
4484
4485 return if (! defined($name) || $name eq '');
4486
4487 $str0 = sprintf "0x%04X", $Address;
4488
4489 given ($size)
4490 {
4491 when (1) { $str1 = '.db'; }
4492 when (2) { $str1 = '.dw'; }
4493 when (4) { $str1 = '.dd'; }
4494 when (8) { $str1 = '.dq'; }
4495 when (10) { $str1 = '.dt'; }
4496 default { $str1 = '.db'; }
4497 }
4498
4499 if ($gen_assembly_code)
4500 {
4501 print "$name:\n";
4502 $str0 = "\t$str1\t?";
4503 }
4504 else
4505 {
4506 $str0 = align("$str0:$name", RAM_ALIGN_SIZE) . "$str1\t?";
4507 }
4508
4509 print align($str0, RAM_ALIGN_SIZE + 1 + EXPL_ALIGN_SIZE) . "; $size bytes\n";
4510 }
4511
4512 #-------------------------------------------------------------------------------
4513
4514 #
4515 # Prints a table of constants.
4516 #
4517
4518 sub print_constants($$)
4519 {
4520 my ($Address, $BlockRef) = @_;
4521 my ($size, $i, $len, $frag, $byte, $spc, $col, $brd);
4522 my ($left_align, $right_align);
4523 my @constants;
4524 my @line;
4525
4526 $size = $BlockRef->{SIZE};
4527
4528 return if (! $size);
4529
4530 $prev_is_jump = FALSE;
4531 $col = ' ';
4532
4533 if ($gen_assembly_code)
4534 {
4535 print ";$table_border\n;\t\t $table_header | $table_header |\n;$table_border\n";
4536 $brd = ' ';
4537 }
4538 else
4539 {
4540 print "$table_border\n| | $table_header | $table_header |\n$table_border\n";
4541 $brd = '|';
4542 }
4543
4544 @constants = @rom[$Address .. ($Address + $size - 1)];
4545 $i = 0;
4546 while (TRUE)
4547 {
4548 $len = $size - $i;
4549
4550 last if (! $len);
4551
4552 $len = TBL_COLUMNS if ($len > TBL_COLUMNS);
4553
4554 if ($gen_assembly_code)
4555 {
4556 print "\t.db\t";
4557 }
4558 else
4559 {
4560 printf "$brd 0x%04X $brd ", $Address;
4561 }
4562
4563 if (($spc = $Address % TBL_COLUMNS))
4564 {
4565 $frag = TBL_COLUMNS - $spc;
4566 $len = $frag if ($len > $frag);
4567 }
4568
4569 $left_align = $col x $spc;
4570 $right_align = $col x (TBL_COLUMNS - $spc - $len);
4571 @line = @constants[$i .. ($i + $len - 1)];
4572 $Address += $len;
4573 $i += $len;
4574
4575 print " $left_align" . join(' ', map { sprintf("%02X ", $_ & 0xFF); } @line);
4576
4577 print "$right_align $brd $left_align " .
4578 join(' ', map {
4579 sprintf((($_ < ord(' ') || $_ >= 0x7F) ? "%02X " : "'%c'"), $_ & 0xFF);
4580 } @line) . "$right_align $brd\n";
4581 } # while (TRUE)
4582
4583 print (($gen_assembly_code) ? ";$table_border\n" : "$table_border\n");
4584 $prev_is_jump = FALSE;
4585 }
4586
4587 #-------------------------------------------------------------------------------
4588
4589 #
4590 # Disassembly contents of $blocks_by_address array.
4591 #
4592
4593 sub disassembler()
4594 {
4595 my ($sname, $prev_block_type, $ref);
4596
4597 $prev_is_jump = FALSE;
4598 $decoder_silent_level = SILENT0;
4599
4600 $table_header = join(' ', map { sprintf '%02X', $_ } (0 .. (TBL_COLUMNS - 1)));
4601
4602 if ($gen_assembly_code)
4603 {
4604 $table_border = ('-' x (TBL_COLUMNS * 4 + 16)) . '+' . ('-' x (TBL_COLUMNS * 4 + 2)) . '+';
4605 }
4606 else
4607 {
4608 $table_border = '+' . ('-' x 10) . '+' . ('-' x (TBL_COLUMNS * 4 + 2)) . '+' . ('-' x (TBL_COLUMNS * 4 + 2)) . '+';
4609 }
4610
4611 print "\n";
4612
4613 if ($gen_assembly_code)
4614 {
4615 emit_globals(TRUE);
4616 print ";$border0\n;\tCode\n;$border0\n\n\t.area\tCODE\t(CODE)\n\n";
4617 }
4618 else
4619 {
4620 emit_globals(FALSE);
4621 emit_ram_data();
4622 emit_io_ports();
4623 print ";$border0\n";
4624 }
4625
4626 $prev_block_type = EMPTY;
4627 foreach (sort {$a <=> $b} keys(%blocks_by_address))
4628 {
4629 $ref = $blocks_by_address{$_};
4630
4631 if ($ref->{TYPE} == BLOCK_INSTR)
4632 {
4633 print_label($_);
4634 print "\n" if ($prev_is_jump);
4635
4636 instruction_decoder($_, $ref);
4637 $prev_block_type = BLOCK_INSTR;
4638 }
4639 elsif ($ref->{TYPE} == BLOCK_RAM)
4640 {
4641 print "\n;$border0\n\n" if ($prev_block_type != BLOCK_RAM);
4642
4643 print_variable($_, $ref);
4644 $prev_block_type = BLOCK_RAM;
4645 }
4646 elsif ($ref->{TYPE} == BLOCK_CONST)
4647 {
4648 print "\n;$border0\n" if ($prev_block_type != BLOCK_CONST);
4649
4650 print_label($_);
4651 print "\n" if ($prev_is_jump);
4652
4653 print_constants($_, $ref);
4654 $prev_block_type = BLOCK_CONST;
4655 }
4656 elsif ($ref->{TYPE} == BLOCK_EMPTY)
4657 {
4658 my $next_block = $_ + $ref->{SIZE};
4659
4660 print "\n;$border0\n" if ($prev_block_type != BLOCK_EMPTY);
4661
4662 if (! $gen_assembly_code)
4663 {
4664 printf("\n0x%04X: -- -- --\n .... -- -- --\n0x%04X: -- -- --\n", $_, $next_block - 1);
4665 }
4666 elsif ($next_block <= $rom_size)
4667 {
4668 # Skip the empty code space.
4669
4670 printf "\n\t.ds\t%u\n", $ref->{SIZE};
4671 }
4672
4673 $prev_block_type = BLOCK_EMPTY;
4674 }
4675 } # foreach (sort {$a <=> $b} keys(%blocks_by_address))
4676 }
4677
4678 #-------------------------------------------------------------------------------
4679
4680 #
4681 # If there are datas in the code, it is possible that some labels will
4682 # be lost. This procedure prints them.
4683 #
4684
4685 sub print_hidden_labels()
4686 {
4687 foreach (sort {$a <=> $b} keys(%labels_by_address))
4688 {
4689 my $label = $labels_by_address{$_};
4690
4691 print STDERR "The label: $label->{NAME} is hidden!\n" if (! $label->{PRINTED});
4692 }
4693 }
4694
4695 ################################################################################
4696 ################################################################################
4697
4698 sub usage()
4699 {
4700 print <<EOT;
4701 Usage: $PROGRAM [options] <hex file>
4702
4703 Options are:
4704
4705 -M|--mcu <header.h>
4706
4707 Header file of the MCU.
4708
4709 -I|--include <path to header>
4710
4711 Path of the header files of Z80 MCUs. (Default: $default_include_path)
4712
4713 --map-file <file.map>
4714
4715 The map file belonging to the input hex file. (optional)
4716
4717 -r|--rom-size <size of program memory>
4718
4719 EOT
4720 ;
4721 printf "\t Defines size of the program memory. (Default %u bytes.)\n", Z80_ROM_SIZE;
4722 print <<EOT;
4723
4724 --const-area <start address> <end address>
4725
4726 Designates a constant area (jumptables, texts, etc.), where data is
4727 stored happen. The option may be given more times, that to select
4728 more areas at the same time. (optional)
4729
4730 -as|--assembly-source
4731
4732 Generates the assembly source file. (Eliminates before the instructions
4733 visible address and hex codes.) Emits global symbol table, etc.
4734
4735 -fl|--find-lost-labels
4736
4737 Finds the "lost" labels. These may be found such in program parts,
4738 which are directly not get call.
4739
4740 --name-list <list_file>
4741
4742 The file contains list of names. They may be: Names of variables and
4743 names of labels. For example:
4744
4745 [IO]
4746 0x21:keyboard_io
4747 ..
4748 ..
4749 ..
4750 [RAM]
4751 0x8021:ram_variable
4752 ..
4753 ..
4754 ..
4755 [ROM]
4756 0x05FC:function_or_label
4757 ..
4758 ..
4759 ..
4760
4761 The contents of list override the names from map file.
4762
4763 -ne|--no-explanations
4764
4765 Eliminates after the instructions visible explaining texts.
4766
4767 -v <level> or --verbose <level>
4768
4769 It provides information on from the own operation.
4770 Possible value of the level between 0 and 10. (default: 0)
4771
4772 -h|--help
4773
4774 This text.
4775 EOT
4776 ;
4777 }
4778
4779 ################################################################################
4780 ################################################################################
4781 ################################################################################
4782
4783 foreach (@default_paths)
4784 {
4785 if (-d $_)
4786 {
4787 $default_include_path = $_;
4788 last;
4789 }
4790 }
4791
4792 if (! @ARGV)
4793 {
4794 usage();
4795 exit(1);
4796 }
4797
4798 for (my $i = 0; $i < @ARGV; )
4799 {
4800 my $opt = $ARGV[$i++];
4801
4802 given ($opt)
4803 {
4804 when (/^-(r|-rom-size)$/o)
4805 {
4806 param_exist($opt, $i);
4807 $rom_size = str2int($ARGV[$i++]);
4808
4809 if ($rom_size < 1024)
4810 {
4811 printf STDERR "$PROGRAM: Code size of the Z80 family greater than 1024 bytes!\n";
4812 exit(1);
4813 }
4814 elsif ($rom_size > Z80_ROM_SIZE)
4815 {
4816 printf STDERR "$PROGRAM: Code size of the Z80 family not greater %u bytes!\n", Z80_ROM_SIZE;
4817 exit(1);
4818 }
4819 }
4820
4821 when (/^--const-area$/o)
4822 {
4823 my ($start, $end);
4824
4825 param_exist($opt, $i);
4826 $start = str2int($ARGV[$i++]);
4827
4828 param_exist($opt, $i);
4829 $end = str2int($ARGV[$i++]);
4830
4831 if ($start > $end)
4832 {
4833 my $t = $start;
4834
4835 $start = $end;
4836 $end = $t;
4837 }
4838 elsif ($start == $end)
4839 {
4840 $start = Z80_ROM_SIZE - 1;
4841 $end = Z80_ROM_SIZE - 1;
4842 }
4843
4844 add_const_area($start, $end) if ($start < $end);
4845 } # when (/^--const-area$/o)
4846
4847 when (/^-(I|-include)$/o)
4848 {
4849 param_exist($opt, $i);
4850 $include_path = $ARGV[$i++];
4851 }
4852
4853 when (/^-(M|-mcu)$/o)
4854 {
4855 param_exist($opt, $i);
4856 $header_file = $ARGV[$i++];
4857 }
4858
4859 when (/^--map-file$/o)
4860 {
4861 param_exist($opt, $i);
4862 $map_file = $ARGV[$i++];
4863 }
4864
4865 when (/^-(as|-assembly-source)$/o)
4866 {
4867 $gen_assembly_code = TRUE;
4868 }
4869
4870 when (/^-(fl|-find-lost-labels)$/o)
4871 {
4872 $find_lost_labels = TRUE;
4873 }
4874
4875 when (/^--name-list$/o)
4876 {
4877 param_exist($opt, $i);
4878 $name_list = $ARGV[$i++];
4879 }
4880
4881 when (/^-(ne|-no-explanations)$/o)
4882 {
4883 $no_explanations = TRUE;
4884 }
4885
4886 when (/^-(v|-verbose)$/o)
4887 {
4888 param_exist($opt, $i);
4889 $verbose = int($ARGV[$i++]);
4890 $verbose = 0 if (! defined($verbose) || $verbose < 0);
4891 $verbose = 10 if ($verbose > 10);
4892 }
4893
4894 when (/^-(h|-help)$/o)
4895 {
4896 usage();
4897 exit(0);
4898 }
4899
4900 default
4901 {
4902 if ($hex_file eq '')
4903 {
4904 $hex_file = $opt;
4905 }
4906 else
4907 {
4908 print STDERR "$PROGRAM: We already have the source file name: $hex_file.\n";
4909 exit(1);
4910 }
4911 }
4912 } # given ($opt)
4913 } # for (my $i = 0; $i < @ARGV; )
4914
4915 $include_path = $default_include_path if ($include_path eq '');
4916
4917 if ($hex_file eq '')
4918 {
4919 print STDERR "$PROGRAM: What do you have to disassembled?\n";
4920 exit(1);
4921 }
4922
4923 is_file_ok($hex_file);
4924
4925 init_mem(0, $rom_size - 1);
4926 read_hex($hex_file);
4927
4928 if ($header_file ne '')
4929 {
4930 is_file_ok("$include_path/$header_file");
4931 reset_preprocessor();
4932 $embed_level = 0;
4933 read_header("$include_path/$header_file");
4934 }
4935
4936 if ($map_file eq '')
4937 {
4938 ($map_file) = ($hex_file =~ /^(.+)\.hex$/io);
4939 $map_file .= '.map';
4940 }
4941
4942 $map_file = '' if (! -e $map_file);
4943
4944 is_file_ok($name_list) if ($name_list ne '');
4945
4946 ###################################
4947
4948 read_map_file();
4949 read_name_list();
4950 split_code_to_blocks();
4951 recognize_jump_tables_in_code();
4952 preliminary_survey(SILENT1);
4953 find_labels_in_code();
4954 find_lost_labels_in_code() if ($find_lost_labels);
4955 add_names_labels();
4956 fix_multi_byte_variables();
4957 fix_io_names();
4958 disassembler();
4959 print_hidden_labels() if ($verbose > 2);
SDCC git mirror