--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/tests/opcodes6809.pl	Wed Sep 07 21:47:07 2011 -0600
@@ -0,0 +1,235 @@
+#!/usr/bin/perl
+#
+# these tests determine if the opcodes for each instruction, in each
+# addressing mode, are correct.
+#
+# The following list is used to construct the tests. The key is the
+# mneumonic and the value is a list of address mode characters as follows
+#
+# R: register/inherent
+# I: immediate
+# E: extended
+# D: direct
+# i: indexed
+# r: register to register (TFR, etc.)
+# p: psh/pul
+# each letter is followed by an = and the 2 or 4 digit opcode in hex
+# each entry is separated by a comma
+
+$lwasm = './lwasm/lwasm';
+
+%insnlist = (
+	'neg' => 'D=00,E=70,i=60',
+	'com' => 'D=03,E=73,i=63',
+	'lsr' => 'D=04,E=74,i=64',
+	'ror' => 'D=06,E=76,i=66',
+	'asr' => 'D=07,E=77,i=67',
+	'lsl' => 'D=08,E=78,i=68',
+	'rol' => 'D=09,E=79,i=69',
+	'dec' => 'D=0A,E=7A,i=6A',
+	'inc' => 'D=0C,E=7C,i=6C',
+	'tst' => 'D=0D,E=7D,i=6D',
+	'jmp' => 'D=0E,E=7E,i=6E',
+	'clr' => 'D=0F,E=7F,i=6F',
+	'nop' => 'R=12',
+	'sync' => 'R=13',
+	'lbra' => 'b=16',
+	'lbsr' => 'b=17',
+	'daa' => 'R=19',
+	'orcc' => 'I=1A',
+	'andcc' => 'I=1C',
+	'sex' => 'R=1D',
+	'exg' => 'r=1E',
+	'tfr' => 'r=1F',
+	'bra' => 'b=20',
+	'brn' => 'b=21',
+	'lbrn' => 'b=1021',
+	'bhi' => 'b=22',
+	'lbhi' => 'b=1022',
+	'bls' => 'b=23',
+	'lbls' => 'b=1023',
+	'bcc' => 'b=24',
+	'lbcc' => 'b=1024',
+	'bhs' => 'b=24',
+	'lbhs' => 'b=1024',
+	'bcs' => 'b=25',
+	'lbcs' => 'b=1025',
+	'blo' => 'b=25',
+	'lblo' => 'b=1025',
+	'bne' => 'b=26',
+	'lbne' => 'b=1026',
+	'beq' => 'b=27',
+	'lbeq' => 'b=1027',
+	'bvc' => 'b=28',
+	'lbvc' => 'b=1028',
+	'bvs' => 'b=29',
+	'lbvs' => 'b=1029',
+	'bpl' => 'b=2A',
+	'lbpl' => 'b=102A',
+	'bmi' => 'b=2B',
+	'lbmi' => 'b=102B',
+	'bge' => 'b=2C',
+	'lbge' => 'b=102C',
+	'blt' => 'b=2D',
+	'lblt' => 'b=102D',
+	'bgt' => 'b=2E',
+	'lbgt' => 'b=102E',
+	'ble' => 'b=2F',
+	'lble' => 'b=102F',
+	'leax' => 'i=30',
+	'leay' => 'i=31',
+	'leas' => 'i=32',
+	'leau' => 'i=33',
+	'pshs' => 'p=34',
+	'puls' => 'p=35',
+	'pshu' => 'p=36',
+	'pulu' => 'p=37',
+	'rts' => 'R=39',
+	'abx' => 'R=3A',
+	'rti' => 'R=3B',
+	'cwai' => 'I=3C',
+	'mul' => 'R=3D',
+	'swi' => 'R=3F',
+	'swi2' => 'R=103F',
+	'swi3' => 'R=113F',
+	'nega' => 'R=40',
+	'coma' => 'R=43',
+	'lsra' => 'R=44',
+	'rora' => 'R=46',
+	'asra' => 'R=47',
+	'lsla' => 'R=48',
+	'rola' => 'R=49',
+	'deca' => 'R=4A',
+	'inca' => 'R=4C',
+	'tsta' => 'R=4D',
+	'clra' => 'R=4F',
+	'negb' => 'R=50',
+	'comb' => 'R=53',
+	'lsrb' => 'R=54',
+	'rorb' => 'R=56',
+	'asrb' => 'R=57',
+	'lslb' => 'R=58',
+	'rolb' => 'R=59',
+	'decb' => 'R=5A',
+	'incb' => 'R=5C',
+	'tstb' => 'R=5D',
+	'clrb' => 'R=5F',
+	'suba' => 'I=80,D=90,i=A0,E=B0',
+	'cmpa' => 'I=81,D=91,i=A1,E=B1',
+	'sbca' => 'I=82,D=92,i=A2,E=B2',
+	'subd' => 'I=83,D=93,i=A3,E=B3',
+	'cmpd' => 'I=1083,D=1093,i=10A3,E=10B3',
+	'cmpu' => 'I=1183,D=1193,i=11A3,E=11B3',
+	'anda' => 'I=84,D=94,i=A4,E=B4',
+	'bita' => 'I=85,D=95,i=A5,E=B5',
+	'lda' => 'I=86,D=96,i=A6,E=B6',
+	'sta' => 'D=97,i=A7,E=B7',
+	'eora' => 'I=88,D=98,i=A8,E=B8',
+	'adca' => 'I=89,D=99,i=A9,E=B9',
+	'ora' => 'I=8A,D=9A,i=AA,E=BA',
+	'adda' => 'I=8B,D=9B,i=AB,E=BB',
+	'cmpx' => 'I=8C,D=9C,i=AC,E=BC',
+	'cmpy' => 'I=108C,D=109C,i=10AC,E=10BC',
+	'cmps' => 'I=118C,D=119C,i=11AC,E=11BC',
+	'bsr' => 'b=8D',
+	'jsr' => 'D=9D,i=AD,E=BD',
+	'ldx' => 'I=8E,D=9E,i=AE,E=BE',
+	'ldy' => 'I=108E,D=109E,i=10AE,E=10BE',
+	'stx' => 'D=9F,i=AF,E=BF',
+	'sty' => 'D=109F,i=10AF,E=10BF',
+	'subb' => 'I=C0,D=D0,i=E0,E=F0',
+	'cmpb' => 'I=C1,D=D1,i=E1,E=F1',
+	'sbcb' => 'I=C2,D=D2,i=E2,E=F2',
+	'addd' => 'I=C3,D=D3,i=E3,E=F3',
+	'andb' => 'I=C4,D=D4,i=E4,E=F4',
+	'bitb' => 'I=C5,D=D5,i=E5,E=F5',
+	'ldb' => 'I=C6,D=D6,i=E6,E=F6',
+	'stb' => 'D=D7,i=E7,E=F7',
+	'eorb' => 'I=C8,D=D8,i=E8,E=F8',
+	'adcb' => 'I=C9,D=D9,i=E9,E=F9',
+	'orb' => 'I=CA,D=DA,i=EA,E=FA',
+	'addb' => 'I=CB,D=DB,i=EB,E=FB',
+	'ldd' => 'I=CC,D=DC,i=EC,E=FC',
+	'std' => 'D=DD,i=ED,E=FD',
+	'ldu' => 'I=CE,D=DE,i=EE,E=FE',
+	'lds' => 'I=10CE,D=10DE,i=10EE,E=10FE',
+	'stu' => 'D=DF,i=EF,E=FF',
+	'sts' => 'D=10DF,i=10EF,E=10FF'
+	
+);
+
+foreach $i (keys %insnlist)
+{
+#	print "$i ... $insnlist{$i}\n";
+	@modes = split(/,/, $insnlist{$i});
+	foreach $j (@modes)
+	{
+		($mc, $oc) = split(/=/, $j);
+		$operand = '';
+		if ($mc eq 'D')
+		{
+			$operand = '<0';
+		}
+		elsif ($mc eq 'E')
+		{
+			$operand = '>0';
+		}
+		elsif ($mc eq 'I')
+		{
+			$operand = '#0';
+		}
+		elsif ($mc eq 'i')
+		{
+			$operand = ',x';
+		}
+		elsif ($mc eq 'r')
+		{
+			$operand = 'a,a';
+		}
+		elsif ($mc eq 'p')
+		{
+			$operand = 'cc';
+		}
+		elsif ($mc eq 'b')
+		{
+			$operand = '*';
+		}
+		$asmcode = "\t$i $operand";
+		
+		# now feed the asm code to the assembler and fetch the result
+		$tf = ".asmtmp.$$.$i.$mc";
+		open H, ">$tf.asm";
+		print H "$asmcode\n";
+		close H;
+		$r = `$lwasm --raw --list -o $tf $tf.asm`;
+		open H, "<$tf";
+		binmode H;
+		$buffer = '';
+		$r = read(H, $buffer, 10);
+		close H;
+		unlink $tf;
+		unlink "$tf.asm";
+		if ($r == 0)
+		{
+			$st = 'FAIL (no result)';
+		}
+		else
+		{
+			@bytes = split(//,$buffer);
+			$rc = sprintf('%02X', ord($bytes[0]));
+			if (length($oc) > 2)
+			{
+				$rc .= sprintf('%02X', ord($bytes[1]));
+			}
+			if ($rc ne $oc)
+			{
+				$st = "FAIL ($rc ≠ $oc, $asmcode)";
+			}
+			else
+			{
+				$st = 'PASS';
+			}
+		}
+		print "$i" . "_$mc $st\n";
+	}
+}