More extension code. Incomplete support for subject and issuer alt
[openssl.git] / crypto / perlasm / alpha.pl
1 #!/usr/local/bin/perl
2
3 package alpha;
4 use Carp qw(croak cluck);
5
6 $label="100";
7
8 $n_debug=0;
9 $smear_regs=1;
10 $reg_alloc=1;
11
12 $align="3";
13 $com_start="#";
14
15 sub main'asm_init_output { @out=(); }
16 sub main'asm_get_output { return(@out); }
17 sub main'get_labels { return(@labels); }
18 sub main'external_label { push(@labels,@_); }
19
20 # General registers
21
22 %regs=( 'r0',   '$0',
23         'r1',   '$1',
24         'r2',   '$2',
25         'r3',   '$3',
26         'r4',   '$4',
27         'r5',   '$5',
28         'r6',   '$6',
29         'r7',   '$7',
30         'r8',   '$8',
31         'r9',   '$22',
32         'r10',  '$23',
33         'r11',  '$24',
34         'r12',  '$25',
35         'r13',  '$27',
36         'r14',  '$28',
37         'r15',  '$21', # argc == 5
38         'r16',  '$20', # argc == 4
39         'r17',  '$19', # argc == 3
40         'r18',  '$18', # argc == 2
41         'r19',  '$17', # argc == 1
42         'r20',  '$16', # argc == 0
43         'r21',  '$9',  # save 0
44         'r22',  '$10', # save 1
45         'r23',  '$11', # save 2
46         'r24',  '$12', # save 3
47         'r25',  '$13', # save 4
48         'r26',  '$14', # save 5
49
50         'a0',   '$16',
51         'a1',   '$17',
52         'a2',   '$18',
53         'a3',   '$19',
54         'a4',   '$20',
55         'a5',   '$21',
56
57         's0',   '$9',
58         's1',   '$10',
59         's2',   '$11',
60         's3',   '$12',
61         's4',   '$13',
62         's5',   '$14',
63         'zero', '$31',
64         'sp',   '$30',
65         );
66
67 $main'reg_s0="r21";
68 $main'reg_s1="r22";
69 $main'reg_s2="r23";
70 $main'reg_s3="r24";
71 $main'reg_s4="r25";
72 $main'reg_s5="r26";
73
74 @reg=(  '$0', '$1' ,'$2' ,'$3' ,'$4' ,'$5' ,'$6' ,'$7' ,'$8',
75         '$22','$23','$24','$25','$20','$21','$27','$28');
76
77
78 sub main'sub    { &out3("subq",@_); }
79 sub main'add    { &out3("addq",@_); }
80 sub main'mov    { &out3("bis",$_[0],$_[0],$_[1]); }
81 sub main'or     { &out3("bis",@_); }
82 sub main'bis    { &out3("bis",@_); }
83 sub main'br     { &out1("br",@_); }
84 sub main'ld     { &out2("ldq",@_); }
85 sub main'st     { &out2("stq",@_); }
86 sub main'cmpult { &out3("cmpult",@_); }
87 sub main'cmplt  { &out3("cmplt",@_); }
88 sub main'bgt    { &out2("bgt",@_); }
89 sub main'ble    { &out2("ble",@_); }
90 sub main'blt    { &out2("blt",@_); }
91 sub main'mul    { &out3("mulq",@_); }
92 sub main'muh    { &out3("umulh",@_); }
93
94 $main'QWS=8;
95
96 sub main'asm_add
97         {
98         push(@out,@_);
99         }
100
101 sub main'asm_finish
102         {
103         &main'file_end();
104         print &main'asm_get_output();
105         }
106
107 sub main'asm_init
108         {
109         ($type,$fn)=@_;
110         $filename=$fn;
111
112         &main'asm_init_output();
113         &main'comment("Don't even think of reading this code");
114         &main'comment("It was automatically generated by $filename");
115         &main'comment("Which is a perl program used to generate the alpha assember.");
116         &main'comment("eric <eay\@cryptsoft.com>");
117         &main'comment("");
118
119         $filename =~ s/\.pl$//;
120         &main'file($filename);
121         }
122
123 sub conv
124         {
125         local($r)=@_;
126         local($v);
127
128         return($regs{$r}) if defined($regs{$r});
129         return($r);
130         }
131
132 sub main'QWPw
133         {
134         local($off,$reg)=@_;
135
136         return(&main'QWP($off*8,$reg));
137         }
138
139 sub main'QWP
140         {
141         local($off,$reg)=@_;
142
143         $ret="$off(".&conv($reg).")";
144         return($ret);
145         }
146
147 sub out3
148         {
149         local($name,$p1,$p2,$p3)=@_;
150
151         $p1=&conv($p1);
152         $p2=&conv($p2);
153         $p3=&conv($p3);
154         push(@out,"\t$name\t");
155         $l=length($p1)+1;
156         push(@out,$p1.",");
157         $ll=3-($l+9)/8;
158         $tmp1=sprintf("\t" x $ll);
159         push(@out,$tmp1);
160
161         $l=length($p2)+1;
162         push(@out,$p2.",");
163         $ll=3-($l+9)/8;
164         $tmp1=sprintf("\t" x $ll);
165         push(@out,$tmp1);
166
167         push(@out,&conv($p3)."\n");
168         }
169
170 sub out2
171         {
172         local($name,$p1,$p2,$p3)=@_;
173
174         $p1=&conv($p1);
175         $p2=&conv($p2);
176         push(@out,"\t$name\t");
177         $l=length($p1)+1;
178         push(@out,$p1.",");
179         $ll=3-($l+9)/8;
180         $tmp1=sprintf("\t" x $ll);
181         push(@out,$tmp1);
182
183         push(@out,&conv($p2)."\n");
184         }
185
186 sub out1
187         {
188         local($name,$p1)=@_;
189
190         $p1=&conv($p1);
191         push(@out,"\t$name\t".$p1."\n");
192         }
193
194 sub out0
195         {
196         push(@out,"\t$_[0]\n");
197         }
198
199 sub main'file
200         {
201         local($file)=@_;
202
203         local($tmp)=<<"EOF";
204  # DEC Alpha assember
205  # Generated from perl scripts contains in SSLeay
206         .file   1 "$file.s"
207         .set noat
208 EOF
209         push(@out,$tmp);
210         }
211
212 sub main'function_begin
213         {
214         local($func)=@_;
215
216 print STDERR "$func\n";
217         local($tmp)=<<"EOF";
218         .text
219         .align $align
220         .globl $func
221         .ent $func
222 ${func}:
223 ${func}..ng:
224         .frame \$30,0,\$26,0
225         .prologue 0
226 EOF
227         push(@out,$tmp);
228         $stack=0;
229         }
230
231 sub main'function_end
232         {
233         local($func)=@_;
234
235         local($tmp)=<<"EOF";
236         ret     \$31,(\$26),1
237         .end $func
238 EOF
239         push(@out,$tmp);
240         $stack=0;
241         %label=();
242         }
243
244 sub main'function_end_A
245         {
246         local($func)=@_;
247
248         local($tmp)=<<"EOF";
249         ret     \$31,(\$26),1
250 EOF
251         push(@out,$tmp);
252         }
253
254 sub main'function_end_B
255         {
256         local($func)=@_;
257
258         $func=$under.$func;
259
260         push(@out,"\t.end $func\n");
261         $stack=0;
262         %label=();
263         }
264
265 sub main'wparam
266         {
267         local($num)=@_;
268
269         if ($num < 6)
270                 {
271                 $num=20-$num;
272                 return("r$num");
273                 }
274         else
275                 { return(&main'QWP($stack+$num*8,"sp")); }
276         }
277
278 sub main'stack_push
279         {
280         local($num)=@_;
281         $stack+=$num*8;
282         &main'sub("sp",$num*8,"sp");
283         }
284
285 sub main'stack_pop
286         {
287         local($num)=@_;
288         $stack-=$num*8;
289         &main'add("sp",$num*8,"sp");
290         }
291
292 sub main'swtmp
293         {
294         return(&main'QWP(($_[0])*8,"sp"));
295         }
296
297 # Should use swtmp, which is above sp.  Linix can trash the stack above esp
298 #sub main'wtmp
299 #       {
300 #       local($num)=@_;
301 #
302 #       return(&main'QWP(-($num+1)*4,"esp","",0));
303 #       }
304
305 sub main'comment
306         {
307         foreach (@_)
308                 {
309                 if (/^\s*$/)
310                         { push(@out,"\n"); }
311                 else
312                         { push(@out,"\t$com_start $_ $com_end\n"); }
313                 }
314         }
315
316 sub main'label
317         {
318         if (!defined($label{$_[0]}))
319                 {
320                 $label{$_[0]}=$label;
321                 $label++;
322                 }
323         return('$'.$label{$_[0]});
324         }
325
326 sub main'set_label
327         {
328         if (!defined($label{$_[0]}))
329                 {
330                 $label{$_[0]}=$label;
331                 $label++;
332                 }
333 #       push(@out,".align $align\n") if ($_[1] != 0);
334         push(@out,'$'."$label{$_[0]}:\n");
335         }
336
337 sub main'file_end
338         {
339         }
340
341 sub main'data_word
342         {
343         push(@out,"\t.long $_[0]\n");
344         }
345
346 @pool_free=();
347 @pool_taken=();
348 $curr_num=0;
349 $max=0;
350
351 sub main'init_pool
352         {
353         local($args)=@_;
354         local($i);
355
356         @pool_free=();
357         for ($i=(14+(6-$args)); $i >= 0; $i--)
358                 {
359                 push(@pool_free,"r$i");
360                 }
361         print STDERR "START :register pool:@pool_free\n";
362         $curr_num=$max=0;
363         }
364
365 sub main'fin_pool
366         {
367         printf STDERR "END %2d:register pool:@pool_free\n",$max;
368         }
369
370 sub main'GR
371         {
372         local($r)=@_;
373         local($i,@n,$_);
374
375         foreach (@pool_free)
376                 {
377                 if ($r ne $_)
378                         { push(@n,$_); }
379                 else
380                         {
381                         $curr_num++;
382                         $max=$curr_num if ($curr_num > $max);
383                         }
384                 }
385         @pool_free=@n;
386 print STDERR "GR:@pool_free\n" if $reg_alloc;
387         return(@_);
388         }
389
390 sub main'NR
391         {
392         local($num)=@_;
393         local(@ret);
394
395         $num=1 if $num == 0;
396         ($#pool_free >= ($num-1)) || croak "out of registers: want $num, have @pool_free";
397         while ($num > 0)
398                 {
399                 push(@ret,pop @pool_free);
400                 $curr_num++;
401                 $max=$curr_num if ($curr_num > $max);
402                 $num--
403                 }
404         print STDERR "nr @ret\n" if $n_debug;
405 print STDERR "NR:@pool_free\n" if $reg_alloc;
406         return(@ret);
407
408         }
409
410 sub main'FR
411         {
412         local(@r)=@_;
413         local(@a,$v,$w);
414
415         print STDERR "fr @r\n" if $n_debug;
416 #       cluck "fr @r";
417         for $w (@pool_free)
418                 {
419                 foreach $v (@r)
420                         {
421                         croak "double register free of $v (@pool_free)" if $w eq $v;
422                         }
423                 }
424         foreach $v (@r)
425                 {
426                 croak "bad argument to FR" if ($v !~ /^r\d+$/);
427                 if ($smear_regs)
428                         { unshift(@pool_free,$v); }
429                 else    { push(@pool_free,$v); }
430                 $curr_num--;
431                 }
432 print STDERR "FR:@pool_free\n" if $reg_alloc;
433         }
434 1;