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