Initial import from FreeBSD RELENG_4:
[dragonfly.git] / sys / kern / makedevops.pl
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: src/sys/kern/makedevops.pl,v 1.12.2.3 2001/01/18 00:23:57 n_hibma Exp $
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] [-l <nr>] [-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 $cfilename / $hfilename via $ctmpname / $htmpname"
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 source file\n";
149       print CFILE " *   $src\n";
150       print CFILE " * with\n";
151       print CFILE " *   $0\n";
152       print CFILE " *\n";
153       print CFILE " * See the source file for legal information\n";
154       print CFILE " */\n";
155       print CFILE "\n";
156       print CFILE "#include <sys/param.h>\n";
157       print CFILE "#include <sys/queue.h>\n";
158       print CFILE "#include <sys/sysctl.h>\n";
159       print CFILE "#include <sys/bus_private.h>\n";
160    }
161
162    if ( $hfile ) {
163       # Produce the header of the H file
164       #
165       print HFILE "/*\n";
166       print HFILE " * This file is produced automatically.\n";
167       print HFILE " * Do not modify anything in here by hand.\n";
168       print HFILE " *\n";
169       print HFILE " * Created from source file\n";
170       print HFILE " *   $src\n";
171       print HFILE " * with\n";
172       print HFILE " *   $0\n";
173       print HFILE " *\n";
174       print HFILE " * See the source file for legal information\n";
175       print HFILE " */\n";
176       print HFILE "\n";
177    }
178
179    %methods = ();    # clear list of methods
180    $lineno = 0;
181    $error = 0;       # to signal clean up and gerror setting
182
183    LINE: while ( $line = <SRC> ) {
184       $lineno++;
185
186       # take special notice of include directives.
187       #
188       if ( $line =~ m/^#\s*include\s+(["<])([^">]+)([">]).*/i ) {
189          warn "Included file: $1$2" . ($1 eq '<'? '>':'"')
190             if $debug;
191          print CFILE "#include $1$2" . ($1 eq '<'? '>':'"') . "\n"
192             if $cfile;
193       }
194
195       $line =~ s/#.*//;                # remove comments
196       $line =~ s/^\s+//;               # remove leading ...
197       $line =~ s/\s+$//;               # remove trailing whitespace
198
199       if ( $line =~ m/^$/ ) {          # skip empty lines
200          # nop
201       } elsif ( $line =~ m/^INTERFACE\s*([^\s;]*)(\s*;?)/i ) {
202          $intname = $1;
203          $semicolon = $2;
204          unless ( $intname =~ m/^[a-z_][a-z0-9_]*$/ ) {
205             warn $line
206                if $debug;
207             warn "$src:$lineno: Invalid interface name '$intname', use [a-z_][a-z0-9_]*";
208             $error = 1;
209             last LINE;
210          }
211
212          warn "$src:$lineno: semicolon missing at end of line, no problem"
213             if $semicolon !~ s/;$//;
214
215          warn "Interface $intname"
216             if $debug;
217
218          print HFILE '#ifndef _'.$intname."_if_h_\n"
219             if $hfile;
220          print HFILE '#define _'.$intname."_if_h_\n\n"
221             if $hfile;
222          print CFILE '#include "'.$intname.'_if.h"'."\n\n"
223             if $cfile;
224       } elsif ( $line =~ m/^CODE\s*{$/i ) {
225          $code = "";
226          $line = <SRC>;
227          $line =~ m/^(\s*)/;
228          $indent = $1;           # find the indent used
229          while ( $line !~ m/^}/ ) {
230             $line =~ s/^$indent//g; # remove the indent
231             $code .= $line;
232             $line = <SRC>;
233             $lineno++
234          }
235          if ( $cfile ) {
236              print CFILE "\n".$code."\n";
237          }
238       } elsif ( $line =~ m/^HEADER\s*{$/i ) {
239          $header = "";
240          $line = <SRC>;
241          $line =~ m/^(\s*)/;
242          $indent = $1;              # find the indent used
243          while ( $line !~ m/^}/ ) {
244             $line =~ s/^$indent//g; # remove the indent
245             $header .= $line;
246             $line = <SRC>;
247             $lineno++
248          }
249          if ( $hfile ) {
250              print HFILE $header;
251          }
252       } elsif ( $line =~ m/^(STATIC|)METHOD/i ) {
253          # Get the return type function name and delete that from
254          # the line. What is left is the possibly first function argument
255          # if it is on the same line.
256          #
257          if ( !$intname ) {
258             warn "$src:$lineno: No interface name defined";
259             $error = 1;
260             last LINE;
261          }
262          $line =~ s/^(STATIC|)METHOD\s+([^{]+?)\s*{\s*//i;
263          $static = $1;                                                    
264          @ret = split m/\s+/, $2;
265          $name = pop @ret;          # last element is name of method
266          $ret = join(" ", @ret);    # return type
267
268          warn "Method: name=$name return type=$ret"
269             if $debug;
270          
271          if ( !$name or !$ret ) {
272             warn $line
273                if $debug;
274             warn "$src:$lineno: Invalid method specification";
275             $error = 1;
276             last LINE;
277          }
278
279          unless ( $name =~ m/^[a-z_][a-z_0-9]*$/ ) {
280             warn $line
281                if $debug;
282             warn "$src:$lineno: Invalid method name '$name', use [a-z_][a-z0-9_]*";
283             $error = 1;
284             last LINE;
285          }
286
287          if ( defined($methods{$name}) ) {
288             warn "$src:$lineno: Duplicate method name";
289             $error = 1;
290             last LINE;
291          }
292
293          $methods{$name} = 'VIS';
294
295          while ( $line !~ m/}/ and $line .= <SRC> ) {
296             $lineno++
297          }
298
299          $default = "";
300          if ( $line !~ s/};?(.*)// ) { # remove first '}' and trailing garbage
301             # The '}' was not there (the rest is optional), so complain
302             warn "$src:$lineno: Premature end of file";
303             $error = 1;
304             last LINE;
305          }
306          $extra = $1;
307          if ( $extra =~ /\s*DEFAULT\s*([a-zA-Z_][a-zA-Z_0-9]*)\s*;/ ) {
308             $default = $1;
309          } else {
310             warn "$src:$lineno: Ignored '$1'"  # warn about garbage at end of line
311                if $debug and $1;
312          }
313
314          # Create a list of variables without the types prepended
315          #
316          $line =~ s/^\s+//;            # remove leading ...
317          $line =~ s/\s+$//;            # ... and trailing whitespace
318          $line =~ s/\s+/ /g;           # remove double spaces
319
320          @arguments = split m/\s*;\s*/, $line;
321          @varnames = ();               # list of varnames
322          foreach $argument (@arguments) {
323             next                       # skip argument if argument is empty
324                if !$argument;
325
326             @ar = split m/[*\s]+/, $argument;
327             if ( $#ar == 0 ) {         # only 1 word in argument?
328                warn "$src:$lineno: no type for '$argument'";
329                $error = 1;
330                last LINE;
331             }
332
333             push @varnames, $ar[-1];   # last element is name of variable
334          };
335
336          warn 'Arguments: ' . join(', ', @arguments) . "\n"
337             . 'Varnames: ' . join(', ', @varnames)
338             if $debug;
339
340          $mname = $intname.'_'.$name;  # method name
341          $umname = uc($mname);         # uppercase method name
342
343          $arguments = join(", ", @arguments);
344          $varnames = join(", ", @varnames);
345
346          $default = "0" if $default eq "";
347
348          if ( $hfile ) {
349             # the method description 
350             print HFILE "extern struct device_op_desc $mname\_desc;\n";
351             # the method typedef
352             my $prototype = "typedef $ret $mname\_t(";
353             print HFILE &format_line("$prototype$arguments);",
354                               $line_width, ', ', ',',' ' x length($prototype))
355                       . "\n";
356             # the method declaration
357             print HFILE "$mname\_t $umname;\n\n";
358          }
359
360          if ( $cfile ) {
361             # Print out the method desc
362             print CFILE "struct device_op_desc $mname\_desc = {\n";
363             print CFILE "\t0, 0, (devop_t) $default, \"$mname\"\n";
364             print CFILE "};\n\n";
365
366             # Print out the method itself
367             if ( 0 ) {                 # haven't chosen the format yet
368                print CFILE "$ret $umname($varnames)\n";
369                print CFILE "\t".join(";\n\t", @arguments).";\n";
370             } else {
371                my $prototype = "$ret $umname(";
372                print CFILE &format_line("$prototype$arguments)",
373                               $line_width, ', ', ',', ' ' x length($prototype))
374                          . "\n";
375             }
376             print CFILE "{\n";
377             if ($static) {
378               print CFILE &format_line("\t$mname\_t *m = ($mname\_t *) DRVOPMETH(driver, $mname);",
379                                        $line_width-8, ' = ', ' =', "\t\t")
380                 . "\n";
381             } else {
382               print CFILE &format_line("\t$mname\_t *m = ($mname\_t *) DEVOPMETH(dev, $mname);",
383                                        $line_width-8, ' = ', ' =', "\t\t")
384                 . "\n";
385             }
386             print CFILE "\t".($ret eq 'void'? '':'return ') . "m($varnames);\n";
387             print CFILE "}\n\n";
388          }
389       } else {
390          warn $line
391             if $debug;
392          warn "$src:$lineno: Invalid line encountered";
393          $error = 1;
394          last LINE;
395       }
396    } # end LINE
397
398    # print the final '#endif' in the header file
399    #
400    print HFILE "#endif /* _".$intname."_if_h_ */\n"
401       if $hfile;
402
403    close SRC;
404    close CFILE
405       if $cfile;
406    close HFILE
407       if $hfile;
408
409    if ( !$error ) {
410       if ( $cfile ) {
411          ($rc = system("mv $ctmpname $cfilename"))
412             and warn "mv $ctmpname $cfilename failed, $rc";
413       }
414
415       if ( $hfile ) {
416          ($rc = system("mv $htmpname $hfilename"))
417             and warn "mv $htmpname $hfilename failed, $rc";
418       }
419    } else {
420       warn 'Output skipped';
421       ($rc = system("rm -f $htmpname $ctmpname"))
422          and warn "rm -f $htmpname $ctmpname failed, $rc";
423       $gerror = 1;
424    }
425 }
426
427 exit $gerror;
428
429
430 sub format_line {
431    my ($line, $maxlength, $break, $new_end, $new_start) = @_;
432    my $rline = "";
433
434    while ( length($line) > $maxlength
435            and ($i = rindex $line, $break, $maxlength-length($new_end)) != -1 ) {
436       $rline .= substr($line, 0, $i) . $new_end . "\n";
437       $line = $new_start . substr($line, $i+length($break));
438    }
439
440    return $rline . $line;
441 }
442
443 # This routine is a crude replacement for one in File::Basename. We
444 # cannot use any library code because it fouls up the Perl bootstrap
445 # when we update a perl version. MarkM
446
447 sub fileparse {
448    my ($filename, @suffix) = @_;
449    my ($dir, $name, $type, $i);
450
451    $type = '';
452    foreach $i (@suffix) {
453       if ($filename =~ m|$i$|) {
454          $filename =~ s|$i$||;
455          $type = $i;
456       }
457    }
458    if ($filename =~ m|/|) {
459       $filename =~ m|([^/]*)$|;
460       $name = $1;
461       $dir = $filename;
462       $dir =~ s|$name$||;
463    }
464    else {
465       $dir = '';
466       $name = $filename;
467    }
468    ($name, $dir, $type);
469 }