diff options
Diffstat (limited to 'src/lib/libcrypto/perlasm')
-rwxr-xr-x | src/lib/libcrypto/perlasm/ppc-xlate.pl | 152 | ||||
-rwxr-xr-x | src/lib/libcrypto/perlasm/x86_64-xlate.pl | 625 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86asm.pl | 317 | ||||
-rw-r--r-- | src/lib/libcrypto/perlasm/x86gas.pl | 247 |
4 files changed, 1088 insertions, 253 deletions
diff --git a/src/lib/libcrypto/perlasm/ppc-xlate.pl b/src/lib/libcrypto/perlasm/ppc-xlate.pl new file mode 100755 index 0000000000..4579671c97 --- /dev/null +++ b/src/lib/libcrypto/perlasm/ppc-xlate.pl | |||
@@ -0,0 +1,152 @@ | |||
1 | #!/usr/bin/env perl | ||
2 | |||
3 | # PowerPC assembler distiller by <appro>. | ||
4 | |||
5 | my $flavour = shift; | ||
6 | my $output = shift; | ||
7 | open STDOUT,">$output" || die "can't open $output: $!"; | ||
8 | |||
9 | my %GLOBALS; | ||
10 | my $dotinlocallabels=($flavour=~/linux/)?1:0; | ||
11 | |||
12 | ################################################################ | ||
13 | # directives which need special treatment on different platforms | ||
14 | ################################################################ | ||
15 | my $globl = sub { | ||
16 | my $junk = shift; | ||
17 | my $name = shift; | ||
18 | my $global = \$GLOBALS{$name}; | ||
19 | my $ret; | ||
20 | |||
21 | $name =~ s|^[\.\_]||; | ||
22 | |||
23 | SWITCH: for ($flavour) { | ||
24 | /aix/ && do { $name = ".$name"; | ||
25 | last; | ||
26 | }; | ||
27 | /osx/ && do { $name = "_$name"; | ||
28 | last; | ||
29 | }; | ||
30 | /linux.*32/ && do { $ret .= ".globl $name\n"; | ||
31 | $ret .= ".type $name,\@function"; | ||
32 | last; | ||
33 | }; | ||
34 | /linux.*64/ && do { $ret .= ".globl .$name\n"; | ||
35 | $ret .= ".type .$name,\@function\n"; | ||
36 | $ret .= ".section \".opd\",\"aw\"\n"; | ||
37 | $ret .= ".globl $name\n"; | ||
38 | $ret .= ".align 3\n"; | ||
39 | $ret .= "$name:\n"; | ||
40 | $ret .= ".quad .$name,.TOC.\@tocbase,0\n"; | ||
41 | $ret .= ".size $name,24\n"; | ||
42 | $ret .= ".previous\n"; | ||
43 | |||
44 | $name = ".$name"; | ||
45 | last; | ||
46 | }; | ||
47 | } | ||
48 | |||
49 | $ret = ".globl $name" if (!$ret); | ||
50 | $$global = $name; | ||
51 | $ret; | ||
52 | }; | ||
53 | my $text = sub { | ||
54 | ($flavour =~ /aix/) ? ".csect" : ".text"; | ||
55 | }; | ||
56 | my $machine = sub { | ||
57 | my $junk = shift; | ||
58 | my $arch = shift; | ||
59 | if ($flavour =~ /osx/) | ||
60 | { $arch =~ s/\"//g; | ||
61 | $arch = ($flavour=~/64/) ? "ppc970-64" : "ppc970" if ($arch eq "any"); | ||
62 | } | ||
63 | ".machine $arch"; | ||
64 | }; | ||
65 | my $asciz = sub { | ||
66 | shift; | ||
67 | my $line = join(",",@_); | ||
68 | if ($line =~ /^"(.*)"$/) | ||
69 | { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; } | ||
70 | else | ||
71 | { ""; } | ||
72 | }; | ||
73 | |||
74 | ################################################################ | ||
75 | # simplified mnemonics not handled by at least one assembler | ||
76 | ################################################################ | ||
77 | my $cmplw = sub { | ||
78 | my $f = shift; | ||
79 | my $cr = 0; $cr = shift if ($#_>1); | ||
80 | # Some out-of-date 32-bit GNU assembler just can't handle cmplw... | ||
81 | ($flavour =~ /linux.*32/) ? | ||
82 | " .long ".sprintf "0x%x",31<<26|$cr<<23|$_[0]<<16|$_[1]<<11|64 : | ||
83 | " cmplw ".join(',',$cr,@_); | ||
84 | }; | ||
85 | my $bdnz = sub { | ||
86 | my $f = shift; | ||
87 | my $bo = $f=~/[\+\-]/ ? 16+9 : 16; # optional "to be taken" hint | ||
88 | " bc $bo,0,".shift; | ||
89 | } if ($flavour!~/linux/); | ||
90 | my $bltlr = sub { | ||
91 | my $f = shift; | ||
92 | my $bo = $f=~/\-/ ? 12+2 : 12; # optional "not to be taken" hint | ||
93 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
94 | " .long ".sprintf "0x%x",19<<26|$bo<<21|16<<1 : | ||
95 | " bclr $bo,0"; | ||
96 | }; | ||
97 | my $bnelr = sub { | ||
98 | my $f = shift; | ||
99 | my $bo = $f=~/\-/ ? 4+2 : 4; # optional "not to be taken" hint | ||
100 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
101 | " .long ".sprintf "0x%x",19<<26|$bo<<21|2<<16|16<<1 : | ||
102 | " bclr $bo,2"; | ||
103 | }; | ||
104 | my $beqlr = sub { | ||
105 | my $f = shift; | ||
106 | my $bo = $f=~/-/ ? 12+2 : 12; # optional "not to be taken" hint | ||
107 | ($flavour =~ /linux/) ? # GNU as doesn't allow most recent hints | ||
108 | " .long ".sprintf "0x%X",19<<26|$bo<<21|2<<16|16<<1 : | ||
109 | " bclr $bo,2"; | ||
110 | }; | ||
111 | # GNU assembler can't handle extrdi rA,rS,16,48, or when sum of last two | ||
112 | # arguments is 64, with "operand out of range" error. | ||
113 | my $extrdi = sub { | ||
114 | my ($f,$ra,$rs,$n,$b) = @_; | ||
115 | $b = ($b+$n)&63; $n = 64-$n; | ||
116 | " rldicl $ra,$rs,$b,$n"; | ||
117 | }; | ||
118 | |||
119 | while($line=<>) { | ||
120 | |||
121 | $line =~ s|[#!;].*$||; # get rid of asm-style comments... | ||
122 | $line =~ s|/\*.*\*/||; # ... and C-style comments... | ||
123 | $line =~ s|^\s+||; # ... and skip white spaces in beginning... | ||
124 | $line =~ s|\s+$||; # ... and at the end | ||
125 | |||
126 | { | ||
127 | $line =~ s|\b\.L(\w+)|L$1|g; # common denominator for Locallabel | ||
128 | $line =~ s|\bL(\w+)|\.L$1|g if ($dotinlocallabels); | ||
129 | } | ||
130 | |||
131 | { | ||
132 | $line =~ s|(^[\.\w]+)\:\s*||; | ||
133 | my $label = $1; | ||
134 | printf "%s:",($GLOBALS{$label} or $label) if ($label); | ||
135 | } | ||
136 | |||
137 | { | ||
138 | $line =~ s|^\s*(\.?)(\w+)([\.\+\-]?)\s*||; | ||
139 | my $c = $1; $c = "\t" if ($c eq ""); | ||
140 | my $mnemonic = $2; | ||
141 | my $f = $3; | ||
142 | my $opcode = eval("\$$mnemonic"); | ||
143 | $line =~ s|\bc?[rf]([0-9]+)\b|$1|g if ($c ne "." and $flavour !~ /osx/); | ||
144 | if (ref($opcode) eq 'CODE') { $line = &$opcode($f,split(',',$line)); } | ||
145 | elsif ($mnemonic) { $line = $c.$mnemonic.$f."\t".$line; } | ||
146 | } | ||
147 | |||
148 | print $line if ($line); | ||
149 | print "\n"; | ||
150 | } | ||
151 | |||
152 | close STDOUT; | ||
diff --git a/src/lib/libcrypto/perlasm/x86_64-xlate.pl b/src/lib/libcrypto/perlasm/x86_64-xlate.pl index a4af769b4a..354673acc1 100755 --- a/src/lib/libcrypto/perlasm/x86_64-xlate.pl +++ b/src/lib/libcrypto/perlasm/x86_64-xlate.pl | |||
@@ -1,6 +1,6 @@ | |||
1 | #!/usr/bin/env perl | 1 | #!/usr/bin/env perl |
2 | 2 | ||
3 | # Ascetic x86_64 AT&T to MASM assembler translator by <appro>. | 3 | # Ascetic x86_64 AT&T to MASM/NASM assembler translator by <appro>. |
4 | # | 4 | # |
5 | # Why AT&T to MASM and not vice versa? Several reasons. Because AT&T | 5 | # Why AT&T to MASM and not vice versa? Several reasons. Because AT&T |
6 | # format is way easier to parse. Because it's simpler to "gear" from | 6 | # format is way easier to parse. Because it's simpler to "gear" from |
@@ -20,12 +20,11 @@ | |||
20 | # Currently recognized limitations: | 20 | # Currently recognized limitations: |
21 | # | 21 | # |
22 | # - can't use multiple ops per line; | 22 | # - can't use multiple ops per line; |
23 | # - indirect calls and jumps are not supported; | ||
24 | # | 23 | # |
25 | # Dual-ABI styling rules. | 24 | # Dual-ABI styling rules. |
26 | # | 25 | # |
27 | # 1. Adhere to Unix register and stack layout [see the end for | 26 | # 1. Adhere to Unix register and stack layout [see cross-reference |
28 | # explanation]. | 27 | # ABI "card" at the end for explanation]. |
29 | # 2. Forget about "red zone," stick to more traditional blended | 28 | # 2. Forget about "red zone," stick to more traditional blended |
30 | # stack frame allocation. If volatile storage is actually required | 29 | # stack frame allocation. If volatile storage is actually required |
31 | # that is. If not, just leave the stack as is. | 30 | # that is. If not, just leave the stack as is. |
@@ -42,21 +41,26 @@ | |||
42 | # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is | 41 | # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is |
43 | # required to identify the spots, where to inject Win64 epilogue! | 42 | # required to identify the spots, where to inject Win64 epilogue! |
44 | # But on the pros, it's then prefixed with rep automatically:-) | 43 | # But on the pros, it's then prefixed with rep automatically:-) |
45 | # 7. Due to MASM limitations [and certain general counter-intuitivity | 44 | # 7. Stick to explicit ip-relative addressing. If you have to use |
46 | # of ip-relative addressing] generation of position-independent | 45 | # GOTPCREL addressing, stick to mov symbol@GOTPCREL(%rip),%r??. |
47 | # code is assisted by synthetic directive, .picmeup, which puts | 46 | # Both are recognized and translated to proper Win64 addressing |
48 | # address of the *next* instruction into target register. | 47 | # modes. To support legacy code a synthetic directive, .picmeup, |
48 | # is implemented. It puts address of the *next* instruction into | ||
49 | # target register, e.g.: | ||
49 | # | 50 | # |
50 | # Example 1: | ||
51 | # .picmeup %rax | 51 | # .picmeup %rax |
52 | # lea .Label-.(%rax),%rax | 52 | # lea .Label-.(%rax),%rax |
53 | # Example 2: | 53 | # |
54 | # .picmeup %rcx | 54 | # 8. In order to provide for structured exception handling unified |
55 | # .Lpic_point: | 55 | # Win64 prologue copies %rsp value to %rax. For further details |
56 | # ... | 56 | # see SEH paragraph at the end. |
57 | # lea .Label-.Lpic_point(%rcx),%rbp | 57 | # 9. .init segment is allowed to contain calls to functions only. |
58 | 58 | # a. If function accepts more than 4 arguments *and* >4th argument | |
59 | my $output = shift; | 59 | # is declared as non 64-bit value, do clear its upper part. |
60 | |||
61 | my $flavour = shift; | ||
62 | my $output = shift; | ||
63 | if ($flavour =~ /\./) { $output = $flavour; undef $flavour; } | ||
60 | 64 | ||
61 | { my ($stddev,$stdino,@junk)=stat(STDOUT); | 65 | { my ($stddev,$stdino,@junk)=stat(STDOUT); |
62 | my ($outdev,$outino,@junk)=stat($output); | 66 | my ($outdev,$outino,@junk)=stat($output); |
@@ -65,13 +69,40 @@ my $output = shift; | |||
65 | if ($stddev!=$outdev || $stdino!=$outino); | 69 | if ($stddev!=$outdev || $stdino!=$outino); |
66 | } | 70 | } |
67 | 71 | ||
72 | my $gas=1; $gas=0 if ($output =~ /\.asm$/); | ||
73 | my $elf=1; $elf=0 if (!$gas); | ||
74 | my $win64=0; | ||
75 | my $prefix=""; | ||
76 | my $decor=".L"; | ||
77 | |||
68 | my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005 | 78 | my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005 |
69 | my $masm=$masmref if ($output =~ /\.asm/); | 79 | my $masm=0; |
70 | if ($masm && `ml64 2>&1` =~ m/Version ([0-9]+)\.([0-9]+)(\.([0-9]+))?/) | 80 | my $PTR=" PTR"; |
71 | { $masm=$1 + $2*2**-16 + $4*2**-32; } | 81 | |
82 | my $nasmref=2.03; | ||
83 | my $nasm=0; | ||
84 | |||
85 | if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1; | ||
86 | $prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`; | ||
87 | chomp($prefix); | ||
88 | } | ||
89 | elsif ($flavour eq "macosx") { $gas=1; $elf=0; $prefix="_"; $decor="L\$"; } | ||
90 | elsif ($flavour eq "masm") { $gas=0; $elf=0; $masm=$masmref; $win64=1; $decor="\$L\$"; } | ||
91 | elsif ($flavour eq "nasm") { $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $decor="\$L\$"; $PTR=""; } | ||
92 | elsif (!$gas) | ||
93 | { if ($ENV{ASM} =~ m/nasm/ && `nasm -v` =~ m/version ([0-9]+)\.([0-9]+)/i) | ||
94 | { $nasm = $1 + $2*0.01; $PTR=""; } | ||
95 | elsif (`ml64 2>&1` =~ m/Version ([0-9]+)\.([0-9]+)(\.([0-9]+))?/) | ||
96 | { $masm = $1 + $2*2**-16 + $4*2**-32; } | ||
97 | die "no assembler found on %PATH" if (!($nasm || $masm)); | ||
98 | $win64=1; | ||
99 | $elf=0; | ||
100 | $decor="\$L\$"; | ||
101 | } | ||
72 | 102 | ||
73 | my $current_segment; | 103 | my $current_segment; |
74 | my $current_function; | 104 | my $current_function; |
105 | my %globals; | ||
75 | 106 | ||
76 | { package opcode; # pick up opcodes | 107 | { package opcode; # pick up opcodes |
77 | sub re { | 108 | sub re { |
@@ -88,8 +119,10 @@ my $current_function; | |||
88 | if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... | 119 | if ($self->{op} =~ /^(movz)b.*/) { # movz is pain... |
89 | $self->{op} = $1; | 120 | $self->{op} = $1; |
90 | $self->{sz} = "b"; | 121 | $self->{sz} = "b"; |
91 | } elsif ($self->{op} =~ /call/) { | 122 | } elsif ($self->{op} =~ /call|jmp/) { |
92 | $self->{sz} = "" | 123 | $self->{sz} = ""; |
124 | } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op)/) { # SSEn | ||
125 | $self->{sz} = ""; | ||
93 | } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { | 126 | } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) { |
94 | $self->{op} = $1; | 127 | $self->{op} = $1; |
95 | $self->{sz} = $2; | 128 | $self->{sz} = $2; |
@@ -105,13 +138,20 @@ my $current_function; | |||
105 | } | 138 | } |
106 | sub out { | 139 | sub out { |
107 | my $self = shift; | 140 | my $self = shift; |
108 | if (!$masm) { | 141 | if ($gas) { |
109 | if ($self->{op} eq "movz") { # movz is pain... | 142 | if ($self->{op} eq "movz") { # movz is pain... |
110 | sprintf "%s%s%s",$self->{op},$self->{sz},shift; | 143 | sprintf "%s%s%s",$self->{op},$self->{sz},shift; |
111 | } elsif ($self->{op} =~ /^set/) { | 144 | } elsif ($self->{op} =~ /^set/) { |
112 | "$self->{op}"; | 145 | "$self->{op}"; |
113 | } elsif ($self->{op} eq "ret") { | 146 | } elsif ($self->{op} eq "ret") { |
114 | ".byte 0xf3,0xc3"; | 147 | my $epilogue = ""; |
148 | if ($win64 && $current_function->{abi} eq "svr4") { | ||
149 | $epilogue = "movq 8(%rsp),%rdi\n\t" . | ||
150 | "movq 16(%rsp),%rsi\n\t"; | ||
151 | } | ||
152 | $epilogue . ".byte 0xf3,0xc3"; | ||
153 | } elsif ($self->{op} eq "call" && !$elf && $current_segment eq ".init") { | ||
154 | ".p2align\t3\n\t.quad"; | ||
115 | } else { | 155 | } else { |
116 | "$self->{op}$self->{sz}"; | 156 | "$self->{op}$self->{sz}"; |
117 | } | 157 | } |
@@ -119,15 +159,25 @@ my $current_function; | |||
119 | $self->{op} =~ s/^movz/movzx/; | 159 | $self->{op} =~ s/^movz/movzx/; |
120 | if ($self->{op} eq "ret") { | 160 | if ($self->{op} eq "ret") { |
121 | $self->{op} = ""; | 161 | $self->{op} = ""; |
122 | if ($current_function->{abi} eq "svr4") { | 162 | if ($win64 && $current_function->{abi} eq "svr4") { |
123 | $self->{op} = "mov rdi,QWORD PTR 8[rsp]\t;WIN64 epilogue\n\t". | 163 | $self->{op} = "mov rdi,QWORD${PTR}[8+rsp]\t;WIN64 epilogue\n\t". |
124 | "mov rsi,QWORD PTR 16[rsp]\n\t"; | 164 | "mov rsi,QWORD${PTR}[16+rsp]\n\t"; |
125 | } | 165 | } |
126 | $self->{op} .= "DB\t0F3h,0C3h\t\t;repret"; | 166 | $self->{op} .= "DB\t0F3h,0C3h\t\t;repret"; |
127 | } | 167 | } elsif ($self->{op} =~ /^(pop|push)f/) { |
168 | $self->{op} .= $self->{sz}; | ||
169 | } elsif ($self->{op} eq "call" && $current_segment eq ".CRT\$XCU") { | ||
170 | $self->{op} = "ALIGN\t8\n\tDQ"; | ||
171 | } | ||
128 | $self->{op}; | 172 | $self->{op}; |
129 | } | 173 | } |
130 | } | 174 | } |
175 | sub mnemonic { | ||
176 | my $self=shift; | ||
177 | my $op=shift; | ||
178 | $self->{op}=$op if (defined($op)); | ||
179 | $self->{op}; | ||
180 | } | ||
131 | } | 181 | } |
132 | { package const; # pick up constants, which start with $ | 182 | { package const; # pick up constants, which start with $ |
133 | sub re { | 183 | sub re { |
@@ -145,14 +195,15 @@ my $current_function; | |||
145 | sub out { | 195 | sub out { |
146 | my $self = shift; | 196 | my $self = shift; |
147 | 197 | ||
148 | if (!$masm) { | 198 | if ($gas) { |
149 | # Solaris /usr/ccs/bin/as can't handle multiplications | 199 | # Solaris /usr/ccs/bin/as can't handle multiplications |
150 | # in $self->{value} | 200 | # in $self->{value} |
151 | $self->{value} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi; | 201 | $self->{value} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi; |
152 | $self->{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; | 202 | $self->{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; |
153 | sprintf "\$%s",$self->{value}; | 203 | sprintf "\$%s",$self->{value}; |
154 | } else { | 204 | } else { |
155 | $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig; | 205 | $self->{value} =~ s/(0b[0-1]+)/oct($1)/eig; |
206 | $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm); | ||
156 | sprintf "%s",$self->{value}; | 207 | sprintf "%s",$self->{value}; |
157 | } | 208 | } |
158 | } | 209 | } |
@@ -163,13 +214,19 @@ my $current_function; | |||
163 | local *line = shift; | 214 | local *line = shift; |
164 | undef $ret; | 215 | undef $ret; |
165 | 216 | ||
166 | if ($line =~ /^([^\(,]*)\(([%\w,]+)\)/) { | 217 | # optional * ---vvv--- appears in indirect jmp/call |
167 | $self->{label} = $1; | 218 | if ($line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)/) { |
168 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$2); | 219 | $self->{asterisk} = $1; |
220 | $self->{label} = $2; | ||
221 | ($self->{base},$self->{index},$self->{scale})=split(/,/,$3); | ||
169 | $self->{scale} = 1 if (!defined($self->{scale})); | 222 | $self->{scale} = 1 if (!defined($self->{scale})); |
170 | $ret = $self; | 223 | $ret = $self; |
171 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 224 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
172 | 225 | ||
226 | if ($win64 && $self->{label} =~ s/\@GOTPCREL//) { | ||
227 | die if (opcode->mnemonic() ne "mov"); | ||
228 | opcode->mnemonic("lea"); | ||
229 | } | ||
173 | $self->{base} =~ s/^%//; | 230 | $self->{base} =~ s/^%//; |
174 | $self->{index} =~ s/^%// if (defined($self->{index})); | 231 | $self->{index} =~ s/^%// if (defined($self->{index})); |
175 | } | 232 | } |
@@ -180,42 +237,50 @@ my $current_function; | |||
180 | my $self = shift; | 237 | my $self = shift; |
181 | my $sz = shift; | 238 | my $sz = shift; |
182 | 239 | ||
240 | $self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
241 | $self->{label} =~ s/\.L/$decor/g; | ||
242 | |||
183 | # Silently convert all EAs to 64-bit. This is required for | 243 | # Silently convert all EAs to 64-bit. This is required for |
184 | # elder GNU assembler and results in more compact code, | 244 | # elder GNU assembler and results in more compact code, |
185 | # *but* most importantly AES module depends on this feature! | 245 | # *but* most importantly AES module depends on this feature! |
186 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 246 | $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
187 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; | 247 | $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/; |
188 | 248 | ||
189 | if (!$masm) { | 249 | if ($gas) { |
190 | # Solaris /usr/ccs/bin/as can't handle multiplications | 250 | # Solaris /usr/ccs/bin/as can't handle multiplications |
191 | # in $self->{label} | 251 | # in $self->{label}, new gas requires sign extension... |
192 | $self->{label} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi; | 252 | use integer; |
253 | $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi; | ||
193 | $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; | 254 | $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg; |
255 | $self->{label} =~ s/([0-9]+)/$1<<32>>32/eg; | ||
256 | $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64"); | ||
194 | 257 | ||
195 | if (defined($self->{index})) { | 258 | if (defined($self->{index})) { |
196 | sprintf "%s(%%%s,%%%s,%d)", | 259 | sprintf "%s%s(%%%s,%%%s,%d)",$self->{asterisk}, |
197 | $self->{label},$self->{base}, | 260 | $self->{label},$self->{base}, |
198 | $self->{index},$self->{scale}; | 261 | $self->{index},$self->{scale}; |
199 | } else { | 262 | } else { |
200 | sprintf "%s(%%%s)", $self->{label},$self->{base}; | 263 | sprintf "%s%s(%%%s)", $self->{asterisk},$self->{label},$self->{base}; |
201 | } | 264 | } |
202 | } else { | 265 | } else { |
203 | %szmap = ( b=>"BYTE", w=>"WORD", l=>"DWORD", q=>"QWORD" ); | 266 | %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR", l=>"DWORD$PTR", q=>"QWORD$PTR" ); |
204 | 267 | ||
205 | $self->{label} =~ s/\./\$/g; | 268 | $self->{label} =~ s/\./\$/g; |
206 | $self->{label} =~ s/0x([0-9a-f]+)/0$1h/ig; | 269 | $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig; |
207 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); | 270 | $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/); |
271 | $sz="q" if ($self->{asterisk}); | ||
208 | 272 | ||
209 | if (defined($self->{index})) { | 273 | if (defined($self->{index})) { |
210 | sprintf "%s PTR %s[%s*%d+%s]",$szmap{$sz}, | 274 | sprintf "%s[%s%s*%d+%s]",$szmap{$sz}, |
211 | $self->{label}, | 275 | $self->{label}?"$self->{label}+":"", |
212 | $self->{index},$self->{scale}, | 276 | $self->{index},$self->{scale}, |
213 | $self->{base}; | 277 | $self->{base}; |
214 | } elsif ($self->{base} eq "rip") { | 278 | } elsif ($self->{base} eq "rip") { |
215 | sprintf "%s PTR %s",$szmap{$sz},$self->{label}; | 279 | sprintf "%s[%s]",$szmap{$sz},$self->{label}; |
216 | } else { | 280 | } else { |
217 | sprintf "%s PTR %s[%s]",$szmap{$sz}, | 281 | sprintf "%s[%s%s]",$szmap{$sz}, |
218 | $self->{label},$self->{base}; | 282 | $self->{label}?"$self->{label}+":"", |
283 | $self->{base}; | ||
219 | } | 284 | } |
220 | } | 285 | } |
221 | } | 286 | } |
@@ -227,9 +292,11 @@ my $current_function; | |||
227 | local *line = shift; | 292 | local *line = shift; |
228 | undef $ret; | 293 | undef $ret; |
229 | 294 | ||
230 | if ($line =~ /^%(\w+)/) { | 295 | # optional * ---vvv--- appears in indirect jmp/call |
296 | if ($line =~ /^(\*?)%(\w+)/) { | ||
231 | bless $self,$class; | 297 | bless $self,$class; |
232 | $self->{value} = $1; | 298 | $self->{asterisk} = $1; |
299 | $self->{value} = $2; | ||
233 | $ret = $self; | 300 | $ret = $self; |
234 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 301 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
235 | } | 302 | } |
@@ -252,7 +319,8 @@ my $current_function; | |||
252 | } | 319 | } |
253 | sub out { | 320 | sub out { |
254 | my $self = shift; | 321 | my $self = shift; |
255 | sprintf $masm?"%s":"%%%s",$self->{value}; | 322 | if ($gas) { sprintf "%s%%%s",$self->{asterisk},$self->{value}; } |
323 | else { $self->{value}; } | ||
256 | } | 324 | } |
257 | } | 325 | } |
258 | { package label; # pick up labels, which end with : | 326 | { package label; # pick up labels, which end with : |
@@ -261,37 +329,63 @@ my $current_function; | |||
261 | local *line = shift; | 329 | local *line = shift; |
262 | undef $ret; | 330 | undef $ret; |
263 | 331 | ||
264 | if ($line =~ /(^[\.\w]+\:)/) { | 332 | if ($line =~ /(^[\.\w]+)\:/) { |
265 | $self->{value} = $1; | 333 | $self->{value} = $1; |
266 | $ret = $self; | 334 | $ret = $self; |
267 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 335 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
268 | 336 | ||
269 | $self->{value} =~ s/\.L/\$L/ if ($masm); | 337 | $self->{value} =~ s/^\.L/$decor/; |
270 | } | 338 | } |
271 | $ret; | 339 | $ret; |
272 | } | 340 | } |
273 | sub out { | 341 | sub out { |
274 | my $self = shift; | 342 | my $self = shift; |
275 | 343 | ||
276 | if (!$masm) { | 344 | if ($gas) { |
277 | $self->{value}; | 345 | my $func = ($globals{$self->{value}} or $self->{value}) . ":"; |
278 | } elsif ($self->{value} ne "$current_function->{name}:") { | 346 | if ($win64 && |
279 | $self->{value}; | 347 | $current_function->{name} eq $self->{value} && |
280 | } elsif ($current_function->{abi} eq "svr4") { | 348 | $current_function->{abi} eq "svr4") { |
281 | my $func = "$current_function->{name} PROC\n". | 349 | $func .= "\n"; |
282 | " mov QWORD PTR 8[rsp],rdi\t;WIN64 prologue\n". | 350 | $func .= " movq %rdi,8(%rsp)\n"; |
283 | " mov QWORD PTR 16[rsp],rsi\n"; | 351 | $func .= " movq %rsi,16(%rsp)\n"; |
352 | $func .= " movq %rsp,%rax\n"; | ||
353 | $func .= "${decor}SEH_begin_$current_function->{name}:\n"; | ||
354 | my $narg = $current_function->{narg}; | ||
355 | $narg=6 if (!defined($narg)); | ||
356 | $func .= " movq %rcx,%rdi\n" if ($narg>0); | ||
357 | $func .= " movq %rdx,%rsi\n" if ($narg>1); | ||
358 | $func .= " movq %r8,%rdx\n" if ($narg>2); | ||
359 | $func .= " movq %r9,%rcx\n" if ($narg>3); | ||
360 | $func .= " movq 40(%rsp),%r8\n" if ($narg>4); | ||
361 | $func .= " movq 48(%rsp),%r9\n" if ($narg>5); | ||
362 | } | ||
363 | $func; | ||
364 | } elsif ($self->{value} ne "$current_function->{name}") { | ||
365 | $self->{value} .= ":" if ($masm && $ret!~m/^\$/); | ||
366 | $self->{value} . ":"; | ||
367 | } elsif ($win64 && $current_function->{abi} eq "svr4") { | ||
368 | my $func = "$current_function->{name}" . | ||
369 | ($nasm ? ":" : "\tPROC $current_function->{scope}") . | ||
370 | "\n"; | ||
371 | $func .= " mov QWORD${PTR}[8+rsp],rdi\t;WIN64 prologue\n"; | ||
372 | $func .= " mov QWORD${PTR}[16+rsp],rsi\n"; | ||
373 | $func .= " mov rax,rsp\n"; | ||
374 | $func .= "${decor}SEH_begin_$current_function->{name}:"; | ||
375 | $func .= ":" if ($masm); | ||
376 | $func .= "\n"; | ||
284 | my $narg = $current_function->{narg}; | 377 | my $narg = $current_function->{narg}; |
285 | $narg=6 if (!defined($narg)); | 378 | $narg=6 if (!defined($narg)); |
286 | $func .= " mov rdi,rcx\n" if ($narg>0); | 379 | $func .= " mov rdi,rcx\n" if ($narg>0); |
287 | $func .= " mov rsi,rdx\n" if ($narg>1); | 380 | $func .= " mov rsi,rdx\n" if ($narg>1); |
288 | $func .= " mov rdx,r8\n" if ($narg>2); | 381 | $func .= " mov rdx,r8\n" if ($narg>2); |
289 | $func .= " mov rcx,r9\n" if ($narg>3); | 382 | $func .= " mov rcx,r9\n" if ($narg>3); |
290 | $func .= " mov r8,QWORD PTR 40[rsp]\n" if ($narg>4); | 383 | $func .= " mov r8,QWORD${PTR}[40+rsp]\n" if ($narg>4); |
291 | $func .= " mov r9,QWORD PTR 48[rsp]\n" if ($narg>5); | 384 | $func .= " mov r9,QWORD${PTR}[48+rsp]\n" if ($narg>5); |
292 | $func .= "\n"; | 385 | $func .= "\n"; |
293 | } else { | 386 | } else { |
294 | "$current_function->{name} PROC"; | 387 | "$current_function->{name}". |
388 | ($nasm ? ":" : "\tPROC $current_function->{scope}"); | ||
295 | } | 389 | } |
296 | } | 390 | } |
297 | } | 391 | } |
@@ -306,13 +400,19 @@ my $current_function; | |||
306 | $ret = $self; | 400 | $ret = $self; |
307 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 401 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
308 | 402 | ||
309 | $self->{value} =~ s/\.L/\$L/g if ($masm); | 403 | $self->{value} =~ s/\@PLT// if (!$elf); |
404 | $self->{value} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
405 | $self->{value} =~ s/\.L/$decor/g; | ||
310 | } | 406 | } |
311 | $ret; | 407 | $ret; |
312 | } | 408 | } |
313 | sub out { | 409 | sub out { |
314 | my $self = shift; | 410 | my $self = shift; |
315 | $self->{value}; | 411 | if ($nasm && opcode->mnemonic()=~m/^j/) { |
412 | "NEAR ".$self->{value}; | ||
413 | } else { | ||
414 | $self->{value}; | ||
415 | } | ||
316 | } | 416 | } |
317 | } | 417 | } |
318 | { package directive; # pick up directives, which start with . | 418 | { package directive; # pick up directives, which start with . |
@@ -332,89 +432,181 @@ my $current_function; | |||
332 | "%r14"=>0x01358d4c, "%r15"=>0x013d8d4c ); | 432 | "%r14"=>0x01358d4c, "%r15"=>0x013d8d4c ); |
333 | 433 | ||
334 | if ($line =~ /^\s*(\.\w+)/) { | 434 | if ($line =~ /^\s*(\.\w+)/) { |
335 | if (!$masm) { | ||
336 | $self->{value} = $1; | ||
337 | $line =~ s/\@abi\-omnipotent/\@function/; | ||
338 | $line =~ s/\@function.*/\@function/; | ||
339 | if ($line =~ /\.picmeup\s+(%r[\w]+)/i) { | ||
340 | $self->{value} = sprintf "\t.long\t0x%x,0x90000000",$opcode{$1}; | ||
341 | } elsif ($line =~ /\.asciz\s+"(.*)"$/) { | ||
342 | $self->{value} = ".byte\t".join(",",unpack("C*",$1),0); | ||
343 | } elsif ($line =~ /\.extern/) { | ||
344 | $self->{value} = ""; # swallow extern | ||
345 | } else { | ||
346 | $self->{value} = $line; | ||
347 | } | ||
348 | $line = ""; | ||
349 | return $self; | ||
350 | } | ||
351 | |||
352 | $dir = $1; | 435 | $dir = $1; |
353 | $ret = $self; | 436 | $ret = $self; |
354 | undef $self->{value}; | 437 | undef $self->{value}; |
355 | $line = substr($line,@+[0]); $line =~ s/^\s+//; | 438 | $line = substr($line,@+[0]); $line =~ s/^\s+//; |
439 | |||
356 | SWITCH: for ($dir) { | 440 | SWITCH: for ($dir) { |
357 | /\.(text)/ | 441 | /\.picmeup/ && do { if ($line =~ /(%r[\w]+)/i) { |
358 | && do { my $v=undef; | 442 | $dir="\t.long"; |
359 | $v="$current_segment\tENDS\n" if ($current_segment); | 443 | $line=sprintf "0x%x,0x90000000",$opcode{$1}; |
360 | $current_segment = "_$1\$"; | 444 | } |
361 | $current_segment =~ tr/[a-z]/[A-Z]/; | 445 | last; |
362 | $v.="$current_segment\tSEGMENT "; | 446 | }; |
363 | $v.=$masm>=$masmref ? "ALIGN(64)" : "PAGE"; | 447 | /\.global|\.globl|\.extern/ |
364 | $v.=" 'CODE'"; | 448 | && do { $globals{$line} = $prefix . $line; |
365 | $self->{value} = $v; | 449 | $line = $globals{$line} if ($prefix); |
366 | last; | 450 | last; |
367 | }; | 451 | }; |
368 | /\.extern/ && do { $self->{value} = "EXTRN\t".$line.":BYTE"; last; }; | ||
369 | /\.globl/ && do { $self->{value} = "PUBLIC\t".$line; last; }; | ||
370 | /\.type/ && do { ($sym,$type,$narg) = split(',',$line); | 452 | /\.type/ && do { ($sym,$type,$narg) = split(',',$line); |
371 | if ($type eq "\@function") { | 453 | if ($type eq "\@function") { |
372 | undef $current_function; | 454 | undef $current_function; |
373 | $current_function->{name} = $sym; | 455 | $current_function->{name} = $sym; |
374 | $current_function->{abi} = "svr4"; | 456 | $current_function->{abi} = "svr4"; |
375 | $current_function->{narg} = $narg; | 457 | $current_function->{narg} = $narg; |
458 | $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE"; | ||
376 | } elsif ($type eq "\@abi-omnipotent") { | 459 | } elsif ($type eq "\@abi-omnipotent") { |
377 | undef $current_function; | 460 | undef $current_function; |
378 | $current_function->{name} = $sym; | 461 | $current_function->{name} = $sym; |
462 | $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE"; | ||
463 | } | ||
464 | $line =~ s/\@abi\-omnipotent/\@function/; | ||
465 | $line =~ s/\@function.*/\@function/; | ||
466 | last; | ||
467 | }; | ||
468 | /\.asciz/ && do { if ($line =~ /^"(.*)"$/) { | ||
469 | $dir = ".byte"; | ||
470 | $line = join(",",unpack("C*",$1),0); | ||
379 | } | 471 | } |
380 | last; | 472 | last; |
381 | }; | 473 | }; |
474 | /\.rva|\.long|\.quad/ | ||
475 | && do { $line =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei; | ||
476 | $line =~ s/\.L/$decor/g; | ||
477 | last; | ||
478 | }; | ||
479 | } | ||
480 | |||
481 | if ($gas) { | ||
482 | $self->{value} = $dir . "\t" . $line; | ||
483 | |||
484 | if ($dir =~ /\.extern/) { | ||
485 | $self->{value} = ""; # swallow extern | ||
486 | } elsif (!$elf && $dir =~ /\.type/) { | ||
487 | $self->{value} = ""; | ||
488 | $self->{value} = ".def\t" . ($globals{$1} or $1) . ";\t" . | ||
489 | (defined($globals{$1})?".scl 2;":".scl 3;") . | ||
490 | "\t.type 32;\t.endef" | ||
491 | if ($win64 && $line =~ /([^,]+),\@function/); | ||
492 | } elsif (!$elf && $dir =~ /\.size/) { | ||
493 | $self->{value} = ""; | ||
494 | if (defined($current_function)) { | ||
495 | $self->{value} .= "${decor}SEH_end_$current_function->{name}:" | ||
496 | if ($win64 && $current_function->{abi} eq "svr4"); | ||
497 | undef $current_function; | ||
498 | } | ||
499 | } elsif (!$elf && $dir =~ /\.align/) { | ||
500 | $self->{value} = ".p2align\t" . (log($line)/log(2)); | ||
501 | } elsif ($dir eq ".section") { | ||
502 | $current_segment=$line; | ||
503 | if (!$elf && $current_segment eq ".init") { | ||
504 | if ($flavour eq "macosx") { $self->{value} = ".mod_init_func"; } | ||
505 | elsif ($flavour eq "mingw64") { $self->{value} = ".section\t.ctors"; } | ||
506 | } | ||
507 | } elsif ($dir =~ /\.(text|data)/) { | ||
508 | $current_segment=".$1"; | ||
509 | } | ||
510 | $line = ""; | ||
511 | return $self; | ||
512 | } | ||
513 | |||
514 | # non-gas case or nasm/masm | ||
515 | SWITCH: for ($dir) { | ||
516 | /\.text/ && do { my $v=undef; | ||
517 | if ($nasm) { | ||
518 | $v="section .text code align=64\n"; | ||
519 | } else { | ||
520 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
521 | $current_segment = ".text\$"; | ||
522 | $v.="$current_segment\tSEGMENT "; | ||
523 | $v.=$masm>=$masmref ? "ALIGN(64)" : "PAGE"; | ||
524 | $v.=" 'CODE'"; | ||
525 | } | ||
526 | $self->{value} = $v; | ||
527 | last; | ||
528 | }; | ||
529 | /\.data/ && do { my $v=undef; | ||
530 | if ($nasm) { | ||
531 | $v="section .data data align=8\n"; | ||
532 | } else { | ||
533 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
534 | $current_segment = "_DATA"; | ||
535 | $v.="$current_segment\tSEGMENT"; | ||
536 | } | ||
537 | $self->{value} = $v; | ||
538 | last; | ||
539 | }; | ||
540 | /\.section/ && do { my $v=undef; | ||
541 | $line =~ s/([^,]*).*/$1/; | ||
542 | $line = ".CRT\$XCU" if ($line eq ".init"); | ||
543 | if ($nasm) { | ||
544 | $v="section $line"; | ||
545 | if ($line=~/\.([px])data/) { | ||
546 | $v.=" rdata align="; | ||
547 | $v.=$1 eq "p"? 4 : 8; | ||
548 | } | ||
549 | } else { | ||
550 | $v="$current_segment\tENDS\n" if ($current_segment); | ||
551 | $v.="$line\tSEGMENT"; | ||
552 | if ($line=~/\.([px])data/) { | ||
553 | $v.=" READONLY"; | ||
554 | $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref); | ||
555 | } | ||
556 | } | ||
557 | $current_segment = $line; | ||
558 | $self->{value} = $v; | ||
559 | last; | ||
560 | }; | ||
561 | /\.extern/ && do { $self->{value} = "EXTERN\t".$line; | ||
562 | $self->{value} .= ":NEAR" if ($masm); | ||
563 | last; | ||
564 | }; | ||
565 | /\.globl|.global/ | ||
566 | && do { $self->{value} = $masm?"PUBLIC":"global"; | ||
567 | $self->{value} .= "\t".$line; | ||
568 | last; | ||
569 | }; | ||
382 | /\.size/ && do { if (defined($current_function)) { | 570 | /\.size/ && do { if (defined($current_function)) { |
383 | $self->{value}="$current_function->{name}\tENDP"; | 571 | undef $self->{value}; |
572 | if ($current_function->{abi} eq "svr4") { | ||
573 | $self->{value}="${decor}SEH_end_$current_function->{name}:"; | ||
574 | $self->{value}.=":\n" if($masm); | ||
575 | } | ||
576 | $self->{value}.="$current_function->{name}\tENDP" if($masm); | ||
384 | undef $current_function; | 577 | undef $current_function; |
385 | } | 578 | } |
386 | last; | 579 | last; |
387 | }; | 580 | }; |
388 | /\.align/ && do { $self->{value} = "ALIGN\t".$line; last; }; | 581 | /\.align/ && do { $self->{value} = "ALIGN\t".$line; last; }; |
389 | /\.(byte|value|long|quad)/ | 582 | /\.(value|long|rva|quad)/ |
390 | && do { my @arr = split(',',$line); | 583 | && do { my $sz = substr($1,0,1); |
391 | my $sz = substr($1,0,1); | 584 | my @arr = split(/,\s*/,$line); |
392 | my $last = pop(@arr); | 585 | my $last = pop(@arr); |
393 | my $conv = sub { my $var=shift; | 586 | my $conv = sub { my $var=shift; |
394 | if ($var=~s/0x([0-9a-f]+)/0$1h/i) { $var; } | 587 | $var=~s/^(0b[0-1]+)/oct($1)/eig; |
395 | else { sprintf"0%Xh",$var; } | 588 | $var=~s/^0x([0-9a-f]+)/0$1h/ig if ($masm); |
589 | if ($sz eq "D" && ($current_segment=~/.[px]data/ || $dir eq ".rva")) | ||
590 | { $var=~s/([_a-z\$\@][_a-z0-9\$\@]*)/$nasm?"$1 wrt ..imagebase":"imagerel $1"/egi; } | ||
591 | $var; | ||
396 | }; | 592 | }; |
397 | 593 | ||
398 | $sz =~ tr/bvlq/BWDQ/; | 594 | $sz =~ tr/bvlrq/BWDDQ/; |
399 | $self->{value} = "\tD$sz\t"; | 595 | $self->{value} = "\tD$sz\t"; |
400 | for (@arr) { $self->{value} .= &$conv($_).","; } | 596 | for (@arr) { $self->{value} .= &$conv($_).","; } |
401 | $self->{value} .= &$conv($last); | 597 | $self->{value} .= &$conv($last); |
402 | last; | 598 | last; |
403 | }; | 599 | }; |
404 | /\.picmeup/ && do { $self->{value} = sprintf"\tDD\t 0%Xh,090000000h",$opcode{$line}; | 600 | /\.byte/ && do { my @str=split(/,\s*/,$line); |
405 | last; | 601 | map(s/(0b[0-1]+)/oct($1)/eig,@str); |
406 | }; | 602 | map(s/0x([0-9a-f]+)/0$1h/ig,@str) if ($masm); |
407 | /\.asciz/ && do { if ($line =~ /^"(.*)"$/) { | 603 | while ($#str>15) { |
408 | my @str=unpack("C*",$1); | ||
409 | push @str,0; | ||
410 | while ($#str>15) { | ||
411 | $self->{value}.="DB\t" | ||
412 | .join(",",@str[0..15])."\n"; | ||
413 | foreach (0..15) { shift @str; } | ||
414 | } | ||
415 | $self->{value}.="DB\t" | 604 | $self->{value}.="DB\t" |
416 | .join(",",@str) if (@str); | 605 | .join(",",@str[0..15])."\n"; |
606 | foreach (0..15) { shift @str; } | ||
417 | } | 607 | } |
608 | $self->{value}.="DB\t" | ||
609 | .join(",",@str) if (@str); | ||
418 | last; | 610 | last; |
419 | }; | 611 | }; |
420 | } | 612 | } |
@@ -429,6 +621,15 @@ my $current_function; | |||
429 | } | 621 | } |
430 | } | 622 | } |
431 | 623 | ||
624 | if ($nasm) { | ||
625 | print <<___; | ||
626 | default rel | ||
627 | ___ | ||
628 | } elsif ($masm) { | ||
629 | print <<___; | ||
630 | OPTION DOTNAME | ||
631 | ___ | ||
632 | } | ||
432 | while($line=<>) { | 633 | while($line=<>) { |
433 | 634 | ||
434 | chomp($line); | 635 | chomp($line); |
@@ -439,43 +640,42 @@ while($line=<>) { | |||
439 | 640 | ||
440 | undef $label; | 641 | undef $label; |
441 | undef $opcode; | 642 | undef $opcode; |
442 | undef $dst; | ||
443 | undef $src; | ||
444 | undef $sz; | 643 | undef $sz; |
644 | undef @args; | ||
445 | 645 | ||
446 | if ($label=label->re(\$line)) { print $label->out(); } | 646 | if ($label=label->re(\$line)) { print $label->out(); } |
447 | 647 | ||
448 | if (directive->re(\$line)) { | 648 | if (directive->re(\$line)) { |
449 | printf "%s",directive->out(); | 649 | printf "%s",directive->out(); |
450 | } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: { | 650 | } elsif ($opcode=opcode->re(\$line)) { ARGUMENT: while (1) { |
451 | 651 | my $arg; | |
452 | if ($src=register->re(\$line)) { opcode->size($src->size()); } | ||
453 | elsif ($src=const->re(\$line)) { } | ||
454 | elsif ($src=ea->re(\$line)) { } | ||
455 | elsif ($src=expr->re(\$line)) { } | ||
456 | 652 | ||
457 | last ARGUMENT if ($line !~ /^,/); | 653 | if ($arg=register->re(\$line)) { opcode->size($arg->size()); } |
654 | elsif ($arg=const->re(\$line)) { } | ||
655 | elsif ($arg=ea->re(\$line)) { } | ||
656 | elsif ($arg=expr->re(\$line)) { } | ||
657 | else { last ARGUMENT; } | ||
458 | 658 | ||
459 | $line = substr($line,1); $line =~ s/^\s+//; | 659 | push @args,$arg; |
460 | 660 | ||
461 | if ($dst=register->re(\$line)) { opcode->size($dst->size()); } | 661 | last ARGUMENT if ($line !~ /^,/); |
462 | elsif ($dst=const->re(\$line)) { } | ||
463 | elsif ($dst=ea->re(\$line)) { } | ||
464 | 662 | ||
663 | $line =~ s/^,\s*//; | ||
465 | } # ARGUMENT: | 664 | } # ARGUMENT: |
466 | 665 | ||
467 | $sz=opcode->size(); | 666 | $sz=opcode->size(); |
468 | 667 | ||
469 | if (defined($dst)) { | 668 | if ($#args>=0) { |
470 | if (!$masm) { | 669 | my $insn; |
471 | printf "\t%s\t%s,%s", $opcode->out($dst->size()), | 670 | if ($gas) { |
472 | $src->out($sz),$dst->out($sz); | 671 | $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz); |
473 | } else { | 672 | } else { |
474 | printf "\t%s\t%s,%s", $opcode->out(), | 673 | $insn = $opcode->out(); |
475 | $dst->out($sz),$src->out($sz); | 674 | $insn .= $sz if (map($_->out() =~ /x?mm/,@args)); |
675 | @args = reverse(@args); | ||
676 | undef $sz if ($nasm && $opcode->mnemonic() eq "lea"); | ||
476 | } | 677 | } |
477 | } elsif (defined($src)) { | 678 | printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args)); |
478 | printf "\t%s\t%s",$opcode->out(),$src->out($sz); | ||
479 | } else { | 679 | } else { |
480 | printf "\t%s",$opcode->out(); | 680 | printf "\t%s",$opcode->out(); |
481 | } | 681 | } |
@@ -484,11 +684,12 @@ while($line=<>) { | |||
484 | print $line,"\n"; | 684 | print $line,"\n"; |
485 | } | 685 | } |
486 | 686 | ||
487 | print "\n$current_segment\tENDS\nEND\n" if ($masm); | 687 | print "\n$current_segment\tENDS\n" if ($current_segment && $masm); |
688 | print "END\n" if ($masm); | ||
488 | 689 | ||
489 | close STDOUT; | 690 | close STDOUT; |
490 | 691 | ||
491 | ################################################# | 692 | ################################################# |
492 | # Cross-reference x86_64 ABI "card" | 693 | # Cross-reference x86_64 ABI "card" |
493 | # | 694 | # |
494 | # Unix Win64 | 695 | # Unix Win64 |
@@ -552,3 +753,161 @@ close STDOUT; | |||
552 | # movq 16(%rsp),%rsi | 753 | # movq 16(%rsp),%rsi |
553 | # endif | 754 | # endif |
554 | # ret | 755 | # ret |
756 | # | ||
757 | ################################################# | ||
758 | # Win64 SEH, Structured Exception Handling. | ||
759 | # | ||
760 | # Unlike on Unix systems(*) lack of Win64 stack unwinding information | ||
761 | # has undesired side-effect at run-time: if an exception is raised in | ||
762 | # assembler subroutine such as those in question (basically we're | ||
763 | # referring to segmentation violations caused by malformed input | ||
764 | # parameters), the application is briskly terminated without invoking | ||
765 | # any exception handlers, most notably without generating memory dump | ||
766 | # or any user notification whatsoever. This poses a problem. It's | ||
767 | # possible to address it by registering custom language-specific | ||
768 | # handler that would restore processor context to the state at | ||
769 | # subroutine entry point and return "exception is not handled, keep | ||
770 | # unwinding" code. Writing such handler can be a challenge... But it's | ||
771 | # doable, though requires certain coding convention. Consider following | ||
772 | # snippet: | ||
773 | # | ||
774 | # .type function,@function | ||
775 | # function: | ||
776 | # movq %rsp,%rax # copy rsp to volatile register | ||
777 | # pushq %r15 # save non-volatile registers | ||
778 | # pushq %rbx | ||
779 | # pushq %rbp | ||
780 | # movq %rsp,%r11 | ||
781 | # subq %rdi,%r11 # prepare [variable] stack frame | ||
782 | # andq $-64,%r11 | ||
783 | # movq %rax,0(%r11) # check for exceptions | ||
784 | # movq %r11,%rsp # allocate [variable] stack frame | ||
785 | # movq %rax,0(%rsp) # save original rsp value | ||
786 | # magic_point: | ||
787 | # ... | ||
788 | # movq 0(%rsp),%rcx # pull original rsp value | ||
789 | # movq -24(%rcx),%rbp # restore non-volatile registers | ||
790 | # movq -16(%rcx),%rbx | ||
791 | # movq -8(%rcx),%r15 | ||
792 | # movq %rcx,%rsp # restore original rsp | ||
793 | # ret | ||
794 | # .size function,.-function | ||
795 | # | ||
796 | # The key is that up to magic_point copy of original rsp value remains | ||
797 | # in chosen volatile register and no non-volatile register, except for | ||
798 | # rsp, is modified. While past magic_point rsp remains constant till | ||
799 | # the very end of the function. In this case custom language-specific | ||
800 | # exception handler would look like this: | ||
801 | # | ||
802 | # EXCEPTION_DISPOSITION handler (EXCEPTION_RECORD *rec,ULONG64 frame, | ||
803 | # CONTEXT *context,DISPATCHER_CONTEXT *disp) | ||
804 | # { ULONG64 *rsp = (ULONG64 *)context->Rax; | ||
805 | # if (context->Rip >= magic_point) | ||
806 | # { rsp = ((ULONG64 **)context->Rsp)[0]; | ||
807 | # context->Rbp = rsp[-3]; | ||
808 | # context->Rbx = rsp[-2]; | ||
809 | # context->R15 = rsp[-1]; | ||
810 | # } | ||
811 | # context->Rsp = (ULONG64)rsp; | ||
812 | # context->Rdi = rsp[1]; | ||
813 | # context->Rsi = rsp[2]; | ||
814 | # | ||
815 | # memcpy (disp->ContextRecord,context,sizeof(CONTEXT)); | ||
816 | # RtlVirtualUnwind(UNW_FLAG_NHANDLER,disp->ImageBase, | ||
817 | # dips->ControlPc,disp->FunctionEntry,disp->ContextRecord, | ||
818 | # &disp->HandlerData,&disp->EstablisherFrame,NULL); | ||
819 | # return ExceptionContinueSearch; | ||
820 | # } | ||
821 | # | ||
822 | # It's appropriate to implement this handler in assembler, directly in | ||
823 | # function's module. In order to do that one has to know members' | ||
824 | # offsets in CONTEXT and DISPATCHER_CONTEXT structures and some constant | ||
825 | # values. Here they are: | ||
826 | # | ||
827 | # CONTEXT.Rax 120 | ||
828 | # CONTEXT.Rcx 128 | ||
829 | # CONTEXT.Rdx 136 | ||
830 | # CONTEXT.Rbx 144 | ||
831 | # CONTEXT.Rsp 152 | ||
832 | # CONTEXT.Rbp 160 | ||
833 | # CONTEXT.Rsi 168 | ||
834 | # CONTEXT.Rdi 176 | ||
835 | # CONTEXT.R8 184 | ||
836 | # CONTEXT.R9 192 | ||
837 | # CONTEXT.R10 200 | ||
838 | # CONTEXT.R11 208 | ||
839 | # CONTEXT.R12 216 | ||
840 | # CONTEXT.R13 224 | ||
841 | # CONTEXT.R14 232 | ||
842 | # CONTEXT.R15 240 | ||
843 | # CONTEXT.Rip 248 | ||
844 | # CONTEXT.Xmm6 512 | ||
845 | # sizeof(CONTEXT) 1232 | ||
846 | # DISPATCHER_CONTEXT.ControlPc 0 | ||
847 | # DISPATCHER_CONTEXT.ImageBase 8 | ||
848 | # DISPATCHER_CONTEXT.FunctionEntry 16 | ||
849 | # DISPATCHER_CONTEXT.EstablisherFrame 24 | ||
850 | # DISPATCHER_CONTEXT.TargetIp 32 | ||
851 | # DISPATCHER_CONTEXT.ContextRecord 40 | ||
852 | # DISPATCHER_CONTEXT.LanguageHandler 48 | ||
853 | # DISPATCHER_CONTEXT.HandlerData 56 | ||
854 | # UNW_FLAG_NHANDLER 0 | ||
855 | # ExceptionContinueSearch 1 | ||
856 | # | ||
857 | # In order to tie the handler to the function one has to compose | ||
858 | # couple of structures: one for .xdata segment and one for .pdata. | ||
859 | # | ||
860 | # UNWIND_INFO structure for .xdata segment would be | ||
861 | # | ||
862 | # function_unwind_info: | ||
863 | # .byte 9,0,0,0 | ||
864 | # .rva handler | ||
865 | # | ||
866 | # This structure designates exception handler for a function with | ||
867 | # zero-length prologue, no stack frame or frame register. | ||
868 | # | ||
869 | # To facilitate composing of .pdata structures, auto-generated "gear" | ||
870 | # prologue copies rsp value to rax and denotes next instruction with | ||
871 | # .LSEH_begin_{function_name} label. This essentially defines the SEH | ||
872 | # styling rule mentioned in the beginning. Position of this label is | ||
873 | # chosen in such manner that possible exceptions raised in the "gear" | ||
874 | # prologue would be accounted to caller and unwound from latter's frame. | ||
875 | # End of function is marked with respective .LSEH_end_{function_name} | ||
876 | # label. To summarize, .pdata segment would contain | ||
877 | # | ||
878 | # .rva .LSEH_begin_function | ||
879 | # .rva .LSEH_end_function | ||
880 | # .rva function_unwind_info | ||
881 | # | ||
882 | # Reference to functon_unwind_info from .xdata segment is the anchor. | ||
883 | # In case you wonder why references are 32-bit .rvas and not 64-bit | ||
884 | # .quads. References put into these two segments are required to be | ||
885 | # *relative* to the base address of the current binary module, a.k.a. | ||
886 | # image base. No Win64 module, be it .exe or .dll, can be larger than | ||
887 | # 2GB and thus such relative references can be and are accommodated in | ||
888 | # 32 bits. | ||
889 | # | ||
890 | # Having reviewed the example function code, one can argue that "movq | ||
891 | # %rsp,%rax" above is redundant. It is not! Keep in mind that on Unix | ||
892 | # rax would contain an undefined value. If this "offends" you, use | ||
893 | # another register and refrain from modifying rax till magic_point is | ||
894 | # reached, i.e. as if it was a non-volatile register. If more registers | ||
895 | # are required prior [variable] frame setup is completed, note that | ||
896 | # nobody says that you can have only one "magic point." You can | ||
897 | # "liberate" non-volatile registers by denoting last stack off-load | ||
898 | # instruction and reflecting it in finer grade unwind logic in handler. | ||
899 | # After all, isn't it why it's called *language-specific* handler... | ||
900 | # | ||
901 | # Attentive reader can notice that exceptions would be mishandled in | ||
902 | # auto-generated "gear" epilogue. Well, exception effectively can't | ||
903 | # occur there, because if memory area used by it was subject to | ||
904 | # segmentation violation, then it would be raised upon call to the | ||
905 | # function (and as already mentioned be accounted to caller, which is | ||
906 | # not a problem). If you're still not comfortable, then define tail | ||
907 | # "magic point" just prior ret instruction and have handler treat it... | ||
908 | # | ||
909 | # (*) Note that we're talking about run-time, not debug-time. Lack of | ||
910 | # unwind information makes debugging hard on both Windows and | ||
911 | # Unix. "Unlike" referes to the fact that on Unix signal handler | ||
912 | # will always be invoked, core dumped and appropriate exit code | ||
913 | # returned to parent (for user notification). | ||
diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl index 5979122158..28080caaa6 100644 --- a/src/lib/libcrypto/perlasm/x86asm.pl +++ b/src/lib/libcrypto/perlasm/x86asm.pl | |||
@@ -1,130 +1,207 @@ | |||
1 | #!/usr/local/bin/perl | 1 | #!/usr/bin/env perl |
2 | 2 | ||
3 | # require 'x86asm.pl'; | 3 | # require 'x86asm.pl'; |
4 | # &asm_init("cpp","des-586.pl"); | 4 | # &asm_init(<flavor>,"des-586.pl"[,$i386only]); |
5 | # XXX | 5 | # &function_begin("foo"); |
6 | # XXX | 6 | # ... |
7 | # main'asm_finish | 7 | # &function_end("foo"); |
8 | 8 | # &asm_finish | |
9 | sub main'asm_finish | 9 | |
10 | { | 10 | $out=(); |
11 | &file_end(); | 11 | $i386=0; |
12 | &asm_finish_cpp() if $cpp; | 12 | |
13 | print &asm_get_output(); | 13 | # AUTOLOAD is this context has quite unpleasant side effect, namely |
14 | } | 14 | # that typos in function calls effectively go to assembler output, |
15 | 15 | # but on the pros side we don't have to implement one subroutine per | |
16 | sub main'asm_init | 16 | # each opcode... |
17 | { | 17 | sub ::AUTOLOAD |
18 | ($type,$fn,$i386)=@_; | 18 | { my $opcode = $AUTOLOAD; |
19 | $filename=$fn; | 19 | |
20 | 20 | die "more than 4 arguments passed to $opcode" if ($#_>3); | |
21 | $elf=$cpp=$coff=$aout=$win32=$netware=$mwerks=0; | 21 | |
22 | if ( ($type eq "elf")) | 22 | $opcode =~ s/.*:://; |
23 | { $elf=1; require "x86unix.pl"; } | 23 | if ($opcode =~ /^push/) { $stack+=4; } |
24 | elsif ( ($type eq "a.out")) | 24 | elsif ($opcode =~ /^pop/) { $stack-=4; } |
25 | { $aout=1; require "x86unix.pl"; } | 25 | |
26 | elsif ( ($type eq "coff" or $type eq "gaswin")) | 26 | &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD"; |
27 | { $coff=1; require "x86unix.pl"; } | 27 | } |
28 | elsif ( ($type eq "cpp")) | 28 | |
29 | { $cpp=1; require "x86unix.pl"; } | 29 | sub ::emit |
30 | elsif ( ($type eq "win32")) | 30 | { my $opcode=shift; |
31 | { $win32=1; require "x86ms.pl"; } | 31 | |
32 | elsif ( ($type eq "win32n")) | 32 | if ($#_==-1) { push(@out,"\t$opcode\n"); } |
33 | { $win32=1; require "x86nasm.pl"; } | 33 | else { push(@out,"\t$opcode\t".join(',',@_)."\n"); } |
34 | elsif ( ($type eq "nw-nasm")) | 34 | } |
35 | { $netware=1; require "x86nasm.pl"; } | 35 | |
36 | elsif ( ($type eq "nw-mwasm")) | 36 | sub ::LB |
37 | { $netware=1; $mwerks=1; require "x86nasm.pl"; } | 37 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'"; |
38 | else | 38 | $1."l"; |
39 | { | 39 | } |
40 | print STDERR <<"EOF"; | 40 | sub ::HB |
41 | { $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'"; | ||
42 | $1."h"; | ||
43 | } | ||
44 | sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); } | ||
45 | sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); } | ||
46 | sub ::blindpop { &pop($_[0]); $stack+=4; } | ||
47 | sub ::wparam { &DWP($stack+4*$_[0],"esp"); } | ||
48 | sub ::swtmp { &DWP(4*$_[0],"esp"); } | ||
49 | |||
50 | sub ::bswap | ||
51 | { if ($i386) # emulate bswap for i386 | ||
52 | { &comment("bswap @_"); | ||
53 | &xchg(&HB(@_),&LB(@_)); | ||
54 | &ror (@_,16); | ||
55 | &xchg(&HB(@_),&LB(@_)); | ||
56 | } | ||
57 | else | ||
58 | { &generic("bswap",@_); } | ||
59 | } | ||
60 | # These are made-up opcodes introduced over the years essentially | ||
61 | # by ignorance, just alias them to real ones... | ||
62 | sub ::movb { &mov(@_); } | ||
63 | sub ::xorb { &xor(@_); } | ||
64 | sub ::rotl { &rol(@_); } | ||
65 | sub ::rotr { &ror(@_); } | ||
66 | sub ::exch { &xchg(@_); } | ||
67 | sub ::halt { &hlt; } | ||
68 | sub ::movz { &movzx(@_); } | ||
69 | sub ::pushf { &pushfd; } | ||
70 | sub ::popf { &popfd; } | ||
71 | |||
72 | # 3 argument instructions | ||
73 | sub ::movq | ||
74 | { my($p1,$p2,$optimize)=@_; | ||
75 | |||
76 | if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/) | ||
77 | # movq between mmx registers can sink Intel CPUs | ||
78 | { &::pshufw($p1,$p2,0xe4); } | ||
79 | else | ||
80 | { &::generic("movq",@_); } | ||
81 | } | ||
82 | |||
83 | # label management | ||
84 | $lbdecor="L"; # local label decoration, set by package | ||
85 | $label="000"; | ||
86 | |||
87 | sub ::islabel # see is argument is a known label | ||
88 | { my $i; | ||
89 | foreach $i (values %label) { return $i if ($i eq $_[0]); } | ||
90 | $label{$_[0]}; # can be undef | ||
91 | } | ||
92 | |||
93 | sub ::label # instantiate a function-scope label | ||
94 | { if (!defined($label{$_[0]})) | ||
95 | { $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; } | ||
96 | $label{$_[0]}; | ||
97 | } | ||
98 | |||
99 | sub ::LABEL # instantiate a file-scope label | ||
100 | { $label{$_[0]}=$_[1] if (!defined($label{$_[0]})); | ||
101 | $label{$_[0]}; | ||
102 | } | ||
103 | |||
104 | sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); } | ||
105 | |||
106 | sub ::set_label_B { push(@out,"@_:\n"); } | ||
107 | sub ::set_label | ||
108 | { my $label=&::label($_[0]); | ||
109 | &::align($_[1]) if ($_[1]>1); | ||
110 | &::set_label_B($label); | ||
111 | $label; | ||
112 | } | ||
113 | |||
114 | sub ::wipe_labels # wipes function-scope labels | ||
115 | { foreach $i (keys %label) | ||
116 | { delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); } | ||
117 | } | ||
118 | |||
119 | # subroutine management | ||
120 | sub ::function_begin | ||
121 | { &function_begin_B(@_); | ||
122 | $stack=4; | ||
123 | &push("ebp"); | ||
124 | &push("ebx"); | ||
125 | &push("esi"); | ||
126 | &push("edi"); | ||
127 | } | ||
128 | |||
129 | sub ::function_end | ||
130 | { &pop("edi"); | ||
131 | &pop("esi"); | ||
132 | &pop("ebx"); | ||
133 | &pop("ebp"); | ||
134 | &ret(); | ||
135 | &function_end_B(@_); | ||
136 | $stack=0; | ||
137 | &wipe_labels(); | ||
138 | } | ||
139 | |||
140 | sub ::function_end_A | ||
141 | { &pop("edi"); | ||
142 | &pop("esi"); | ||
143 | &pop("ebx"); | ||
144 | &pop("ebp"); | ||
145 | &ret(); | ||
146 | $stack+=16; # readjust esp as if we didn't pop anything | ||
147 | } | ||
148 | |||
149 | sub ::asciz | ||
150 | { my @str=unpack("C*",shift); | ||
151 | push @str,0; | ||
152 | while ($#str>15) { | ||
153 | &data_byte(@str[0..15]); | ||
154 | foreach (0..15) { shift @str; } | ||
155 | } | ||
156 | &data_byte(@str) if (@str); | ||
157 | } | ||
158 | |||
159 | sub ::asm_finish | ||
160 | { &file_end(); | ||
161 | print @out; | ||
162 | } | ||
163 | |||
164 | sub ::asm_init | ||
165 | { my ($type,$fn,$cpu)=@_; | ||
166 | |||
167 | $filename=$fn; | ||
168 | $i386=$cpu; | ||
169 | |||
170 | $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=0; | ||
171 | if (($type eq "elf")) | ||
172 | { $elf=1; require "x86gas.pl"; } | ||
173 | elsif (($type eq "a\.out")) | ||
174 | { $aout=1; require "x86gas.pl"; } | ||
175 | elsif (($type eq "coff" or $type eq "gaswin")) | ||
176 | { $coff=1; require "x86gas.pl"; } | ||
177 | elsif (($type eq "win32n")) | ||
178 | { $win32=1; require "x86nasm.pl"; } | ||
179 | elsif (($type eq "nw-nasm")) | ||
180 | { $netware=1; require "x86nasm.pl"; } | ||
181 | #elsif (($type eq "nw-mwasm")) | ||
182 | #{ $netware=1; $mwerks=1; require "x86nasm.pl"; } | ||
183 | elsif (($type eq "win32")) | ||
184 | { $win32=1; require "x86masm.pl"; } | ||
185 | elsif (($type eq "macosx")) | ||
186 | { $aout=1; $macosx=1; require "x86gas.pl"; } | ||
187 | else | ||
188 | { print STDERR <<"EOF"; | ||
41 | Pick one target type from | 189 | Pick one target type from |
42 | elf - Linux, FreeBSD, Solaris x86, etc. | 190 | elf - Linux, FreeBSD, Solaris x86, etc. |
43 | a.out - OpenBSD, DJGPP, etc. | 191 | a.out - DJGPP, elder OpenBSD, etc. |
44 | coff - GAS/COFF such as Win32 targets | 192 | coff - GAS/COFF such as Win32 targets |
45 | win32 - Windows 95/Windows NT | ||
46 | win32n - Windows 95/Windows NT NASM format | 193 | win32n - Windows 95/Windows NT NASM format |
47 | nw-nasm - NetWare NASM format | 194 | nw-nasm - NetWare NASM format |
48 | nw-mwasm- NetWare Metrowerks Assembler | 195 | macosx - Mac OS X |
49 | EOF | 196 | EOF |
50 | exit(1); | 197 | exit(1); |
51 | } | 198 | } |
52 | 199 | ||
53 | $pic=0; | 200 | $pic=0; |
54 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } | 201 | for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); } |
55 | 202 | ||
56 | &asm_init_output(); | 203 | $filename =~ s/\.pl$//; |
57 | 204 | &file($filename); | |
58 | &comment("Don't even think of reading this code"); | 205 | } |
59 | &comment("It was automatically generated by $filename"); | ||
60 | &comment("Which is a perl program used to generate the x86 assember for"); | ||
61 | &comment("any of ELF, a.out, COFF, Win32, ..."); | ||
62 | &comment("eric <eay\@cryptsoft.com>"); | ||
63 | &comment(""); | ||
64 | |||
65 | $filename =~ s/\.pl$//; | ||
66 | &file($filename); | ||
67 | } | ||
68 | |||
69 | sub asm_finish_cpp | ||
70 | { | ||
71 | return unless $cpp; | ||
72 | |||
73 | local($tmp,$i); | ||
74 | foreach $i (&get_labels()) | ||
75 | { | ||
76 | $tmp.="#define $i _$i\n"; | ||
77 | } | ||
78 | print <<"EOF"; | ||
79 | /* Run the C pre-processor over this file with one of the following defined | ||
80 | * ELF - elf object files, | ||
81 | * OUT - a.out object files, | ||
82 | * BSDI - BSDI style a.out object files | ||
83 | * SOL - Solaris style elf | ||
84 | */ | ||
85 | |||
86 | #define TYPE(a,b) .type a,b | ||
87 | #define SIZE(a,b) .size a,b | ||
88 | |||
89 | #if defined(OUT) || (defined(BSDI) && !defined(ELF)) | ||
90 | $tmp | ||
91 | #endif | ||
92 | |||
93 | #ifdef OUT | ||
94 | #define OK 1 | ||
95 | #define ALIGN 4 | ||
96 | #if defined(__CYGWIN__) || defined(__DJGPP__) || (__MINGW32__) | ||
97 | #undef SIZE | ||
98 | #undef TYPE | ||
99 | #define SIZE(a,b) | ||
100 | #define TYPE(a,b) .def a; .scl 2; .type 32; .endef | ||
101 | #endif /* __CYGWIN || __DJGPP */ | ||
102 | #endif | ||
103 | |||
104 | #if defined(BSDI) && !defined(ELF) | ||
105 | #define OK 1 | ||
106 | #define ALIGN 4 | ||
107 | #undef SIZE | ||
108 | #undef TYPE | ||
109 | #define SIZE(a,b) | ||
110 | #define TYPE(a,b) | ||
111 | #endif | ||
112 | |||
113 | #if defined(ELF) || defined(SOL) | ||
114 | #define OK 1 | ||
115 | #define ALIGN 16 | ||
116 | #endif | ||
117 | |||
118 | #ifndef OK | ||
119 | You need to define one of | ||
120 | ELF - elf systems - linux-elf, NetBSD and DG-UX | ||
121 | OUT - a.out systems - linux-a.out and FreeBSD | ||
122 | SOL - solaris systems, which are elf with strange comment lines | ||
123 | BSDI - a.out with a very primative version of as. | ||
124 | #endif | ||
125 | |||
126 | /* Let the Assembler begin :-) */ | ||
127 | EOF | ||
128 | } | ||
129 | 206 | ||
130 | 1; | 207 | 1; |
diff --git a/src/lib/libcrypto/perlasm/x86gas.pl b/src/lib/libcrypto/perlasm/x86gas.pl new file mode 100644 index 0000000000..6eab727fd4 --- /dev/null +++ b/src/lib/libcrypto/perlasm/x86gas.pl | |||
@@ -0,0 +1,247 @@ | |||
1 | #!/usr/bin/env perl | ||
2 | |||
3 | package x86gas; | ||
4 | |||
5 | *out=\@::out; | ||
6 | |||
7 | $::lbdecor=$::aout?"L":".L"; # local label decoration | ||
8 | $nmdecor=($::aout or $::coff)?"_":""; # external name decoration | ||
9 | |||
10 | $initseg=""; | ||
11 | |||
12 | $align=16; | ||
13 | $align=log($align)/log(2) if ($::aout); | ||
14 | $com_start="#" if ($::aout or $::coff); | ||
15 | |||
16 | sub opsize() | ||
17 | { my $reg=shift; | ||
18 | if ($reg =~ m/^%e/o) { "l"; } | ||
19 | elsif ($reg =~ m/^%[a-d][hl]$/o) { "b"; } | ||
20 | elsif ($reg =~ m/^%[xm]/o) { undef; } | ||
21 | else { "w"; } | ||
22 | } | ||
23 | |||
24 | # swap arguments; | ||
25 | # expand opcode with size suffix; | ||
26 | # prefix numeric constants with $; | ||
27 | sub ::generic | ||
28 | { my($opcode,@arg)=@_; | ||
29 | my($suffix,$dst,$src); | ||
30 | |||
31 | @arg=reverse(@arg); | ||
32 | |||
33 | for (@arg) | ||
34 | { s/^(\*?)(e?[a-dsixphl]{2})$/$1%$2/o; # gp registers | ||
35 | s/^([xy]?mm[0-7])$/%$1/o; # xmm/mmx registers | ||
36 | s/^(\-?[0-9]+)$/\$$1/o; # constants | ||
37 | s/^(\-?0x[0-9a-f]+)$/\$$1/o; # constants | ||
38 | } | ||
39 | |||
40 | $dst = $arg[$#arg] if ($#arg>=0); | ||
41 | $src = $arg[$#arg-1] if ($#arg>=1); | ||
42 | if ($dst =~ m/^%/o) { $suffix=&opsize($dst); } | ||
43 | elsif ($src =~ m/^%/o) { $suffix=&opsize($src); } | ||
44 | else { $suffix="l"; } | ||
45 | undef $suffix if ($dst =~ m/^%[xm]/o || $src =~ m/^%[xm]/o); | ||
46 | |||
47 | if ($#_==0) { &::emit($opcode); } | ||
48 | elsif ($opcode =~ m/^j/o && $#_==1) { &::emit($opcode,@arg); } | ||
49 | elsif ($opcode eq "call" && $#_==1) { &::emit($opcode,@arg); } | ||
50 | elsif ($opcode =~ m/^set/&& $#_==1) { &::emit($opcode,@arg); } | ||
51 | else { &::emit($opcode.$suffix,@arg);} | ||
52 | |||
53 | 1; | ||
54 | } | ||
55 | # | ||
56 | # opcodes not covered by ::generic above, mostly inconsistent namings... | ||
57 | # | ||
58 | sub ::movzx { &::movzb(@_); } | ||
59 | sub ::pushfd { &::pushfl; } | ||
60 | sub ::popfd { &::popfl; } | ||
61 | sub ::cpuid { &::emit(".byte\t0x0f,0xa2"); } | ||
62 | sub ::rdtsc { &::emit(".byte\t0x0f,0x31"); } | ||
63 | |||
64 | sub ::call { &::emit("call",(&::islabel($_[0]) or "$nmdecor$_[0]")); } | ||
65 | sub ::call_ptr { &::generic("call","*$_[0]"); } | ||
66 | sub ::jmp_ptr { &::generic("jmp","*$_[0]"); } | ||
67 | |||
68 | *::bswap = sub { &::emit("bswap","%$_[0]"); } if (!$::i386); | ||
69 | |||
70 | sub ::DWP | ||
71 | { my($addr,$reg1,$reg2,$idx)=@_; | ||
72 | my $ret=""; | ||
73 | |||
74 | $addr =~ s/^\s+//; | ||
75 | # prepend global references with optional underscore | ||
76 | $addr =~ s/^([^\+\-0-9][^\+\-]*)/&::islabel($1) or "$nmdecor$1"/ige; | ||
77 | |||
78 | $reg1 = "%$reg1" if ($reg1); | ||
79 | $reg2 = "%$reg2" if ($reg2); | ||
80 | |||
81 | $ret .= $addr if (($addr ne "") && ($addr ne 0)); | ||
82 | |||
83 | if ($reg2) | ||
84 | { $idx!= 0 or $idx=1; | ||
85 | $ret .= "($reg1,$reg2,$idx)"; | ||
86 | } | ||
87 | elsif ($reg1) | ||
88 | { $ret .= "($reg1)"; } | ||
89 | |||
90 | $ret; | ||
91 | } | ||
92 | sub ::QWP { &::DWP(@_); } | ||
93 | sub ::BP { &::DWP(@_); } | ||
94 | sub ::BC { @_; } | ||
95 | sub ::DWC { @_; } | ||
96 | |||
97 | sub ::file | ||
98 | { push(@out,".file\t\"$_[0].s\"\n.text\n"); } | ||
99 | |||
100 | sub ::function_begin_B | ||
101 | { my $func=shift; | ||
102 | my $global=($func !~ /^_/); | ||
103 | my $begin="${::lbdecor}_${func}_begin"; | ||
104 | |||
105 | &::LABEL($func,$global?"$begin":"$nmdecor$func"); | ||
106 | $func=$nmdecor.$func; | ||
107 | |||
108 | push(@out,".globl\t$func\n") if ($global); | ||
109 | if ($::coff) | ||
110 | { push(@out,".def\t$func;\t.scl\t".(3-$global).";\t.type\t32;\t.endef\n"); } | ||
111 | elsif (($::aout and !$::pic) or $::macosx) | ||
112 | { } | ||
113 | else | ||
114 | { push(@out,".type $func,\@function\n"); } | ||
115 | push(@out,".align\t$align\n"); | ||
116 | push(@out,"$func:\n"); | ||
117 | push(@out,"$begin:\n") if ($global); | ||
118 | $::stack=4; | ||
119 | } | ||
120 | |||
121 | sub ::function_end_B | ||
122 | { my $func=shift; | ||
123 | push(@out,".size\t$nmdecor$func,.-".&::LABEL($func)."\n") if ($::elf); | ||
124 | $::stack=0; | ||
125 | &::wipe_labels(); | ||
126 | } | ||
127 | |||
128 | sub ::comment | ||
129 | { | ||
130 | if (!defined($com_start) or $::elf) | ||
131 | { # Regarding $::elf above... | ||
132 | # GNU and SVR4 as'es use different comment delimiters, | ||
133 | push(@out,"\n"); # so we just skip ELF comments... | ||
134 | return; | ||
135 | } | ||
136 | foreach (@_) | ||
137 | { | ||
138 | if (/^\s*$/) | ||
139 | { push(@out,"\n"); } | ||
140 | else | ||
141 | { push(@out,"\t$com_start $_ $com_end\n"); } | ||
142 | } | ||
143 | } | ||
144 | |||
145 | sub ::external_label | ||
146 | { foreach(@_) { &::LABEL($_,$nmdecor.$_); } } | ||
147 | |||
148 | sub ::public_label | ||
149 | { push(@out,".globl\t".&::LABEL($_[0],$nmdecor.$_[0])."\n"); } | ||
150 | |||
151 | sub ::file_end | ||
152 | { if (grep {/\b${nmdecor}OPENSSL_ia32cap_P\b/i} @out) { | ||
153 | my $tmp=".comm\t${nmdecor}OPENSSL_ia32cap_P,4"; | ||
154 | if ($::elf) { push (@out,"$tmp,4\n"); } | ||
155 | else { push (@out,"$tmp\n"); } | ||
156 | } | ||
157 | if ($::macosx) | ||
158 | { if (%non_lazy_ptr) | ||
159 | { push(@out,".section __IMPORT,__pointers,non_lazy_symbol_pointers\n"); | ||
160 | foreach $i (keys %non_lazy_ptr) | ||
161 | { push(@out,"$non_lazy_ptr{$i}:\n.indirect_symbol\t$i\n.long\t0\n"); } | ||
162 | } | ||
163 | } | ||
164 | push(@out,$initseg) if ($initseg); | ||
165 | } | ||
166 | |||
167 | sub ::data_byte { push(@out,".byte\t".join(',',@_)."\n"); } | ||
168 | sub ::data_word { push(@out,".long\t".join(',',@_)."\n"); } | ||
169 | |||
170 | sub ::align | ||
171 | { my $val=$_[0],$p2,$i; | ||
172 | if ($::aout) | ||
173 | { for ($p2=0;$val!=0;$val>>=1) { $p2++; } | ||
174 | $val=$p2-1; | ||
175 | $val.=",0x90"; | ||
176 | } | ||
177 | push(@out,".align\t$val\n"); | ||
178 | } | ||
179 | |||
180 | sub ::picmeup | ||
181 | { my($dst,$sym,$base,$reflabel)=@_; | ||
182 | |||
183 | if ($::pic && ($::elf || $::aout)) | ||
184 | { if (!defined($base)) | ||
185 | { &::call(&::label("PIC_me_up")); | ||
186 | &::set_label("PIC_me_up"); | ||
187 | &::blindpop($dst); | ||
188 | $base=$dst; | ||
189 | $reflabel=&::label("PIC_me_up"); | ||
190 | } | ||
191 | if ($::macosx) | ||
192 | { my $indirect=&::static_label("$nmdecor$sym\$non_lazy_ptr"); | ||
193 | &::mov($dst,&::DWP("$indirect-$reflabel",$base)); | ||
194 | $non_lazy_ptr{"$nmdecor$sym"}=$indirect; | ||
195 | } | ||
196 | else | ||
197 | { &::lea($dst,&::DWP("_GLOBAL_OFFSET_TABLE_+[.-$reflabel]", | ||
198 | $base)); | ||
199 | &::mov($dst,&::DWP("$sym\@GOT",$dst)); | ||
200 | } | ||
201 | } | ||
202 | else | ||
203 | { &::lea($dst,&::DWP($sym)); } | ||
204 | } | ||
205 | |||
206 | sub ::initseg | ||
207 | { my $f=$nmdecor.shift; | ||
208 | |||
209 | if ($::elf) | ||
210 | { $initseg.=<<___; | ||
211 | .section .init | ||
212 | call $f | ||
213 | jmp .Linitalign | ||
214 | .align $align | ||
215 | .Linitalign: | ||
216 | ___ | ||
217 | } | ||
218 | elsif ($::coff) | ||
219 | { $initseg.=<<___; # applies to both Cygwin and Mingw | ||
220 | .section .ctors | ||
221 | .long $f | ||
222 | ___ | ||
223 | } | ||
224 | elsif ($::macosx) | ||
225 | { $initseg.=<<___; | ||
226 | .mod_init_func | ||
227 | .align 2 | ||
228 | .long $f | ||
229 | ___ | ||
230 | } | ||
231 | elsif ($::aout) | ||
232 | { my $ctor="${nmdecor}_GLOBAL_\$I\$$f"; | ||
233 | $initseg.=".text\n"; | ||
234 | $initseg.=".type $ctor,\@function\n" if ($::pic); | ||
235 | $initseg.=<<___; # OpenBSD way... | ||
236 | .globl $ctor | ||
237 | .align 2 | ||
238 | $ctor: | ||
239 | jmp $f | ||
240 | ___ | ||
241 | } | ||
242 | } | ||
243 | |||
244 | sub ::dataseg | ||
245 | { push(@out,".data\n"); } | ||
246 | |||
247 | 1; | ||