#!/usr/bin/perl -w

# DLIFE disassembler.
# By Richard W.M. Jones.
#
# $Id: dlife_disasm.pl,v 1.1 2002/04/05 14:40:26 rich Exp $

use strict;

use Getopt::Long;

my $help;

GetOptions ("help|?" => \$help);

if ($help)
  {
    printf STDERR "dlife_disasm.pl [--help] [file.dlo] > file.dla\n";
    exit 1;
  }

# Read the entire input file into memory so that we can do some
# clever stuff with string regexes.
my $code = "";

while (<>)
  {
    $code .= $_;
  }

# Remove anything which isn't [0-9a-f].
$code =~ tr/0-9a-fA-F//cd;
$code =~ tr/a-f/A-F/;

# Convert code to <xx>.
$code =~ s/(..)/<$1>/g;

# NOTE: The order of this substitutions IS important.

# CALLB and CALLF macros.
$code =~ s/<23>(<08>|<09>)((<00>|<01>)+)<22><27>/convert_call ($1, $2)/ge;

# JMPB and JMPF macros.
$code =~ s/(<08>|<09>)((<00>|<01>)+)<22><27>/convert_jmp ($1, $2)/ge;

# JMPBZ and JMPFZ macros.
$code =~ s/(<08>|<09>)((<00>|<01>)+)<22><07><27><26>/convert_jmpz ($1, $2)/ge;

# Basic FINDF and FINDB commands.
$code =~ s/(<08>|<09>)((<00>|<01>)+)/convert_find ($1, $2)/ge;

# Any other patterns are labels.
$code =~ s/((<00>|<01>)+)/convert_label ($1)/ge;

# MOVE macro.
$code =~ s/(<2[0-3]>)(<2[4-7]>)/convert_move ($1, $2)/ge;

# SWAP macro. XXX Difficult ...







print $code;

sub convert_call
  {
    my $find_code = shift;
    my $pattern = shift;

    my $insn = $find_code eq "<08>" ? "CALLB" : "CALLF";

    $pattern =~ s/<00>/1/g;	# Pattern is complemented.
    $pattern =~ s/<01>/0/g;

    return "\n\t$insn ~$pattern\n";
  }

sub convert_jmp
  {
    my $find_code = shift;
    my $pattern = shift;

    my $insn = $find_code eq "<08>" ? "JMPB" : "JMPF";

    $pattern =~ s/<00>/1/g;	# Pattern is complemented.
    $pattern =~ s/<01>/0/g;

    return "\n\t$insn ~$pattern\n";
  }

sub convert_jmpz
  {
    my $find_code = shift;
    my $pattern = shift;

    my $insn = $find_code eq "<08>" ? "JMPBZ" : "JMPFZ";

    $pattern =~ s/<00>/1/g;	# Pattern is complemented.
    $pattern =~ s/<01>/0/g;

    return "\n\t$insn ~$pattern\n";
  }

sub convert_find
  {
    my $find_code = shift;
    my $pattern = shift;

    my $insn = $find_code eq "<08>" ? "FINDB" : "FINDF";

    $pattern =~ s/<00>/1/g;	# Pattern is complemented.
    $pattern =~ s/<01>/0/g;

    return "\n\t$insn ~$pattern\n";
  }

sub convert_label
  {
    my $pattern = shift;

    $pattern =~ s/<00>/0/g;
    $pattern =~ s/<01>/1/g;

    return "\n$pattern:\n";
  }

sub convert_move
  {
    my $push_code = shift;
    my $pop_code = shift;

    my ($src, $dst);
    if ($push_code eq "<20>") { $src = "A" }
    elsif ($push_code eq "<21>") { $src = "B" }
    elsif ($push_code eq "<22>") { $src = "I" }
    elsif ($push_code eq "<23>") { $src = "P" }
    if ($pop_code eq "<24>") { $dst = "A" }
    elsif ($pop_code eq "<25>") { $dst = "B" }
    elsif ($pop_code eq "<26>") { $dst = "I" }
    elsif ($pop_code eq "<27>") { $dst = "P" }

    return "\n\tMOVE $src,$dst\n";
  }