Add more CHECKGLERROR calls, and clean up a few obsolete code scraps.
[xonotic/darkplaces.git] / 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;