#!/bin/perl -T

%hex_opcode = (
	'ADD'	=> [0x02, 36],	#add
	'BR'	=> [0xCF, 33],	#branch
	'CGE'	=> [0xE0, 17],	#character generator enable
	'CLD'	=> [0x2C, 19],	#clear display
	'DI'	=> [0xF1, 17],	#display on or off
	'DIV'	=> [0x21, 37],	#divide
	'DR'	=> [0xF0, 42],	#decrement register
	'GET'	=> [0x08, 38],	#get into r0
	'H'	=> [0xBF, 35],	#halt, return to manual mode
	'IN'	=> [0xF8, 48],	#input from remote control
	'JMP'	=> [0x0B, 34],	#jump to subroutine
	'MUL'	=> [0x22, 37],	#multiply
	'NE'	=> [0xFF, 35],	#no entry, 1/60 sec
	'P'	=> [0xFD, 22],	#play
	'PAGE'	=> [0x11,  4],	#page
	'PUT'	=> [0x09, 39],	#put r0 somewhere
	'RC'	=> [0x7F, 39],	#recall (activate a register)
	'SC'	=> [0xF7, 24],	#search
	'SCM'	=> [0x8C, 31],	#set chapter mode
	'ST'	=> [0xF5, 44],	#store into active register
	'SUB'	=> [0x03, 36],	#subtract
	'SUD'	=> [0x2B, 19],	#set user display
);

if (@ARGV != 1) {
	die "$0: requires .l file as command line argument";
}

for ($pass = 1; $pass <= 2; ++$pass) {
	run_pass($pass);
} 

sub run_pass {
	$pass = $_[0];
	open(FILE, "<$ARGV[0]") or die "$0: couldn't open $ARGV[0]";

	while (($_ = <FILE>) ne '') {
		$source = $_;
		$comment = '';
		unless (/\.DS/) {
			($comment) = /(;.*)/;
			s/;.*//;
		}
		@field = split;

		$label = $opcode = '';
		@operand = ();
		if (@field > 0) {
			if ($field[0] =~ /:$/) {
				$label = $field[0];
				chop $label;
				if ($pass == 1) {
					$symbol{$label} = $address;
				}
			} elsif (@field == 1) {
				$opcode = $field[$#field];
			} else {
				$opcode = $field[$#field];
				if ($opcode eq '.DS') {
					($operand[0]) = /("[^"]*")/;
				} else {
					@operand = @field[0 .. $#field - 1];
				}
			}
		}

		if ($opcode eq '.ORG') {
			$address = $operand[0];
		}

		if ($pass == 2) {
			$outline = '';
			if ($label ne '' || @operand > 0 || $opcode ne '') {
				$outline .= sprintf("%4d: ", $address);
			}

			if ($label ne '') {
				$outline .= "$label:";
			}

			$_ = '';
			foreach $operand (@operand) {
				$_ .= $operand;
				if ($symbol{$operand} eq '') {
					$_ .= ' ';
				} else {
					$_ .= "($symbol{$operand})";
				}
			}
			$outline .= $_;

			if ($opcode ne '') {
				if (length($_) < 7) {
					$outline .= ' ' x (7 - length($_));
				}
				if ($opcode eq '.ORG') {
					$outline .= '     .ORG     ';
				} elsif ($opcode eq '.DS' ||
					$opcode eq '.DB' ||
					$opcode eq '.DW') {
					$outline .= "     $opcode     ";
				} else {
					$outline .=
						sprintf('0x%02X %-4s 4-%2d',
							$hex_opcode{$opcode}[0],
							$opcode,
							$hex_opcode{$opcode}[1]
						);
				}
			}
			print $outline;
			if ($comment ne '') {
				if (($label ne '' ||
					@operand > 0 ||
					$opcode ne '') &&
					length($outline) < 28) {
					print ' ' x (28 - length($outline));
				}
				print $comment;
			}
			print "\n";

			if ($opcode eq '.DS') {
				for ($i = 1; $i < length($operand[0])-1; ++$i) {
					print sprintf('x%02X',
						ord(substr($operand[0], $i)));
					print $i < length($operand[0])-2 ? ' ' :
						"\n";
						
				}
			} elsif ($opcode eq '.DB') {
				for ($i = 0; $i <= $#operand; ++$i) {
					print sprintf('x%02X', $operand[$i]);
					print $i < $#operand ? ' ' : "\n";
				}
			}
		}

		if ($opcode ne '' &&
			$opcode ne '.ORG' &&
			$opcode ne '.DS' &&
			$opcode ne '.DB' &&
			$opcode ne '.DW') {
			++$address;	#Each opcode is one byte.
		}

		if ($opcode ne '.ORG') {
			foreach $operand (@operand) {
				if ($operand eq 'ARG' || $operand eq 'DROP' ||
					$opcode eq '.DB') {
					++$address;
				} elsif ($operand =~ /^\d+$/) {
					$address += length($operand);
				} elsif ($operand =~ /^0x[0-9A-F]+$/) {
					$address += ((length($operand) - 2)/2);
				} elsif ($operand =~ /^"[^"]*"$/) {
					$address += (length($operand) - 2);
				} elsif ($symbol{$operand} ne '') {
					$address += length($symbol{$operand});
				} else {
					$address += 3;	#address is three digits
				}
			}
		}
	}

	close(FILE) or die "$0: couldn't close $ARGV[0]";
}
