#!/afs/athena/contrib/perl/perl

$omagic = 'impure';
$nmagic = 'swapped';
$zmagic = 'paged';
$nul1		= "\x00";
$nul2		= $nul1 x 2;
$nul4		= $nul1 x 4;
@BATTERY	= ();
if (length("\x00") != 1)
{
$prog = '';
open(OLDME, $0)		|| die "Failed\n";
while(<OLDME>)
{
next		if /^\s*#/;
while(/\\x([\da-f][\da-f])/i)
{
$_ = $` . sprintf("\\%03o", hex($1)) . $';
}
$prog .= $_;
}
close(OLDME);
eval $prog;
exit 0;
}
sub Require
{
local($filename) = @_;
return 1 if $INC{$filename};
local($realfilename,$result);
ITER:	{
local($prefix);
foreach $prefix (@INC)
{
$realfilename = "$prefix/$filename";
if (-f $realfilename)
{
$result = do $realfilename;
last ITER;
}
}
die "Can't find $filename in \@INC";
}
die $@ if $@;
die "$filename did not return true value" unless $result;
$INC{$filename} = $realfilename;
$result;
}
sub Major
{
($_[0] >> 8) & 0xFF;
}
sub Minor
{
$_[0] & 0xFF;
}
sub MmDev
{
"(" . &Major($_[0]) . "/" . &Minor($_[0]) . ")";
}
sub MmVer
{
&Major($_[0]) . "." . &Minor($_[0]);
}
sub MsbVal
{
local($_) = @_;
local(@bytes) = unpack("C".length($_), $_);
local($ans);
while(@bytes)
{
$ans = (($ans << 8) | shift(@bytes));
}
return $ans;
}
sub LsbVal
{
local($_) = @_;
local(@bytes) = reverse(unpack("C".length($_), $_));
local($ans);
while(@bytes)
{
$ans = (($ans << 8) | shift(@bytes));
}
return $ans;
}
&MsbVal("\002\001") == 0x0201 || die "&MsbVal is broken. Stopped";
&LsbVal("\002\001") == 0x0102 || die "&LsbVal is broken. Stopped";
sub BufMatch
{
substr($_[0], $_[1], length($_[2])) eq $_[2];
}
sub BufString
{
return ''	if $_[1] > length($_[0]);
return $1	if substr($_[0],$_[1],length($_[0])-$_[1])
=~ /^([\040-\176]+)/;
return '';
}
push(@BATTERY, 'IsElf');
sub IsElf
{
local($_)		= @_;
local($bytes0_3)	= substr($_,  0, 4);	# long
$bytes0_3 eq "\x7F\x45\x4C\x46" || return '';
local($ans)		= 'ELF';
local(@bytes)		= unpack("C".length($_), $_);
local($bytes16_17)	= substr($_, 16, 2);	# short
local($bytes18_19)	= substr($_, 18, 2);	# short
local($bytes20_23)	= substr($_, 20, 4);	# long
local($bytes36_39)	= substr($_, 36, 4);	# long
$ans .= ' 32-bit'		if $bytes[4] == 1;
$ans .= ' LSB'			if $bytes[5] == 1;
$ans .= ' MSB'			if $bytes[5] == 2;
$ans .= ' unknown machine'	if &MsbVal($bytes18_19) == 0;
$ans .= ' WE32100'		if &MsbVal($bytes18_19) == 1;
$ans .= ' SPARC'		if &MsbVal($bytes18_19) == 2;
$ans .= ' 80386'		if &MsbVal($bytes18_19) == 3;
$ans .= ' M68000'		if &MsbVal($bytes18_19) == 4;
$ans .= ' M88000'		if &MsbVal($bytes18_19) == 5;
$ans .= '+MAU'			if &MsbVal($bytes36_39) == 1;
$ans .= ' unknown type'		if &MsbVal($bytes16_17) == 0;
$ans .= ' relocatable'		if &MsbVal($bytes16_17) == 1;
$ans .= ' executable'		if &MsbVal($bytes16_17) == 2;
$ans .= ' dynamic library'	if &MsbVal($bytes16_17) == 3;
$ans .= ' core file'		if &MsbVal($bytes16_17) == 4;
$ans .= ' Version ' . &MsbVal($bytes20_23);
return $ans;
}
push(@BATTERY, 'IsMach');
%mach_file =
('1'	,'relocatable'
,'2'	,'paged executable'
,'3'	,'shared library'
,'4'	,'core'
,'5'	,'preloaded executable'
);
%mach_cpu = (
'1,1'		,'VAX780'
,'1,2'		,'VAX785'
,'1,3'		,'VAX750'
,'1,4'		,'VAX730'
,'1,5'		,'UVAXI'
,'1,6'		,'UVAXII'
,'1,7'		,'VAX8200'
,'1,8'		,'VAX8500'
,'1,9'		,'VAX8600'
,'1,10'		,'VAX8650'
,'1,11'		,'VAX8800'
,'1,12'		,'UVAXIII'
,'2,1'		,'ROMP RT_PC'
,'2,2'		,'ROMP RT_APC'
,'2,3'		,'ROMP RT_135'
,'4,1'		,'NS32032 MMAX_DPC'
,'4,2'		,'NS32032 SQT'
,'4,3'		,'NS32032 MMAX_APC_FPU'
,'4,4'		,'NS32032 MMAX_APC_FPA'
,'4,5'		,'NS32032 MMAX_XPC'
,'5,1'		,'NS32332 MMAX_DPC'
,'5,2'		,'NS32332 SQT'
,'5,3'		,'NS32332 MMAX_APC_FPU'
,'5,4'		,'NS32332 MMAX_APC_FPA'
,'5,5'		,'NS32332 MMAX_XPC'
,'9,1'		,'NS32532 MMAX_DPC'
,'9,2'		,'NS32532 SQT'
,'9,3'		,'NS32532 MMAX_APC_FPU'
,'9,4'		,'NS32532 MMAX_APC_FPA'
,'9,5'		,'NS32532 MMAX_XPC'
,'6,1'		,'MC68030'
,'6,2'		,'MC68040'
,'7,1'		,'I386 AT386'
,'7,2'		,'I386 EXL'
,'8,1'		,'MIPS R2300'
,'8,2'		,'MIPS R2600'
,'8,3'		,'MIPS R2800'
,'8,4'		,'MIPS R2000a'
,'11,1'		,'HPPA 825'
,'11,2'		,'HPPA 835'
,'11,3'		,'HPPA 840'
,'11,4'		,'HPPA 850'
,'11,5'		,'HPPA 855'
,'12,1'		,'ARM A500_ARCH'
,'12,2'		,'ARM A500'
,'12,3'		,'ARM A440'
,'12,4'		,'ARM M4'
,'12,5'		,'ARM A680'
,'13,1'		,'MC88000 MMAX_JPC'
,'14,1'		,'SPARC SUN4_260'
,'14,2'		,'SPARC SUN4_110'
);
sub IsMach
{
local($ans)	= 'MACH';
local($BtoI);	# name of byte-string to value routine
local($magic)	= substr($_, 0, 4);
local($tmp);
if($magic eq "\xFE\xED\xFA\xCE")
{
$ans .= ' MSB';
$BtoI = 'MsbVal';
}
elsif($magic eq "\xCE\xFA\xED\xFE")
{
$ans .= ' LSB';
$BtoI = 'LsbVal';
}
else
{
return '';
}
local($cputype)		= &$BtoI(substr($_,  4, 4));
local($cpusubtype)	= &$BtoI(substr($_,  8, 4));
local($filetype)	= &$BtoI(substr($_, 12, 4));
local($ncmds)		= &$BtoI(substr($_, 16, 4));
local($sizeofcmds)	= &$BtoI(substr($_, 20, 4));
local($flags)		= &$BtoI(substr($_, 24, 4));
if($verbose_mach)
{
print "$path:\n";
print "Mach header+cmds occupy 28+$sizeofcmds = "
, 28+$sizeofcmds
, " bytes\n";
print "4:\tcputype\t\t$cputype\n";
print "8:\tcpusubtype\t$cpusubtype\n";
print "12:\tfiletype\t$filetype\n";
print "16:\tncmds\t\t$ncmds\n";
print "20:\tsizeofcmds\t$sizeofcmds\n";
print "24:\tflags\t\t$flags\n";
}
local($cpu)		= $cputype.','.$cpusubtype;
if(($tmp = $mach_cpu{$cpu}) ne '')
{
$ans .= ' ' . $tmp;
}
else
{
$ans .= ' (UNKNOWN CPU '.$cpu.')';
}
if(($tmp = $mach_file{$filetype}) ne '')
{
$ans .= ' ' . $tmp;
}
else
{
$ans .= ' (UNKNOWN FILETYPE '.$filetype.')';
}
local($nsyms)	= &MachNsyms;
$ans .= ' not stripped'	if $nsyms > 0;
$ans .= ' (header truncated?)'	if $nsyms < 0;
$ans;
}
sub MachNsyms
{
local($ncmds)		= &$BtoI(substr($_, 16, 4));
local($sizeofcmds)	= &$BtoI(substr($_, 20, 4));
local($ans) = 0;
local($size) = 0;
local($ret, $desc);
return -1	if !seek(FILE, 28, 0);
while($ncmds--)
{
($ret,$desc) = &DumpMachCommand;
return -1	if $ret == 0;
$size += $ret;
print $desc	if $verbose_MACH;
if($desc =~ /LC_SYMTAB/)
{
$desc =~ /\s+nsyms\s+(\d+)/;
$ans = $1;
}
}
return -1	if $size != $sizeofcmds;
$ans;
}
sub DumpMachCommand
{
local($load_command);
local($here)		= tell(FILE);
return (0,'') if read(FILE, $load_command, 8) != 8;
local($cmd)		= &$BtoI(substr($load_command,0,4));
local($cmdsize)		= &$BtoI(substr($load_command,4,4));
local($fmt)		= $here.":\tcommand %-13s ($cmdsize)\n";
local($body);		# body of command
local($size)		= $cmdsize - 8;
local($desc);		# description to be returned
return (0,'') if $size < 0;
return (0,'') if read(FILE, $body, $size) != $size;
if($cmd == 1)
{
$desc = sprintf($fmt, 'LC_SEGMENT');
local($segname)  = unpack("A16", $body);
local($vmaddr)   = &$BtoI(substr($body,16,4));
local($vmsize)   = &$BtoI(substr($body,20,4));
local($fileoff)  = &$BtoI(substr($body,24,4));
local($filesize) = &$BtoI(substr($body,28,4));
local($maxprot)  = &$BtoI(substr($body,32,4));
local($initprot) = &$BtoI(substr($body,36,4));
local($nsects)   = &$BtoI(substr($body,40,4));
local($flags)    = &$BtoI(substr($body,44,4));
$desc .= "\tsegname\t\t".$segname."\n";
$desc .= "\tvmaddr\t\t" .$vmaddr ."\n";
$desc .= "\tvmsize\t\t" .$vmsize ."\n";
$desc .= "\tmaxprot\t\t". &MachProt($maxprot)."\n";
$desc .= "\tinitprot\t".&MachProt($initprot)."\n";
$desc .= "\tnsects\t\t" .$nsects ."\n";
$desc .= "\tflags\t\t" .$flags ."\n";
}
elsif($cmd == 2)
{
$desc = sprintf($fmt, 'LC_SYMTAB');
local($symoff)  = &$BtoI(substr($body, 0,4));
local($nsyms)   = &$BtoI(substr($body, 4,4));
local($stroff)  = &$BtoI(substr($body, 8,4));
local($strsize) = &$BtoI(substr($body,12,4));
$desc .= "\tsymoff\t\t" .$symoff ."\n";
$desc .= "\tnsyms\t\t"  .$nsyms  ."\n";
$desc .= "\tstroff\t\t" .$stroff ."\n";
$desc .= "\tstrsize\t\t".$strsize."\n";
}
elsif($cmd == 3)
{
$desc = sprintf($fmt, 'LC_SYMSEG(obsolete)');
}
elsif($cmd == 4)
{
$desc = sprintf($fmt, 'LC_THREAD');
}
elsif($cmd == 5)
{
$desc = sprintf($fmt, 'LC_UNIXTHREAD');
}
elsif($cmd == 6 || $cmd == 7)
{
$desc = sprintf($fmt, ($cmd == 6)?'LC_LOADFVMLIB'
:'LC_IDFVMLIB');
local($name)          = &$BtoI(substr($body, 0,4));
local($minor_version) = &$BtoI(substr($body, 4,4));
local($header_addr)   = &$BtoI(substr($body, 8,4));
local($tail) = substr($body, 12, length($body)-12);
$tail =~ s/\000+$//;
$desc .= "\tname\t\t"       .$tail         ."\n";
$desc .= "\tminor_version\t".$minor_version."\n";
$desc .= "\theader_addr\t".sprintf("0x%08x",$header_addr)."\n";
}
elsif($cmd == 8)
{
$desc = sprintf($fmt, 'LC_IDENT(obsolete)');
}
else
{
$desc = sprintf($fmt, $cmd);
}
return (0,'')	if !seek(FILE, $here + $cmdsize, 0);
($cmdsize, $desc);
}
sub MachProt
{
local($val)	= @_;
local($ans)	= '';
$ans .= ($val & 1) ? 'r' : '-';
$ans .= ($val & 2) ? 'w' : '-';
$ans .= ($val & 4) ? 'x' : '-';
$ans;
}
push(@BATTERY, 'IsSun');
push(@BATTERY, 'IsBsd');
$bsd_msb_machine="IBM RT";
$bsd_lsb_machine="VAX";
%bsd_msb=
( "\x00\xC8\x01\x07", "BSD MSB hp200 $omagic executable"
, "\x00\xC8\x01\x08", "BSD MSB hp200 $nmagic executable"
, "\x00\xC8\x01\x0B", "BSD MSB hp200 $zmagic executable"
, "\x01\x2C\x01\x07", "BSD MSB hp300 $omagic executable"
, "\x01\x2C\x01\x08", "BSD MSB hp300 $nmagic executable"
, "\x01\x2C\x01\x0B", "BSD MSB hp300 $zmagic executable"
, "\x02\x0B\x01\x07", "HPUX MSB hp800 $omagic executable"
, "\x02\x0B\x01\x08", "HPUX MSB hp800 $nmagic executable"
, "\x02\x0B\x01\x0B", "HPUX MSB hp800 $zmagic executable"
, "\x02\x0C\x01\x07", "HPUX MSB hp200/300 $omagic executable"
, "\x02\x0C\x01\x08", "HPUX MSB hp200/300 $nmagic executable"
, "\x02\x0C\x01\x0B", "HPUX MSB hp200/300 $zmagic executable"
, "\x02\x0B\x01\x06", "HPUX MSB hp800 relocatable"
, "\x02\x0C\x01\x06", "HPUX MSB hp200/300 relocatable"
, "\x50\x90\x01\x07", "OSx MSB Pyramid 90x $omagic executable"
, "\x50\x90\x01\x08", "OSx MSB Pyramid 90x $nmagic executable"
, "\x50\x90\x01\x0B", "OSx MSB Pyramid 90x $zmagic executable"
, "\x00\x00\x01\x47", "Convex MSB old relocatable"
, "\x00\x00\x01\x4B", "Convex MSB old demand paged executable"
, "\x00\x00\x01\x4D", "Convex MSB old pre-paged executable"
, "\x00\x00\x01\x4F", "Convex MSB old pre-paged, non-swapped executable"
, "\x00\x00\x01\x01", "BSD MSB 68k pure executable"
, "\x00\x00\x01\x15", "BSD MSB 68020 executable"
, "\x00\x00\x01\x17", "BSD MSB 68020 executable"
, "\x00\x00\x01\x18", "BSD MSB 68020 executable"
, "\x00\x00\x01\x19", "BSD MSB 68020 executable"
, "\x00\x00\x01\x07", "BSD MSB $bsd_msb_machine $omagic executable"
, "\x00\x00\x01\x08", "BSD MSB $bsd_msb_machine $nmagic executable"
, "\x00\x00\x01\x0B", "BSD MSB $bsd_msb_machine $zmagic executable"
, "\x00\x00\x01\x10", "BSD MSB $bsd_msb_machine $zmagic executable (invalid @ 0)"
);
%bsd_lsb=
( "\x07\x01\x00\x00", "BSD LSB $bsd_lsb_machine $omagic executable"
, "\x08\x01\x00\x00", "BSD LSB $bsd_lsb_machine $nmagic executable"
, "\x0B\x01\x00\x00", "BSD LSB $bsd_lsb_machine $zmagic executable"
, "\x10\x01\x00\x00", "BSD LSB $bsd_lsb_machine $zmagic executable (invalid @ 0)"
, "\x07\x01\x01\x00", "Ultrix-32 LSB VAX $omagic SVID executable"
, "\x08\x01\x01\x00", "Ultrix-32 LSB VAX $nmagic SVID executable"
, "\x0B\x01\x01\x00", "Ultrix-32 LSB VAX $zmagic SVID executable"
, "\x07\x01\x02\x00", "Ultrix-32 LSB VAX $omagic POSIX executable"
, "\x08\x01\x02\x00", "Ultrix-32 LSB VAX $nmagic POSIX executable"
, "\x0B\x01\x02\x00", "Ultrix-32 LSB VAX $zmagic POSIX executable"
, "\xEA\x00\x00\x00", "DYNIX? LSB BALANCE ns32000 relocatable"
, "\xEA\x10\x00\x00", "DYNIX? LSB BALANCE ns32000 executable (0 @ 0)"
, "\xEA\x20\x00\x00", "DYNIX? LSB BALANCE ns32000 executable (invalid @ 0)"
, "\xEA\x30\x00\x00", "DYNIX? LSB BALANCE ns32000 standalone executable"
, "\xEB\x12\x00\x00", "DYNIX LSB SYMMETRY i386 relocatable"
, "\xEB\x22\x00\x00", "DYNIX LSB SYMMETRY i386 executable (0 @ 0)"
, "\xEB\x32\x00\x00", "DYNIX LSB SYMMETRY i386 executable (invalid @ 0)"
, "\xEB\x42\x00\x00", "DYNIX LSB SYMMETRY i386 standalone executable"
);
sub IsBsd
{
local($_)		= @_;
local($a_magic)		= substr($_,  0, 4);	# long
local($a_syms)		= substr($_, 16, 4);	# long
local($ans)		= '';
if(($ans = $bsd_msb{$a_magic}) ne '')
{
$ans .= ' not stripped'	if $a_syms ne $nul4;
return $ans;
}
if(($ans = $bsd_lsb{$a_magic}) ne '')
{
$ans .= ' not stripped'	if $a_syms ne $nul4;
return $ans;
}
return '';
}
%magic_sun=
(	"\x00\x01\x01\x07", "BSD MSB mc68010 $omagic executable"
,	"\x00\x01\x01\x08", "BSD MSB mc68010 $nmagic executable"
,	"\x00\x01\x01\x0B", "BSD MSB mc68010 $zmagic executable"
,	"\x00\x02\x01\x07", "BSD MSB mc68020 $omagic executable"
,	"\x00\x02\x01\x08", "BSD MSB mc68020 $nmagic executable"
,	"\x00\x02\x01\x0B", "BSD MSB mc68020 $zmagic executable"
,	"\x00\x03\x01\x07", "BSD MSB sparc $omagic executable"
,	"\x00\x03\x01\x08", "BSD MSB sparc $nmagic executable"
,	"\x00\x03\x01\x0B", "BSD MSB sparc $zmagic executable"
);
sub IsSun
{
local($buf)		= @_;
local($ans);
local($a_magic)		= substr($buf,  0, 4);	# long
local($a_syms)		= substr($buf, 16, 4);	# long
local($ans);
local(@bytes)		= unpack("C4", $a_magic);
local($byte0)		= shift @bytes;
$a_magic = pack("C4", 0x00, @bytes);
if(($ans = $magic_sun{$a_magic}) ne '') {
local($a_dynamic)	= $byte0 & 0x80;
local($a_toolversion)	= $byte0 & 0x7F;
$ans .= ' dynamically linked'	if $a_dynamic;
$ans .= ' Version '.$a_toolversion
if $a_toolversion;
$ans .= ' not stripped'		if $a_syms ne $nul4;
}
return $ans;
}
push(@BATTERY, 'IsCoff');
$coff_msb{$MIPSEBMAGIC	= "\x01\x60"}	= "MIPS R2000";
$coff_lsb{$MIPSELMAGIC	= "\x62\x01"}	= "MIPS R2000";
$coff_msb{$MIPSEBUMAGIC	= "\x01\x80"}	= "MIPS ucode";
$coff_lsb{$MIPSELUMAGIC	= "\x82\x01"}	= "MIPS ucode";
$coff_msb{$MIPSEBMAGIC_2= "\x01\x63"}	= "MIPS R6000";
$coff_lsb{$MIPSELMAGIC_2= "\x66\x01"}	= "MIPS R6000";
$coff_msb{$MIPSEBMAGIC_3= "\x01\x40"}	= "MIPS R4000";
$coff_lsb{$MIPSELMAGIC_3= "\x42\x01"}	= "MIPS R4000";
$coff_lsb{$IAPX16	= "\x44\x01"}	= "iAPX16";
$coff_lsb{$IAPX16TV	= "\x45\x01"}	= "iAPX16(TV)";
$coff_lsb{$IAPX20	= "\x46\x01"}	= "iAPX20";
$coff_lsb{$IAPX20TV	= "\x47\x01"}	= "iAPX20(TV)";
$coff_lsb{$B16MAGIC	= "\x42\x01"}	= "basic-16";
$coff_lsb{$BTVMAGIC	= "\x43\x01"}	= "basic-16(TV)";
$coff_lsb{$X86MAGIC	= "\x48\x01"}	= "x86";
$coff_lsb{$XTVMAGIC	= "\x49\x01"}	= "x86(TV)";
$coff_lsb{$I286SMAGIC	= "\x4A\x01"}	= "80286(small)";
$coff_lsb{$I286LMAGIC	= "\x52\x01"}	= "80286(large)";
$coff_lsb{$X386MAGIC	= "\x4C\x01"}	= "80386";
$coff_msb{$N3BMAGIC	= "\x01\x68"}	= "3B20";
$coff_msb{$NTVMAGIC	= "\x01\x69"}	= "3B20(TV)";
$coff_msb{$WE32MAGIC	= "\x01\x70"}	= "WE32000";
$coff_msb{$MTVMAGIC	= "\x01\x71"}	= "WE32000(TV)";
sub isWE32
{
$_[0] eq $WE32MAGIC	||
$_[0] eq $MTVMAGIC	;
}
$coff_lsb{$VAXWRMAGIC	= "\x78\x01"}	= "VAX";	# LSB
$coff_lsb{$VAXROMAGIC	= "\x7D\x01"}	= "VAX";	# LSB
$coff_msb{$M68MAGIC	= "\x00\x88"}	= "M68000";
$coff_msb{$M68TVMAGIC	= "\x00\x89"}	= "M68000";
$coff_msb{$MC68KWRMAGIC	= "\x01\x50"}	= "M68000";
$coff_msb{$MC68KROMAGIC	= "\x01\x51"}	= "M68000";
$coff_msb{$MC68KPGMAGIC	= "\x01\x52"}	= "M68000";
$coff_msb{$U370WRMAGIC	= "\x01\x58"}	= "IBM 370";
$coff_msb{$U370ROMAGIC	= "\x01\x5D"}	= "IBM 370";
$coff_msb{$U800WRMAGIC	= "\x01\x98"}	= "IBM RT";
$coff_msb{$U800ROMAGIC	= "\x01\x9D"}	= "IBM RT";
$coff_msb{$U800TOCMAGIC	= "\x01\x9F"}	= "IBM RT";
$coff_msb{$U802WRMAGIC	= "\x01\xD8"}	= "IBM R2";
$coff_msb{$U802ROMAGIC	= "\x01\xDD"}	= "IBM R2";
$coff_msb{$U802TOCMAGIC	= "\x01\xDF"}	= "IBM R2";
sub isR2
{
$_[0] eq $U802WRMAGIC	||
$_[0] eq $U802ROMAGIC	||
$_[0] eq $U802TOCMAGIC	;
}
$coff_msb{$tower2a	= "\x01\x88"}	= "Tower/XP rel 2";
$coff_msb{$tower2b	= "\x01\x8D"}	= "Tower/XP rel 2";
$coff_msb{$tower3a	= "\x01\x90"}	= "Tower/XP rel 3";
$coff_msb{$tower3b	= "\x01\x95"}	= "Tower/XP rel 3";
$coff_msb{$tower420	= "\x01\x98"}	= "Tower32/600/400 68020";
$coff_msb{$tower820	= "\x01\xA0"}	= "Tower32/800 68020";
$coff_msb{$tower810	= "\x01\xA5"}	= "Tower32/800 68010";
$F_RELFLG=	0x0001;
$F_EXEC=	0x0002;
$F_LNNO=	0x0004;
$F_LSYMS=	0x0008;
$F_MINMAL=	0x0010;
$F_UPDATE=	0x0020;
$F_SWABD=	0x0040;
$F_AR16WR=	0x0080;
$F_AR32WR=	0x0100;
$F_AR32W=	0x0200;
$F_PATCH=	0x0400;
$F_NODF=	0x0400;
$F_BM32RST=	0x1000;
$F_BM32ID=	0xE000;
$F_BM32B=	0x2000;
$F_BM32MAU=	0x4000;
$F_80186=	0x1000;
$F_80286=	0x2000;
$F_DYNLOAD=	0x1000;
$F_SHROBJ=	0x2000;
$F_tower_68881=	0x2000;
$F_tower_compat=0x4000;
$OMAGIC=	0x0107;
$NMAGIC=	0x0108;
$ZMAGIC=	0x010B;
$LIBMAGIC=	0x0123;
sub CoffFlags
{
local($f_flag, $f_magic) = @_;
local($ans)	= '';
local($flag);
local(@bits);
@bits = ( 'F_BM32RST'
, 'F_BM32B'
, 'F_BM32MAU'
)		if &isWE32($f_magic);
@bits = ( 'F_DYNLOAD'
, 'F_SHROBJ'
)		if &isR2($f_magic);
foreach $flag	( 'F_RELFLG'
, 'F_EXEC'
, 'F_LNNO'
, 'F_LSYMS'
, 'F_MINMAL'
, 'F_UPDATE'
, 'F_SWABD'
, 'F_AR16WR'
, 'F_AR32WR'
, 'F_AR32W'
, @bits
)
{
if($f_flag & eval "\$$flag")
{
$ans .= $flag . " ";
}
}
if($f_flag & $F_MINMAL)
{
$ans .= "F_NODF "	if($f_flag & $F_NODF);
}
else
{
$ans .= "F_PATCH "	if($f_flag & $F_PATCH);
}
chop $ans	if($ans ne '');
return $ans;
}
sub IsCoff
{
local($_)		= @_;
local($f_magic)		= substr($_,  0, 2);	# short
local($ans)		= 'COFF';
local($mach);		# machine type
local($file);		# file type
local($vers)		= '';		# file version
local($w, $W);
return ''		if $f_magic eq $N3BMAGIC
&& defined(&IsSccs)
&& &IsSccs(@_) ne '';
if(($mach = $coff_lsb{$f_magic}) ne '')
{
$ans .= ' LSB';
($w, $W) = ('v', 'V');
}
elsif(($mach = $coff_msb{$f_magic}) ne '')
{
$ans .= ' MSB';
($w, $W) = ('n', 'N');
}
else
{
return '';
}
if($coff_lsb{$f_magic}
&& $coff_msb{$f_magic})
{
return $ans . ' ambiguous!!';
}
local($f_nsyms)	= unpack("x12 $W", $_);	# long
local($f_opthdr)= unpack("x16 $w", $_);	# short
local($f_flags)	= unpack("x18 $w", $_);	# short
local($magic);
local($vstamp);
local($entry);
local($o_modtype);
if($f_opthdr > 0)
{
$magic	= unpack("x20 $w", $_);	# short
$vstamp	= unpack("x22 $w", $_);	# short
if(&isR2($f_magic))
{
$entry		= unpack("x36 $W", $_);
$o_modtype	= unpack("x68 A2", $_);
if($verbose_coff)
{
print "$path:\t";
printf("entry=0x%08x ", $entry);
printf("o_modtype='%s' ", $o_modtype);
print "\n";
}
}
}
if($verbose_coff)
{
print "$path:\t";
printf("magic=0x%04x ", $magic);
printf("f_flags=0x%04x: ", $f_flags);
print &CoffFlags($f_flags, $f_magic);
print "\n";
}
if($f_magic eq $WE32MAGIC && ($f_flags & $F_BM32B))
{
$mach = 'WE32100';
}
if($f_magic eq $MTVMAGIC  && ($f_flags & $F_BM32B))
{
$mach = 'WE32100(TV)';
}
if(&isWE32($f_magic))
{
$mach .= '+MAU'		if $f_flags & $F_BM32MAU;
}
if($f_magic eq $tower810
|| $f_magic eq $tower820)
{
$mach .= '+68881'	if $f_flags & $F_tower_68881;
$mach .= ' compatible'	if $f_flags & $F_tower_compat;
}
$ans .= ' ' . $mach;
$file = '';
if(&isWE32($f_magic))
{
$file = 'relocatable'	unless ($f_flags & $F_RELFLG);
}
else
{
$file = 'relocatable'	unless ($f_flags & $F_EXEC);
}
if($file eq '' && &isR2($f_magic))
{
$file = 'shared object'		if $entry == 0xFFFFFFFF;
}
if($file eq '')
{
$file = "$omagic executable"	if $magic == $OMAGIC;
$file = "$nmagic executable"	if $magic == $NMAGIC;
$file = "$zmagic executable"	if $magic == $ZMAGIC;
$file = "static shared library"	if $magic == $LIBMAGIC;
}
if($file ne '' && &isR2($f_magic))
{
local($mtype);
$mtype = 'S'		if $f_flags & $F_SHROBJ;
$mtype .= $o_modtype;
$file .= " Type $mtype"	if $mtype ne '';
}
$file = 'unknown type'			if($file eq '');
$ans .= ' ' . $file;
if($vstamp != 0)
{
$vers = $vstamp;
if($f_magic eq $MIPSEBMAGIC
|| $f_magic eq $MIPSELMAGIC
|| $f_magic eq $MIPSEBMAGIC_2
|| $f_magic eq $MIPSELMAGIC_2) {
$vers = &MmVer($vstamp);
}
}
$ans .= ' Version ' . $vers	if $vers ne '';
$ans .= ' not stripped'		if $f_nsyms != 0;
return $ans;
}
push(@BATTERY, 'IsSoff');
$soff_msb{$convexobj	= "\x00\x00\x01\x81"}	= "Convex";
$soff_msb{$convexcheck	= "\x00\x00\x01\x87"}	= "Convex";
%soff_lsb=();
$lfm_MASK	= 0x000f0000;
$lfm_c1		= 0x00000000;	# c1
$lfm_c2		= 0x00010000;	# c2
$lfm_c2mp	= 0x00020000;	# c2mp
$lfm_par	= 0x00040000;	# parallel
$lfm_int	= 0x00080000;	# intrinsic
$lf_posix	= 0x00000008;	# POSIX
$hfp_MASK	= 0x18000000;
$hfp_native	= 0x00000000;	# native fpmode
$hfp_ieee	= 0x10000000;	# ieee fpmode
$hfp_undef	= 0x18000000;	# undefined fpmode
$lf_paged	= 0x00000001;	# demand paged
$lf_swapped	= 0x00000002;	# pre-paged
$lf_impure	= 0x00000004;	# non-swapped
$hf_exe		= 0x80000000;	# executable
$hf_reloc	= 0x40000000;	# relocatable
$hf_stripped	= 0x20000000;	# stripped
sub IsSoff
{
local($_)		= @_;
local($f_magic)		= substr($_,  0, 4);	# short
local($ans)		= 'SOFF';
local($mach);		# machine type
local($file);		# file type
local($hiflags);
local($loflags);
if(($mach = $soff_lsb{$f_magic}) ne '')
{
$ans	.= ' LSB';
$hiflags= &LsbVal(substr($_, 88, 4));	# long
$loflags= &LsbVal(substr($_, 84, 4));	# long
}
elsif(($mach = $soff_msb{$f_magic}) ne '')
{
$ans	.= ' MSB';
$hiflags= &MsbVal(substr($_, 84, 4));	# long
$loflags= &MsbVal(substr($_, 88, 4));	# long
}
else
{
return '';
}
if($soff_lsb{$f_magic}
&& $soff_msb{$f_magic})
{
return $ans . ' ambiguous!!';
}
$ans .= ' ' . $mach;
$file = '';
local($bits);
$bits = $loflags & $lfm_MASK;
$file .= " c1"			if $bits == $lfm_c1;
$file .= " c2"			if $bits &  $lfm_c2;
$file .= " c2mp"		if $bits &  $lfm_c2mp;
$file .= " parallel"		if $bits &  $lfm_par;
$file .= " intrinsic"		if $bits &  $lfm_int;
$file .= " POSIX"		if $loflags & $lf_posix;
$bits = $hiflags & $hfp_MASK;
$file .= " native fpmode"	if $bits == $hfp_native;
$file .= " ieee fpmode"		if $bits == $hfp_ieee;
$file .= " undefined fpmode"	if $bits == $hfp_undef;
if($f_magic eq $convexcheck)
{
$file .= ' checkpoint';
}
elsif($f_magic eq $convexobj)
{
$file .= ' demand paged'if $loflags & $lf_paged;
$file .= ' pre-paged'	if $loflags & $lf_swapped;
$file .= ' non-swapped'	if $loflags & $lf_impure;
$file .= ' executable'	if $hiflags & $hf_exe;
$file .= ' relocatable'	if $hiflags & $hf_reloc;
}
else
{
$file .= ' unknown type';
}
$ans .= $file;
$ans .= ' not stripped'	if !($hiflags & $hf_stripped);
return $ans;
}
push(@BATTERY, 'IsPdp');
%pdp11_sys=
( "\x01\x01", "pdp11 lpd (UNIX/RT)"
, "\x05\x01", "pdp11 overlay"
, "\x1F\x01", "pdp11 kernel overlay, separate I&D"
);
%pdp11_exe=
( "\x07\x01", "pdp11 executable"
, "\x08\x01", "pdp11 pure executable"
, "\x09\x01", "pdp11 separate I&D executable"
);
%ultrix11=
( "\x18\x01", "Ultrix-11 overlay text kernel executable"
, "\x19\x01", "Ultrix-11 user overlay (separated I&D) executable"
, "\x28\x01", "Ultrix-11 overlay kernel executable"
, "\x29\x01", "Ultrix-11 overlay kernel (separated I&D) executable"
);
sub IsPdp
{
local($buf)	= @_;
local($bytes0_1)= substr($buf, 0, 2);
local($ans);
return ''		if defined(&IsBsd)
&& &IsBsd(@_) ne '';
if(($ans = $pdp11_sys{$bytes0_1}) ne '')
{
return $ans;
}
if(($ans = $pdp11_exe{$bytes0_1}) ne '')
{
local($a_syms)	= &LsbVal(substr($buf,  8, 2));
local($a_stamp)	= &LsbVal(substr($buf, 15, 1));
$ans .= ' version '.$a_stamp	if $a_stamp != 0;
$ans .= ' not stripped'		if $a_syms  != 0;
return $ans;
}
return ''		if $bytes0_1 eq "\x19\x01"
&& defined(&IsCoded)
&& &IsCoded(@_) ne '';
if(($ans = $ultrix11{$bytes0_1}) ne '')
{
return $ans;
}
'';
}
push(@BATTERY, 'IsAr');
%ar_4=
( "\x00\x00\xFF\x6D", 'obsolete ar archive'
, "\x00\x00\xFF\x65", 'old archive'
, "\x00\x00\xFF\x66", '68020 old archive'
);
%ar_2=
( "\x6D\xFF", 'very old PDP-11 archive'
, "\x65\xFF", 'xenix ar archive'
, "\xF0\x0D", 'Borland C/C++ archive'
);
sub IsAr
{
local($_)	= @_;
local($*)	= 1;
local($ans);
local($bytes0_1)	= substr($_, 0, 2);	# short
local($bytes0_3)	= substr($_, 0, 4);	# long
if(/^<ar>/)
{
return 'System V Release 1 ar archive';
}
if(/^!<arch>\n__.SYMDEF/)
{
return 'ar archive - randomized';
}
if(/^!<arch>\n__________E([BL])([EU])([BL])([_X])/)
{
local($hashb, $memt, $memb, $status) = ($1, $2, $3, $4);
$ans 	= ($hashb eq 'B' ? 'MSB' : 'LSB')
. ' MIPS ar archive of '
. ($memb  eq 'B' ? 'MSB' : 'LSB')
. ' '
. ($memt  eq 'E' ? 'mips' : 'ucode')
. ' objects';
$ans .= ' - out of date'	if $status eq 'X';
return $ans;
}
if(/^!<arch>\n/)
{
return 'ar archive';
}
if(/^<aiaff>\n/)
{
return 'AIX3.1 ar archive';
}
return $ans	if ($ans = $ar_4{$bytes0_3}) ne '';
if(($ans = $ar_2{$bytes0_1}) ne '')
{
$ans .= ' - randomized'	if /^..__\.SYMDEF/;
return $ans;
}
'';
}
push(@BATTERY, 'IsCpio');
sub IsCpio
{
return 'MSB cpio archive'   if &BufMatch($_[0], 0, "\x71\xC7");
return 'LSB cpio archive'   if &BufMatch($_[0], 0, "\xC7\x71");
return 'ASCII cpio archive' if &BufMatch($_[0], 0, '070707');
return '';
}
push(@BATTERY, 'IsTar');
sub IsTar
{
local($_) = @_;
length == 512				|| return '';
local($chksum) = substr($_,148,8);
substr($_,148,8) = ' ' x 8;
$chksum =~ /^\s*[0-7][0-7]*[\s\000]*$/	|| return '';
local($recsum) = oct($chksum);
local($sum) = unpack("%32C".length($_), $_);
$recsum == $sum				|| return '';
local($magic)  = substr($_,257,8);
return 'POSIX tar archive'	if $magic eq "ustar\000"."00";
return 'POSIX? tar archive'	if $magic eq "ustar  \000";
return 'tar archive';
}
push(@BATTERY, 'IsZoo');
sub IsZoo
{
local($_) = @_;
substr($_, 20, 4) eq "\xDC\xA7\xC4\xFD"	|| return '';
local(@ver) = unpack("C2", substr($_,32,2));
/^ZOO\s([^\s]*)\s/;
return  "zoo "
. $1
. " archive data (updatable by zoo "
. sprintf("%d.%02d)", $ver[0], $ver[1]);
}
push(@BATTERY, 'IsCoded');
%coded_2=
(	"\x1F\x1F", 'old pack data'
,	"\x1F\x9E", 'freeze (v1.0) data'
,	"\x1F\x9F", 'freeze (v2.1) data'
,	"\xCB\x05", 'huf output'
,	"\xFF\x1F", 'compact data'
);
sub IsCoded
{
local($_)		= @_;
local($ans);
local(@bytes)		= unpack("C".length($_), $_);
local($bytes0_1)	= substr($_, 0, 2);	# short
local($bytes0_3)	= substr($_, 0, 4);	# long
local($bytes0_4)	= substr($_, 0, 5);
if($bytes0_1 eq "\x1F\x9D")	# compressed data
{
$ans = 'compress ';
$ans .= ($bytes[2] & 0x7F) . '-bit';
$ans .= ($bytes[2] & 0x80) ? ' block' : ' non-block';
return $ans . ' compressed data';
}
if($bytes0_1 eq "\x1F\x1E")	# packed data
{
$ans = 'pack data';
$ans .= ' (originally '.unpack ("x2 N", $_).' bytes)';
return $ans;
}
if($bytes0_3 eq "\x17\x08\x01\x10")
{
local($n) = 4;
return  'whap -m'
. substr($_,$n+1,$bytes[$n])
. ' data';
}
if($bytes0_4 eq "\x19\x01\x02\x02\x01")
{
local($n) = 5;
return  'yabba -m'
. substr($_,$n+1,$bytes[$n])
. ' data';
}
if($bytes0_3 eq "\x50\x4B\x03\x04")
{
local($ver) = unpack("x4 C", $_);
return  'zip (v'
. $ver/10
. '.'
. $ver%10
. ') data';
}
return $ans	if ($ans = $coded_2{$bytes0_1}) ne '';
return '';
}
push(@BATTERY, 'IsSccs');
sub IsSccs
{
if($_[0] =~ m:^\001h\d{5}\n\001s \d{5}/\d{5}/\d{5}\n:)
{
return 'SCCS archive data';
}
return '';
}
push(@BATTERY, 'IsAix');
%aix2_msb=
( $aix2obj    = "\x01\x03", "AIX2 RT object"
,		"\x01\x04", "AIX shared library"
,		"\x01\x05", "AIX ctab data"
,		"\xFE\x04", "AIX structured file"
);
sub IsAix
{
local($_)	= @_;
local($bytes0_1)= substr($_, 0, 2);
local($ans);
return 'AIX message catalog'
if &BufMatch($_, 0, "\xAB\xCD\xEF");
if($bytes0_1 eq $aix2obj)
{
return ''	if defined(&IsSun)
&& &IsSun(@_) ne '';
}
if(($ans = $aix2_msb{$bytes0_1}) ne '')
{
return $ans	if $bytes0_1 ne $aix2obj;
local($type) = &MsbVal(substr($_,  2, 1));
local($vers) = &MsbVal(substr($_,  6, 2));
local($syms) = &MsbVal(substr($_, 28, 4));
$ans .= ' pure'			if $type == 0x50;
$ans .= ' version '.$vers	if $vers != 0;
$ans .= ' not stripped'		if $syms != 0;
return $ans;
}
return '';
}
push(@BATTERY, 'IsXout');
push(@BATTERY, 'IsXoutRel');
$X_MAGIC_LSB=	"\x06\x02";
$X_MAGIC_MSB=	"\x02\x06";
$XC_BSWAP=	0x80;
$XC_WSWAP=	0x40;
$XC_CPU=	0x3f;
%x_cpu =
( ($XC_PDP11=	'0x01')	,'pdp11'
, ($XC_23=	'0x02')	,'23fixed from pdp11'
, ($XC_Z8K=	'0x03')	,'Z8000'
, ($XC_8086=	'0x04')	,'8086'
, ($XC_68K=	'0x05')	,'M68000'
, ($XC_Z80=	'0x06')	,'Z80'
, ($XC_VAX=	'0x07')	,'VAX 780/750'
, ($XC_16032=	'0x08')	,'NS16032'
, ($XC_286=	'0x09')	,'80286'
, ($XC_286V=	'0x29')	,'80286'	# use xe_osver for version
, ($XC_386=	'0x0a')	,'80386'
, ($XC_186=	'0x0b')	,'80186'
);
$XE_V2=		0x4000;
$XE_V3=		0x8000;
$XE_V5=		0xc000;
$XE_VERS=	0xc000;
$XE_res1=	0x2000;
$XE_res2=	0x1000;
$XE_SEG=	0x0800;
$XE_ABS=	0x0400;
$XE_ITER=	0x0200;
$XE_VMOD=	0x0100;
$XE_FPH=	0x0080;
$XE_LTEXT=	0x0040;
$XE_LDATA=	0x0020;
$XE_OVER=	0x0010;
$XE_FS=		0x0008;
$XE_PURE=	0x0004;
$XE_SEP=	0x0002;
$XE_EXEC=	0x0001;
$xe_mod_mask	= $XE_LTEXT | $XE_LDATA;
$xe_mod_s	= 0;
$xe_mod_m	= $XE_LTEXT;
$xe_mod_l	= $XE_LTEXT | $XE_LDATA;
sub x_renv
{
local($x_renv) = @_;
local($ans)	= '';
local($flag);
foreach $flag	( 'XE_V2'
, 'XE_V3'
, 'XE_V5'
)
{
if(($x_renv & $XE_VERS) == eval "\$$flag")
{
$ans .= $flag . " ";
}
}
foreach $flag	( 'XE_res1'
, 'XE_res2'
, 'XE_SEG'
, 'XE_ABS'
, 'XE_ITER'
, 'XE_VMOD'
, 'XE_FPH'
, 'XE_LTEXT'
, 'XE_LDATA'
, 'XE_OVER'
, 'XE_FS'
, 'XE_PURE'
, 'XE_SEP'
, 'XE_EXEC'
)
{
if($x_renv & eval "\$$flag")
{
$ans .= $flag . " ";
}
}
chop $ans	if($ans ne '');
return $ans;
}
%xs_type =
(($XS_TNULL=	0)	,'unused segment'
,($XS_TTEXT=	1)	,'text segment'
,($XS_TDATA=	2)	,'data segment'
,($XS_TSYMS=	3)	,'symbol table segment'
,($XS_TREL=	4)	,'relocation segment'
,($XS_TSESTR=	5)	,"segment table's string table segment"
,($XS_TGRPS=	6)	,'group definitions segment'
,($XS_TIDATA=	64)	,'iterated data'
,($XS_TTSS=	65)	,'tss'
,($XS_TLFIX=	66)	,'lodfix'
,($XS_TDNAME=	67)	,'descriptor names'
,($XS_TDTEXT=	68)	,'debug text segment'
,($XS_TDFIX=	69)	,'debug relocation'
,($XS_TOVTAB=	70)	,'overlay table'
,($XS_TSYSTR=	72)	,'symbol string table'
);
$XS_AMEM=	0x8000;
$XS_AMASK=	0x7fff;
$XS_AITER=	0x0001;
$XS_AHUGE=	0x0002;
$XS_ABSS=	0x0004;
$XS_APURE=	0x0008;
$XS_AEDOWN=	0x0010;
$XS_APRIV=	0x0020;
$XS_A32BIT=	0x0040;
$XS_S5BELL=	0;
$XS_SXSEG=	1;
$XS_SISLAND=	2;
$XS_RXSEG=	1;
$XS_R86SEG=	2;
sub xs_attr
{
local($xs_type, $xs_attr) = @_;
local($ans)	= '';
local($flag);
local(@bits);	# additional bits to try
local(@vals);	# additional values to try
if($xs_type == $XS_TTEXT || $xs_type == $XS_TDATA)
{
@bits =	('XS_AITER'
,'XS_AHUGE'
,'XS_ABSS'
,'XS_APURE'
,'XS_AEDOWN'
,'XS_APRIV'
,'XS_A32BIT'
);
}
elsif($xs_type == $XS_TSYMS)
{
@vals =	( 'XS_S5BELL'
, 'XS_SXSEG'
, 'XS_SISLAND'
);
}
elsif($xs_type == $XS_TREL)
{
@vals =	( 'XS_RXSEG'
, 'XS_R86SEG'
);
}
foreach ( 'XS_AMEM'
, @bits
)
{
if(eval "\$$_" & $xs_attr)
{
$ans .= $_ . " ";
}
}
foreach ( @vals
)
{
if(eval "\$$_" == ($xs_attr & $XS_AMASK))
{
$ans .= $_ . " ";
}
}
chop $ans	if($ans ne '');
return $ans;
}
sub XoutSegRec
{
local($buf,$ans);
read(FILE, $buf, 32) == 32	|| return '';
local	( $xs_type
, $xs_attr
, $xs_seg
, $xs_align
, $xs_cres
, $xs_filpos
, $xs_psize
, $xs_vsize
, $xs_rbase
, $xs_noff
, $xs_sres
, $xs_lres) = unpack("${w}3 C2 ${W}4 ${w}2 ${W}", $buf);
$ans .= "xs_type   = $xs_type: $xs_type{$xs_type}\n";
$ans .= "xs_attr   = "
.sprintf("0x%04x", $xs_attr)
.": "
.&xs_attr($xs_type,$xs_attr)
."\n";
$ans .= "xs_seg    = $xs_seg\n";
$ans .= "xs_filpos = $xs_filpos\n";
$ans .= "xs_psize  = $xs_psize\n";
$ans .= "xs_vsize  = $xs_vsize\n";
}
sub XoutSegTbl	# offset, size
{
local($offs, $size) = @_;
local($ans);
$size % 32 == 0			|| return '';
seek(FILE,$offs,0);
for(1 .. $size/32)
{
$ans .= &XoutSegRec;
}
$ans;
}
sub IsXout
{
local($x_magic)		= substr($_,  0, 2);	# short
return ''		if $x_magic ne $X_MAGIC_LSB
&& $x_magic ne $X_MAGIC_MSB;
local($ans)		= 'x.out ';
local($w, $W);
if ($x_magic eq $X_MAGIC_LSB)
{
$ans .= 'LSB';
($w, $W)	= ('v', 'V');
}
else
{
$ans .= 'MSB';
($w, $W)	= ('n', 'N');
}
local($x_ext)	= unpack("x2  $w", $_);
local($x_text)	= unpack("x4  $W", $_);
local($x_data)	= unpack("x8  $W", $_);
local($x_bss)	= unpack("x12 $W", $_);
local($x_syms)	= unpack("x16 $W", $_);
local($x_reloc)	= unpack("x20 $W", $_);
local($x_entry)	= unpack("x24 $W", $_);
local($x_cpu)	= unpack("x28 C",  $_);
local($x_relsym)= unpack("x29 C",  $_);
local($x_renv)	= unpack("x30 $w", $_);
if($verbose_xout || $verbose_XOUT)
{
print "$path:\n";
print "x_ext    = $x_ext\n";
print "x_text   = $x_text\n";
print "x_data   = $x_data\n";
print "x_bss    = $x_bss\n";
print "x_syms   = $x_syms\n";
print "x_reloc  = $x_reloc\n";
print "x_entry  = $x_entry\n";
printf "x_cpu    = 0x%02x\n", $x_cpu;
printf "x_relsym = 0x%02x\n", $x_relsym;
printf "x_renv   = 0x%04x", $x_renv;
if($verbose_XOUT)
{
print " == " . &x_renv($x_renv);
}
print "\n";
}
if(($x_cpu & ~$XC_CPU) == $XC_WSWAP)
{
warn "IsXout: expected LSB x_cpu value"
if $x_magic ne $X_MAGIC_LSB;
}
elsif(($x_cpu & ~$XC_CPU) == $XC_BSWAP)
{
warn "IsXout: expected MSB x_cpu value"
if $x_magic ne $X_MAGIC_MSB;
}
else
{
warn "IsXout: unexpected x_cpu value";
}
return $ans . ' Corrupted?'	if($x_ext != 44);
local($xe_stksize)	= unpack("x48 $W", $_);
local($xe_segpos)	= unpack("x52 $W", $_);
local($xe_segsize)	= unpack("x56 $W", $_);
local($xe_mdtpos)	= unpack("x60 $W", $_);
local($xe_mdtsize)	= unpack("x64 $W", $_);
local($xe_mdttype)	= unpack("x68 C", $_);
local($xe_pagesize)	= unpack("x69 C", $_);
local($xe_ostype)	= unpack("x70 C", $_);
local($xe_osvers)	= unpack("x71 C", $_);
local($xe_eseg)		= unpack("x72 $w", $_);
local($xe_sres)		= unpack("x74 $w", $_);
if($verbose_xout || $verbose_XOUT)
{
print "xe_stksize  = $xe_stksize\n";
print "xe_segpos   = $xe_segpos\n";
print "xe_segsize  = $xe_segsize\n";
print "xe_mdtpos   = $xe_mdtpos\n";
print "xe_mdtsize  = $xe_mdtsize\n";
print "xe_mdttype  = $xe_mdttype\n";
print "xe_pagesize = $xe_pagesize\n";
print "xe_ostype   = $xe_ostype\n";
print "xe_osvers   = $xe_osvers\n";
print "xe_eseg     = $xe_eseg\n";
print "xe_sres     = $xe_sres\n";
if($verbose_XOUT && ($x_renv & $XE_SEG))
{
print &XoutSegTbl($xe_segpos, $xe_segsize);
}
}
local($acpu);		# cpu type
local($cpu)		= sprintf("0x%02x", $x_cpu & $XC_CPU);
if(($acpu = $x_cpu{$cpu}) eq '')
{
$acpu = '(UNKNOWN CPU '.$cpu.')';
}
$ans .= ' ' . $acpu;
$ans .= ' standalone'			if $x_renv & $XE_ABS;
local($model);		# file model
local($tmp)		= $x_renv & $xe_mod_mask;
$model	= 'small model'			if $tmp == $xe_mod_s;
$model	= 'middle model'		if $tmp == $xe_mod_m;
$model	= 'large model'			if $tmp == $xe_mod_l;
$model = '(unknown model)'		if($model eq '');
$ans .= ' ' . $model;
$ans .= ' segmented'			if $x_renv & $XE_SEG;
local($file);		# file type
$file = 'executable'			if $x_renv & $XE_EXEC;
$file = '(unknown type)'		if($file eq '');
$ans .= ' ' . $file;
$ans .= ' not stripped'		if $x_syms != 0;
return $ans;
}
sub XoutRelRec
{
local($hdr,$buf);
read(FILE, $hdr, 3) == 3	|| return '';
local($type, $length) = unpack("C v", $hdr);
read(FILE, $buf, $length)	|| return '';
0 == unpack("%8C*", $hdr.$buf)	|| return '';
chop($buf);
$buf =~ s/[^\x20-\x7E]/sprintf("\\x%02x",unpack("C",$&))/eg;
local($desc);
xrdesc:	{
$desc = 'MTHEADR', last xrdesc if $type == 0x80;
$desc = 'MCOMENT', last xrdesc if $type == 0x88;
$desc = 'MMODEND', last xrdesc if $type == 0x8a;
$desc = 'MEXTDEF', last xrdesc if $type == 0x8c;
$desc = 'MPUBDEF', last xrdesc if $type == 0x90;
$desc = 'MLNAMES', last xrdesc if $type == 0x96;
$desc = 'MSEGDEF', last xrdesc if $type == 0x98;
$desc = 'MGRPDEF', last xrdesc if $type == 0x9a;
$desc = 'MFIXUPP', last xrdesc if $type == 0x9c;
$desc = 'MLEDATA', last xrdesc if $type == 0xa0;
$desc = sprintf("0x%02x", $type);
}
sprintf("%-7s %s\n", $desc, $buf);
}
sub XoutRelHdr
{
local($ans, $rec);
seek(FILE,0,0);
$ans .= $rec	while ($rec = &XoutRelRec) ne ''
&& ($rec =~ /^MTHEADR/ ||
$rec =~ /^MCOMENT/);
$ans;
}
sub XoutRelDesc
{
local($ans, $rec);
seek(FILE,0,0);
$ans .= $rec	while ($rec = &XoutRelRec) ne '';
$ans;
}
sub IsXoutRel
{
return ''	if substr($_, 0, 1) ne "\x80";
local($h) = &XoutRelHdr;
return ''	if $h eq '';
if($verbose_xout)
{
print "$path:\n";
print $h;
}
if($verbose_XOUT)
{
print "$path:\n";
print &XoutRelDesc;
}
local($*) = 1;
local($ans) = 'x.out LSB';
$ans .= ' 8086'		if $h =~ /^MCOMENT .x00.x9d0[lms].*$/;
$ans .= ' 80286'	if $h =~ /^MCOMENT .x00.x9d[lms].*$/;
$ans .= ' large model'	if $h =~ /^MCOMENT .x00.x9d.*l.*$/;
$ans .= ' middle model'	if $h =~ /^MCOMENT .x00.x9d.*m.*$/;
$ans .= ' small model'	if $h =~ /^MCOMENT .x00.x9d.*s.*$/;
$ans .= ' optimized'	if $h =~ /^MCOMENT .x00.x9d.*O.*$/;
$ans .= ' relocatable';
}
push(@BATTERY, 'IsDos');
sub IsDos
{
local($_)	= @_;
local($byte0)   = substr($_, 0, 1);
local($byte1)   = substr($_, 1, 1);
local($bytes0_1)= substr($_, 0, 2);
local($ans);
return 'DOS executable (EXE)'		if $bytes0_1 eq 'MZ';
return 'DOS executable (built-in)'	if $bytes0_1 eq 'LZ';
return 'DOS executable (COM)'		if $byte0 eq "\xE9";
if($byte0 eq "\xEB")
{
return ''	if defined(&IsBsd)
&& &IsBsd(@_) ne '';
return 'DOS executable (COM)';
}
if($byte0 eq "\x1A")
{
return ''	if defined(&IsKnown)
&& &IsKnown(@_) ne '';
$ans = 'arc archive data';
$ans .= ' (empty)'	if $byte1 eq "\x00";
$ans .= ' (old format)'	if $byte1 eq "\x01";
return $ans;
}
return '';
}
push(@BATTERY, 'IsAudio');
%snd_format=
( 0	,'unspecified'
, 1	,'mulaw 8-bit'
, 2	,'linear PCM 8-bit'
, 3	,'linear PCM 16-bit'
, 4	,'linear PCM 24-bit'
, 5	,'linear PCM 32-bit'
, 6	,'float'
, 7	,'double'
, 8	,'indirect'
, 9	,'nested'
, 10	,'DSP code'
, 11	,'DSP data 8-bit'
, 12	,'DSP data 16-bit'
, 13	,'DSP data 24-bit'
, 14	,'DSP data 32-bit'
, 16	,'display'
, 17	,'mulaw squelch'
, 18	,'emphasized'
, 19	,'compressed'
, 20	,'compressed emphasized'
, 21	,'DSP commands'
, 22	,'DSP commands samples'
);
sub IsAudio
{
local($ans);
if(/^\.snd/ || /^dns\./)
{
local($fmt);
local($L);
if (/^\.snd/)
{
$ans = 'MSB';
$L = 'N';
}
else
{
$ans = 'LSB';
$L = 'V';
}
local	( $format
, $rate
, $numchan
) = unpack("x12 ${L}3", $_);
$fmt = $snd_format{$format};
$fmt = 'format '.$format	if $fmt eq '';
$ans .= " audio data: $fmt, $rate Hz, $numchan channel";
return $ans;
}
$ans;
}
push(@BATTERY, 'IsVideo');
%ras_type =
( 0,	'old'
, 1,	'standard'
, 2,	'run-length byte encoded'
, 3,	'RGB'
, 4,	'TIFF'
, 5,	'IFF'
, 0xffff,'experimental'
);
%ras_maptype =
( 0,	'no'
, 1,	'RGB'
, 2,	'raw'
);
%colormap=
( 0,	'normal'
, 1,	'dithered'
, 2,	'screen'
, 3,	'colormap'
);
%itype=
( 0x0000,	'verbatim'
, 0x0100,	'rle'
);
sub IsVideo
{
local($ans)	= '';
local($ret);
local($bytes0_2)	= substr($_, 0, 3);
if(eval "/^\x59\xA6\x6A\x95/")
{
local   ( $width
, $height
, $depth
, $ras_length
, $type
, $maptype
, $ras_maplength) = unpack('x4 N7', $_);
$ans = "Sun rasterfile data, ${width}x${height}x${depth}";
if(($ret = $ras_type{$type}) eq '')
{
$ret = "format $type";
}
$ans .= " $ret image";
if($maptype == 0)
{
$ret = '';
}
elsif(($ret = $ras_maptype{$maptype}) eq '')
{
$ret = "colormap $maptype";
}
else
{
$ret .= ' colormap';
}
$ans .= ', '. $ret	if $ret ne '';
return $ans;
}
if(eval "/^\x01\xDA/")
{
local	($type
,$dim
,$xsize
,$ysize
,$zsize
,$name
,$colormap
) = unpack('x2 n5 x4x4x4 A80 N', $_);
local($storage)	= $type & 0xFF00;
$ans = "SGI ${xsize}x${ysize}x${zsize}";
$ans .= "(Hmmm. dim = $dim)"	if $dim != $zsize;
if(($ret = $itype{$storage}) eq '')
{
$ret = "storage $storage";
}
$ans .= " $ret";
if(($ret = $colormap{$colormap}) eq '')
{
$ret = "type $storage";
}
$ans .= " $ret imagelib data";
$name =~ s/^\s+//;
$name =~ s/\s+$//;
$ans .= " named '$name'"	if $name ne '';
return $ans;
}
if(/^GIF87a/ || /^GIF89a/)
{
local	($version
,$width
,$height
,$flags) = unpack('x3 A3 v v C', $_);
local	($pixel)=  ($flags & 0x07)+1;
local	($cr)	= (($flags & 0x70)>>4)+1;
local	($depth)= 2 ** $pixel;
local	($cdepth)= 2 ** $cr;
$ans = "GIF($version)";
$ans .= " ${width}x${height}x${pixel}x${cr}";
$ans .= " image data";
return $ans;
}
return 'LSB Tiff 5.0 image data'
if $bytes0_2 eq 'II*';
return 'MSB Tiff 5.0 image data'
if $bytes0_2 eq 'MM*';
$ans;
}
push(@BATTERY, 'IsKnown');
%known_2=
( "\x01\x1E", 'MSB Berkeley vfont data'
, "\x1E\x01", 'LSB Berkeley vfont data'
, "\x40\xEF", 'very old (C/A/T) troff output data'
, "\x01\x61", 'MSB mc88100 DGUX executable'
, "\x01\x6D", 'MSB mc88100 executable'
, "\x49\x50", 'MSB CVL format picture'
, "\x50\x49", 'LSB CVL format picture'
, "\x00\xA8", 'VAX/VMS executable'
, "\x01\x1B", 'MSB curses screen image data (type B)'
, "\x1B\x01", 'LSB curses screen image data (type B)'
, "\x01\x1C", 'MSB curses screen image data (type C)'
, "\x1C\x01", 'LSB curses screen image data (type C)'
);
%known_4=
( "\x00\x00\x81\x6C", 'MSB APL workspace'
, "\x6C\x81\x00\x00", 'LSB APL workspace'
, "\x00\x00\x6D\x83", 'PDP-11 single precision APL workspace'
, "\x00\x00\x6C\x83", 'PDP-11 double precision APL workspace'
, "\x6F\x83\x00\x00", 'VAX single precision APL workspace'
, "\x6E\x83\x00\x00", 'VAX double precision APL workspace'
, "\x00\x00\x7A\xB7", 'Mirage Assembler m.out executable WHERE IS THIS?'
, "\x01\x01\x01\x01", 'MMDF mailbox'
, "\x00\x12\xD6\x87", 'MSB X image'
, "\x87\xD6\x12\x00", 'LSB X image'
);
%known_3=
( "\x1B\x63\x1B", 'LN03 printer data'
, "\xFF\xFF\x7F", 'ddis/ddif document'
, "\xFF\xFF\x7E", 'ddis/dtif table data'
, "\xFF\xFF\x7C", 'ddis/dots archive'
);
sub IsKnown
{
local($ans);
local($bytes0_1)	= substr($_, 0, 2);
local($bytes0_2)	= substr($_, 0, 3);
local($bytes0_3)	= substr($_, 0, 4);
if(&BufMatch($_, 0, 'Rast'))
{
$ans = 'RST-format raster font data';
local($str) = &BufString($_, 45);
$ans .= ' - face '. $str	if $str ne '';
return $ans;
}
if($bytes0_1 eq "\x1A\x01")
{
$ans = 'terminfo data';
local($str) = &BufString($_, 12);
chop($str)	if $str =~ /\|$/;
$str =~ s/.*\|//;
$ans .= ' for ' . $str	if($str ne '');
return $ans;
}
if($_ =~ /^\x8A*\xF7([\x02\x03])/)
{
local($_) = $';
local($vers)		= unpack('C', $1);
local($id_len)		= &MsbVal(substr($_, 12, 1));
local($id_string)	= substr($_, 13, $id_len);
$ans = "TeX DVI Version $vers data";
$ans .= $1	if $id_string =~ /^ TeX output( .*)/;
return $ans;
}
return 'Xerox InterPress data'
if &BufMatch($_, 0, 'Interpress/Xerox');
if($bytes0_1 eq "\xAA\xAA")
{
$ans = 'SoftQuad DESC or font file binary';
local($vers) = &MsbVal(substr($_, 2, 2));
$ans .= " - version $vers"	if($vers != 0);
}
return 'MSB X11 SNF (Server Natural Font) data - version 4'
if(&BufMatch($_,   0, "\x00\x00\x00\x04")
&& &BufMatch($_, 104, "\x00\x00\x00\x04"));
return 'LSB X11 SNF (Server Natural Font) data - version 4'
if(&BufMatch($_,   0, "\x04\x00\x00\x00")
&& &BufMatch($_, 104, "\x04\x00\x00\x00"));
local($bytes24_27) = substr($_, 24, 4);
return 'MSB dump format, 4.1 BSD or earlier'
if($bytes24_27 eq "\x00\x00\xEA\x6B");
return 'MSB dump format, 4.2 or 4.3 BSD without IDC'
if($bytes24_27 eq "\x00\x00\xEA\x6C");
return 'MSB dump format'
if($bytes24_27 eq "\x00\x00\xEA\x6D");
return 'LSB dump format, 4.1 BSD or earlier'
if($bytes24_27 eq "\x6B\xEA\x00\x00");
return 'LSB dump format, 4.2 or 4.3 BSD without IDC'
if($bytes24_27 eq "\x6C\xEA\x00\x00");
return 'LSB dump format'
if($bytes24_27 eq "\x6D\xEA\x00\x00");
return "FrameMaker $1 document"	if /^<MakerFile (\d+\.\d+)>/;
return 'FrameMaker MIF file'	if /^<MIFFile/;
return 'FrameMaker MML file'	if /^<MML/;
return "Interleaf $1 ASCII document"
if /^<!OPS, Version (\d+\.\d+)>/;
return 'SunWrite document'
if &BufMatch($_,  3, 'pgscriptver');
return 'SunDraw document'
if &BufMatch($_, 10, 'sundraw');
if (/^GKSM/)
{
return 'SunGKS Metafile'
if &BufMatch($_, 24, 'SunGKS');
return 'GKS Metafile';
}
return 'clear text Computer Graphics Metafile'
if /^BEGMF/;
return 'character Computer Graphics Metafile'
if /^0 /;
return 'binary Computer Graphics Metafile'
if (&MsbVal($bytes0_1) & 0xFFE0) == 0x0020;
return 'PHIGS clear text archive'
if /^ARF_BEGARF/;
if (/^@\(#\)SunPHIGS/)
{
$ans = 'SunPHIGS';
$ans .= ' binary'	if &BufMatch($_, 40, 'SunBin');
$ans .= ' archive'	if &BufMatch($_, 32, 'archive');
return $ans;
}
return 'NeWS bitmap font'
if &BufMatch($_, 0, "\x13\x7A\x29\x44");
return 'NeWS font family'
if &BufMatch($_, 0, "\x13\x7A\x29\x47");
return 'scalable OpenFont binary'
if &BufMatch($_, 0, "\x13\x7A\x29\x50");
return 'encrypted scalable OpenFont binary'
if &BufMatch($_, 0, "\x13\x7A\x29\x51");
return 'X11/NeWS bitmap font'
if &BufMatch($_, 8, "\x13\x7A\x2B\x45");
return 'X11/NeWS font family'
if &BufMatch($_, 8, "\x13\x7A\x2B\x48");
if(/^KiLo/ || /^oLiK/)
{
local($fmt);
local($BtoI);
if (/^KiLo/)
{
$BtoI = 'MsbVal';
$ans = 'MSB';
}
else
{
$BtoI = 'LsbVal';
$ans = 'LSB';
}
local($entries)	= &$BtoI(substr($_, 16, 4));
$ans .= " nn compiled kill file with $entries entries";
return $ans;
}
if($bytes0_3 eq "\xFF\xFF\x00\x00")
{
local($ty,$ve) = unpack("x4 C C", $_);
return "PRIMOS executable type $ty version $ve";
}
return $ans	if ($ans = $known_4{$bytes0_3}) ne '';
return $ans	if ($ans = $known_3{$bytes0_2}) ne '';
return $ans	if ($ans = $known_2{$bytes0_1}) ne '';
return '';
}
push(@BATTERY, 'IsLint');
sub IsLint
{
local($_)	= @_;
local($*)	= 1;
return 'LSB lint library data'
if substr($_, 0, 8) eq "\x00\x02\x00\x00\x00\x00\x00\x00";
return 'MSB lint library data'
if substr($_, 0, 8) eq "\x02\x00\x00\x00\x00\x00\x00\x00";
return 'BSD lint library data (Metaware High C?)'
if substr($_, 0, 6) eq "\x02\x00\x00\x00\x10\x02";
return 'BSD lint library data (gcc?)'
if substr($_, 0, 4) eq "\x02\x00\x00\x04";
return 'AIX3.1 lint library data'
if substr($_, 0, 6) eq "\x01llib-";
'';
}
push(@BATTERY, 'IsCore');
%core_2=
(
);
%core_4=
( "\x00\x01\x12\x57", "MSB Convex core data"
, "\x00\x00\x01\x85", "MSB Convex SOFF core data"
);
sub IsCore
{
local($bytes0_1)	= substr($_, 0, 2);
local($bytes0_3)	= substr($_, 0, 4);
local($ans);
if($bytes0_3 eq "\x00\x08\x04\x56")
{
local($c_len)	= unpack('x4 N', $_);
local($x_aouthdr, $c_aouthdr);
local($x_signo,	  $c_signo);
local($x_cmdname, $c_cmdname);
if($c_len == 826)
{
$x_aouthdr = 80;
$x_signo   = 112;
$x_cmdname = 128;
}
elsif($c_len == 432)
{
$x_aouthdr = 84;
$x_signo   = 116;
$x_cmdname = 132;
}
else
{
return 'MSB SunOS core (DETAILS UNKNOWN)';
}
$c_aouthdr = unpack("x$x_aouthdr a32", $_);
$c_signo   = unpack("x$x_signo   N",   $_);
$c_cmdname = unpack("x$x_cmdname A17", $_);
$ans = 'SunOS';
$ans .= " signal $c_signo"	if $c_signo != 0;
$ans .= ' core';
$ans .= " of $c_cmdname"	if $c_cmdname ne '';
if(defined(&IsSun))
{
local($_) = $c_aouthdr;
$ans .= ': ' . &IsSun;
}
return $ans;
}
if($bytes0_3 eq "\xDE\xAD\xAD\xB0")
{
local	($version
,$sigcause) = unpack('x4 N x4x4x80x80 N', $_);
local	($args)	= &BufString($_, 96);
$args =~ s/\s+$//;
$ans = 'IRIX';
$ans .= ' format ' . $version;
$ans .= ' signal ' . $sigcause;
$ans .=	' core' . " of '$args'";
return $ans;
}
return '[Darwin] core dump data (WHERE WAS THIS FOUND?)'
if(&BufMatch($_, 22, "\x26\x00")
|| &BufMatch($_, 22, "\x00\x26"));
return $ans	if(($ans = $core_4{$bytes0_3}) ne '');
return $ans	if(($ans = $core_2{$bytes0_1}) ne '');
'';
}
sub DoStat
{
local($path)	= @_;
local	($dev	,$ino	,$mode	,$nlink	,$uid	,$gid	,$rdev
,$size	,$atime	,$mtime	,$ctime	,$blksize,$blocks)
= lstat $path;
return ('', 'symbolic link to ' . readlink)	if -l $path;
return ('', 'No such file or directory')	unless -e _;
local($p)	= '';	# prefix
if(-u _) {
local(@pwuid) = getpwuid($uid);
$p .= 'setuid '.($pwuid[0] || $uid).' ';
}
if(-g _) {
local(@grgid) = getgrgid($gid);
$p .= 'setgid '.($grgid[0] || $gid).' ';
}
if(-k _) {
$p .= 'sticky ';
}
return ($p, 'directory')			if -d _;
return ($p, 'character special '.&MmDev($rdev))	if -c _;
return ($p, 'block special '    .&MmDev($rdev))	if -b _;
return ($p, 'fifo (named pipe)')		if -p _;
return ($p, 'socket')				if -S _;
die "$0: internal error"			unless -f _;
return ($p, 'empty')				if -z _;
if(! -r _)
{
$p .= 'writeable, '			if $mode & 0002;
$p .= 'executable, '			if $mode & 0111;
return ($p, "can't read");
}
($p, '',   $mtime, $atime);
}
$text_c    = 'c program text';
$text_fort = 'fortran program text';
$text_make = 'make commands text';
$text_pl1  = 'pl/1 program text';
$text_as   = 'asembler program text';
$text_eng  = 'English text';
$text_pas  = 'pascal program text';
$text_mail = 'mail text';
$text_news = 'news text';
$text_asci = 'ascii text';
($SCmagic = <<'!') =~ s/^X//g;
X# This data file was generated by the Spreadsheet Calculator.
X# You almost certainly shouldn't edit it.
!
sub IsText
{
return ''		if($_ !~ /^(.*)\n/);
local($buf)		= $_;
local($_)		= $1;
local($ans);
return $text_mail			if /^From /;
return "old $text_news"			if /^Relay-Version: /;
return "batched $text_news"		if /^#! rnews/
|| /^#!rnews/;
return "mailed, batched $text_news"	if /^N#! rnews/
|| /^N#!rnews/;
return "forwarding $text_mail"		if /^Forward to /;
return "piping $text_mail"		if /^Pipe to /;
return "smtp $text_mail"		if /^Return-Path: /;
return $text_news			if /^Path: /;
return $text_news			if /^Xref: /;
return "news or $text_mail"		if /^From: /;
return "saved $text_news"		if /^Article \d+ /;
return "uuencode $text_mail"		if /^begin [0-7]+ /;
if(/^#!/)
{
$ans = 'executable '			if -x $path;
s/^#!\s*//;
split;
$ans .= $_[0] . ' commands text';
return $ans;
}
return 'RCS archive text' if /^head\t\d+\.\d+(\.\d+\.\d+)*;$/;
return 'diff output text'	if /^diff /;
return 'diff output text'	if /^\*\*\* /;
return 'diff output text'	if /^Only in /;
return 'diff output text'	if /^Common subdirectories: /;
return 'ditroff output text for the C/A/T'	if /^x T cat/;
return 'ditroff output text for PostScript'	if /^x T ps/;
return 'ditroff output text'			if /^x T /;
if(/^\@document\(/)	# )
{
$ans = 'Imagen printer';
$_ = $';
return $ans	unless	/^language /;
$_ = $';
return $ans.' imPRESS data'		if /^impress/;
return $ans.' daisywheel text'		if /^daisy/;
return $ans.' daisywheel text'		if /^diablo/;
return $ans.' line printer emulation'	if /^printer/;
return $ans.' Tektronix 4014 emulation'	if /^tektronix/;
return $ans.' (unknown format)';
}
if(/^%!/)
{
$ans = 'PostScript text';
$_ = $';
$ans .= ' conforming at level '.$'	if /^PS-Adobe-/;
return $ans;
}
return "X11 BDF (Bitmap Distribution Format) $1 text"
if /^STARTFONT +(\d+(\.\d+)+) *$/;
return 'ASCII vfont text'	if /^FONT/;
return 'antique shell commands text'	if /^: /;
return "$text_c (from lex)"
if &BufMatch($buf, 53, "yyprevious")
|| &BufMatch($buf, 62, "yyprevious");
return 'archive (Software Tools format) text'
if /^-h-/;
return 'ASCII font metrics'	if /^StartFontMetrics/;
return 'ASCII font bits'	if /^StartFont/;
return 'sc spreadsheet text'
if &BufMatch($buf, 0, $SCmagic);
'';
}
sub IsAscii
{
return 'troff or preprocessor input text'
if /^\.\w\w/
|| /^\.\\"/;
return $text_fort	if /^[cC]\s/;
return $text_c		if m:/\*:
|| /\b#include\b/
|| /\bchar\b/;
return 'TeX or LaTeX input text'
if /\\begin\{/
|| /\\end\{/
|| /\\def/
|| /\\document/;
return $text_eng	if /\b[Tt]he\b/;
return $text_c		if /\bdouble\b/
|| /\bextern\b/
|| /\bfloat\b/
|| /\breal\b/
|| /\bstruct\b/
|| /\bunion\b/;
return $text_make	if /\bCFLAGS\b/
|| /\bLDFLAGS\b/
|| /\ball:\b/
|| /\b\.PRECIOUS\b/;
return $text_as		if /\b\.ascii\b/
|| /\b\.asciiz\b/
|| /\b\.byte\b/
|| /\b\.even\b/
|| /\b\.globl\b/
|| /\bclr\b/;
return $text_pas	if /\b\(input,\b/;
return $text_pl1	if /\bdcl\b/;
return $text_mail	if /\bReceived:\b/
|| /\b>From\b/
|| /\bReturn-Path:\b/
|| /\bCc:\b/;
return $text_news	if /\bNewsgroups:\b/
|| /\bPath:\b/
|| /\bOrganization:\b/;
if (!tr/\200-\377//)
{
local($ans)	= $text_asci;
$ans .= ' (with escape sequences)'	if /\033/;
return $ans;
}
'';
}
sub File
{
local($path)	= @_;
local ($p, $desc,   $mtime, $atime) = &DoStat($path);
return "$p$desc"	if($desc ne '');
open(FILE, $path)
||	die "$0: internal error: Can't open $path: $!\n";
local($ans)	= '';	# the answer we will return
local($_);		# buffer of file contents
read(FILE,$_,512);
$ans = &FileTest($p);
close(FILE);
$ans;
}
sub FileTest
{
local($p)	= @_;
local($ans)	= '';
&FileAns($ans, $p, &IsText);
return $ans	if($ans ne '');
foreach $test (@BATTERY)
{
if($test eq 'IsTEMPLATE')
{
warn "Tried using &$test(): a new test type?\n";
next;
}
unless (eval "defined(&$test)")
{
warn "Internal error: &$test() is undefined\n";
next;
}
&FileAns($ans, $p, &$test($_));
}
&FileAns($ans, $p, &IsAscii)		if $ans eq '';
&FileAns($ans, $p, 'data')		if $ans eq '';
$ans;
}
sub FileAns
{
return		unless length($_[2]);
if (length($_[0]))
{
$_[0] .= "\n" . ($width > 0 ? ' ' x $width : "\t");
}
$_[0] .= $_[1].$_[2];
}
sub MaxLen
{
local($max) = pop(@_);
for(@_)
{
$max = $_	if length($max) < length($_);
}
length($max);
}
$0 =~ s#.*/##;
eval 'require "getopts.pl"' || &Require("getopts.pl");
sub Usage
{
local($status) = @_;
local($*, $_) = (1, <<EOF); s/^X//g; print;
Xusage: $0 [-f namefile] [-C] [-v key[,key...]] pathname ...
X-f namefile	Read the names of the files to examine from the file 'namefile'.
X		To read from stdin, use '-'.
X
X-C		Produce file(1)-compatible output.  (The default is to arrange
X		filenames and descriptions into neat columns.)
X
X-v key		Verbose output, depending on the key.  Multiple keys may be
X		given, separated by commas.  Keys include:
X
X		coff	dump header information for COFF object files
X			(not yet implemented)
X		mach	dump header for Mach object files
X		MACH	dump load commands for Mach object files
X		xout	dump header information for x.out objects
X		XOUT	dump all available information for x.out objects
X
XThe '-c' and '-m magicfile' options of file(1) are accepted but ignored.
EOF
exit $status;
}
dump BEGIN	if $#ARGV == $[ && $ARGV[$[] eq '-u';
BEGIN:
if ($#ARGV < $[)
{
&Usage(0);
}
&Getopts('cf:m:Cv:')	|| &Usage(1);
if($opt_v)
{
local($warn) = 0;
for (split(',', $opt_v))
{
if($_ eq 'coff'
|| $_ eq 'mach'
|| $_ eq 'MACH'
|| $_ eq 'xout'
|| $_ eq 'XOUT'
)
{
eval "\$verbose_$_ = 1";
}
else
{
warn "unknown option to -v: $_\n";
$warn++;
}
}
&Usage($warn)	if $warn;
}
if($opt_f ne '')
{
open(opt_f)	|| die "$0: Can't open $opt_f: $!\n";
@ARGV=();
while(<opt_f>) { chop; push (@ARGV, $_); }
close(opt_f);
}
$width = ($opt_C ne '') ? 0 : &MaxLen(@ARGV)+1;	# 1 for " "
for (@ARGV)
{
$name = $width ? sprintf("%-${width}s", "$_") : "$_:\t";
print $name, &File($_), "\n";
}