1 1.1 christos #! /usr/bin/env perl 2 1.1 christos # 3 1.1 christos # C source compressor. This: 4 1.1 christos # 5 1.1 christos # - merges continuation lines 6 1.1 christos # - removes comments (not in strings) 7 1.1 christos # - removes empty lines (not in strings) 8 1.1 christos 9 1.1 christos use strict; 10 1.1 christos use warnings; 11 1.1 christos 12 1.1 christos my $debug = defined $ENV{DEBUG}; 13 1.1 christos my $lang = shift @ARGV; 14 1.1 christos 15 1.1 christos # Slurp the file 16 1.1 christos $/ = undef; 17 1.1 christos $_ = <>; 18 1.1 christos 19 1.1 christos if ($lang eq 'C') { 20 1.1 christos # Merge continuation lines 21 1.1 christos s{\\\n}{}g; 22 1.1 christos 23 1.1 christos # Regexp for things that should be preserved 24 1.1 christos my $preserved = 25 1.1 christos qr{ 26 1.1 christos (?: 27 1.1 christos " # String start 28 1.1 christos (?: \\. | [^\"])* # Any character, including escaped ones 29 1.1 christos " # String end 30 1.1 christos ) 31 1.1 christos 32 1.1 christos | # OR 33 1.1 christos 34 1.1 christos (?: 35 1.1 christos ' # Character start (multi-chars supported) 36 1.1 christos (?: \\. | [^\'])+ # Any character, including escaped ones 37 1.1 christos ' # String end 38 1.1 christos ) 39 1.1 christos }x; 40 1.1 christos 41 1.1 christos # Remove comments while preserving strings 42 1.1 christos s{ 43 1.1 christos (?| # All things preserved end up in $1 44 1.1 christos 45 1.1 christos /\* # C comment start 46 1.1 christos .*? # Contents up until 47 1.1 christos \*/ # C comment end 48 1.1 christos 49 1.1 christos | # OR 50 1.1 christos 51 1.1 christos ( # Grouping for the replacement 52 1.1 christos $preserved 53 1.1 christos ) 54 1.1 christos 55 1.1 christos ) 56 1.1 christos }{ 57 1.1 christos if ($debug) { 58 1.1 christos print STDERR "DEBUG: '$&' => '$1'\n" if defined $1; 59 1.1 christos print STDERR "DEBUG: '$&' removed\n" unless defined $1; 60 1.1 christos } 61 1.1 christos defined $1 ? $1 : "" 62 1.1 christos }gsxe; 63 1.1 christos 64 1.1 christos # Remove empty lines 65 1.1 christos s{ 66 1.1 christos (?| # All things preserved end up in $1 67 1.1 christos 68 1.1 christos (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline 69 1.1 christos 70 1.1 christos | # OR 71 1.1 christos 72 1.1 christos ( # Grouping for the replacement 73 1.1 christos $preserved 74 1.1 christos ) 75 1.1 christos 76 1.1 christos ) 77 1.1 christos }{$1}gsx; 78 1.1 christos 79 1.1 christos # Remove extra spaces 80 1.1 christos s{ 81 1.1 christos (?| # All things preserved end up in $1 82 1.1 christos 83 1.1 christos \h+ # Horizontal spaces replaced with one 84 1.1 christos 85 1.1 christos | # OR 86 1.1 christos 87 1.1 christos ( # Grouping for the replacement 88 1.1 christos $preserved 89 1.1 christos ) 90 1.1 christos 91 1.1 christos ) 92 1.1 christos }{ 93 1.1 christos if ($debug) { 94 1.1 christos print STDERR "DEBUG: '$&' => '$1'\n" if defined $1; 95 1.1 christos print STDERR "DEBUG: '$&' => ' '\n" unless defined $1; 96 1.1 christos } 97 1.1 christos defined $1 ? $1 : " " 98 1.1 christos }gsxe; 99 1.1 christos 100 1.1 christos # Clean up spaces at start and end of lines 101 1.1 christos s/^ //mg; 102 1.1 christos s/ $//mg; 103 1.1 christos } elsif ($lang eq 'S') { 104 1.1 christos # Because we use C++ style comments in our .S files, all we can do 105 1.1 christos # is to drop them 106 1.1 christos s{ 107 1.1 christos ^([^\n]*?)//[^\n]*?$ # Any line with a // comment 108 1.1 christos }{ 109 1.1 christos if ($debug) { 110 1.1 christos print STDERR "DEBUG: '$&' => '$1'\n" if defined $1; 111 1.1 christos print STDERR "DEBUG: '$&' removed\n" unless defined $1; 112 1.1 christos } 113 1.1 christos defined $1 ? $1 : "" 114 1.1 christos }mgsxe; 115 1.1 christos 116 1.1 christos # Drop all empty lines 117 1.1 christos s{ 118 1.1 christos (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline 119 1.1 christos }{$1}gsx; 120 1.1 christos } elsif ($lang eq 'perl') { 121 1.1 christos # Merge continuation lines 122 1.1 christos s{\\\n}{}g; 123 1.1 christos 124 1.1 christos # Regexp for things that should be preserved 125 1.1 christos my $preserved = 126 1.1 christos qr{ 127 1.1 christos (?: 128 1.1 christos <<["']?(\w+)["']? # HERE document start 129 1.1 christos .*? # Its contents 130 1.1 christos ^\g{-1}$ 131 1.1 christos ) 132 1.1 christos | 133 1.1 christos (?: 134 1.1 christos " # Double quoted string start 135 1.1 christos (?: \\. | [^\"])* # Any character, including escaped ones 136 1.1 christos " # Double quoted string end 137 1.1 christos ) 138 1.1 christos 139 1.1 christos | # OR 140 1.1 christos 141 1.1 christos (?: 142 1.1 christos ' # Single quoted string start 143 1.1 christos [^\']* # Any character 144 1.1 christos ' # Single quoted string end 145 1.1 christos ) 146 1.1 christos }msx; 147 1.1 christos 148 1.1 christos # Remove comments while preserving strings 149 1.1 christos s{ 150 1.1 christos (?| # All things preserved end up in $1 151 1.1 christos 152 1.1 christos \#.*?(\n|$) # Perl comments 153 1.1 christos 154 1.1 christos | # OR 155 1.1 christos 156 1.1 christos ( # Grouping for the replacement 157 1.1 christos $preserved 158 1.1 christos ) 159 1.1 christos 160 1.1 christos ) 161 1.1 christos }{ 162 1.1 christos if ($debug) { 163 1.1 christos print STDERR "DEBUG: '$&' => '$1'\n" if defined $1; 164 1.1 christos print STDERR "DEBUG: '$&' removed\n" unless defined $1; 165 1.1 christos } 166 1.1 christos defined $1 ? $1 : "" 167 1.1 christos }gsxe; 168 1.1 christos 169 1.1 christos # Remove empty lines 170 1.1 christos s{ 171 1.1 christos (?| # All things preserved end up in $1 172 1.1 christos 173 1.1 christos (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline 174 1.1 christos 175 1.1 christos | # OR 176 1.1 christos 177 1.1 christos ( # Grouping for the replacement 178 1.1 christos $preserved 179 1.1 christos ) 180 1.1 christos 181 1.1 christos ) 182 1.1 christos }{$1}gsx; 183 1.1 christos } 184 1.1 christos 185 1.1 christos print; 186