Ubuntu Wiki

   1 #!/usr/bin/perl
   2 
   3 my $previous;
   4 
   5 # Some canned regexes to use later:
   6 my $lconditions = qr/(eq|ne|cs|hs|cc|ls|vs|vc|mi|pl|hi|ls|lt|ge|le|gt)?/io;
   7 my $uconditions = qr/(EQ|NE|CS|HS|CC|LS|VS|VC|MI|PL|HI|LS|LT|GE|LE|GT)?/io;
   8 my $add_sub_mov_match = qr/(^|[^\w.])((add|sub|mov)(${lconditions}s?|s?$lconditions)|(ADD|SUB|MOV)(${uconditions}S?|S?$uconditions))\W/o;
   9 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;
  10 my $swp_match = qr/(^|[^\w.])((SWP)(${uconditions}B?|B?$uconditions)|swp(${lconditions}b?|b?$lconditions))\W/o;
  11 my $ldrex_strex_match = qr/(^|[^\w.])((LD|ST)REX($conditions[BHD]?|[BHD]?$conditions)|(ld|st)rex($conditions[bhd]?|[bhd]?$conditions))\W/o;
  12 
  13 # Write all the rejected lines to a separate file for debugging purposes:
  14 open REJECTS, '>rejects' or die;
  15 
  16 while (<>)
  17 {
  18 	my $string = $_;
  19 	# Attempt to ignore comments:
  20 	$_ =~ s/\/\*.*\*\// /g;
  21 	$_ =~ s/\/\/.*/ /g;
  22 
  23 	my $reject = 0;
  24 
  25 	# Refine the search a bit to exclude some stuff which isn't assmbler,
  26 	# mathing only the instruction patterns we want:
  27 
  28 	$reject = 1 unless /^\S/ or
  29 		/$add_sub_mov_match(.*,.*(?<![.\w])pc|.*(?<![.\w])pc.*,)/i or
  30 		/$neon_float_match/i or
  31 		/$swp_match.*,.*,/i or
  32 		/$ldrex_strex_match/i;
  33 
  34 	# Reject various irrelevant-looking content:
  35 
  36 	$reject = 1 if /[^[:ascii:]]{4}/; # Ignore binary-like stuff
  37 	$reject = 1 if /^ .*(->|\|=|==|&=)/; # Ignore some C-only syntax
  38 	$reject = 1 if /^ [^:]*\/changelog/i; # ignore changelog comments
  39 	$reject = 1 if /^ [^:]*postgres[^\s\/:]*:/i; # ignore pgdesigner-1.2.16/.gambas/CPOSTGRES70 and similar (?)
  40 	$reject = 1 if /^ .*add.*support/i; # ignore some maintainer comments
  41 	$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
  42 	$reject = 1 if /^ [^:]*\/waf:/; # Reject a random binary file from a2jmidid
  43 	$reject = 1 if /^ [^:]*\/debian-keyring/; # Reject keys from debian-keyring-*
  44 
  45 	if ($reject)
  46 	{
  47 		print REJECTS $string;
  48 		next;
  49 	}
  50 
  51 	# Print non-rejected lines,
  52 	# filtering out file stanzas with no remaining matches:
  53 
  54 	# 
  55 
  56 	if (/^\s/)
  57 	{
  58 		print $previous if defined $previous;
  59 		undef $previous;
  60 	}
  61 	else
  62 	{
  63 		print REJECTS $previous if defined $previous;
  64 		$previous = $string;
  65 
  66 		next;
  67 	}
  68 
  69 	# Print matching line and iterate:
  70 	print $string;
  71 }