1 files changed, 221 insertions, 0 deletions
diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl
new file mode 100644
index 0000000000..4756a28e59
--- /dev/null
+++ b/src/lib/libcrypto/perlasm/x86asm.pl
@@ -0,0 +1,221 @@
+#!/usr/bin/env perl
+# require 'x86asm.pl';
+# &asm_init(<flavor>,"des-586.pl"[,$i386only]);
+# &function_begin("foo");
+# ...
+# &function_end("foo");
+# &asm_finish
+$out=();
+$i386=0;
+# AUTOLOAD is this context has quite unpleasant side effect, namely
+# that typos in function calls effectively go to assembler output,
+# but on the pros side we don't have to implement one subroutine per
+# each opcode...
+sub ::AUTOLOAD
+{ my $opcode = $AUTOLOAD;
+    die "more than 4 arguments passed to $opcode" if ($#_>3);
+    $opcode =~ s/.*:://;
+    if    ($opcode =~ /^push/) { $stack+=4; }
+    elsif ($opcode =~ /^pop/)  { $stack-=4; }
+    &generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
+}
+sub ::emit
+{ my $opcode=shift;
+    if ($#_==-1)    { push(@out,"\t$opcode\n");                         }
+    else            { push(@out,"\t$opcode\t".join(',',@_)."\n");       }
+}
+sub ::emitraw
+{ my $opcode=shift;
+    if ($#_==-1)    { push(@out,"$opcode\n");                           }
+    else            { push(@out,"$opcode\t".join(',',@_)."\n"); }
+}
+sub ::LB
+{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
+  $1."l";
+}
+sub ::HB
+{   $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
+  $1."h";
+}
+sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num);      }
+sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num);      }
+sub ::blindpop  { &pop($_[0]); $stack+=4;                               }
+sub ::wparam    { &DWP($stack+4*$_[0],"esp");                           }
+sub ::swtmp     { &DWP(4*$_[0],"esp");                                  }
+sub ::bswap
+{   if ($i386)  # emulate bswap for i386
+    {   &comment("bswap @_");
+        &xchg(&HB(@_),&LB(@_));
+        &ror (@_,16);
+        &xchg(&HB(@_),&LB(@_));
+    }
+    else
+    {   &generic("bswap",@_);   }
+}
+# These are made-up opcodes introduced over the years essentially
+# by ignorance, just alias them to real ones...
+sub ::movb      { &mov(@_);     }
+sub ::xorb      { &xor(@_);     }
+sub ::rotl      { &rol(@_);     }
+sub ::rotr      { &ror(@_);     }
+sub ::exch      { &xchg(@_);    }
+sub ::halt      { &hlt;         }
+sub ::movz      { &movzx(@_);   }
+sub ::pushf     { &pushfd;      }
+sub ::popf      { &popfd;       }
+# 3 argument instructions
+sub ::movq
+{ my($p1,$p2,$optimize)=@_;
+    if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
+    # movq between mmx registers can sink Intel CPUs
+    {   &::pshufw($p1,$p2,0xe4);                }
+    else
+    {   &::generic("movq",@_);                  }
+}
+# label management
+$lbdecor="L";           # local label decoration, set by package
+$label="000";
+sub ::islabel           # see is argument is a known label
+{ my $i;
+    foreach $i (values %label) { return $i if ($i eq $_[0]); }
+  $label{$_[0]};        # can be undef
+}
+sub ::label             # instantiate a function-scope label
+{   if (!defined($label{$_[0]}))
+    {   $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++;   }
+  $label{$_[0]};
+}
+sub ::LABEL             # instantiate a file-scope label
+{   $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
+  $label{$_[0]};
+}
+sub ::static_label      { &::LABEL($_[0],$lbdecor.$_[0]); }
+sub ::set_label_B       { push(@out,"@_:\n"); }
+sub ::set_label
+{ my $label=&::label($_[0]);
+    &::align($_[1]) if ($_[1]>1);
+    &::set_label_B($label);
+  $label;
+}
+sub ::wipe_labels       # wipes function-scope labels
+{   foreach $i (keys %label)
+    {   delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); }
+}
+# subroutine management
+sub ::function_begin
+{   &function_begin_B(@_);
+    $stack=4;
+    &push("ebp");
+    &push("ebx");
+    &push("esi");
+    &push("edi");
+}
+sub ::function_end
+{   &pop("edi");
+    &pop("esi");
+    &pop("ebx");
+    &pop("ebp");
+    &ret();
+    &function_end_B(@_);
+    $stack=0;
+    &wipe_labels();
+}
+sub ::function_end_A
+{   &pop("edi");
+    &pop("esi");
+    &pop("ebx");
+    &pop("ebp");
+    &ret();
+    $stack+=16; # readjust esp as if we didn't pop anything
+}
+sub ::asciz
+{ my @str=unpack("C*",shift);
+    push @str,0;
+    while ($#str>15) {
+        &data_byte(@str[0..15]);
+        foreach (0..15) { shift @str; }
+    }
+    &data_byte(@str) if (@str);
+}
+sub ::asm_finish
+{   &file_end();
+    print @out;
+}
+sub ::asm_init
+{ my ($type,$fn,$cpu)=@_;
+    $filename=$fn;
+    $i386=$cpu;
+    $elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=0;
+    if    (($type eq "elf"))
+    {   $elf=1;                 require "x86gas.pl";    }
+    elsif (($type eq "a\.out"))
+    {   $aout=1;                require "x86gas.pl";    }
+    elsif (($type eq "coff" or $type eq "gaswin"))
+    {   $coff=1;                require "x86gas.pl";    }
+    elsif (($type eq "win32n"))
+    {   $win32=1;               require "x86nasm.pl";   }
+    elsif (($type eq "nw-nasm"))
+    {   $netware=1;             require "x86nasm.pl";   }
+    #elsif (($type eq "nw-mwasm"))
+    #{  $netware=1; $mwerks=1;  require "x86nasm.pl";   }
+    elsif (($type eq "win32"))
+    {   $win32=1;               require "x86masm.pl";   }
+    elsif (($type eq "macosx"))
+    {   $aout=1; $macosx=1;     require "x86gas.pl";    }
+    elsif (($type eq "openbsd-elf"))
+    {   $openbsd=$elf=1;        require "x86gas.pl";    }
+    elsif (($type eq "openbsd-a.out"))
+    {   $openbsd=1;             require "x86gas.pl";    }
+    else
+    {   print STDERR <<"EOF";
+Pick one target type from
+        elf     - Linux, FreeBSD, Solaris x86, etc.
+        a.out   - DJGPP, elder OpenBSD, etc.
+        coff    - GAS/COFF such as Win32 targets
+        win32n  - Windows 95/Windows NT NASM format
+        openbsd-elf     - OpenBSD elf
+        openbsd-a.out   - OpenBSD a.out
+        nw-nasm - NetWare NASM format
+        macosx  - Mac OS X
+EOF
+        exit(1);
+    }
+    $pic=0;
+    for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
+    ::emitraw("#include <machine/asm.h>\n") if $openbsd;
+    $filename =~ s/\.pl$//;
+    &file($filename);
+}
+1;

