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|func_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                 elsif(/getglobal\w*\(\w+, "(\w+)"\)/)
 182                 {
 183                         # hack for weird DP source
 184                         $vm{csprogs}{globals}{$1} = [0, "DP_CSQC_SPAWNPARTICLE"];
 185                 }
 186         }
 187         close $fh;
 188 }
 189
 190 # now read in dpdefs
 191 for((
 192         ["csprogsdefs.qc", "csprogs"],
 193         ["dpextensions.qc", "progs"],
 194         ["menudefs.qc", "menu"],
 195         ["progsdefs.qc", "progs"]
 196 ))
 197 {
 198         my ($file, $v) = @$_;
 199         open my $fh, "<", "$file"
 200                 or die "<$file: $!";
 201         while(<$fh>)
 202         {
 203                 s/\/\/.*//;
 204                 if(/^(?:float|entity|string|vector)\s+((?:\w+\s*,\s*)*\w+)\s*;/)
 205                 {
 206                         for(split /\s*,\s*/, $1)
 207                         {
 208                                 print "// $v: Global $_ declared but not defined\n"
 209                                         if not $vm{$v}{globals}{$_};
 210                                 $vm{$v}{globals}{$_}[0] = 1; # documented!
 211                         }
 212                 }
 213                 elsif(/^\.(?:float|entity|string|vector|void)(?:.*\))?\s+((?:\w+\s*,\s*)*\w+)\s*;/)
 214                 {
 215                         for(split /\s*,\s*/, $1)
 216                         {
 217                                 print "// $v: Field $_ declared but not defined\n"
 218                                         if not $vm{$v}{fields}{$_};
 219                                 $vm{$v}{fields}{$_}[0] = 1; # documented!
 220                         }
 221                 }
 222                 elsif(/#(\d+)/)
 223                 {
 224                         print "// $v: Builtin #$1 declared but not defined\n"
 225                                 if not $vm{$v}{builtins}[$1];
 226                         $vm{$v}{builtins}[$1][0] = 1; # documented!
 227                 }
 228                 else
 229                 {
 230                 }
 231         }
 232         close $fh;
 233 }
 234
 235 # some dumb output
 236 for my $v(sort keys %vm)
 237 {
 238         print "/******************************************\n";
 239         print " * $v\n";
 240         print " ******************************************/\n";
 241         my $b = $vm{$v}{builtins};
 242         for(0..@$b)
 243         {
 244                 next if not defined $b->[$_];
 245                 my ($documented, $func, $extension) = @{$b->[$_]};
 246                 print "float $func(...) = #$_; // $extension\n"
 247                         unless $documented;
 248         }
 249         my $g = $vm{$v}{globals};
 250         for(sort keys %$g)
 251         {
 252                 my ($documented, $extension) = @{$g->{$_}};
 253                 print "float $_; // $extension\n"
 254                         unless $documented;
 255         }
 256         my $f = $vm{$v}{fields};
 257         for(sort keys %$f)
 258         {
 259                 my ($documented, $extension) = @{$f->{$_}};
 260                 print ".float $_; // $extension\n"
 261                         unless $documented;
 262         }
 263
 264 }
 265
 266 __END__
 267 use Data::Dumper;
 268 $Data::Dumper::Sortkeys = 1;
 269 print Dumper \%vm;