Added specific routines for OUTPUT_DEBUG_STRING and EXCEPTION debug events.
[wine] / tools / make_requests
1 #! /usr/bin/perl -w
2 #
3 # Build the server/trace.c and server/request.h files
4 # from the contents of include/server.h.
5 #
6 # Copyright (C) 1998 Alexandre Julliard
7 #
8
9 %formats =
10 (
11     "int"           => "%d",
12     "long"          => "%ld",
13     "char"          => "%c",
14     "unsigned char" => "%02x",
15     "unsigned int"  => "%08x",
16     "void*"         => "%p",
17     "time_t"        => "%ld",
18     "path_t"        => "&dump_path_t",
19     "debug_event_t" => "&dump_debug_event_t",
20     "CONTEXT"       => "&dump_context",
21     "EXCEPTION_RECORD" => "&dump_exc_record",
22     "char[1]"       => "\\\"%s\\\"",
23     "WCHAR[1]"      => "&dump_unicode_string"
24 );
25
26 my @requests = ();
27 my %replies = ();
28
29 open(SERVER,"include/server.h") or die "Can't open include/server.h";
30
31 ### Parse server.h to find request/reply structure definitions
32
33 my @trace_lines = ();
34 my $protocol = 0;  # server protocol version
35
36 while (<SERVER>)
37 {
38     if (/^struct +(\w+)_request/) { &DO_REQUEST($1); }
39     if (/^\#define SERVER_PROTOCOL_VERSION (\d+)/) { $protocol = $1 + 1; }
40 }
41
42 ### Output the dumping function tables
43
44 push @trace_lines, "static const dump_func req_dumpers[REQ_NB_REQUESTS] = {\n";
45 foreach $req (@requests)
46 {
47     push @trace_lines, "    (dump_func)dump_${req}_request,\n";
48 }
49 push @trace_lines, "};\n\n";
50
51 push @trace_lines, "static const dump_func reply_dumpers[REQ_NB_REQUESTS] = {\n";
52 foreach $req (@requests)
53 {
54     push @trace_lines, "    (dump_func)", $replies{$req} ? "dump_${req}_reply,\n" : "0,\n";
55 }
56 push @trace_lines, "};\n\n";
57
58 push @trace_lines, "static const char * const req_names[REQ_NB_REQUESTS] = {\n";
59 foreach $req (@requests)
60 {
61     push @trace_lines, "    \"$req\",\n";
62 }
63 push @trace_lines, "};\n";
64
65 REPLACE_IN_FILE( "server/trace.c", @trace_lines );
66
67 ### Replace the request list in server.h by the new values
68
69 my @server_lines = ();
70
71 push @server_lines, "enum request\n{\n";
72 foreach $req (@requests) { push @server_lines, "    REQ_\U$req,\n"; }
73 push @server_lines, "    REQ_NB_REQUESTS\n};\n";
74 push @server_lines, "\n#define SERVER_PROTOCOL_VERSION $protocol\n";
75
76 REPLACE_IN_FILE( "include/server.h", @server_lines );
77
78 ### Output the request handlers list
79
80 my @request_lines = ();
81
82 foreach $req (@requests) { push @request_lines, "DECL_HANDLER($req);\n"; }
83 push @request_lines, "\n#ifdef WANT_REQUEST_HANDLERS\n\n";
84 push @request_lines, "typedef void (*req_handler)( void *req );\n";
85 push @request_lines, "static const req_handler req_handlers[REQ_NB_REQUESTS] =\n{\n";
86 foreach $req (@requests)
87 {
88     push @request_lines, "    (req_handler)req_$req,\n";
89 }
90 push @request_lines, "};\n#endif  /* WANT_REQUEST_HANDLERS */\n";
91
92 REPLACE_IN_FILE( "server/request.h", @request_lines );
93
94 ### Handle a request structure definition
95
96 sub DO_REQUEST
97 {
98     my $name = shift;
99     my @in_struct = ();
100     my @out_struct = ();
101     while (<SERVER>)
102     {
103         my ($dir, $type, $var);
104         last if /^};$/;
105         next if /^{$/;
106         s!/\*.*\*/!!g;
107         next if /^\s*$/;
108         /^\s*(IN|OUT)\s*(\w+\**(\s+\w+\**)*)\s+(\w+)(\[[1]\])?;/ or die "Unrecognized syntax $_";
109         $dir = $1;
110         $type = $2 . ($5 || "");
111         $var = $4;
112         die "Unrecognized type $type" unless (defined($formats{$type}) || $5);
113         if ($dir =~ /IN/) { push @in_struct, $type, $var; }
114         if ($dir =~ /OUT/) { push @out_struct, $type, $var; }
115     }
116     push @requests, $name;
117     &DO_DUMP_FUNC( $name, "request", @in_struct);
118     if ($#out_struct >= 0)
119     {
120         $replies{$name} = 1;
121         &DO_DUMP_FUNC( $name, "reply", @out_struct);
122     }
123 }
124
125 ### Generate a dumping function
126
127 sub DO_DUMP_FUNC
128 {
129     my $name = shift;
130     my $req = shift;
131     push @trace_lines, "static void dump_${name}_$req( const struct ${name}_request *req )\n{\n";
132     while ($#_ >= 0)
133     {
134         my $type = shift;
135         my $var = shift;
136         if (defined($formats{$type}))
137         {
138             if ($formats{$type} =~ /^&(.*)/)
139             {
140                 my $func = $1;
141                 push @trace_lines, "    fprintf( stderr, \" $var=\" );\n";
142                 if ($type =~ /[1]/) { push @trace_lines, "    $func( req->$var );\n"; }
143                 else { push @trace_lines, "    $func( &req->$var );\n"; }
144                 push @trace_lines, "    fprintf( stderr, \",\" );\n" if ($#_ > 0);
145             }
146             else
147             {
148                 push @trace_lines, "    fprintf( stderr, \" $var=$formats{$type}";
149                 push @trace_lines, "," if ($#_ > 0);
150                 push @trace_lines, "\", ";
151                 push @trace_lines, "req->$var );\n";
152             }
153         }
154         else  # must be some varargs format
155         {
156             push @trace_lines, "    fprintf( stderr, \" $var=\" );\n";
157             push @trace_lines, "    dump_varargs_${name}_${req}( req );\n";
158         }
159     }
160     push @trace_lines, "}\n\n";
161 }
162
163 ### Replace the contents of a file between ### make_requests ### marks
164
165 sub REPLACE_IN_FILE
166 {
167     my $name = shift;
168     my @data = @_;
169     my @lines = ();
170     open(FILE,$name) or die "Can't open $name";
171     while (<FILE>)
172     {
173         push @lines, $_;
174         last if /\#\#\# make_requests begin \#\#\#/;
175     }
176     push @lines, "\n", @data;
177     while (<FILE>)
178     {
179         if (/\#\#\# make_requests end \#\#\#/) { push @lines, "\n", $_; last; }
180     }
181     push @lines, <FILE>;
182     open(FILE,">$name") or die "Can't modify $name";
183     print FILE @lines;
184     close(FILE);
185 }