ARM Club 1/ARM_CLUB_CD.iso/contents/apps/program/d/fpbas4tla/!fpbas4tla/!runimage

Text File | 1992-01-26 | 5.4 KB | 168 lines

# extract fpu-commands for Acorn Archimedes out of a inputfile,
# writes a basic-file for FPAbas/FPAssemble (by S. Brodie)
# ( FPAbas/FPAssemble converts fpu-commands into the matching numbers )
# starts the basic-file and bring the output back into Assemblerfile, with
# the syntax for a Assembler that doesn't support fpu-commands (here TLA cause
# current version doesn't support fpu-commands )

# usage: perl thisfile inputfile outfilefile

# for other assemblers you may need: hexsign='&'
   $hexsign='';
# for other assemblers you may need a other commentsign
   $commentsign=';';
# for other assemblers you may need a other wordcommand (eg. EQUD)
   $wordcommand='.WORD';
#

   $nl="\n";
   $[=1;
   $outfile=$ARGV[2];
   $infile=$ARGV[1];
   $buffer=' ' x 256;
   $bufferlen=length($buffer);
   $varstring='fpabas4tla$dir';
   $regs=syscall("OS_ReadVarVal",$varstring,$buffer,$bufferlen,3,4,5,6,7,8,9);
   ($r0,$r1,$r2)=unpack('I3',$regs);
   $buffer=substr($buffer,1,$r2);
   $obeydir=$buffer;
   $outworkfile=$obeydir.'.work.basicfile';
   $inworkfile=$obeydir.'.work.basicout';
   $s='*unset fpabas4tla$error';
   system($s);
   $s='*set fpabas4tla$error true';
   system($s);
   $i=0;
   $f=0;
   open($outworkfilehandle,'>'.$outworkfile);
   printf($outworkfilehandle '1 LIBRARY "<fpabas$path>FPAbas"'.$nl);
   open($infilehandle,$infile);
   while (<$infilehandle>)
      {
      $i=$i+1;
      s/\r\n|\n\r|\r|\n//g;
      $s=$_;
      if (substr($_,1,1) =~ ' ') { s/ +//; }
      @s2=split(/ +/,$_,3);
      $pos=0;
      for ($n=1;$n<=2;$n++)
         {
         if (
             (
              ($n==1)
              ||
              (($n==2) && (substr($s,1,1) !~ ' '))
             )
             &&
             (
              ($s2[$n] =~ /^[Ll][Dd][Ff]/) ||
              ($s2[$n] =~ /^[Ss][Tt][Ff]/) ||
              ($s2[$n] =~ /^[Aa][Dd][Ff]/) ||
              ($s2[$n] =~ /^[Mm][Uu][Ff]/) ||
              ($s2[$n] =~ /^[Ss][Uu][Ff]/) ||
              ($s2[$n] =~ /^[Rr][Ss][Ff]/) ||
              ($s2[$n] =~ /^[Dd][Vv][Ff]/) ||
              ($s2[$n] =~ /^[Rr][Dd][Ff]/) ||
              ($s2[$n] =~ /^[Pp][Oo][Ww]/) ||
              ($s2[$n] =~ /^[Rr][Pp][Ww]/) ||
              ($s2[$n] =~ /^[Rr][Mm][Ff]/) ||
              ($s2[$n] =~ /^[Ff][Mm][Ll]/) ||
              ($s2[$n] =~ /^[Ff][Dd][Vv]/) ||
              ($s2[$n] =~ /^[Ff][Rr][Dd]/) ||
              ($s2[$n] =~ /^[Pp][Oo][Ll]/) ||
              ($s2[$n] =~ /^[Mm][Vv][Ff]/) ||
              ($s2[$n] =~ /^[Mm][Nn][Ff]/) ||
              ($s2[$n] =~ /^[Aa][Bb][Ss]/) ||
              ($s2[$n] =~ /^[Rr][Nn][Dd]/) ||
              ($s2[$n] =~ /^[Ss][Qq][Tt]/) ||
              ($s2[$n] =~ /^[Ll][Oo][Gg]/) ||
              ($s2[$n] =~ /^[Ll][Gg][Nn]/) ||
              ($s2[$n] =~ /^[Ee][Xx][Pp]/) ||
              ($s2[$n] =~ /^[Ss][Ii][Nn]/) ||
              ($s2[$n] =~ /^[Cc][Oo][Ss]/) ||
              ($s2[$n] =~ /^[Tt][Aa][Nn]/) ||
              ($s2[$n] =~ /^[Aa][Ss][Nn]/) ||
              ($s2[$n] =~ /^[Aa][Cc][Ss]/) ||
              ($s2[$n] =~ /^[Aa][Tt][Nn]/) ||
              ($s2[$n] =~ /^[Ff][Ll][Tt]/) ||
              ($s2[$n] =~ /^[Ff][Ii][Xx]/) ||
              ($s2[$n] =~ /^[Ww][Ff][Ss]/) ||
              ($s2[$n] =~ /^[Rr][Ff][Ss]/) ||
              ($s2[$n] =~ /^[Ww][Ff][Cc]/) ||
              ($s2[$n] =~ /^[Rr][Ff][Cc]/) ||
              ($s2[$n] =~ /^[Cc][Mm][Ff]/) ||
              ($s2[$n] =~ /^[Cc][Nn][Ff]/)
             )
            )
            {
            $pos=$n;
            }
         }
      if ($pos!=0)
         {
         $asmtext[$i]=$commentsign.substr($s,3-$pos);
         $i=$i+1;
         $f=$f+1;
         $ind[$f]=$i;
         $label[$i]=substr($s,1,index($s,$s2[$pos])-1);
         printf($outworkfilehandle "%d PRINT ~",$f+1);
         printf($outworkfilehandle 'FN_FP("'."%s".'")'.$nl
                ,substr($s,index($s,$s2[$pos])));
         }
      else
         {
         for ($n=1;$n<=2;$n++)
            {
            if (
                (
                 ($n==1)
                 ||
                 (($n==2) && (substr($s,1,1) !~ ' '))
                )
                &&
                ($s2[$n] =~ /^\.[Ff][Ll][Oo][Aa][Tt]/)
               )
               {
               $pos=$n;
               }
            }
         if ($pos!=0)
            {
            $asmtext[$i]=$commentsign.substr($s,3-$pos);
            $i=$i+1;
            $asmtext[$i]=substr($s,1,index($s,$s2[$pos])-1)
                         .$wordcommand.' '.$hexsign.'0'
                         .sprintf("%X",unpack('i',pack('f',$s2[$pos+1])));
            }
         else
            {
            $asmtext[$i]=$s;
            }
         }
      }
   close($infilehandle);
   $s=' *UNSET fpabas4tla$error';
   printf($outworkfilehandle "%d".$s.$nl,$f+2);
   $s=' *SET fpabas4tla$error false';
   printf($outworkfilehandle "%d".$s.$nl,$f+3);
   printf($outworkfilehandle "%d END\n",$f+4);
   close($outworkfilehandle);
   system('*SETTYPE '.$outworkfile.' BASIC');
   system('BASIC -quit '.$outworkfile.' { > '.$inworkfile.' }');
   open($inworkfilehandle,$inworkfile);
   for ($z=1;$z<=$f;$z++)
      {
      $_=<$inworkfilehandle>;
      s/\r\n|\n\r|\r|\n//g;
      if (substr($_,1,1) =~ ' ') { s/ +//; }
      $s3=$_;
      $asmtext[$ind[$z]]=$label[$ind[$z]].$wordcommand.' '.$hexsign.'0'.$s3;
      }
   close($inworkfilehandle);
   open($outfilehandle,'>'.$outfile);
   for ($z=1;$z<=$i;$z++)
      {
      print $outfilehandle $asmtext[$z],$nl;
      }
   close($outfilehandle);