Import of old SSLeay release: SSLeay 0.9.1b (unreleased)
[openssl.git] / crypto / perlasm / alpha.pl
diff --git a/crypto/perlasm/alpha.pl b/crypto/perlasm/alpha.pl
new file mode 100644 (file)
index 0000000..3dac571
--- /dev/null
@@ -0,0 +1,434 @@
+#!/usr/local/bin/perl
+
+package alpha;
+use Carp qw(croak cluck);
+
+$label="100";
+
+$n_debug=0;
+$smear_regs=1;
+$reg_alloc=1;
+
+$align="3";
+$com_start="#";
+
+sub main'asm_init_output { @out=(); }
+sub main'asm_get_output { return(@out); }
+sub main'get_labels { return(@labels); }
+sub main'external_label { push(@labels,@_); }
+
+# General registers
+
+%regs=(        'r0',   '$0',
+       'r1',   '$1',
+       'r2',   '$2',
+       'r3',   '$3',
+       'r4',   '$4',
+       'r5',   '$5',
+       'r6',   '$6',
+       'r7',   '$7',
+       'r8',   '$8',
+       'r9',   '$22',
+       'r10',  '$23',
+       'r11',  '$24',
+       'r12',  '$25',
+       'r13',  '$27',
+       'r14',  '$28',
+       'r15',  '$21', # argc == 5
+       'r16',  '$20', # argc == 4
+       'r17',  '$19', # argc == 3
+       'r18',  '$18', # argc == 2
+       'r19',  '$17', # argc == 1
+       'r20',  '$16', # argc == 0
+       'r21',  '$9',  # save 0
+       'r22',  '$10', # save 1
+       'r23',  '$11', # save 2
+       'r24',  '$12', # save 3
+       'r25',  '$13', # save 4
+       'r26',  '$14', # save 5
+
+       'a0',   '$16',
+       'a1',   '$17',
+       'a2',   '$18',
+       'a3',   '$19',
+       'a4',   '$20',
+       'a5',   '$21',
+
+       's0',   '$9',
+       's1',   '$10',
+       's2',   '$11',
+       's3',   '$12',
+       's4',   '$13',
+       's5',   '$14',
+       'zero', '$31',
+       'sp',   '$30',
+       );
+
+$main'reg_s0="r21";
+$main'reg_s1="r22";
+$main'reg_s2="r23";
+$main'reg_s3="r24";
+$main'reg_s4="r25";
+$main'reg_s5="r26";
+
+@reg=(  '$0', '$1' ,'$2' ,'$3' ,'$4' ,'$5' ,'$6' ,'$7' ,'$8',
+       '$22','$23','$24','$25','$20','$21','$27','$28');
+
+
+sub main'sub   { &out3("subq",@_); }
+sub main'add   { &out3("addq",@_); }
+sub main'mov   { &out3("bis",$_[0],$_[0],$_[1]); }
+sub main'or    { &out3("bis",@_); }
+sub main'bis   { &out3("bis",@_); }
+sub main'br    { &out1("br",@_); }
+sub main'ld    { &out2("ldq",@_); }
+sub main'st    { &out2("stq",@_); }
+sub main'cmpult        { &out3("cmpult",@_); }
+sub main'cmplt { &out3("cmplt",@_); }
+sub main'bgt   { &out2("bgt",@_); }
+sub main'ble   { &out2("ble",@_); }
+sub main'blt   { &out2("blt",@_); }
+sub main'mul   { &out3("mulq",@_); }
+sub main'muh   { &out3("umulh",@_); }
+
+$main'QWS=8;
+
+sub main'asm_add
+       {
+       push(@out,@_);
+       }
+
+sub main'asm_finish
+       {
+       &main'file_end();
+       print &main'asm_get_output();
+       }
+
+sub main'asm_init
+       {
+       ($type,$fn)=@_;
+       $filename=$fn;
+
+       &main'asm_init_output();
+       &main'comment("Don't even think of reading this code");
+       &main'comment("It was automatically generated by $filename");
+       &main'comment("Which is a perl program used to generate the alpha assember.");
+       &main'comment("eric <eay\@cryptsoft.com>");
+       &main'comment("");
+
+       $filename =~ s/\.pl$//;
+       &main'file($filename);
+       }
+
+sub conv
+       {
+       local($r)=@_;
+       local($v);
+
+       return($regs{$r}) if defined($regs{$r});
+       return($r);
+       }
+
+sub main'QWPw
+       {
+       local($off,$reg)=@_;
+
+       return(&main'QWP($off*8,$reg));
+       }
+
+sub main'QWP
+       {
+       local($off,$reg)=@_;
+
+       $ret="$off(".&conv($reg).")";
+       return($ret);
+       }
+
+sub out3
+       {
+       local($name,$p1,$p2,$p3)=@_;
+
+       $p1=&conv($p1);
+       $p2=&conv($p2);
+       $p3=&conv($p3);
+       push(@out,"\t$name\t");
+       $l=length($p1)+1;
+       push(@out,$p1.",");
+       $ll=3-($l+9)/8;
+       $tmp1=sprintf("\t" x $ll);
+       push(@out,$tmp1);
+
+       $l=length($p2)+1;
+       push(@out,$p2.",");
+       $ll=3-($l+9)/8;
+       $tmp1=sprintf("\t" x $ll);
+       push(@out,$tmp1);
+
+       push(@out,&conv($p3)."\n");
+       }
+
+sub out2
+       {
+       local($name,$p1,$p2,$p3)=@_;
+
+       $p1=&conv($p1);
+       $p2=&conv($p2);
+       push(@out,"\t$name\t");
+       $l=length($p1)+1;
+       push(@out,$p1.",");
+       $ll=3-($l+9)/8;
+       $tmp1=sprintf("\t" x $ll);
+       push(@out,$tmp1);
+
+       push(@out,&conv($p2)."\n");
+       }
+
+sub out1
+       {
+       local($name,$p1)=@_;
+
+       $p1=&conv($p1);
+       push(@out,"\t$name\t".$p1."\n");
+       }
+
+sub out0
+       {
+       push(@out,"\t$_[0]\n");
+       }
+
+sub main'file
+       {
+       local($file)=@_;
+
+       local($tmp)=<<"EOF";
+ # DEC Alpha assember
+ # Generated from perl scripts contains in SSLeay
+       .file   1 "$file.s"
+       .set noat
+EOF
+       push(@out,$tmp);
+       }
+
+sub main'function_begin
+       {
+       local($func)=@_;
+
+print STDERR "$func\n";
+       local($tmp)=<<"EOF";
+       .text
+       .align $align
+       .globl $func
+       .ent $func
+${func}:
+${func}..ng:
+       .frame \$30,0,\$26,0
+       .prologue 0
+EOF
+       push(@out,$tmp);
+       $stack=0;
+       }
+
+sub main'function_end
+       {
+       local($func)=@_;
+
+       local($tmp)=<<"EOF";
+       ret     \$31,(\$26),1
+       .end $func
+EOF
+       push(@out,$tmp);
+       $stack=0;
+       %label=();
+       }
+
+sub main'function_end_A
+       {
+       local($func)=@_;
+
+       local($tmp)=<<"EOF";
+       ret     \$31,(\$26),1
+EOF
+       push(@out,$tmp);
+       }
+
+sub main'function_end_B
+       {
+       local($func)=@_;
+
+       $func=$under.$func;
+
+       push(@out,"\t.end $func\n");
+       $stack=0;
+       %label=();
+       }
+
+sub main'wparam
+       {
+       local($num)=@_;
+
+       if ($num < 6)
+               {
+               $num=20-$num;
+               return("r$num");
+               }
+       else
+               { return(&main'QWP($stack+$num*8,"sp")); }
+       }
+
+sub main'stack_push
+       {
+       local($num)=@_;
+       $stack+=$num*8;
+       &main'sub("sp",$num*8,"sp");
+       }
+
+sub main'stack_pop
+       {
+       local($num)=@_;
+       $stack-=$num*8;
+       &main'add("sp",$num*8,"sp");
+       }
+
+sub main'swtmp
+       {
+       return(&main'QWP(($_[0])*8,"sp"));
+       }
+
+# Should use swtmp, which is above sp.  Linix can trash the stack above esp
+#sub main'wtmp
+#      {
+#      local($num)=@_;
+#
+#      return(&main'QWP(-($num+1)*4,"esp","",0));
+#      }
+
+sub main'comment
+       {
+       foreach (@_)
+               {
+               if (/^\s*$/)
+                       { push(@out,"\n"); }
+               else
+                       { push(@out,"\t$com_start $_ $com_end\n"); }
+               }
+       }
+
+sub main'label
+       {
+       if (!defined($label{$_[0]}))
+               {
+               $label{$_[0]}=$label;
+               $label++;
+               }
+       return('$'.$label{$_[0]});
+       }
+
+sub main'set_label
+       {
+       if (!defined($label{$_[0]}))
+               {
+               $label{$_[0]}=$label;
+               $label++;
+               }
+#      push(@out,".align $align\n") if ($_[1] != 0);
+       push(@out,'$'."$label{$_[0]}:\n");
+       }
+
+sub main'file_end
+       {
+       }
+
+sub main'data_word
+       {
+       push(@out,"\t.long $_[0]\n");
+       }
+
+@pool_free=();
+@pool_taken=();
+$curr_num=0;
+$max=0;
+
+sub main'init_pool
+       {
+       local($args)=@_;
+       local($i);
+
+       @pool_free=();
+       for ($i=(14+(6-$args)); $i >= 0; $i--)
+               {
+               push(@pool_free,"r$i");
+               }
+       print STDERR "START :register pool:@pool_free\n";
+       $curr_num=$max=0;
+       }
+
+sub main'fin_pool
+       {
+       printf STDERR "END %2d:register pool:@pool_free\n",$max;
+       }
+
+sub main'GR
+       {
+       local($r)=@_;
+       local($i,@n,$_);
+
+       foreach (@pool_free)
+               {
+               if ($r ne $_)
+                       { push(@n,$_); }
+               else
+                       {
+                       $curr_num++;
+                       $max=$curr_num if ($curr_num > $max);
+                       }
+               }
+       @pool_free=@n;
+print STDERR "GR:@pool_free\n" if $reg_alloc;
+       return(@_);
+       }
+
+sub main'NR
+       {
+       local($num)=@_;
+       local(@ret);
+
+       $num=1 if $num == 0;
+       ($#pool_free >= ($num-1)) || croak "out of registers: want $num, have @pool_free";
+       while ($num > 0)
+               {
+               push(@ret,pop @pool_free);
+               $curr_num++;
+               $max=$curr_num if ($curr_num > $max);
+               $num--
+               }
+       print STDERR "nr @ret\n" if $n_debug;
+print STDERR "NR:@pool_free\n" if $reg_alloc;
+       return(@ret);
+
+       }
+
+sub main'FR
+       {
+       local(@r)=@_;
+       local(@a,$v,$w);
+
+       print STDERR "fr @r\n" if $n_debug;
+#      cluck "fr @r";
+       for $w (@pool_free)
+               {
+               foreach $v (@r)
+                       {
+                       croak "double register free of $v (@pool_free)" if $w eq $v;
+                       }
+               }
+       foreach $v (@r)
+               {
+               croak "bad argument to FR" if ($v !~ /^r\d+$/);
+               if ($smear_regs)
+                       { unshift(@pool_free,$v); }
+               else    { push(@pool_free,$v); }
+               $curr_num--;
+               }
+print STDERR "FR:@pool_free\n" if $reg_alloc;
+       }
+1;