1 #!/usr/bin/perl
2 #
3 # Copyright (c) 1992, 1993
4 # The Regents of the University of California. All rights reserved.
5 #
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions
8 # are met:
9 # 1. Redistributions of source code must retain the above copyright
10 # notice, this list of conditions and the following disclaimer.
11 # 2. Redistributions in binary form must reproduce the above copyright
12 # notice, this list of conditions and the following disclaimer in the
13 # documentation and/or other materials provided with the distribution.
14 # 3. All advertising materials mentioning features or use of this software
15 # must display the following acknowledgement:
16 # This product includes software developed by the University of
17 # California, Berkeley and its contributors.
18 # 4. Neither the name of the University nor the names of its contributors
19 # may be used to endorse or promote products derived from this software
20 # without specific prior written permission.
21 #
22 # THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
23 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
26 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
31 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
32 # SUCH DAMAGE.
33 #
34 # From @(#)vnode_if.sh 8.1 (Berkeley) 6/10/93
35 # From @(#)makedevops.sh 1.1 1998/06/14 13:53:12 dfr Exp $
36 # From @(#)makedevops.sh ?.? 1998/10/05
37 #
38 # $FreeBSD$
39
40 #
41 # Script to produce device front-end sugar.
42 #
43
44 $debug = 0;
45 $cfile = 0; # by default do not produce any file type
46 $hfile = 0;
47
48 $keepcurrentdir = 1;
49
50 $line_width = 80;
51
52 # Process the command line
53 #
54 while ( $arg = shift @ARGV ) {
55 if ( $arg eq '-c' ) {
56 warn "Producing .c output files"
57 if $debug;
58 $cfile = 1;
59 } elsif ( $arg eq '-h' ) {
60 warn "Producing .h output files"
61 if $debug;
62 $hfile = 1;
63 } elsif ( $arg eq '-ch' || $arg eq '-hc' ) {
64 warn "Producing .c and .h output files"
65 if $debug;
66 $cfile = 1;
67 $hfile = 1;
68 } elsif ( $arg eq '-d' ) {
69 $debug = 1;
70 } elsif ( $arg eq '-p' ) {
71 warn "Will produce files in original not in current directory"
72 if $debug;
73 $keepcurrentdir = 0;
74 } elsif ( $arg eq '-l' ) {
75 if ( $line_width = shift @ARGV and $line_width > 0 ) {
76 warn "Line width set to $line_width"
77 if $debug;
78 } else {
79 die "Please specify a valid line width after -l";
80 }
81 } elsif ( $arg =~ m/\.m$/ ) {
82 warn "Filename: $arg"
83 if $debug;
84 push @filenames, $arg;
85 } else {
86 warn "$arg ignored"
87 if $debug;
88 }
89 }
90
91
92 # Validate the command line parameters
93 #
94 die "usage: $0 [-d] [-p] [-c|-h] srcfile
95 where -c produce only .c files
96 -h produce only .h files
97 -p use the path component in the source file for destination dir
98 -l set line width for output files [80]
99 -d switch on debugging
100 "
101 unless ($cfile or $hfile)
102 and $#filenames != -1;
103
104 # FIXME should be able to do this more easily
105 #
106 $tmpdir = $ENV{'TMPDIR'}; # environment variables
107 $tmpdir = $ENV{'TMP'}
108 if !$tmpdir;
109 $tmpdir = $ENV{'TEMP'}
110 if !$tmpdir;
111 $tmpdir = '/tmp' # look for a physical directory
112 if !$tmpdir and -d '/tmp';
113 $tmpdir = '/usr/tmp'
114 if !$tmpdir and -d '/usr/tmp';
115 $tmpdir = '/var/tmp'
116 if !$tmpdir and -d '/var/tmp';
117 $tmpdir = '.' # give up and use current dir
118 if !$tmpdir;
119
120 foreach $src ( @filenames ) {
121 # Names of the created files
122 $ctmpname = "$tmpdir/ctmp.$$";
123 $htmpname = "$tmpdir/htmp.$$";
124
125 ($name, $path, $suffix) = &fileparse($src, '.m');
126 $path = '.'
127 if $keepcurrentdir;
128 $cfilename="$path/$name.c";
129 $hfilename="$path/$name.h";
130
131 warn "Processing from $src to $cfile / $hfile via $ctmp / $htmp"
132 if $debug;
133
134 die "Could not open $src, $!"
135 if !open SRC, "$src";
136 die "Could not open $ctmpname, $!"
137 if $cfile and !open CFILE, ">$ctmpname";
138 die "Could not open $htmpname, $!"
139 if $hfile and !open HFILE, ">$htmpname";
140
141 if ( $cfile ) {
142 # Produce the header of the C file
143 #
144 print CFILE "/*\n";
145 print CFILE " * This file is produced automatically.\n";
146 print CFILE " * Do not modify anything in here by hand.\n";
147 print CFILE " *\n";
148 print CFILE " * Created from\n";
149 print CFILE " * $src\n";
150 print CFILE " * with\n";
151 print CFILE " * $0\n";
152 print CFILE " */\n";
153 print CFILE "\n";
154 print CFILE "#include <sys/param.h>\n";
155 print CFILE "#include <sys/queue.h>\n";
156 print CFILE "#include <sys/bus_private.h>\n";
157 }
158
159 if ( $hfile ) {
160 # Produce the header of the H file
161 #
162 print HFILE "/*\n";
163 print HFILE " * This file is produced automatically.\n";
164 print HFILE " * Do not modify anything in here by hand.\n";
165 print HFILE " *\n";
166 print HFILE " * Created from\n";
167 print HFILE " * $src\n";
168 print HFILE " * with\n";
169 print HFILE " * $0\n";
170 print HFILE " */\n";
171 print HFILE "\n";
172 }
173
174 %methods = (); # clear list of methods
175 $lineno = 0;
176 $error = 0; # to signal clean up and gerror setting
177
178 LINE: while ( $line = <SRC> ) {
179 $lineno++;
180
181 # take special notice of include directives.
182 #
183 if ( $line =~ m/^#\s*include\s+(["<])([^">]+)([">]).*/i ) {
184 warn "Included file: $1$2" . ($1 eq '<'? '>':'"')
185 if $debug;
186 print CFILE "#include $1$2" . ($1 eq '<'? '>':'"') . "\n"
187 if $cfile;
188 }
189
190 $line =~ s/#.*//; # remove comments
191 $line =~ s/^\s+//; # remove leading ...
192 $line =~ s/\s+$//; # remove trailing whitespace
193
194 if ( $line =~ m/^$/ ) { # skip empty lines
195 # nop
196
197 } elsif ( $line =~ m/^INTERFACE\s*([^\s;]*)(\s*;?)/i ) {
198 $intname = $1;
199 $semicolon = $2;
200 unless ( $intname =~ m/^[a-z_][a-z0-9_]*$/ ) {
201 warn $line
202 if $debug;
203 warn "$src:$lineno: Invalid interface name '$intname', use [a-z_][a-z0-9_]*";
204 $error = 1;
205 last LINE;
206 }
207
208 warn "$src:$lineno: semicolon missing at end of line, no problem"
209 if $semicolon !~ s/;$//;
210
211 warn "Interface $intname"
212 if $debug;
213
214 print HFILE '#ifndef _'.$intname."_if_h_\n"
215 if $hfile;
216 print HFILE '#define _'.$intname."_if_h_\n\n"
217 if $hfile;
218 print CFILE '#include "'.$intname.'_if.h"'."\n\n"
219 if $cfile;
220
221 } elsif ( $line =~ m/^METHOD/i ) {
222 # Get the return type function name and delete that from
223 # the line. What is left is the possibly first function argument
224 # if it is on the same line.
225 #
226 # FIXME For compatibilities sake METHOD and METHODE is accepted.
227 #
228 if ( !$intname ) {
229 warn "$src:$lineno: No interface name defined";
230 $error = 1;
231 last LINE;
232 }
233 $line =~ s/^METHODE?\s+([^{]+?)\s*{\s*//i;
234 @ret = split m/\s+/, $1;
235 $name = pop @ret; # last element is name of method
236 $ret = join(" ", @ret); # return type
237
238 warn "Method: name=$name return type=$ret"
239 if $debug;
240
241 if ( !$name or !$ret ) {
242 warn $line
243 if $debug;
244 warn "$src:$lineno: Invalid method specification";
245 $error = 1;
246 last LINE;
247 }
248
249 unless ( $name =~ m/^[a-z_][a-z_0-9]*$/ ) {
250 warn $line
251 if $debug;
252 warn "$src:$lineno: Invalid method name '$name', use [a-z_][a-z0-9_]*";
253 $error = 1;
254 last LINE;
255 }
256
257 if ( defined($methods{$name}) ) {
258 warn "$src:$lineno: Duplicate method name";
259 $error = 1;
260 last LINE;
261 }
262
263 $methods{$name} = 'VIS';
264
265 while ( $line !~ m/}/ and $line .= <SRC> ) { }
266
267 if ( $line !~ s/};?(.*)// ) { # remove first '}' and trailing garbage
268 # The '}' was not there (the rest is optional), so complain
269 warn "$src:$lineno: Premature end of file";
270 $error = 1;
271 last LINE;
272 }
273 warn "$src:$lineno: Ignored '$1'" # warn about garbage at end of line
274 if $debug and $1;
275
276 # Create a list of variables without the types prepended
277 #
278 $line =~ s/^\s+//; # remove leading ...
279 $line =~ s/\s+$//; # ... and trailing whitespace
280 $line =~ s/\s+/ /; # remove double spaces
281
282 @arguments = split m/\s*;\s*/, $line;
283 @varnames = (); # list of varnames
284 foreach $argument (@arguments) {
285 next # skip argument if argument is empty
286 if !$argument;
287
288 @ar = split m/[*\s]+/, $argument;
289 if ( $#ar == 0 ) { # only 1 word in argument?
290 warn "$src:$lineno: no type for '$argument'";
291 $error = 1;
292 last LINE;
293 }
294
295 push @varnames, $ar[-1]; # last element is name of variable
296 };
297
298 warn 'Arguments: ' . join(', ', @arguments) . "\n"
299 . 'Varnames: ' . join(', ', @varnames)
300 if $debug;
301
302 $mname = $intname.'_'.$name; # method name
303 $umname = uc($mname); # uppercase method name
304
305 $arguments = join(", ", @arguments);
306 $varnames = join(", ", @varnames);
307
308 if ( $hfile ) {
309 # the method description
310 print HFILE "extern struct device_op_desc $mname\_desc;\n";
311 # the method typedef
312 print HFILE &format_line("typedef $ret $mname\_t($arguments);",
313 $line_width, ', ',
314 ',',' ' x length("typedef $ret $mname\_t("))
315 . "\n";
316 # the method declaration
317 print HFILE "$mname\_t $umname;\n\n";
318 }
319
320 if ( $cfile ) {
321 # Print out the method desc
322 print CFILE "struct device_op_desc $mname\_desc = {\n";
323 print CFILE "\t0, \"$mname\"\n";
324 print CFILE "};\n\n";
325
326 # Print out the method itself
327 if ( 0 ) { # haven't chosen the format yet
328 print CFILE "$ret $umname($varnames)\n";
329 print CFILE "\t".join(";\n\t", @arguments).";\n";
330 } else {
331 print CFILE &format_line("$ret $umname($arguments)",
332 $line_width, ', ',
333 ',', ' ' x length("$ret $umname(")) . "\n";
334 }
335 print CFILE "{\n";
336 print CFILE &format_line("\t$mname\_t *m = ($mname\_t *) DEVOPMETH(dev, $mname);",
337 $line_width-8, ' = ', ' =', "\t\t")
338 . "\n";
339 print CFILE "\t".($ret eq 'void'? '':'return ') . "m($varnames);\n";
340 print CFILE "}\n\n";
341 }
342 } else {
343 warn $line
344 if $debug;
345 warn "$src:$lineno: Invalid line encountered";
346 $error = 1;
347 last LINE;
348 }
349 } # end LINE
350
351 # print the final '#endif' in the header file
352 #
353 print HFILE "#endif /* _".$intname."_if_h_ */\n"
354 if $hfile;
355
356 close SRC;
357 close CFILE
358 if $cfile;
359 close HFILE
360 if $hfile;
361
362 if ( !$error ) {
363 if ( $cfile ) {
364 ($rc = system("mv $ctmpname $cfilename"))
365 and warn "mv $ctmpname $cfilename failed, $rc";
366 }
367
368 if ( $hfile ) {
369 ($rc = system("mv $htmpname $hfilename"))
370 and warn "mv $htmpname $hfilename failed, $rc";
371 }
372 } else {
373 warn 'File' . ($hfile and $cfile? 's':'') . ' skipped';
374 ($rc = system("rm -f $htmpname $ctmpname"))
375 and warn "rm -f $htmpname $ctmpname failed, $rc";
376 $gerror = 1;
377 }
378 }
379
380 exit $gerror;
381
382
383 sub format_line {
384 my ($line, $maxlength, $break, $new_end, $new_start) = @_;
385 my $rline = "";
386
387 while ( length($line) > $maxlength
388 and ($i = rindex $line, $break, $maxlength-length($new_end)) != -1 ) {
389 $rline .= substr($line, 0, $i) . $new_end . "\n";
390 $line = $new_start . substr($line, $i+length($break));
391 }
392
393 return $rline . $line;
394 }
395
396 # This routine is a crude replacement for one in File::Basename. We
397 # cannot use any library code because it fouls up the Perl bootstrap
398 # when we update a perl version. MarkM
399
400 sub fileparse {
401 my ($filename, @suffix) = @_;
402 my ($dir, $name, $type, $i);
403
404 $type = '';
405 foreach $i (@suffix) {
406 if ($filename =~ m|$i$|) {
407 $filename =~ s|$i$||;
408 $type = $i;
409 }
410 }
411 if ($filename =~ m|/|) {
412 $filename =~ m|([^/]*)$|;
413 $name = $1;
414 $dir = $filename;
415 $dir =~ s|$name$||;
416 }
417 else {
418 $dir = '';
419 $name = $filename;
420 }
421 ($name, $dir, $type);
422 }
Cache object: a13f77042318939dcaedd66cc2f58d78
|