dlife_asm.pl

   1 #!/usr/bin/perl -w
   2
   3 # DLIFE assembler.
   4 # By Richard W.M. Jones.
   5 #
   6 # $Id: dlife_asm.pl,v 1.1 2002/04/05 14:40:26 rich Exp $
   7
   8 use strict;
   9
  10 use Getopt::Long;
  11
  12 my $help;
  13
  14 GetOptions ("help|?" => \$help);
  15
  16 if ($help)
  17   {
  18     print STDERR "dlife_asm.pl [--help] file.dla [file.dla [...]]\n";
  19     exit 1;
  20   }
  21
  22 # Read input file(s) and assemble each one. Each input file has the
  23 # form ``filename.dla'' and we will write a file called ``filename.dlo''.
  24 foreach my $filename (@ARGV)
  25   {
  26     my $output = $filename . ".dlo";
  27
  28     if ($filename =~ m/(.*)\.dla$/)
  29       {
  30         $output = $1 . ".dlo";
  31       }
  32
  33     open FILE, "<$filename" or die "$filename: $!";
  34     open OUT, ">$output" or die "$output: $!";
  35
  36     while (<FILE>)
  37       {
  38         # Remove terminating CRs and LFs.
  39         s/[\n\r]+//;
  40
  41         # Ignore blank lines and comments.
  42         s/;.*$//;
  43         s/^[ \t]*$//;
  44         next if m/^$/;
  45
  46         # Parse the instruction.
  47         parse_insn ($_);
  48       }
  49
  50     close FILE;
  51     print OUT "\n";
  52     close OUT;
  53   }
  54
  55 sub parse_insn
  56   {
  57     my $insn = shift;
  58
  59     # Trim leading and trailing whitespace.
  60     $insn =~ s/^[ \t]+//g;
  61     $insn =~ s/[ \t]+$//g;
  62
  63     # Leading label?
  64     if ($insn =~ m/^([01]+):(.*)$/)
  65       {
  66         my $label = $1;
  67         my $rest = $2;
  68
  69         foreach (split //, $label)
  70           {
  71             if (m/0/) { print OUT "00" }
  72             if (m/1/) { print OUT "01" }
  73           }
  74
  75         parse_insn ($rest);
  76         return;
  77       }
  78
  79     # IFZ instruction prefix?
  80     if ($insn =~ m/^IFZ[ \t]+(.*)$/i)
  81       {
  82         my $rest = $1;
  83
  84         print OUT "07\n";
  85
  86         parse_insn ($rest);
  87         return;
  88       }
  89     # Empty instruction?
  90     elsif ($insn =~ m/^$/)
  91       {
  92         return;
  93       }
  94     # Other instruction?
  95     elsif ($insn =~ m/^NOP0$/i)
  96       {
  97         print OUT "00\n";
  98       }
  99     elsif ($insn =~ m/^NOP1$/i)
 100       {
 101         print OUT "01\n";
 102       }
 103     elsif ($insn =~ m/^INC[ \t]+A$/i)
 104       {
 105         print OUT "02\n";
 106       }
 107     elsif ($insn =~ m/^DEC[ \t]+A$/i)
 108       {
 109         print OUT "03\n";
 110       }
 111     elsif ($insn =~ m/^SHL[ \t]+A$/i)
 112       {
 113         print OUT "04\n";
 114       }
 115     elsif ($insn =~ m/^FINDB[ \t](.*)$/i)
 116       {
 117         print OUT "08\n";
 118         parse_pattern ($1);
 119       }
 120     elsif ($insn =~ m/^FINDF[ \t](.*)$/i)
 121       {
 122         print OUT "09\n";
 123         parse_pattern ($1);
 124       }
 125     elsif ($insn =~ m/^MALLOC$/i)
 126       {
 127         print OUT "0A\n";
 128       }
 129     elsif ($insn =~ m/^DIVIDE$/i)
 130       {
 131         print OUT "0B\n";
 132       }
 133     elsif ($insn =~ m/^MOVE[ \t]+\[I\],A$/i)
 134       {
 135         print OUT "0C\n";
 136       }
 137     elsif ($insn =~ m/^MOVE[ \t]+A,\[I\]$/i)
 138       {
 139         print OUT "0D\n";
 140       }
 141     elsif ($insn =~ m/^DMOVE[ \t]+\[I\],A$/i)
 142       {
 143         print OUT "0E\n";
 144       }
 145     elsif ($insn =~ m/^DMOVE[ \t]+A,\[I\]$/i)
 146       {
 147         print OUT "0F\n";
 148       }
 149     elsif ($insn =~ m/^XOR[ \t]+([ABIP]),([ABIP])$/i)
 150       {
 151         my $reg1 = reg2bin ($1);
 152         my $reg2 = reg2bin ($2);
 153
 154         printf OUT ("%02X\n", 16 + ($reg2 << 2) + $reg1);
 155       }
 156     elsif ($insn =~ m/^PUSH[ \t]+([ABIP])$/i)
 157       {
 158         my $reg = reg2bin ($1);
 159
 160         printf OUT ("%02X\n", 32 + $reg);
 161       }
 162     elsif ($insn =~ m/^POP[ \t]+([ABIP])$/i)
 163       {
 164         my $reg = reg2bin ($1);
 165
 166         printf OUT ("%02X\n", 36 + $reg);
 167       }
 168     # Instruction set macros.
 169     elsif ($insn =~ m/MOVE[ \t]+([ABIP]),([ABIP])$/i)
 170       {
 171         my $reg1 = reg2bin ($1);
 172         my $reg2 = reg2bin ($2);
 173
 174         printf OUT ("%02X", 32 + $reg1); # PUSH reg1
 175         printf OUT ("%02X\n", 36 + $reg2); # POP reg2
 176       }
 177     elsif ($insn =~ m/SWAP[ \t]+([ABIP]),([ABIP])$/i)
 178       {
 179         my $reg1 = reg2bin ($1);
 180         my $reg2 = reg2bin ($2);
 181
 182         printf OUT ("%02X", 16 + ($reg2 << 2) + $reg1); # XOR reg1, reg2
 183         printf OUT ("%02X", 16 + ($reg1 << 2) + $reg2); # XOR reg2, reg1
 184         printf OUT ("%02X", 16 + ($reg2 << 2) + $reg1); # XOR reg1, reg2
 185         printf OUT ("%02X\n", 16 + ($reg1 << 2) + $reg2); # XOR reg2, reg1
 186       }
 187     elsif ($insn =~ m/ZERO[ \t]+([ABIP])$/i)
 188       {
 189         my $reg = reg2bin ($1);
 190
 191         printf OUT ("%02X\n", 16 + ($reg << 2) + $reg); # XOR reg, reg
 192       }
 193     elsif ($insn =~ m/ADD[ \t]+([0-9]+),A$/i)
 194       {
 195         my $n = $1;
 196
 197         for (my $i = 0; $i < $n; ++$i)
 198           {
 199             print OUT "02";
 200           }
 201         print OUT "\n";
 202       }
 203     elsif ($insn =~ m/MOVE[ \t]+([0-9]+),A$/i)
 204       {
 205         my $n = $1;
 206
 207         print OUT "10";         # XOR A,A
 208         while ($n > 0)
 209           {
 210             if (($n & 1) == 1)
 211               {
 212                 print OUT "0402"; # SHL A; INC A
 213               }
 214             else
 215               {
 216                 print OUT "04"; # SHL A
 217               }
 218             $n >>= 1;
 219           }
 220         print OUT "\n";
 221       }
 222     elsif ($insn =~ m/LOAD[ \t]+([0-9]+),A$/i)
 223       {
 224         my $n = $1;
 225
 226         print OUT "222124";     # PUSH I; PUSH B; POP A
 227         for (my $i = 0; $i < $n * 2; ++$i)
 228           {
 229             print OUT "02";     # INC A
 230           }
 231         print OUT "20260E26\n"; # PUSH A; POP I; DMOVE [I],A; POP I
 232       }
 233     elsif ($insn =~ m/STORE[ \t]+A,([0-9]+)$/i)
 234       {
 235         my $n = $1;
 236
 237         print OUT "22202124";   # PUSH I; PUSH A; PUSH B; POP A
 238         for (my $i = 0; $i < $n * 2; ++$i)
 239           {
 240             print OUT "02";     # INC A
 241           }
 242         print OUT "2026240F26\n"; # PUSH A; POP I; POP A; DMOVE A,[I]; POP I
 243       }
 244     elsif ($insn =~ m/^JMP[ \t]+I$/i)
 245       {
 246         print OUT "2227\n";     # PUSH I; POP P
 247       }
 248     elsif ($insn =~ m/^JMPF[ \t](.*)$/i)
 249       {
 250         print OUT "09";         # FINDF
 251         parse_pattern ($1);
 252         print OUT "2227\n";     # PUSH I; POP P
 253       }
 254     elsif ($insn =~ m/^JMPB[ \t](.*)$/i)
 255       {
 256         print OUT "08";         # FINDB
 257         parse_pattern ($1);
 258         print OUT "2227\n";     # PUSH I; POP P
 259       }
 260     elsif ($insn =~ m/^JMPZF[ \t](.*)$/i)
 261       {
 262         print OUT "09";         # FINDF
 263         parse_pattern ($1);
 264         print OUT "22072726\n"; # PUSH I; IFZ POP P; POP I
 265       }
 266     elsif ($insn =~ m/^JMPZB[ \t](.*)$/i)
 267       {
 268         print OUT "08";         # FINDB
 269         parse_pattern ($1);
 270         print OUT "22072726\n"; # PUSH I; IFZ POP P; POP I
 271       }
 272     elsif ($insn =~ m/^CALLF[ \t](.*)$/i)
 273       {
 274         print OUT "2309";       # PUSH P; FINDF
 275         parse_pattern ($1);
 276         print OUT "2227\n";     # PUSH I; POP P
 277       }
 278     elsif ($insn =~ m/^CALLB[ \t](.*)$/i)
 279       {
 280         print OUT "2308";       # PUSH P; FINDB
 281         parse_pattern ($1);
 282         print OUT "2227\n";     # PUSH I; POP P
 283       }
 284     elsif ($insn =~ m/^RET[ \t]+([0-9]+)$/i)
 285       {
 286         my $n = $1;
 287         print OUT "24";         # POP A
 288         for (my $i = 0; $i < $n + 3; ++$i)
 289           {
 290             print OUT "02";     # INC A
 291           }
 292         print OUT "2027\n";     # PUSH A; POP P
 293       }
 294     elsif ($insn =~ m/^DB[ \t]+([0-9]+)$/i)
 295       {
 296         my $n = $1;
 297         for (my $i = 0; $i < $n; ++$i)
 298           {
 299             print OUT "FF";
 300           }
 301         print OUT "\n";
 302       }
 303     elsif ($insn =~ m/^DW[ \t]+([0-9]+)$/i)
 304       {
 305         my $n = $1;
 306         for (my $i = 0; $i < $n * 2; ++$i)
 307           {
 308             print OUT "FF";
 309           }
 310         print OUT "\n";
 311       }
 312     else
 313       {
 314         die "$insn: unknown instruction";
 315       }
 316   }
 317
 318 sub parse_pattern
 319   {
 320     my $pattern = shift;
 321
 322     if ($pattern =~ m/^([01]+)$/)
 323       {
 324         foreach (split //, $1)
 325           {
 326             if (m/0/) { print OUT "00" }
 327             if (m/1/) { print OUT "01" }
 328           }
 329       }
 330     elsif ($pattern =~ m/^~([01]+)$/) # Complemented pattern.
 331       {
 332         foreach (split //, $1)
 333           {
 334             if (m/0/) { print OUT "01" }
 335             if (m/1/) { print OUT "00" }
 336           }
 337       }
 338     else
 339       {
 340         die "$pattern: unrecognized pattern argument";
 341       }
 342   }
 343
 344 sub reg2bin
 345   {
 346     my $reg = shift;
 347
 348     if (uc($reg) eq "A") { return 0 }
 349     elsif (uc($reg) eq "B") { return 1 }
 350     elsif (uc($reg) eq "I") { return 2 }
 351     elsif (uc($reg) eq "P") { return 3 }
 352     else
 353       {
 354         die "$reg: unknown register name";
 355       }
 356   }