Add predicate message facility.
[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 # $DragonFly: src/sys/kern/Attic/makedevops.pl,v 1.2 2003/06/17 04:28:41 dillon Exp $
40
41 #
42 # Script to produce device front-end sugar.
43 #
44
45 $debug = 0;
46 $cfile = 0;          # by default do not produce any file type
47 $hfile = 0;
48
49 $keepcurrentdir = 1;
50
51 $line_width = 80;
52
53 # Process the command line
54 #
55 while ( $arg = shift @ARGV ) {
56    if ( $arg eq '-c' ) {
57       warn "Producing .c output files"
58          if $debug;
59       $cfile = 1;
60    } elsif ( $arg eq '-h' ) {
61       warn "Producing .h output files"
62          if $debug;
63       $hfile = 1;
64    } elsif ( $arg eq '-ch' || $arg eq '-hc' ) {
65       warn "Producing .c and .h output files"
66          if $debug;
67       $cfile = 1;
68       $hfile = 1;
69    } elsif ( $arg eq '-d' ) {
70       $debug = 1;
71    } elsif ( $arg eq '-p' ) {
72       warn "Will produce files in original not in current directory"
73          if $debug;
74       $keepcurrentdir = 0;
75    } elsif ( $arg eq '-l' ) {
76       if ( $line_width = shift @ARGV and $line_width > 0 ) {
77          warn "Line width set to $line_width"
78             if $debug;
79       } else {
80          die "Please specify a valid line width after -l";
81       }
82    } elsif ( $arg =~ m/\.m$/ ) {
83       warn "Filename: $arg"
84          if $debug;
85       push @filenames, $arg;
86    } else {
87       warn "$arg ignored"
88          if $debug;
89    }
90 }
91
92
93 # Validate the command line parameters
94 #
95 die "usage: $0 [-d] [-p] [-l <nr>] [-c|-h] srcfile
96 where -c   produce only .c files
97       -h   produce only .h files
98       -p   use the path component in the source file for destination dir
99       -l   set line width for output files [80]
100       -d   switch on debugging
101 "
102         unless ($cfile or $hfile)
103            and $#filenames != -1;
104
105 # FIXME should be able to do this more easily
106 #
107 $tmpdir = $ENV{'TMPDIR'};           # environment variables
108 $tmpdir = $ENV{'TMP'}
109    if !$tmpdir;
110 $tmpdir = $ENV{'TEMP'}
111    if !$tmpdir;
112 $tmpdir = '/tmp'                    # look for a physical directory
113    if !$tmpdir and -d '/tmp';
114 $tmpdir = '/usr/tmp'
115    if !$tmpdir and -d '/usr/tmp';
116 $tmpdir = '/var/tmp'
117    if !$tmpdir and -d '/var/tmp';
118 $tmpdir = '.'                       # give up and use current dir
119    if !$tmpdir;
120
121 foreach $src ( @filenames ) {
122    # Names of the created files
123    $ctmpname = "$tmpdir/ctmp.$$";
124    $htmpname = "$tmpdir/htmp.$$";
125
126    ($name, $path, $suffix) = &fileparse($src, '.m');
127    $path = '.'
128       if $keepcurrentdir;
129    $cfilename="$path/$name.c";
130    $hfilename="$path/$name.h";
131
132    warn "Processing from $src to $cfilename / $hfilename via $ctmpname / $htmpname"
133       if $debug;
134
135    die "Could not open $src, $!"
136       if !open SRC, "$src";
137    die "Could not open $ctmpname, $!"
138       if $cfile and !open CFILE, ">$ctmpname";
139    die "Could not open $htmpname, $!"
140       if $hfile and !open HFILE, ">$htmpname";
141
142    if ( $cfile ) {
143       # Produce the header of the C file
144       #
145       print CFILE "/*\n";
146       print CFILE " * This file is produced automatically.\n";
147       print CFILE " * Do not modify anything in here by hand.\n";
148       print CFILE " *\n";
149       print CFILE " * Created from source file\n";
150       print CFILE " *   $src\n";
151       print CFILE " * with\n";
152       print CFILE " *   $0\n";
153       print CFILE " *\n";
154       print CFILE " * See the source file for legal information\n";
155       print CFILE " */\n";
156       print CFILE "\n";
157       print CFILE "#include <sys/param.h>\n";
158       print CFILE "#include <sys/queue.h>\n";
159       print CFILE "#include <sys/sysctl.h>\n";
160       print CFILE "#include <sys/bus_private.h>\n";
161    }
162
163    if ( $hfile ) {
164       # Produce the header of the H file
165       #
166       print HFILE "/*\n";
167       print HFILE " * This file is produced automatically.\n";
168       print HFILE " * Do not modify anything in here by hand.\n";
169       print HFILE " *\n";
170       print HFILE " * Created from source file\n";
171       print HFILE " *   $src\n";
172       print HFILE " * with\n";
173       print HFILE " *   $0\n";
174       print HFILE " *\n";
175       print HFILE " * See the source file for legal information\n";
176       print HFILE " */\n";
177       print HFILE "\n";
178    }
179
180    %methods = ();    # clear list of methods
181    $lineno = 0;
182    $error = 0;       # to signal clean up and gerror setting
183
184    LINE: while ( $line = <SRC> ) {
185       $lineno++;
186
187       # take special notice of include directives.
188       #
189       if ( $line =~ m/^#\s*include\s+(["<])([^">]+)([">]).*/i ) {
190          warn "Included file: $1$2" . ($1 eq '<'? '>':'"')
191             if $debug;
192          print CFILE "#include $1$2" . ($1 eq '<'? '>':'"') . "\n"
193             if $cfile;
194       }
195
196       $line =~ s/#.*//;                # remove comments
197       $line =~ s/^\s+//;               # remove leading ...
198       $line =~ s/\s+$//;               # remove trailing whitespace
199
200       if ( $line =~ m/^$/ ) {          # skip empty lines
201          # nop
202       } elsif ( $line =~ m/^INTERFACE\s*([^\s;]*)(\s*;?)/i ) {
203          $intname = $1;
204          $semicolon = $2;
205          unless ( $intname =~ m/^[a-z_][a-z0-9_]*$/ ) {
206             warn $line
207                if $debug;
208             warn "$src:$lineno: Invalid interface name '$intname', use [a-z_][a-z0-9_]*";
209             $error = 1;
210             last LINE;
211          }
212
213          warn "$src:$lineno: semicolon missing at end of line, no problem"
214             if $semicolon !~ s/;$//;
215
216          warn "Interface $intname"
217             if $debug;
218
219          print HFILE '#ifndef _'.$intname."_if_h_\n"
220             if $hfile;
221          print HFILE '#define _'.$intname."_if_h_\n\n"
222             if $hfile;
223          print CFILE '#include "'.$intname.'_if.h"'."\n\n"
224             if $cfile;
225       } elsif ( $line =~ m/^CODE\s*{$/i ) {
226          $code = "";
227          $line = <SRC>;
228          $line =~ m/^(\s*)/;
229          $indent = $1;           # find the indent used
230          while ( $line !~ m/^}/ ) {
231             $line =~ s/^$indent//g; # remove the indent
232             $code .= $line;
233             $line = <SRC>;
234             $lineno++
235          }
236          if ( $cfile ) {
237              print CFILE "\n".$code."\n";
238          }
239       } elsif ( $line =~ m/^HEADER\s*{$/i ) {
240          $header = "";
241          $line = <SRC>;
242          $line =~ m/^(\s*)/;
243          $indent = $1;              # find the indent used
244          while ( $line !~ m/^}/ ) {
245             $line =~ s/^$indent//g; # remove the indent
246             $header .= $line;
247             $line = <SRC>;
248             $lineno++
249          }
250          if ( $hfile ) {
251              print HFILE $header;
252          }
253       } elsif ( $line =~ m/^(STATIC|)METHOD/i ) {
254          # Get the return type function name and delete that from
255          # the line. What is left is the possibly first function argument
256          # if it is on the same line.
257          #
258          if ( !$intname ) {
259             warn "$src:$lineno: No interface name defined";
260             $error = 1;
261             last LINE;
262          }
263          $line =~ s/^(STATIC|)METHOD\s+([^{]+?)\s*{\s*//i;
264          $static = $1;                                                    
265          @ret = split m/\s+/, $2;
266          $name = pop @ret;          # last element is name of method
267          $ret = join(" ", @ret);    # return type
268
269          warn "Method: name=$name return type=$ret"
270             if $debug;
271          
272          if ( !$name or !$ret ) {
273             warn $line
274                if $debug;
275             warn "$src:$lineno: Invalid method specification";
276             $error = 1;
277             last LINE;
278          }
279
280          unless ( $name =~ m/^[a-z_][a-z_0-9]*$/ ) {
281             warn $line
282                if $debug;
283             warn "$src:$lineno: Invalid method name '$name', use [a-z_][a-z0-9_]*";
284             $error = 1;
285             last LINE;
286          }
287
288          if ( defined($methods{$name}) ) {
289             warn "$src:$lineno: Duplicate method name";
290             $error = 1;
291             last LINE;
292          }
293
294          $methods{$name} = 'VIS';
295
296          while ( $line !~ m/}/ and $line .= <SRC> ) {
297             $lineno++
298          }
299
300          $default = "";
301          if ( $line !~ s/};?(.*)// ) { # remove first '}' and trailing garbage
302             # The '}' was not there (the rest is optional), so complain
303             warn "$src:$lineno: Premature end of file";
304             $error = 1;
305             last LINE;
306          }
307          $extra = $1;
308          if ( $extra =~ /\s*DEFAULT\s*([a-zA-Z_][a-zA-Z_0-9]*)\s*;/ ) {
309             $default = $1;
310          } else {
311             warn "$src:$lineno: Ignored '$1'"  # warn about garbage at end of line
312                if $debug and $1;
313          }
314
315          # Create a list of variables without the types prepended
316          #
317          $line =~ s/^\s+//;            # remove leading ...
318          $line =~ s/\s+$//;            # ... and trailing whitespace
319          $line =~ s/\s+/ /g;           # remove double spaces
320
321          @arguments = split m/\s*;\s*/, $line;
322          @varnames = ();               # list of varnames
323          foreach $argument (@arguments) {
324             next                       # skip argument if argument is empty
325                if !$argument;
326
327             @ar = split m/[*\s]+/, $argument;
328             if ( $#ar == 0 ) {         # only 1 word in argument?
329                warn "$src:$lineno: no type for '$argument'";
330                $error = 1;
331                last LINE;
332             }
333
334             push @varnames, $ar[-1];   # last element is name of variable
335          };
336
337          warn 'Arguments: ' . join(', ', @arguments) . "\n"
338             . 'Varnames: ' . join(', ', @varnames)
339             if $debug;
340
341          $mname = $intname.'_'.$name;  # method name
342          $umname = uc($mname);         # uppercase method name
343
344          $arguments = join(", ", @arguments);
345          $varnames = join(", ", @varnames);
346
347          $default = "0" if $default eq "";
348
349          if ( $hfile ) {
350             # the method description 
351             print HFILE "extern struct device_op_desc $mname\_desc;\n";
352             # the method typedef
353             my $prototype = "typedef $ret $mname\_t(";
354             print HFILE &format_line("$prototype$arguments);",
355                               $line_width, ', ', ',',' ' x length($prototype))
356                       . "\n";
357             # the method declaration
358             print HFILE "$mname\_t $umname;\n\n";
359          }
360
361          if ( $cfile ) {
362             # Print out the method desc
363             print CFILE "struct device_op_desc $mname\_desc = {\n";
364             print CFILE "\t0, 0, (devop_t) $default, \"$mname\"\n";
365             print CFILE "};\n\n";
366
367             # Print out the method itself
368             if ( 0 ) {                 # haven't chosen the format yet
369                print CFILE "$ret $umname($varnames)\n";
370                print CFILE "\t".join(";\n\t", @arguments).";\n";
371             } else {
372                my $prototype = "$ret $umname(";
373                print CFILE &format_line("$prototype$arguments)",
374                               $line_width, ', ', ',', ' ' x length($prototype))
375                          . "\n";
376             }
377             print CFILE "{\n";
378             if ($static) {
379               print CFILE &format_line("\t$mname\_t *m = ($mname\_t *) DRVOPMETH(driver, $mname);",
380                                        $line_width-8, ' = ', ' =', "\t\t")
381                 . "\n";
382             } else {
383               print CFILE &format_line("\t$mname\_t *m = ($mname\_t *) DEVOPMETH(dev, $mname);",
384                                        $line_width-8, ' = ', ' =', "\t\t")
385                 . "\n";
386             }
387             print CFILE "\t".($ret eq 'void'? '':'return ') . "m($varnames);\n";
388             print CFILE "}\n\n";
389          }
390       } else {
391          warn $line
392             if $debug;
393          warn "$src:$lineno: Invalid line encountered";
394          $error = 1;
395          last LINE;
396       }
397    } # end LINE
398
399    # print the final '#endif' in the header file
400    #
401    print HFILE "#endif /* _".$intname."_if_h_ */\n"
402       if $hfile;
403
404    close SRC;
405    close CFILE
406       if $cfile;
407    close HFILE
408       if $hfile;
409
410    if ( !$error ) {
411       if ( $cfile ) {
412          ($rc = system("mv $ctmpname $cfilename"))
413             and warn "mv $ctmpname $cfilename failed, $rc";
414       }
415
416       if ( $hfile ) {
417          ($rc = system("mv $htmpname $hfilename"))
418             and warn "mv $htmpname $hfilename failed, $rc";
419       }
420    } else {
421       warn 'Output skipped';
422       ($rc = system("rm -f $htmpname $ctmpname"))
423          and warn "rm -f $htmpname $ctmpname failed, $rc";
424       $gerror = 1;
425    }
426 }
427
428 exit $gerror;
429
430
431 sub format_line {
432    my ($line, $maxlength, $break, $new_end, $new_start) = @_;
433    my $rline = "";
434
435    while ( length($line) > $maxlength
436            and ($i = rindex $line, $break, $maxlength-length($new_end)) != -1 ) {
437       $rline .= substr($line, 0, $i) . $new_end . "\n";
438       $line = $new_start . substr($line, $i+length($break));
439    }
440
441    return $rline . $line;
442 }
443
444 # This routine is a crude replacement for one in File::Basename. We
445 # cannot use any library code because it fouls up the Perl bootstrap
446 # when we update a perl version. MarkM
447
448 sub fileparse {
449    my ($filename, @suffix) = @_;
450    my ($dir, $name, $type, $i);
451
452    $type = '';
453    foreach $i (@suffix) {
454       if ($filename =~ m|$i$|) {
455          $filename =~ s|$i$||;
456          $type = $i;
457       }
458    }
459    if ($filename =~ m|/|) {
460       $filename =~ m|([^/]*)$|;
461       $name = $1;
462       $dir = $filename;
463       $dir =~ s|$name$||;
464    }
465    else {
466       $dir = '';
467       $name = $filename;
468    }
469    ($name, $dir, $type);
470 }