1 files changed, 434 insertions, 0 deletions

diff --git a/src/lib/libcrypto/perlasm/alpha.pl b/src/lib/libcrypto/perlasm/alpha.pl
new file mode 100644
index 0000000000..3dac571743
--- /dev/null
+++ b/src/lib/libcrypto/perlasm/alpha.pl
@@ -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;