dpdefs/source_compare.pl

   1 use strict;
   2 use warnings;
   3
   4 my %vm = (
   5         menu => {},
   6         csprogs => {},
   7         progs => {}
   8 );
   9
  10 my $skip = 0;
  11
  12 my $parsing_builtins = undef;
  13 my $parsing_builtin = 0;
  14
  15 my $parsing_fields = undef;
  16 my $parsing_globals = undef;
  17 my $parsing_vm = undef;
  18
  19 for(<../*.h>, <../*.c>)
  20 {
  21         open my $fh, "<", $_
  22                 or die "<$_: $!";
  23         while(<$fh>)
  24         {
  25                 chomp;
  26                 if(/^#if 0$/)
  27                 {
  28                         $skip = 1;
  29                 }
  30                 elsif(/^#else$/)
  31                 {
  32                         $skip = 0;
  33                 }
  34                 elsif(/^#endif$/)
  35                 {
  36                         $skip = 0;
  37                 }
  38                 elsif($skip)
  39                 {
  40                 }
  41                 elsif(/^prvm_builtin_t vm_m_/)
  42                 {
  43                         $parsing_builtins = "menu";
  44                         $parsing_builtin = 0;
  45                 }
  46                 elsif(/^prvm_builtin_t vm_cl_/)
  47                 {
  48                         $parsing_builtins = "csprogs";
  49                         $parsing_builtin = 0;
  50                 }
  51                 elsif(/^prvm_builtin_t vm_sv_/)
  52                 {
  53                         $parsing_builtins = "progs";
  54                         $parsing_builtin = 0;
  55                 }
  56                 elsif(/^\}/)
  57                 {
  58                         $parsing_builtins = undef;
  59                         $parsing_globals = undef;
  60                         $parsing_fields = undef;
  61                         $parsing_vm = undef;
  62                 }
  63                 elsif(/^typedef struct entvars_s$/)
  64                 {
  65                         $parsing_fields = "fields";
  66                         $parsing_vm = "progs";
  67                 }
  68                 elsif(/^typedef struct cl_entvars_s$/)
  69                 {
  70                         $parsing_fields = "fields";
  71                         $parsing_vm = "csprogs";
  72                 }
  73                 elsif(/^typedef struct prvm_prog_fieldoffsets_s$/)
  74                 {
  75                         $parsing_fields = "fields";
  76                 }
  77                 elsif(/^typedef struct globalvars_s$/)
  78                 {
  79                         $parsing_globals = "globals";
  80                         $parsing_vm = "progs";
  81                 }
  82                 elsif(/^typedef struct cl_globalvars_s$/)
  83                 {
  84                         $parsing_globals = "globals";
  85                         $parsing_vm = "csprogs";
  86                 }
  87                 elsif(/^typedef struct m_globalvars_s$/)
  88                 {
  89                         $parsing_globals = "globals";
  90                         $parsing_vm = "menu";
  91                 }
  92                 elsif(/^typedef struct prvm_prog_globaloffsets_s$/)
  93                 {
  94                         $parsing_globals = "globals";
  95                 }
  96                 elsif($parsing_builtins)
  97                 {
  98                         s/\/\*.*?\*\// /g;
  99                         if(/^\s*\/\//)
 100                         {
 101                         }
 102                         elsif(/^NULL\b/)
 103                         {
 104                                 $parsing_builtin += 1;
 105                         }
 106                         elsif(/^(\w+)\s*,?\s*\/\/\s+#(\d+)\s*(.*)/)
 107                         {
 108                                 my $func = $1;
 109                                 my $builtin = int $2;
 110                                 my $descr = $3;
 111                                 my $extension = "DP_UNKNOWN";
 112
 113                                 if($descr =~ s/\s+\(([0-9A-Z_]*)\)//)
 114                                 {
 115                                         $extension = $1;
 116                                 }
 117                                 # 'void(vector ang) makevectors'
 118
 119                                 if($descr eq "")
 120                                 {
 121                                 }
 122                                 elsif($descr eq "draw functions...")
 123                                 {
 124                                 }
 125                                 elsif($descr =~ /^\/\//)
 126                                 {
 127                                 }
 128                                 elsif($descr =~ /\) (\w+)/)
 129                                 {
 130                                         $func = $1;
 131                                 }
 132                                 elsif($descr =~ /(\w+)\s*\(/)
 133                                 {
 134                                         $func = $1;
 135                                 }
 136                                 elsif($descr =~ /^\w+$/)
 137                                 {
 138                                         $func = $descr;
 139                                 }
 140                                 else
 141                                 {
 142                                         warn "No function name found in $descr";
 143                                 }
 144
 145                                 warn "builtin sequence error: #$builtin (expected: $parsing_builtin)"
 146                                         if $builtin != $parsing_builtin;
 147                                 $parsing_builtin = $builtin + 1;
 148                                 $vm{$parsing_builtins}{builtins}[$builtin] = [0, $func, $extension];
 149                         }
 150                         else
 151                         {
 152                                 warn "Fails to parse: $_";
 153                         }
 154                 }
 155                 elsif($parsing_fields || $parsing_globals)
 156                 {
 157                         my $f = $parsing_fields || $parsing_globals;
 158                         if(/^\s*\/\//)
 159                         {
 160                         }
 161                         elsif(/^\s+(?:int|float|string_t|vec3_t)\s+(\w+);\s*(?:\/\/(.*))?/)
 162                         {
 163                                 my $name = $1;
 164                                 my $descr = $2 || "";
 165                                 my $extension = "DP_UNKNOWN";
 166                                 $extension = $1
 167                                         if $descr =~ /\b([0-9A-Z_]+)\b/;
 168                                 my $found = undef;
 169                                 $vm{menu}{$f}{$name} = ($found = [0, $extension])
 170                                         if $descr =~ /common|menu/;
 171                                 $vm{progs}{$f}{$name} = ($found = [0, $extension])
 172                                         if $descr =~ /common|ssqc/;
 173                                 $vm{csprogs}{$f}{$name} = ($found = [0, $extension])
 174                                         if $descr =~ /common|csqc/;
 175                                 $vm{$parsing_vm}{$f}{$name} = ($found = [0, $extension])
 176                                         if not defined $found and defined $parsing_vm;
 177                                 warn "$descr does not yield info about target VM"
 178                                         if not defined $found;
 179                         }
 180                 }
 181         }
 182         close $fh;
 183 }
 184
 185 # now read in dpdefs
 186 for((
 187         ["csprogsdefs.qc", "csprogs"],
 188         ["dpextensions.qc", "progs"],
 189         ["menudefs.qc", "menu"],
 190         ["progsdefs.qc", "progs"]
 191 ))
 192 {
 193         my ($file, $v) = @$_;
 194         open my $fh, "<", "$file"
 195                 or die "<$file: $!";
 196         while(<$fh>)
 197         {
 198                 s/\/\/.*//;
 199                 if(/^(?:float|entity|string|vector)\s+((?:\w+\s*,\s*)*\w+)\s*;/)
 200                 {
 201                         for(split /\s*,\s*/, $1)
 202                         {
 203                                 print "// $v: Global $_ declared but not defined\n"
 204                                         if not $vm{$v}{globals}{$_};
 205                                 $vm{$v}{globals}{$_}[0] = 1; # documented!
 206                         }
 207                 }
 208                 elsif(/^\.(?:float|entity|string|vector|void)(?:.*\))?\s+((?:\w+\s*,\s*)*\w+)\s*;/)
 209                 {
 210                         for(split /\s*,\s*/, $1)
 211                         {
 212                                 print "// $v: Field $_ declared but not defined\n"
 213                                         if not $vm{$v}{fields}{$_};
 214                                 $vm{$v}{fields}{$_}[0] = 1; # documented!
 215                         }
 216                 }
 217                 elsif(/#(\d+)/)
 218                 {
 219                         print "// $v: Builtin #$1 declared but not defined\n"
 220                                 if not $vm{$v}{builtins}[$1];
 221                         $vm{$v}{builtins}[$1][0] = 1; # documented!
 222                 }
 223                 else
 224                 {
 225                 }
 226         }
 227         close $fh;
 228 }
 229
 230 # some dumb output
 231 for my $v(sort keys %vm)
 232 {
 233         print "/******************************************\n";
 234         print " * $v\n";
 235         print " ******************************************/\n";
 236         my $b = $vm{$v}{builtins};
 237         for(0..@$b)
 238         {
 239                 next if not defined $b->[$_];
 240                 my ($documented, $func, $extension) = @{$b->[$_]};
 241                 print "float $func(...) = #$_; // $extension\n"
 242                         unless $documented;
 243         }
 244         my $g = $vm{$v}{globals};
 245         for(sort keys %$g)
 246         {
 247                 my ($documented, $extension) = @{$g->{$_}};
 248                 print "float $_; // $extension\n"
 249                         unless $documented;
 250         }
 251         my $f = $vm{$v}{fields};
 252         for(sort keys %$f)
 253         {
 254                 my ($documented, $extension) = @{$f->{$_}};
 255                 print ".float $_; // $extension\n"
 256                         unless $documented;
 257         }
 258
 259 }
 260
 261 __END__
 262 use Data::Dumper;
 263 $Data::Dumper::Sortkeys = 1;
 264 print Dumper \%vm;