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