src/dynapi/gendynapi.pl
author Ryan C. Gordon
Mon, 01 Jan 2018 19:16:51 -0500
changeset 11803 454f6dc9cb85
parent 10737 3406a0f8b041
child 11811 5d94cb6b24d3
permissions -rwxr-xr-x
windows: Remove references to GetVersionExA (thanks, Andrew Pilley!).

"GetVersionExA is deprecated in windows 8.1 and above's SDK, causing a warning
when building against the win10 SDK. Attached patch cleans up the usage for a
warning-free build.

GetVersionExA was being used to test to see if SDL was running on win9x or
winnt. A quick chat with Ryan on twitter suggested that SDL doesn't
officially support win9x anymore, so the call to this can be outright removed.

As an aside, replacing the call to GetVersionExA with VerifyVersionInfoA (the
recommended path) would have been pointless, as VerifyVersionInfoA only
supports VER_PLATFORM_WIN32_NT and doesn't officially support any other value
for dwPlatformId currently. (And it's probable that win9x SDKs didn't have
VerifyVersionInfo* in them anyway.)"

Fixes Bugzilla #4019.
     1 #!/usr/bin/perl -w
     2 
     3 #  Simple DirectMedia Layer
     4 #  Copyright (C) 1997-2017 Sam Lantinga <slouken@libsdl.org>
     5 #
     6 #  This software is provided 'as-is', without any express or implied
     7 #  warranty.  In no event will the authors be held liable for any damages
     8 #  arising from the use of this software.
     9 #
    10 #  Permission is granted to anyone to use this software for any purpose,
    11 #  including commercial applications, and to alter it and redistribute it
    12 #  freely, subject to the following restrictions:
    13 #
    14 #  1. The origin of this software must not be misrepresented; you must not
    15 #     claim that you wrote the original software. If you use this software
    16 #     in a product, an acknowledgment in the product documentation would be
    17 #     appreciated but is not required.
    18 #  2. Altered source versions must be plainly marked as such, and must not be
    19 #     misrepresented as being the original software.
    20 #  3. This notice may not be removed or altered from any source distribution.
    21 
    22 # WHAT IS THIS?
    23 #  When you add a public API to SDL, please run this script, make sure the
    24 #  output looks sane (hg diff, it adds to existing files), and commit it.
    25 #  It keeps the dynamic API jump table operating correctly.
    26 
    27 # If you wanted this to be readable, you shouldn't have used perl.
    28 
    29 use warnings;
    30 use strict;
    31 use File::Basename;
    32 
    33 chdir(dirname(__FILE__) . '/../..');
    34 my $sdl_dynapi_procs_h = "src/dynapi/SDL_dynapi_procs.h";
    35 my $sdl_dynapi_overrides_h = "src/dynapi/SDL_dynapi_overrides.h";
    36 
    37 my %existing = ();
    38 if (-f $sdl_dynapi_procs_h) {
    39     open(SDL_DYNAPI_PROCS_H, '<', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
    40     while (<SDL_DYNAPI_PROCS_H>) {
    41         if (/\ASDL_DYNAPI_PROC\(.*?,(.*?),/) {
    42             $existing{$1} = 1;
    43         }
    44     }
    45     close(SDL_DYNAPI_PROCS_H)
    46 }
    47 
    48 open(SDL_DYNAPI_PROCS_H, '>>', $sdl_dynapi_procs_h) or die("Can't open $sdl_dynapi_procs_h: $!\n");
    49 open(SDL_DYNAPI_OVERRIDES_H, '>>', $sdl_dynapi_overrides_h) or die("Can't open $sdl_dynapi_overrides_h: $!\n");
    50 
    51 opendir(HEADERS, 'include') or die("Can't open include dir: $!\n");
    52 while (readdir(HEADERS)) {
    53     next if not /\.h\Z/;
    54     my $header = "include/$_";
    55     open(HEADER, '<', $header) or die("Can't open $header: $!\n");
    56     while (<HEADER>) {
    57         chomp;
    58         next if not /\A\s*extern\s+DECLSPEC/;
    59         my $decl = "$_ ";
    60         if (not $decl =~ /\)\s*;/) {
    61             while (<HEADER>) {
    62                 chomp;
    63                 s/\A\s+//;
    64                 s/\s+\Z//;
    65                 $decl .= "$_ ";
    66                 last if /\)\s*;/;
    67             }
    68         }
    69 
    70         $decl =~ s/\s+\Z//;
    71         #print("DECL: [$decl]\n");
    72 
    73         if ($decl =~ /\A\s*extern\s+DECLSPEC\s+(const\s+|)(unsigned\s+|)(.*?)\s*(\*?)\s*SDLCALL\s+(.*?)\s*\((.*?)\);/) {
    74             my $rc = "$1$2$3$4";
    75             my $fn = $5;
    76 
    77             next if $existing{$fn};   # already slotted into the jump table.
    78 
    79             my @params = split(',', $6);
    80 
    81             #print("rc == '$rc', fn == '$fn', params == '$params'\n");
    82 
    83             my $retstr = ($rc eq 'void') ? '' : 'return';
    84             my $paramstr = '(';
    85             my $argstr = '(';
    86             my $i = 0;
    87             foreach (@params) {
    88                 my $str = $_;
    89                 $str =~ s/\A\s+//;
    90                 $str =~ s/\s+\Z//;
    91                 #print("1PARAM: $str\n");
    92                 if ($str eq 'void') {
    93                     $paramstr .= 'void';
    94                 } elsif ($str eq '...') {
    95                     if ($i > 0) {
    96                         $paramstr .= ', ';
    97                     }
    98                     $paramstr .= $str;
    99                 } elsif ($str =~ /\A\s*((const\s+|)(unsigned\s+|)([a-zA-Z0-9_]*)\s*([\*\s]*))\s*(.*?)\Z/) {
   100                     #print("PARSED: [$1], [$2], [$3], [$4], [$5]\n");
   101                     my $type = $1;
   102                     my $var = $6;
   103                     $type =~ s/\A\s+//;
   104                     $type =~ s/\s+\Z//;
   105                     $var =~ s/\A\s+//;
   106                     $var =~ s/\s+\Z//;
   107                     $type =~ s/\s*\*\Z/*/g;
   108                     $type =~ s/\s*(\*+)\Z/ $1/;
   109                     #print("SPLIT: ($type, $var)\n");
   110                     my $name = chr(ord('a') + $i);
   111                     if ($i > 0) {
   112                         $paramstr .= ', ';
   113                         $argstr .= ',';
   114                     }
   115                     my $spc = ($type =~ /\*\Z/) ? '' : ' ';
   116                     $paramstr .= "$type$spc$name";
   117                     $argstr .= "$name";
   118                 }
   119                 $i++;
   120             }
   121 
   122             $paramstr = '(void' if ($i == 0);  # Just to make this consistent.
   123 
   124             $paramstr .= ')';
   125             $argstr .= ')';
   126 
   127             print("NEW: $decl\n");
   128             print SDL_DYNAPI_PROCS_H "SDL_DYNAPI_PROC($rc,$fn,$paramstr,$argstr,$retstr)\n";
   129             print SDL_DYNAPI_OVERRIDES_H "#define $fn ${fn}_REAL\n";
   130         } else {
   131             print("Failed to parse decl [$decl]!\n");
   132         }
   133     }
   134     close(HEADER);
   135 }
   136 closedir(HEADERS);
   137 
   138 close(SDL_DYNAPI_PROCS_H);
   139 close(SDL_DYNAPI_OVERRIDES_H);
   140 
   141 # vi: set ts=4 sw=4 expandtab: