tools/st7_dtc_as/st7_dtc_as.pl

   1 #!/bin/perl
   2 #***************************************************************************
   3 #*   Copyright (C) 2008 Lou Deluxe                                         *
   4 #*   lou.openocd012@fixit.nospammail.net                                   *
   5 #*                                                                         *
   6 #*   This program is free software; you can redistribute it and/or modify  *
   7 #*   it under the terms of the GNU General Public License as published by  *
   8 #*   the Free Software Foundation; either version 2 of the License, or     *
   9 #*   (at your option) any later version.                                   *
  10 #*                                                                         *
  11 #*   This program is distributed in the hope that it will be useful,       *
  12 #*   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  13 #*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  14 #*   GNU General Public License for more details.                          *
  15 #*                                                                         *
  16 #*   You should have received a copy of the GNU General Public License     *
  17 #*   along with this program; if not, write to the                         *
  18 #*   Free Software Foundation, Inc.,                                       *
  19 #*   51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.           *
  20 #***************************************************************************
  21
  22 # A rudimentary assembler for DTC code.
  23 # It is not robust, by any means, but it gets the job done.
  24
  25 {package DTC_as;
  26
  27 my($i); # for later loop to generate reverse lookup
  28
  29 sub new {
  30         my($self) = bless{};
  31
  32         $self->{'pagewidth'} = 60;
  33         $self;
  34 }
  35
  36
  37
  38 %status_bit_arg = (
  39         'STOP' => 0x01,
  40         'ERROR' => 0x02,
  41 );
  42
  43 %cp_arg = (
  44         'A=>X' => 0x00,
  45         'A<X' => 0x01,
  46         'CARRY' => 0x02,
  47         'ALWAYS' => 0x03,
  48         'ADR_BUFFER0=>CMP0' => 0x04,
  49         'ADR_BUFFER0<CMP0' => 0x05,
  50         'ADR_BUFFER1=>CMP1' => 0x06,
  51         'ADR_BUFFER1<CMP1' => 0x07,
  52 );
  53
  54 %shift_unit_arg = (
  55         'CARD' => 0x00,
  56         'MPEG' => 0x08,
  57 );
  58
  59 %shift_pin_arg = (
  60         'PIN0=>IN' => 0x00,
  61         'PIN1=>IN' => 0x04,
  62         'OUT=>PIN0' => 0x01,
  63         'OUT=>PIN1' => 0x03,
  64 );
  65
  66 @ld_arg = (
  67         '<Y>',
  68         'X',
  69         'Y',
  70         'MASK',
  71         'ADR_BUFFER00',
  72         'ADR_BUFFER01',
  73         'ADR_BUFFER10',
  74         'ADR_BUFFER11',
  75         'CMP00',
  76         'CMP01',
  77         'CMP10',
  78         'CMP11',
  79         'DATA_FLASH',
  80         'CTRL_FCI',
  81         'CTRL_CARD',
  82         'CTRL_MPEG',
  83         'DR_PARALLEL',
  84         'DDR_PARALLEL',
  85         'OR_PARALLEL',
  86         'DR_CARD',
  87         'DDR_CARD',
  88         'OR_CARD',
  89         'SHIFT_CARD',
  90         'DR_MPEG',
  91         'DDR_MPEG',
  92         'OR_MPEG',
  93         'SHIFT_MPEG',
  94         'DATA_BUFFER0',
  95         'DATA_BUFFER1',
  96         'ECC_CRC',
  97         'TMP_ECC',
  98         'BUFFER_MNGT'
  99 );
 100
 101 for($i = 0; $i < @ld_arg; $i++) {
 102         $ld_arg{$ld_arg[$i]} = $i;
 103 }
 104
 105
 106 # ADDER8 / SUB8
 107 sub alu8 {
 108         my($self) = shift;
 109         my($operand, $i) = shift;
 110
 111         if(defined($ld_arg{$operand})) {
 112                 $i = $ld_arg{$operand};
 113
 114                 if($i > 0x00 && $i < 0x04) {
 115                         return(($i - 0x01) << 3);
 116                 }
 117         }
 118
 119         return undef;
 120 }
 121
 122 # ADDER16 / SUB16
 123 sub alu16 {
 124         my($self) = shift;
 125         my($operand, $i) = shift;
 126
 127         $operand .= '0';
 128
 129         if(defined($ld_arg{$operand})) {
 130                 $i = $ld_arg{$operand};
 131
 132                 if($i > 0x03 && $i < 0x0c) {
 133                         return(($i - 0x04) << 2);
 134                 }
 135         }
 136
 137         return undef;
 138 }
 139
 140
 141 # BSET / BCLR
 142 sub bsetorclr {
 143         my($self) = shift;
 144         my($ret);
 145
 146         if(@_ < 1) {
 147                 return undef;
 148         }
 149         $ret = $_[0];
 150
 151         if(($ret < 0) || ($ret > 3)) {
 152                 return undef;
 153         }
 154
 155         return $ret;
 156 }
 157
 158
 159 # Opcode lookup table
 160 %op = (
 161         'NOP' => [
 162                 0x0,
 163         ],
 164         'SEC' => [
 165                 0x1,
 166         ],
 167         'CLC' => [
 168                 0x2,
 169         ],
 170         'RET' => [
 171                 0x3,
 172         ],
 173         'STATUS' => [
 174                 0x4,
 175                 sub {
 176                         my($self) = shift;
 177                         my($ret, $i);
 178
 179                         for $i (@_) {
 180                                 if(!defined($status_bit_arg{"\U$i"})) {
 181                                         return undef;
 182                                 }
 183
 184                                 $ret |= $status_bit_arg{"\U$i"};
 185                         }
 186                         if($ret < 1) {
 187                                 return undef;
 188                         }
 189
 190                         return $ret;
 191                 }
 192         ],
 193         'CP' => [
 194                 0x8,
 195                 sub {
 196                         my($self) = shift;
 197                         if((@_ != 1) || (!defined($cp_arg{"\U$_[0]"}))) {
 198                                 return undef;
 199                         }
 200                         return($cp_arg{"\U$_[0]"});
 201                 }
 202         ],
 203         'SHIFT' => [
 204                 0x10,
 205                 sub {
 206                         my($self) = shift;
 207                         my($ret, $i);
 208
 209                         if((@_ < 2) || (!defined($shift_unit_arg{"\U$_[0]"}))) {
 210                                 return undef;
 211                         }
 212                         $ret = $shift_unit_arg{"\U$_[0]"};
 213                         shift;
 214
 215                         for $i (@_) {
 216                                 if(!defined($shift_pin_arg{"\U$i"})) {
 217                                         return undef;
 218                                 }
 219
 220                                 $ret |= $shift_pin_arg{"\U$i"};
 221                         }
 222
 223                         return $ret;
 224                 }
 225         ],
 226         'SUB8' => [
 227                 0x24,
 228                 \&alu8
 229         ],
 230         'ADDER8' => [
 231                 0x25,
 232                 \&alu8
 233         ],
 234         'SUB16' => [
 235                 0x26,
 236                 \&alu16
 237         ],
 238         'ADDER16' => [
 239                 0x27,
 240                 \&alu16
 241         ],
 242         'BCLR' => [
 243                 0x28,
 244                 \&bsetorclr
 245         ],
 246         'BSET' => [
 247                 0x38,
 248                 \&bsetorclr
 249         ],
 250         'REVERSE' => [
 251                 0x30,
 252         ],
 253         'XOR' => [
 254                 0x31,
 255         ],
 256         'AND' => [
 257                 0x32,
 258         ],
 259         'EXCHANGE' => [
 260                 0x33,
 261         ],
 262         'DECY' => [
 263                 0x3c,
 264         ],
 265         'INCY' => [
 266                 0x3d,
 267         ],
 268         'JP' => [
 269                 0x40,
 270                 sub {
 271                         my($self) = shift;
 272                         my($i);
 273
 274                         if(@_ != 1) {
 275                                 return undef;
 276                         }
 277                         $i = $_[0];
 278                         if(!defined($self->{'label'}{$i})) {
 279                                 $i =~ s/^://o;
 280                                 if(!defined($self->{'label'}{$i})) {
 281                                         # not a defined label
 282                                         undef $i;
 283                                 }
 284                         }
 285
 286                         if(defined($i)) {
 287                                 $i = $self->{'label'}{$i} - $self->{'pc'};
 288                         } else {
 289                                 $i = $_[0];
 290                         }
 291
 292                         if($i =~ m/^([+-]?\d+)$/) {
 293                                 $i = 0 + $1;
 294                                 if(($i > 31) || ($i < -31)) {
 295                                         warn "relative jump ($i) out of range";
 296                                         return undef;
 297                                 }
 298                                 if($i < 0) {
 299                                         return(0x20 - $1);
 300                                 } else {
 301                                         return(0x00 + $1);
 302                                 }
 303                         }
 304
 305                         return undef;
 306                 }
 307         ],
 308         'BRANCH' => [
 309                 0x60,
 310         ],
 311         'LD' => [
 312                 0x80,
 313                 sub {
 314                         my($self) = shift;
 315                         my($i);
 316
 317 #                       print STDERR join(", ", LD, @_), "\n";
 318
 319                         if(@_ == 1) {
 320                                 $_[1] = 'A';
 321                         }
 322                         if(@_ != 2) {
 323                                 return undef;
 324                         }
 325
 326
 327                         if($_[0] =~ m/^([ML])S[BN]$/o) {
 328                                 # MSB/LSB aka MSN/LSN
 329                                 if($1 eq 'L') {
 330                                         $_[0] = 'A.L';
 331                                 } else {
 332                                         $_[0] = 'A.H';
 333                                 }
 334                         }
 335                         if($_[0] =~ m/^A\.([LH])$/o) {
 336                                 # A.L/A.H
 337                                 my($islsb) = ($1 eq 'L') ? 1 : 0;
 338                                 $i = $_[1];
 339                                 if($i =~ s/^0x([0-9a-fA-F])$/hex($1)/e) {
 340 #                                       print "$i looks hex\n";
 341                                 } elsif($i =~ m/^\d+$/) {
 342 #                                       print "$i looks decimal\n";
 343                                 } elsif(defined($self->{'label'}{$i})) {
 344 #                                       print "label match for $i ($self->{'label'}{$i})\n";
 345                                         $i = $self->{'label'}{$i};
 346 #                                       print "\$i=$i\n";
 347 #                                       print "\$islsb=$islsb\n";
 348                                         if($islsb) {
 349                                                 $i = ($i & 0xf);
 350                                         } else {
 351                                                 $i = ($i >> 4) & 0xf;
 352                                         }
 353 #                                       print "\$i=$i\n";
 354                                 } else {
 355                                         print "no label match for $i\n";
 356                                         return undef;
 357                                 }
 358                                 if(($i < 0) || ($i > 0xf)) {
 359                                         return undef;
 360                                 }
 361                                 if($islsb) {
 362                                         $i |= 0x10;
 363                                 };
 364                                 return(0x20 | $i);
 365                         } elsif($_[0] eq 'A') {
 366                                 if(!defined($ld_arg{$_[1]})) {
 367                                         return undef;
 368                                 }
 369                                 return(0x40 | $ld_arg{$_[1]});
 370                         } elsif($_[1] eq 'A') {
 371                                 if(!defined($ld_arg{$_[0]})) {
 372                                         return undef;
 373                                 }
 374                                 return(0x00 | $ld_arg{$_[0]});
 375                         }
 376
 377                         return undef;
 378                 }
 379         ],
 380 );
 381
 382 $op{'JR'} = $op{'JP'};
 383
 384
 385 sub pass {
 386         my($self, $ifh, $ofh, $passnum) = @_;
 387
 388         # passnum=0 for plain parsing pass to populate label values
 389         # passnum=1 for actual pass to assemble
 390
 391         my($line, $oline, $opcd);
 392
 393         if($passnum == 0) {
 394                 delete($self->{'label'});
 395                 delete($self->{'binary'});
 396                 delete($self->{'ENTRY'});
 397                 delete($self->{'LUT'});
 398         }
 399
 400         seek($ifh, 0, 0); # rewind
 401         $self->{'pc'} = 0;
 402         $self->{'line_number'} = 0;
 403         while(defined($line = <$ifh>)) {
 404                 $self->{'line_number'}++;
 405                 $line =~ s/\s+$//so;
 406                 $oline = $line;
 407                 $line =~ s/;.*//o;
 408                 $line =~ s/^\s+//o;
 409                 @_ = split(/[\s,]+/, $line);
 410
 411                 undef($opcd);
 412
 413                 if(@_ > 0) {
 414
 415                         if(
 416                                 ($_[0] =~ s/^://o)
 417                                 ||
 418                                 ($_[0] =~ s/:$//o)
 419                         ) {
 420                                 if($passnum == 0) {
 421                                         if(defined($self->{'label'}{$_[0]})) {
 422                                                 die "label redefinition for \"$_[0]\" in line $self->{'line_number'}";
 423                                         }
 424                                         $self->{'label'}{$_[0]} = $self->{'pc'};
 425                                 }
 426                                 shift(@_);
 427                         }
 428
 429                         if(@_ > 0) {
 430                                 if($passnum == 1) {
 431                                         if((@_ == 3) && ($_[1] eq '=')) {
 432                                                 # convert this = that to LD
 433                                                 $_[1] = $_[0];
 434                                                 $_[0] = 'LD';
 435                                         }
 436                                         elsif((@_ == 3) && ($_[1] eq '+=')) {
 437                                                 # convert this += that to ADDER8 or ADDER16
 438                                                 if($_[0] eq 'A') {
 439                                                         @_ = ('ADDER8', $_[2]);
 440                                                 }
 441                                                 elsif($_[2] eq 'X') {
 442                                                         @_ = ('ADDER16', $_[0]);
 443                                                 }
 444                                         }
 445                                         elsif((@_ == 3) && ($_[1] eq '-=')) {
 446                                                 # convert this -= that to ADDER8 or ADDER16
 447                                                 if($_[0] eq 'A') {
 448                                                         @_ = ('SUB8', $_[2]);
 449                                                 }
 450                                                 elsif($_[2] eq 'X') {
 451                                                         @_ = ('SUB16', $_[0]);
 452                                                 }
 453                                         }
 454                                         elsif((@_ == 1) && ($_[0] =~ m/^(B((SET)|(CLR)))([1-4])$/oi)) {
 455                                                 # convert BSETn or BCLRn to BSET n-1 or BCLR n-1
 456                                                 $_[0] = $1;
 457                                                 $_[1] = $5 - 1;
 458                                         }
 459
 460                                         $op = "\U$_[0]";
 461                                         if(!defined($op{$op})) {
 462                                                 die "unknown instruction: $op in line $self->{'line_number'}";
 463                                         }
 464                                         shift(@_);
 465
 466                                         $op = $op{$op};
 467                                         $sub = $op->[1];
 468                                         if(defined($sub)) {
 469                                                 $opcd = &$sub($self, @_);
 470                                         } else {
 471                                                 $opcd = 0;
 472                                         }
 473
 474                                         if(!defined($opcd)) {
 475                                                 die "bad argument(s) in line $self->{'line_number'}";
 476                                         }
 477
 478                                         $opcd |= $op->[0];
 479                                 }
 480
 481                                 $self->{'pc'}++;
 482                         }
 483
 484                 } else {
 485                         if($passnum == 0) {
 486                                 if($oline =~ m/^;LUT; (.*)/o) {
 487                                         my($entry, $label) = split(/\s+/, $1);
 488                                         $entry =~ s/^0x//o;
 489                                         $self->{'LUT'}[hex($entry)] = $label;
 490                                 }
 491                                 if($oline =~ m/^;ENTRY; (.*)/o) {
 492                                         my($id, $label) = split(/\s+/, $1);
 493                                         $self->{'ENTRY'}{$id} = $label;
 494                                 }
 495                         }
 496                 }
 497
 498                 if($passnum == 1) {
 499                         if(defined($opcd)) {
 500                                 $self->{'binary'} .= chr($opcd);
 501
 502                                 printf $ofh ("/* 0x%02x */ 0x%02x%s /* %-*s */\n",
 503                                         $self->{'pc'} - 1,
 504                                         $opcd,
 505                                         (
 506                                                 (
 507                                                         ($self->{'last pc'} < 0xff)
 508                                                         ||
 509                                                         ($self->{'last pc'} != $self->{'pc'} - 1)
 510                                                 ) ?
 511                                                         ','
 512                                                 :
 513                                                         ''
 514                                         ),
 515                                         $self->{'pagewidth'} - 23,
 516                                         $oline
 517                                 );
 518                         } else {
 519                                 if($oline ne '') {
 520                                         print $ofh "                 /* $oline */\n";
 521                                 } else {
 522                                         print $ofh "\n";
 523                                 }
 524                         }
 525                 }
 526         }
 527
 528         if($passnum == 0) {
 529                 $self->{'last pc'} = $self->{'pc'} - 1;
 530         }
 531
 532         if($passnum == 1) {
 533                 while($self->{'pc'} < 0xff) {
 534                         printf $ofh ("/* 0x%02x */ 0,\n",
 535                                 $self->{'pc'}
 536                         );
 537                         $self->{'pc'}++;
 538                 }
 539                 if($self->{'pc'} < 0x100) {
 540                         printf $ofh ("/* 0x%02x */ 0\n",
 541                                 $self->{'pc'}
 542                         );
 543                         $self->{'pc'}++;
 544                 }
 545         }
 546 }
 547
 548 } # package DTC_as
 549
 550
 551 use Getopt::Std;
 552
 553 %opt = (
 554         't' => 'unsigned char',
 555 );
 556
 557 # -t type of arrays (defaults to unsigned char)
 558 # -l lookup table array name (no table generated if not provided)
 559 # -d DTC code array name (naked elements if not provided)
 560 # -i input filename (trailing argument if not provided)
 561 # -o output filename (stdout if not provided)
 562 getopts('l:d:i:o:t:b', \%opt);
 563
 564 if(defined($opt{'i'})) {
 565         $infile = $opt{'i'};
 566 } else {
 567         $infile = shift;
 568 }
 569
 570 if(!open(IN, '<', $infile)) {
 571         die "$infile: $!";
 572 }
 573
 574
 575 if($opt{'b'}) {
 576         if(!defined($opt{'o'})) {
 577                 die "binary format requires -o";
 578         }
 579         if(!open(OUT, '>&', *STDOUT)) {
 580                 die "dup stdout: $!";
 581         }
 582         open(STDOUT, '>&', *STDERR);
 583 } else {
 584         if(defined($opt{'o'})) {
 585                 if(!open(OUT, '>', $opt{'o'})) {
 586                         die "$opt{'o'}: $!";
 587                 }
 588         } else {
 589                 if(!open(OUT, '>&', *STDOUT)) {
 590                         die "dup stdout: $!";
 591                 }
 592                 open(STDOUT, '>&', *STDERR);
 593         }
 594 }
 595
 596
 597 $as = new DTC_as;
 598
 599 $as->pass(*IN, *OUT, 0);
 600
 601 if(defined($opt{'d'})) {
 602         print OUT "$opt{'t'} $opt{'d'}", "[0x100] = {\n";
 603 }
 604 $as->pass(*IN, *OUT, 1);
 605 if(defined($opt{'d'})) {
 606         print OUT "};\n\n";
 607 }
 608
 609 close(IN);
 610
 611 if(defined($opt{'l'})) {
 612         print OUT "$opt{'t'} $opt{'l'}", "[0x40] = {\n";
 613 #       $end = @{$as->{'LUT'}};
 614 #       if($end > 0x100) {
 615 #               $end = 0x100;
 616 #       }
 617         for($i = 0xc0; $i < 0x100; $i++) {
 618                 $label = $as->{'LUT'}[$i];
 619                 if(defined($label)) {
 620                         if(defined($as->{'label'}{$label})) {
 621                                 printf OUT ("/* 0x%02x */ 0x%02x%s /* %s */\n",
 622                                         $i,
 623                                         $as->{'label'}{$label},
 624                                         (($i < 0xff) ? ',' : ''),
 625                                         $label
 626                                 );
 627                         } else {
 628                                 die "label $label has not been defined";
 629                         }
 630                 } else {
 631                         printf OUT ("/* 0x%02x */ 0%s\n",
 632                                 $i,
 633                                 (($i < 0xff) ? ',' : ''),
 634                         );
 635                 }
 636         }
 637         print OUT "};\n\n";
 638 }
 639
 640
 641 close(OUT);
 642
 643 sub DTCLOAD_COMMENT { 0; }
 644 sub DTCLOAD_ENTRY { 1; }
 645 sub DTCLOAD_LOAD { 2; }
 646 sub DTCLOAD_RUN { 3; }
 647 sub DTCLOAD_LUT_START { 4; }
 648 sub DTCLOAD_LUT { 5; }
 649
 650
 651 if($opt{'b'}) {
 652         open(OUT, ">", $opt{'o'}) || die "$opt{'o'}: $!";
 653         syswrite(OUT, pack('CC', DTCLOAD_LUT_COMMENT, 3 - 1) . 'DTC');
 654
 655         $ref = $as->{'LUT'};
 656         if(@$ref > 0) {
 657                 for($start = 0; $start < @$ref && !defined($ref->[$start]); $start++) {}
 658                 for($end = 0xff; $end >= $start && !defined($ref->[$end]); $end--) {}
 659                 undef($lut);
 660                 for($i = $start; $i <= $end; $i++) {
 661                         if(!defined($ref->[$i])) {
 662                                 $lut .= "\0";
 663                                 next;
 664                         }
 665                         $label = $ref->[$i];
 666                         if(defined($as->{'label'}{$label})) {
 667                                 $label = $as->{'label'}{$label};
 668 #                               printf("adding LUT entry 0x%02x\n", $label);
 669                                 $lut .= chr($label);
 670                         } else {
 671                                 die "label $label has not been defined";
 672                         }
 673                 }
 674                 if(length($lut) > 0) {
 675                         syswrite(OUT, pack('CCC', DTCLOAD_LUT_START, 1 - 1, $start));
 676                         syswrite(OUT, pack('CC', DTCLOAD_LUT, length($lut) - 1) . $lut);
 677                 }
 678         }
 679
 680         while(($key, $label) = each(%{$as->{'ENTRY'}})) {
 681 #               print "$key = $label\n";
 682                 if(defined($as->{'label'}{$label})) {
 683                         $label = $as->{'label'}{$label};
 684 #                       print "key=$key\n";
 685 #                       print "label=$label\n";
 686                         syswrite(OUT, pack('CCC', DTCLOAD_ENTRY, length($key), $label) . $key);
 687                 } else {
 688                         die "label $label has not been defined";
 689                 }
 690         }
 691
 692         if(length($as->{'binary'})) {
 693 #               printf("DTC code size: 0x%x\n", length($as->{'binary'}));
 694                 syswrite(OUT, pack('CC',
 695                         DTCLOAD_LOAD ,
 696                         length($as->{'binary'}) - 1
 697                 ) . $as->{'binary'});
 698
 699                 if(%{$as->{'ENTRY'}} < 1) {
 700                         syswrite(OUT, pack('CCC', DTCLOAD_RUN, 1 - 1, 0x00));
 701                 }
 702         }
 703
 704         close(OUT);
 705 }
 706
 707
 708 0;
 709