diff options
Diffstat (limited to 'crypto/perlasm/alpha.pl')
| -rw-r--r-- | crypto/perlasm/alpha.pl | 434 |
1 files changed, 434 insertions, 0 deletions
diff --git a/crypto/perlasm/alpha.pl b/crypto/perlasm/alpha.pl new file mode 100644 index 0000000000..3dac571743 --- /dev/null +++ b/crypto/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; |