summaryrefslogtreecommitdiff
path: root/src/lib/libcrypto/perlasm/x86nasm.pl
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/libcrypto/perlasm/x86nasm.pl')
-rw-r--r--src/lib/libcrypto/perlasm/x86nasm.pl559
1 files changed, 424 insertions, 135 deletions
diff --git a/src/lib/libcrypto/perlasm/x86nasm.pl b/src/lib/libcrypto/perlasm/x86nasm.pl
index ce2bed9bb2..fa38f89c09 100644
--- a/src/lib/libcrypto/perlasm/x86nasm.pl
+++ b/src/lib/libcrypto/perlasm/x86nasm.pl
@@ -1,166 +1,455 @@
1#!/usr/bin/env perl 1#!/usr/local/bin/perl
2 2
3package x86nasm; 3package x86nasm;
4 4
5*out=\@::out; 5$label="L000";
6$under=($main'netware)?'':'_';
6 7
7$::lbdecor="L\$"; # local label decoration 8%lb=( 'eax', 'al',
8$nmdecor=$::netware?"":"_"; # external name decoration 9 'ebx', 'bl',
9$drdecor=$::mwerks?".":""; # directive decoration 10 'ecx', 'cl',
11 'edx', 'dl',
12 'ax', 'al',
13 'bx', 'bl',
14 'cx', 'cl',
15 'dx', 'dl',
16 );
10 17
11$initseg=""; 18%hb=( 'eax', 'ah',
19 'ebx', 'bh',
20 'ecx', 'ch',
21 'edx', 'dh',
22 'ax', 'ah',
23 'bx', 'bh',
24 'cx', 'ch',
25 'dx', 'dh',
26 );
12 27
13sub ::generic 28sub main'asm_init_output { @out=(); }
14{ my $opcode=shift; 29sub main'asm_get_output { return(@out); }
15 my $tmp; 30sub main'get_labels { return(@labels); }
16 31
17 if (!$::mwerks) 32sub main'external_label
18 { if ($opcode =~ m/^j/o && $#_==0) # optimize jumps 33{
19 { $_[0] = "NEAR $_[0]"; } 34 push(@labels,@_);
20 elsif ($opcode eq "lea" && $#_==1) # wipe storage qualifier from lea 35 foreach (@_) {
21 { $_[1] =~ s/^[^\[]*\[/\[/o; } 36 push(@out,".") if ($main'mwerks);
22 } 37 push(@out, "extern\t${under}$_\n");
23 &::emit($opcode,@_); 38 }
24 1;
25} 39}
26# 40
27# opcodes not covered by ::generic above, mostly inconsistent namings... 41sub main'LB
28# 42 {
29sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } 43 (defined($lb{$_[0]})) || die "$_[0] does not have a 'low byte'\n";
30sub ::call_ptr { &::emit("call",@_); } 44 return($lb{$_[0]});
31sub ::jmp_ptr { &::emit("jmp",@_); } 45 }
46
47sub main'HB
48 {
49 (defined($hb{$_[0]})) || die "$_[0] does not have a 'high byte'\n";
50 return($hb{$_[0]});
51 }
52
53sub main'BP
54 {
55 &get_mem("BYTE",@_);
56 }
57
58sub main'DWP
59 {
60 &get_mem("DWORD",@_);
61 }
62
63sub main'QWP
64 {
65 &get_mem("",@_);
66 }
67
68sub main'BC
69 {
70 return (($main'mwerks)?"":"BYTE ")."@_";
71 }
72
73sub main'DWC
74 {
75 return (($main'mwerks)?"":"DWORD ")."@_";
76 }
77
78sub main'stack_push
79 {
80 my($num)=@_;
81 $stack+=$num*4;
82 &main'sub("esp",$num*4);
83 }
84
85sub main'stack_pop
86 {
87 my($num)=@_;
88 $stack-=$num*4;
89 &main'add("esp",$num*4);
90 }
32 91
33sub get_mem 92sub get_mem
34{ my($size,$addr,$reg1,$reg2,$idx)=@_; 93 {
35 my($post,$ret); 94 my($size,$addr,$reg1,$reg2,$idx)=@_;
36 95 my($t,$post);
37 if ($size ne "") 96 my($ret)=$size;
38 { $ret .= "$size"; 97 if ($ret ne "")
39 $ret .= " PTR" if ($::mwerks); 98 {
40 $ret .= " "; 99 $ret .= " PTR" if ($main'mwerks);
41 } 100 $ret .= " ";
42 $ret .= "["; 101 }
43 102 $ret .= "[";
44 $addr =~ s/^\s+//; 103 $addr =~ s/^\s+//;
45 # prepend global references with optional underscore 104 if ($addr =~ /^(.+)\+(.+)$/)
46 $addr =~ s/^([^\+\-0-9][^\+\-]*)/::islabel($1) or "$nmdecor$1"/ige; 105 {
47 # put address arithmetic expression in parenthesis 106 $reg2=&conv($1);
48 $addr="($addr)" if ($addr =~ /^.+[\-\+].+$/); 107 $addr="$under$2";
49 108 }
50 if (($addr ne "") && ($addr ne 0)) 109 elsif ($addr =~ /^[_a-z][_a-z0-9]*$/i)
51 { if ($addr !~ /^-/) { $ret .= "$addr+"; } 110 {
52 else { $post=$addr; } 111 $addr="$under$addr";
53 } 112 }
54 113
55 if ($reg2 ne "") 114 if ($addr =~ /^.+\-.+$/) { $addr="($addr)"; }
56 { $idx!=0 or $idx=1; 115
57 $ret .= "$reg2*$idx"; 116 $reg1="$regs{$reg1}" if defined($regs{$reg1});
58 $ret .= "+$reg1" if ($reg1 ne ""); 117 $reg2="$regs{$reg2}" if defined($regs{$reg2});
59 } 118 if (($addr ne "") && ($addr ne 0))
60 else 119 {
61 { $ret .= "$reg1"; } 120 if ($addr !~ /^-/)
62 121 { $ret.="${addr}+"; }
63 $ret .= "$post]"; 122 else { $post=$addr; }
64 $ret =~ s/\+\]/]/; # in case $addr was the only argument 123 }
65 124 if ($reg2 ne "")
66 $ret; 125 {
67} 126 $t="";
68sub ::BP { &get_mem("BYTE",@_); } 127 $t="*$idx" if ($idx != 0);
69sub ::DWP { &get_mem("DWORD",@_); } 128 $reg1="+".$reg1 if ("$reg1$post" ne "");
70sub ::QWP { &get_mem("",@_); } 129 $ret.="$reg2$t$reg1$post]";
71sub ::BC { (($::mwerks)?"":"BYTE ")."@_"; } 130 }
72sub ::DWC { (($::mwerks)?"":"DWORD ")."@_"; } 131 else
73 132 {
74sub ::file 133 $ret.="$reg1$post]"
75{ if ($::mwerks) { push(@out,".section\t.text,64\n"); } 134 }
76 else 135 $ret =~ s/\+\]/]/; # in case $addr was the only argument
77 { my $tmp=<<___; 136 return($ret);
78%ifidn __OUTPUT_FORMAT__,obj 137 }
79section code use32 class=code align=64 138
80%elifidn __OUTPUT_FORMAT__,win32 139sub main'mov { &out2("mov",@_); }
81\$\@feat.00 equ 1 140sub main'movb { &out2("mov",@_); }
82section .text code align=64 141sub main'and { &out2("and",@_); }
142sub main'or { &out2("or",@_); }
143sub main'shl { &out2("shl",@_); }
144sub main'shr { &out2("shr",@_); }
145sub main'xor { &out2("xor",@_); }
146sub main'xorb { &out2("xor",@_); }
147sub main'add { &out2("add",@_); }
148sub main'adc { &out2("adc",@_); }
149sub main'sub { &out2("sub",@_); }
150sub main'sbb { &out2("sbb",@_); }
151sub main'rotl { &out2("rol",@_); }
152sub main'rotr { &out2("ror",@_); }
153sub main'exch { &out2("xchg",@_); }
154sub main'cmp { &out2("cmp",@_); }
155sub main'lea { &out2("lea",@_); }
156sub main'mul { &out1("mul",@_); }
157sub main'imul { &out2("imul",@_); }
158sub main'div { &out1("div",@_); }
159sub main'dec { &out1("dec",@_); }
160sub main'inc { &out1("inc",@_); }
161sub main'jmp { &out1("jmp",@_); }
162sub main'jmp_ptr { &out1p("jmp",@_); }
163
164# This is a bit of a kludge: declare all branches as NEAR.
165$near=($main'mwerks)?'':'NEAR';
166sub main'je { &out1("je $near",@_); }
167sub main'jle { &out1("jle $near",@_); }
168sub main'jz { &out1("jz $near",@_); }
169sub main'jge { &out1("jge $near",@_); }
170sub main'jl { &out1("jl $near",@_); }
171sub main'ja { &out1("ja $near",@_); }
172sub main'jae { &out1("jae $near",@_); }
173sub main'jb { &out1("jb $near",@_); }
174sub main'jbe { &out1("jbe $near",@_); }
175sub main'jc { &out1("jc $near",@_); }
176sub main'jnc { &out1("jnc $near",@_); }
177sub main'jnz { &out1("jnz $near",@_); }
178sub main'jne { &out1("jne $near",@_); }
179sub main'jno { &out1("jno $near",@_); }
180
181sub main'push { &out1("push",@_); $stack+=4; }
182sub main'pop { &out1("pop",@_); $stack-=4; }
183sub main'pushf { &out0("pushfd"); $stack+=4; }
184sub main'popf { &out0("popfd"); $stack-=4; }
185sub main'bswap { &out1("bswap",@_); &using486(); }
186sub main'not { &out1("not",@_); }
187sub main'call { &out1("call",($_[0]=~/^\@L/?'':$under).$_[0]); }
188sub main'call_ptr { &out1p("call",@_); }
189sub main'ret { &out0("ret"); }
190sub main'nop { &out0("nop"); }
191sub main'test { &out2("test",@_); }
192sub main'bt { &out2("bt",@_); }
193sub main'leave { &out0("leave"); }
194sub main'cpuid { &out0("cpuid"); }
195sub main'rdtsc { &out0("rdtsc"); }
196sub main'halt { &out0("hlt"); }
197sub main'movz { &out2("movzx",@_); }
198sub main'neg { &out1("neg",@_); }
199sub main'cld { &out0("cld"); }
200
201# SSE2
202sub main'emms { &out0("emms"); }
203sub main'movd { &out2("movd",@_); }
204sub main'movq { &out2("movq",@_); }
205sub main'movdqu { &out2("movdqu",@_); }
206sub main'movdqa { &out2("movdqa",@_); }
207sub main'movdq2q{ &out2("movdq2q",@_); }
208sub main'movq2dq{ &out2("movq2dq",@_); }
209sub main'paddq { &out2("paddq",@_); }
210sub main'pmuludq{ &out2("pmuludq",@_); }
211sub main'psrlq { &out2("psrlq",@_); }
212sub main'psllq { &out2("psllq",@_); }
213sub main'pxor { &out2("pxor",@_); }
214sub main'por { &out2("por",@_); }
215sub main'pand { &out2("pand",@_); }
216
217sub out2
218 {
219 my($name,$p1,$p2)=@_;
220 my($l,$t);
221
222 push(@out,"\t$name\t");
223 if (!$main'mwerks and $name eq "lea")
224 {
225 $p1 =~ s/^[^\[]*\[/\[/;
226 $p2 =~ s/^[^\[]*\[/\[/;
227 }
228 $t=&conv($p1).",";
229 $l=length($t);
230 push(@out,$t);
231 $l=4-($l+9)/8;
232 push(@out,"\t" x $l);
233 push(@out,&conv($p2));
234 push(@out,"\n");
235 }
236
237sub out0
238 {
239 my($name)=@_;
240
241 push(@out,"\t$name\n");
242 }
243
244sub out1
245 {
246 my($name,$p1)=@_;
247 my($l,$t);
248 push(@out,"\t$name\t".&conv($p1)."\n");
249 }
250
251sub conv
252 {
253 my($p)=@_;
254 $p =~ s/0x([0-9A-Fa-f]+)/0$1h/;
255 return $p;
256 }
257
258sub using486
259 {
260 return if $using486;
261 $using486++;
262 grep(s/\.386/\.486/,@out);
263 }
264
265sub main'file
266 {
267 if ($main'mwerks) { push(@out,".section\t.text\n"); }
268 else {
269 local $tmp=<<___;
270%ifdef __omf__
271section code use32 class=code
83%else 272%else
84section .text code 273section .text
85%endif 274%endif
86___ 275___
276 push(@out,$tmp);
277 }
278 }
279
280sub main'function_begin
281 {
282 my($func,$extra)=@_;
283
284 push(@labels,$func);
285 push(@out,".") if ($main'mwerks);
286 my($tmp)=<<"EOF";
287global $under$func
288$under$func:
289 push ebp
290 push ebx
291 push esi
292 push edi
293EOF
87 push(@out,$tmp); 294 push(@out,$tmp);
88 } 295 $stack=20;
89} 296 }
90 297
91sub ::function_begin_B 298sub main'function_begin_B
92{ my $func=shift; 299 {
93 my $global=($func !~ /^_/); 300 my($func,$extra)=@_;
94 my $begin="${::lbdecor}_${func}_begin"; 301 push(@out,".") if ($main'mwerks);
302 my($tmp)=<<"EOF";
303global $under$func
304$under$func:
305EOF
306 push(@out,$tmp);
307 $stack=4;
308 }
95 309
96 $begin =~ s/^\@/./ if ($::mwerks); # the torture never stops 310sub main'function_end
311 {
312 my($func)=@_;
97 313
98 &::LABEL($func,$global?"$begin":"$nmdecor$func"); 314 my($tmp)=<<"EOF";
99 $func=$nmdecor.$func; 315 pop edi
316 pop esi
317 pop ebx
318 pop ebp
319 ret
320EOF
321 push(@out,$tmp);
322 $stack=0;
323 %label=();
324 }
100 325
101 push(@out,"${drdecor}global $func\n") if ($global); 326sub main'function_end_B
102 push(@out,"${drdecor}align 16\n"); 327 {
103 push(@out,"$func:\n"); 328 $stack=0;
104 push(@out,"$begin:\n") if ($global); 329 %label=();
105 $::stack=4; 330 }
106}
107 331
108sub ::function_end_B 332sub main'function_end_A
109{ $::stack=0; 333 {
110 &::wipe_labels(); 334 my($func)=@_;
111}
112 335
113sub ::file_end 336 my($tmp)=<<"EOF";
114{ if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) 337 pop edi
115 { my $comm=<<___; 338 pop esi
116${drdecor}segment .bss 339 pop ebx
117${drdecor}common ${nmdecor}OPENSSL_ia32cap_P 4 340 pop ebp
118___ 341 ret
119 # comment out OPENSSL_ia32cap_P declarations 342EOF
120 grep {s/(^extern\s+${nmdecor}OPENSSL_ia32cap_P)/\;$1/} @out; 343 push(@out,$tmp);
121 push (@out,$comm) 344 }
122 }
123 push (@out,$initseg) if ($initseg);
124}
125 345
126sub ::comment { foreach (@_) { push(@out,"\t; $_\n"); } } 346sub main'file_end
347 {
348 }
127 349
128sub ::external_label 350sub main'wparam
129{ foreach(@_) 351 {
130 { push(@out,"${drdecor}extern\t".&::LABEL($_,$nmdecor.$_)."\n"); } 352 my($num)=@_;
131}
132 353
133sub ::public_label 354 return(&main'DWP($stack+$num*4,"esp","",0));
134{ push(@out,"${drdecor}global\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } 355 }
135 356
136sub ::data_byte 357sub main'swtmp
137{ push(@out,(($::mwerks)?".byte\t":"db\t").join(',',@_)."\n"); } 358 {
359 return(&main'DWP($_[0]*4,"esp","",0));
360 }
138 361
139sub ::data_word 362# Should use swtmp, which is above esp. Linix can trash the stack above esp
140{ push(@out,(($::mwerks)?".long\t":"dd\t").join(',',@_)."\n"); } 363#sub main'wtmp
364# {
365# my($num)=@_;
366#
367# return(&main'DWP(-(($num+1)*4),"esp","",0));
368# }
141 369
142sub ::align 370sub main'comment
143{ push(@out,"${drdecor}align\t$_[0]\n"); } 371 {
372 foreach (@_)
373 {
374 push(@out,"\t; $_\n");
375 }
376 }
144 377
145sub ::picmeup 378sub main'public_label
146{ my($dst,$sym)=@_; 379 {
147 &::lea($dst,&::DWP($sym)); 380 $label{$_[0]}="${under}${_[0]}" if (!defined($label{$_[0]}));
148} 381 push(@out,".") if ($main'mwerks);
382 push(@out,"global\t$label{$_[0]}\n");
383 }
149 384
150sub ::initseg 385sub main'label
151{ my $f=$nmdecor.shift; 386 {
152 if ($::win32) 387 if (!defined($label{$_[0]}))
153 { $initseg=<<___; 388 {
154segment .CRT\$XCU data align=4 389 $label{$_[0]}="\@${label}${_[0]}";
155extern $f 390 $label++;
156dd $f 391 }
157___ 392 return($label{$_[0]});
158 } 393 }
159}
160 394
161sub ::dataseg 395sub main'set_label
162{ if ($mwerks) { push(@out,".section\t.data,4\n"); } 396 {
163 else { push(@out,"section\t.data align=4\n"); } 397 if (!defined($label{$_[0]}))
164} 398 {
399 $label{$_[0]}="\@${label}${_[0]}";
400 $label++;
401 }
402 if ($_[1]!=0 && $_[1]>1)
403 {
404 main'align($_[1]);
405 }
406 push(@out,"$label{$_[0]}:\n");
407 }
408
409sub main'data_byte
410 {
411 push(@out,(($main'mwerks)?".byte\t":"DB\t").join(',',@_)."\n");
412 }
413
414sub main'data_word
415 {
416 push(@out,(($main'mwerks)?".long\t":"DD\t").join(',',@_)."\n");
417 }
418
419sub main'align
420 {
421 push(@out,".") if ($main'mwerks);
422 push(@out,"align\t$_[0]\n");
423 }
424
425sub out1p
426 {
427 my($name,$p1)=@_;
428 my($l,$t);
429
430 push(@out,"\t$name\t".&conv($p1)."\n");
431 }
432
433sub main'picmeup
434 {
435 local($dst,$sym)=@_;
436 &main'lea($dst,&main'DWP($sym));
437 }
438
439sub main'blindpop { &out1("pop",@_); }
440
441sub main'initseg
442 {
443 local($f)=@_;
444 if ($main'win32)
445 {
446 local($tmp)=<<___;
447segment .CRT\$XCU data
448extern $under$f
449DD $under$f
450___
451 push(@out,$tmp);
452 }
453 }
165 454
1661; 4551;
generated by cgit v1.2.3-55-g6feb (git 2.39.1) at 2025-12-11 02:15:58 +0000