view release on metacpan or  search on metacpan

t/dis_zx81.t  view on Meta::CPAN

			}
			else {
				push @block, "\n", x4($addr)."\t:C $label\n", "\n";
			}
		}
		
		push @$ctl_to, @block;
		
		return $addr;
	}
	elsif ($asm->[0] =~ /^L[0-9A-F]+:\s*|^\s+/) {		# code block
		# get opcode and first comment
		my $line = $';
		my($opcode, $comment);
		if ($line =~ /\s*;/) {
			$opcode = $`;
			chomp($comment = $');
		}
		else {
			($opcode = $line) =~ s/\s+$//;
		}
		
		# update ctl file
		if ($opcode =~ /^DEFB\s+(.*)/) {
			$addr = consume_bytes($addr, 1, $1, $ctl_from, $ctl_to, $comment);
		}
		elsif ($opcode =~ /^DEFW\s+(.*)/) {
			$addr = consume_bytes($addr, 2, $1, $ctl_from, $ctl_to, $comment);
		}
		else {
			$addr = consume_code($addr, $opcode, $ctl_from, $ctl_to, $comment);
		}
		
		# get following comments
		shift @$asm;
		while (@$asm && $asm->[0] =~ /^\s+;|^\s*$/) {			# follow-on comments
			chomp(my $comment = $');
			push @$ctl_to, " " x 32, ":;$comment\n";
			shift @$asm;		
		}
		
		return $addr;
	}
	else {
		die "cannot parse ", $asm->[0];
	}
}

sub consume_bytes {
	my($addr, $size, $def_args, $ctl_from, $ctl_to, $comment) = @_;
	my $num = scalar(split(/,/, $def_args));
	my($new_addr, $bytes_str) = get_bytes_str($addr, $num * $size, $ctl_from);
	
	push @$ctl_to, sprintf("%-31s", x4($addr).'-'.x4($new_addr-1).' '.$bytes_str)." :".
			($size == 1 ? 'B' : 'W')."\n";
	
	if (defined $comment) {
		push @$ctl_to, (" " x 32).":;$comment\n";
	}
	
	# synchronize code after bytes
	isa_ok my $dis = CPU::Z80::Disassembler->new(), 'CPU::Z80::Disassembler';
	$dis->memory->load_file($rom_file, $new_addr, $new_addr);
	$dis->write_dump($ctl_file."2");
	@$ctl_from = path($ctl_file."2")->lines;
	unlink $ctl_file."2";
	
	return $new_addr;
}

sub consume_code {
	my($addr, $opcode, $ctl_from, $ctl_to, $comment) = @_;
	
	# compare asm hash
	@$ctl_from or die;
	$ctl_from->[0] =~ /^([0-9A-F]{4})\s+([0-9A-F]+)\s+(.*)/ or die;
	hex($1) == $addr or die;
	my $size = length($2) / 2;

	my $ctl_hash = $3;
	my $opcode_hash = $opcode;
	for ($ctl_hash, $opcode_hash) {
		$_ = uc($_);
		s/\s+//g;
		s/[L\$]([0-9A-F]{4})/\$$1/g;
		s/(I[XY])\+\$0+/$1/g;
		s/(RST)\$?([0-9A-F]{2})H?/$1$2/;
		s/[L\$]([0-9A-F]+)\+\$?([0-9A-F]+)/ '$' . x4(hex($1)+hex($2)) /ge;
		s/[L\$]([0-9A-F]+)\-\$?([0-9A-F]+)/ '$' . x4(hex($1)-hex($2)) /ge;
	}
	$ctl_hash eq $opcode_hash or die "($ctl_hash,$opcode_hash)";
	
	# copy to output
	chomp(my $line = shift @$ctl_from); 
	$line = sprintf("%-31s", $line).(defined $comment ? " :;$comment" : "")."\n";
	push @$ctl_to, $line;
	
	$addr += $size;
	return $addr;
}

sub get_bytes_str {
	my($addr, $num, $ctl_from) = @_;
	my $bytes_str = '';
	my $got = 0;
	
	while ($got < $num) {
		@$ctl_from or die;
		if ($ctl_from->[0] =~ /^([0-9A-F]{4})\s+([0-9A-F]{2})([0-9A-F]*)/) {	# has one byte
			hex($1) == $addr or die;
			$ctl_from->[0] = x4($addr+1).' '.$3.'  '.$';
			$bytes_str .= $2;
			
			shift @$ctl_from if $3 eq '';		# was last byte in the line
			
			$addr++;
			$got++;
		}
		else {
			shift @$ctl_from;
		}