tools/make_X11wrappers

   1 #!/usr/bin/perl -w
   2
   3 # Create threads safe wrappers around X11 calls.
   4 #
   5 # Copyright 1998 Kristian Nielsen.
   6 #
   7 # This library is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU Lesser General Public
   9 # License as published by the Free Software Foundation; either
  10 # version 2.1 of the License, or (at your option) any later version.
  11 #
  12 # This library is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # Lesser General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU Lesser General Public
  18 # License along with this library; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20 #
  21 # FIXME: This does not do full C prototype parsing, but relies on
  22 # knowledge on how the X11 include files are formatted. It will
  23 # probably need to be modified for new include files. It also fails
  24 # for certain prototypes (notably those with function pointer
  25 # arguments or results), so these must be added manually. And it
  26 # relies on a fixed location of X11 includes (/usr/X11R6/include/).
  27 #
  28 # This program expects to be run from Wine's main directory.
  29
  30 $X11_include_dir = "/usr/X11/include";
  31 $outdir = "dlls/x11drv";
  32 $wantfile = "$outdir/X11_calls";
  33 @dolist = ("Xlib");
  34
  35 # First read list of wanted function names.
  36
  37 open(WANT, $wantfile) || die "open";
  38 while(<WANT>) {
  39     next if /^\s*\#/;           # Skip comment lines.
  40     next if /^\s*$/;            # Skip empty lines.
  41     if(/^\s*([a-zA-Z0-9_]+)\s*$/) {
  42         $want{$1} = 1;
  43     } else {
  44         die "syntax error in file '$wantfile', in line '$_'";
  45     }
  46 }
  47 close(WANT);
  48
  49 foreach $name (@dolist) {
  50
  51     $ucname = uc $name;
  52     $lcname = lc $name;
  53
  54     $outfile = "/ts_$lcname";
  55     open(OUTC, ">$outdir/$outfile.c") || die "open";
  56     open(OUTH, ">$outdir/$outfile.h") || die "open";
  57
  58     $x11_incl = "";
  59     $extensions_dir = "";
  60     $pre_file = "#ifdef HAVE_X11_XLIB_H\n";
  61     $post_file = "#endif /* defined(HAVE_X11_XLIB_H) */\n";
  62     $inc_name = $name;
  63
  64     print OUTH <<END;
  65 /*
  66  * Thread safe wrappers around $name calls.
  67  * Always include this file instead of <X11/$name.h>.
  68  * This file was generated automatically by tools/make_X11wrappers
  69  * DO NOT EDIT!
  70  */
  71
  72 #ifndef __WINE_TS_$ucname\_H
  73 #define __WINE_TS_$ucname\_H
  74
  75 #ifndef __WINE_CONFIG_H
  76 # error You must include config.h to use this header
  77 #endif
  78
  79 $pre_file
  80 $x11_incl#include <X11/$extensions_dir$inc_name.h>
  81
  82 extern void wine_tsx11_lock(void);
  83 extern void wine_tsx11_unlock(void);
  84
  85 END
  86
  87     print OUTC <<END;
  88 /*
  89  * Thread safe wrappers around $name calls.
  90  * This file was generated automatically by tools/make_X11wrappers
  91  * DO NOT EDIT!
  92  */
  93
  94 #include "config.h"
  95
  96 $pre_file
  97 $x11_incl#include <X11/$extensions_dir$inc_name.h>
  98
  99 #include "ts_$lcname.h"
 100
 101 END
 102
 103         open(IN,
 104              "echo \"$x11_incl#include <X11/$extensions_dir$name.h>\" | " .
 105              "gcc -L$X11_include_dir -DNeedFunctionPrototypes -E - | " .
 106              "grep -v '^[ \t]*\$)' |"
 107              ) || die "open";
 108
 109       PROTO: while(<IN>) {
 110           if(m'extern\s+([^()]*)\b([a-zA-Z0-9_]+)\s*\(') {
 111               $result_type = $1;
 112               $fn_name = $2;
 113               $result_type = "int" if $result_type =~ /^\s*$/;
 114               @args = ();
 115               while(<IN>) {
 116                   last if m'\)\s*;';
 117                   # Give up on vararg functions and function pointer args.
 118                   if(m'\.\.\.|\(\*\)') {
 119                       undef $fn_name;
 120                       last;
 121                   }
 122                   if(m'\s*([^,]*[^, \t])\s*(,?\n)') {
 123                       $args[$#args+1] = $1;
 124                       if ($1 =~ /char\s*\[/) { # small hack for XQueryKeymap
 125                         $args[$#args] = "char*";
 126                       }
 127                   }
 128               }
 129               # Skip if vararg, function pointer arg, or not needed.
 130               next unless $fn_name;
 131               next unless $want{$fn_name} && $want{$fn_name} == 1;
 132
 133               # Special case for no arguments (which is specified as "void").
 134               if($#args == 0 && $args[0] eq "void") {
 135                   @args = ();
 136               }
 137               $proto = "";
 138               $formals = "";
 139               $actuals = "";
 140               for($i = 0; $i <= $#args; $i++) {
 141                   $comma = $i < $#args ? ", " : "";
 142                   $proto .= "$args[$i]$comma";
 143                   $formals .= "$args[$i] a$i$comma";
 144                   $actuals .= "a$i$comma";
 145               }
 146               $proto = $formals = "void" if $#args == -1;
 147               output_fn($fn_name, $result_type, $proto, $formals, $actuals);
 148           }
 149       }
 150
 151     print OUTH <<END;
 152
 153 $post_file
 154 #endif /* __WINE_TS_$ucname\_H */
 155 END
 156     print OUTC "\n", $post_file;
 157 }
 158
 159 foreach $i (keys %want) {
 160     if($want{$i} == 1) {
 161         print "Unresolved: $i\n";
 162     }
 163 }
 164
 165
 166 sub output_fn {
 167     # Example call:
 168     # output_fn("main", "int", "int, char **", "int a0, char **a1", "a0, a1")
 169     #
 170
 171     my ($fn_name, $result_type, $protos, $formals, $actuals) = @_;
 172
 173     return raw_output_fn($fn_name,
 174                          $result_type =~ /^\s*void\s*$/ ? "" : "$result_type r",
 175                          "$result_type TS$fn_name($protos)",
 176                          "$result_type TS$fn_name($formals)",
 177                          $actuals);
 178 }
 179
 180 sub output_fn_short {
 181     # Example call:
 182     # output_fn_sort("Bool", "XDGAQueryExtension", "Display *", "int *", "int *");
 183     #
 184     my ($result_type, $fn_name, @args) = @_;
 185
 186     my ($i, $proto, $formals, $actuals) = (0,
 187                                            "$result_type TS$fn_name(",
 188                                            "$result_type TS$fn_name(",
 189                                            "");
 190     while ($val = shift @args) {
 191         $proto = $proto . $val;
 192         $formals = $formals . $val . " a$i";
 193         $actuals = $actuals . " a$i";
 194         $i++;
 195         if (@args) {
 196             $proto = $proto . ", ";
 197             $formals = $formals . ", ";
 198             $actuals = $actuals . ", ";
 199         }
 200     }
 201     $proto = $proto . ")";
 202     $formals = $formals . ")";
 203
 204
 205     raw_output_fn($fn_name,
 206                   $result_type =~ /^\s*void\s*$/ ? "" : "$result_type r",
 207                   $proto,
 208                   $formals,
 209                   $actuals);
 210 }
 211
 212 sub raw_output_fn {
 213     # Example call:
 214     # output_fn("main", "int r", "int main(int, char **)", "int main(int a0, char **a1)", "a0, a1")
 215     #
 216
 217     my ($fn_name, $resultdecl, $protodecl, $defdecl, $actuals) = @_;
 218
 219     return undef unless $want{$fn_name} && $want{$fn_name} == 1;
 220
 221     print OUTC "\n$defdecl\n";
 222     print OUTH "extern $protodecl;\n";
 223 #    print OUTH "#define $fn_name TS$fn_name\n";
 224     print OUTC "{\n";
 225     print OUTC "  $resultdecl;\n" if $resultdecl;
 226     print OUTC "  wine_tsx11_lock();\n";
 227     print OUTC "  ";
 228     print OUTC "r = " if $resultdecl;
 229     print OUTC "$fn_name($actuals);\n";
 230     print OUTC "  wine_tsx11_unlock();\n";
 231     print OUTC "  return r;\n" if $resultdecl;
 232     print OUTC "}\n";
 233     $want{$fn_name} = 2;
 234     return 1;
 235 }