diff --git a/src/lib/libcrypto/perlasm/x86asm.pl b/src/lib/libcrypto/perlasm/x86asm.pl new file mode 100644 index 0000000000..4756a28e59 --- /dev/null +++ b/src/lib/libcrypto/perlasm/x86asm.pl
@@ -0,0 +1,221 @@
	1	#!/usr/bin/env perl
	2
	3	# require 'x86asm.pl';
	4	# &asm_init(<flavor>,"des-586.pl"[,$i386only]);
	5	# &function_begin("foo");
	6	# ...
	7	# &function_end("foo");
	8	# &asm_finish
	9
	10	$out=();
	11	$i386=0;
	12
	13	# AUTOLOAD is this context has quite unpleasant side effect, namely
	14	# that typos in function calls effectively go to assembler output,
	15	# but on the pros side we don't have to implement one subroutine per
	16	# each opcode...
	17	sub ::AUTOLOAD
	18	{ my $opcode = $AUTOLOAD;
	19
	20	die "more than 4 arguments passed to $opcode" if ($#_>3);
	21
	22	$opcode =~ s/.*:://;
	23	if ($opcode =~ /^push/) { $stack+=4; }
	24	elsif ($opcode =~ /^pop/) { $stack-=4; }
	25
	26	&generic($opcode,@_) or die "undefined subroutine \&$AUTOLOAD";
	27	}
	28
	29	sub ::emit
	30	{ my $opcode=shift;
	31
	32	if ($#_==-1) { push(@out,"\t$opcode\n"); }
	33	else { push(@out,"\t$opcode\t".join(',',@_)."\n"); }
	34	}
	35
	36	sub ::emitraw
	37	{ my $opcode=shift;
	38
	39	if ($#_==-1) { push(@out,"$opcode\n"); }
	40	else { push(@out,"$opcode\t".join(',',@_)."\n"); }
	41	}
	42
	43	sub ::LB
	44	{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'low byte'";
	45	$1."l";
	46	}
	47	sub ::HB
	48	{ $_[0] =~ m/^e?([a-d])x$/o or die "$_[0] does not have a 'high byte'";
	49	$1."h";
	50	}
	51	sub ::stack_push{ my $num=$_[0]*4; $stack+=$num; &sub("esp",$num); }
	52	sub ::stack_pop { my $num=$_[0]*4; $stack-=$num; &add("esp",$num); }
	53	sub ::blindpop { &pop($_[0]); $stack+=4; }
	54	sub ::wparam { &DWP($stack+4*$_[0],"esp"); }
	55	sub ::swtmp { &DWP(4*$_[0],"esp"); }
	56
	57	sub ::bswap
	58	{ if ($i386) # emulate bswap for i386
	59	{ &comment("bswap @_");
	60	&xchg(&HB(@_),&LB(@_));
	61	&ror (@_,16);
	62	&xchg(&HB(@_),&LB(@_));
	63	}
	64	else
	65	{ &generic("bswap",@_); }
	66	}
	67	# These are made-up opcodes introduced over the years essentially
	68	# by ignorance, just alias them to real ones...
	69	sub ::movb { &mov(@_); }
	70	sub ::xorb { &xor(@_); }
	71	sub ::rotl { &rol(@_); }
	72	sub ::rotr { &ror(@_); }
	73	sub ::exch { &xchg(@_); }
	74	sub ::halt { &hlt; }
	75	sub ::movz { &movzx(@_); }
	76	sub ::pushf { &pushfd; }
	77	sub ::popf { &popfd; }
	78
	79	# 3 argument instructions
	80	sub ::movq
	81	{ my($p1,$p2,$optimize)=@_;
	82
	83	if ($optimize && $p1=~/^mm[0-7]$/ && $p2=~/^mm[0-7]$/)
	84	# movq between mmx registers can sink Intel CPUs
	85	{ &::pshufw($p1,$p2,0xe4); }
	86	else
	87	{ &::generic("movq",@_); }
	88	}
	89
	90	# label management
	91	$lbdecor="L"; # local label decoration, set by package
	92	$label="000";
	93
	94	sub ::islabel # see is argument is a known label
	95	{ my $i;
	96	foreach $i (values %label) { return $i if ($i eq $_[0]); }
	97	$label{$_[0]}; # can be undef
	98	}
	99
	100	sub ::label # instantiate a function-scope label
	101	{ if (!defined($label{$_[0]}))
	102	{ $label{$_[0]}="${lbdecor}${label}${_[0]}"; $label++; }
	103	$label{$_[0]};
	104	}
	105
	106	sub ::LABEL # instantiate a file-scope label
	107	{ $label{$_[0]}=$_[1] if (!defined($label{$_[0]}));
	108	$label{$_[0]};
	109	}
	110
	111	sub ::static_label { &::LABEL($_[0],$lbdecor.$_[0]); }
	112
	113	sub ::set_label_B { push(@out,"@_:\n"); }
	114	sub ::set_label
	115	{ my $label=&::label($_[0]);
	116	&::align($_[1]) if ($_[1]>1);
	117	&::set_label_B($label);
	118	$label;
	119	}
	120
	121	sub ::wipe_labels # wipes function-scope labels
	122	{ foreach $i (keys %label)
	123	{ delete $label{$i} if ($label{$i} =~ /^\Q${lbdecor}\E[0-9]{3}/); }
	124	}
	125
	126	# subroutine management
	127	sub ::function_begin
	128	{ &function_begin_B(@_);
	129	$stack=4;
	130	&push("ebp");
	131	&push("ebx");
	132	&push("esi");
	133	&push("edi");
	134	}
	135
	136	sub ::function_end
	137	{ &pop("edi");
	138	&pop("esi");
	139	&pop("ebx");
	140	&pop("ebp");
	141	&ret();
	142	&function_end_B(@_);
	143	$stack=0;
	144	&wipe_labels();
	145	}
	146
	147	sub ::function_end_A
	148	{ &pop("edi");
	149	&pop("esi");
	150	&pop("ebx");
	151	&pop("ebp");
	152	&ret();
	153	$stack+=16; # readjust esp as if we didn't pop anything
	154	}
	155
	156	sub ::asciz
	157	{ my @str=unpack("C*",shift);
	158	push @str,0;
	159	while ($#str>15) {
	160	&data_byte(@str[0..15]);
	161	foreach (0..15) { shift @str; }
	162	}
	163	&data_byte(@str) if (@str);
	164	}
	165
	166	sub ::asm_finish
	167	{ &file_end();
	168	print @out;
	169	}
	170
	171	sub ::asm_init
	172	{ my ($type,$fn,$cpu)=@_;
	173
	174	$filename=$fn;
	175	$i386=$cpu;
	176
	177	$elf=$cpp=$coff=$aout=$macosx=$win32=$netware=$mwerks=$openbsd=0;
	178	if (($type eq "elf"))
	179	{ $elf=1; require "x86gas.pl"; }
	180	elsif (($type eq "a\.out"))
	181	{ $aout=1; require "x86gas.pl"; }
	182	elsif (($type eq "coff" or $type eq "gaswin"))
	183	{ $coff=1; require "x86gas.pl"; }
	184	elsif (($type eq "win32n"))
	185	{ $win32=1; require "x86nasm.pl"; }
	186	elsif (($type eq "nw-nasm"))
	187	{ $netware=1; require "x86nasm.pl"; }
	188	#elsif (($type eq "nw-mwasm"))
	189	#{ $netware=1; $mwerks=1; require "x86nasm.pl"; }
	190	elsif (($type eq "win32"))
	191	{ $win32=1; require "x86masm.pl"; }
	192	elsif (($type eq "macosx"))
	193	{ $aout=1; $macosx=1; require "x86gas.pl"; }
	194	elsif (($type eq "openbsd-elf"))
	195	{ $openbsd=$elf=1; require "x86gas.pl"; }
	196	elsif (($type eq "openbsd-a.out"))
	197	{ $openbsd=1; require "x86gas.pl"; }
	198	else
	199	{ print STDERR <<"EOF";
	200	Pick one target type from
	201	elf - Linux, FreeBSD, Solaris x86, etc.
	202	a.out - DJGPP, elder OpenBSD, etc.
	203	coff - GAS/COFF such as Win32 targets
	204	win32n - Windows 95/Windows NT NASM format
	205	openbsd-elf - OpenBSD elf
	206	openbsd-a.out - OpenBSD a.out
	207	nw-nasm - NetWare NASM format
	208	macosx - Mac OS X
	209	EOF
	210	exit(1);
	211	}
	212
	213	$pic=0;
	214	for (@ARGV) { $pic=1 if (/\-[fK]PIC/i); }
	215
	216	::emitraw("#include <machine/asm.h>\n") if $openbsd;
	217	$filename =~ s/\.pl$//;
	218	&file($filename);
	219	}
	220
	221	1;