#!/usr/bin/perl

my $previous;

# Some canned regexes to use later:
my $lconditions = qr/(eq|ne|cs|hs|cc|ls|vs|vc|mi|pl|hi|ls|lt|ge|le|gt)?/io;
my $uconditions = qr/(EQ|NE|CS|HS|CC|LS|VS|VC|MI|PL|HI|LS|LT|GE|LE|GT)?/io;
my $add_sub_mov_match = qr/(^|[^\w.])((add|sub|mov)(${lconditions}s?|s?$lconditions)|(ADD|SUB|MOV)(${uconditions}S?|S?$uconditions))\W/o;
my $neon_float_match = qr/(^|[^\w.])((V(LDR|STR|MOV)[LNW]?|F(LD|ST)[MSD])${uconditions}|(v(ldr|str|mov)[lnw]?|f(ld|st)[msd])${lconditions})\W/o;
my $swp_match = qr/(^|[^\w.])((SWP)(${uconditions}B?|B?$uconditions)|swp(${lconditions}b?|b?$lconditions))\W/o;
my $ldrex_strex_match = qr/(^|[^\w.])((LD|ST)REX($conditions[BHD]?|[BHD]?$conditions)|(ld|st)rex($conditions[bhd]?|[bhd]?$conditions))\W/o;

# Write all the rejected lines to a separate file for debugging purposes:
open REJECTS, '>rejects' or die;

while (<>)
{
	my $string = $_;
	# Attempt to ignore comments:
	$_ =~ s/\/\*.*\*\// /g;
	$_ =~ s/\/\/.*/ /g;

	my $reject = 0;

	# Refine the search a bit to exclude some stuff which isn't assmbler,
	# mathing only the instruction patterns we want:

	$reject = 1 unless /^\S/ or
		/$add_sub_mov_match(.*,.*(?<![.\w])pc|.*(?<![.\w])pc.*,)/i or
		/$neon_float_match/i or
		/$swp_match.*,.*,/i or
		/$ldrex_strex_match/i;

	# Reject various irrelevant-looking content:

	$reject = 1 if /[^[:ascii:]]{4}/; # Ignore binary-like stuff
	$reject = 1 if /^ .*(->|\|=|==|&=)/; # Ignore some C-only syntax
	$reject = 1 if /^ [^:]*\/changelog/i; # ignore changelog comments
	$reject = 1 if /^ [^:]*postgres[^\s\/:]*:/i; # ignore pgdesigner-1.2.16/.gambas/CPOSTGRES70 and similar (?)
	$reject = 1 if /^ .*add.*support/i; # ignore some maintainer comments
	$reject = 1 if /^ [^:]*(readme|\.(txt|html?|doc|gmo|texi|hlp|image|nhr|gz|bz2|lzma|xz|png|tiff|gif|jpe?g|ogg|wav|flac|h2drumkit|cvd|pdf|pat|svgz?|pfb|tar|tgz|zip|jar|exe|dll|dfsg|po|ai|qch|uu|z|d|1c|sf2|group|uqm|dds|sit|pack|htb|data|dsk|bmp|pyd|pyc|blend|mesh|a|o|so(\.[^\/:]*)|chm|deb|dat)):/i; # ignore various random non-source file types which may trigger false positives
	$reject = 1 if /^ [^:]*\/waf:/; # Reject a random binary file from a2jmidid
	$reject = 1 if /^ [^:]*\/debian-keyring/; # Reject keys from debian-keyring-*

	if ($reject)
	{
		print REJECTS $string;
		next;
	}

	# Print non-rejected lines,
	# filtering out file stanzas with no remaining matches:

	# 

	if (/^\s/)
	{
		print $previous if defined $previous;
		undef $previous;
	}
	else
	{
		print REJECTS $previous if defined $previous;
		$previous = $string;

		next;
	}

	# Print matching line and iterate:
	print $string;
}

