src/syscall/mksyscall_libc.pl

   1 #!/usr/bin/env perl
   2 # Copyright 2009 The Go Authors. All rights reserved.
   3 # Use of this source code is governed by a BSD-style
   4 # license that can be found in the LICENSE file.
   5
   6 # This program reads a file containing function prototypes
   7 # (like syscall_solaris.go) and generates system call bodies.
   8 # The prototypes are marked by lines beginning with "//sys"
   9 # and read like func declarations if //sys is replaced by func, but:
  10 #       * The parameter lists must give a name for each argument.
  11 #         This includes return parameters.
  12 #       * The parameter lists must give a type for each argument:
  13 #         the (x, y, z int) shorthand is not allowed.
  14 #       * If the return parameter is an error number, it must be named err.
  15 #       * If go func name needs to be different than its libc name,
  16 #       * or the function is not in libc, name could be specified
  17 #       * at the end, after "=" sign, like
  18 #         //sys getsockopt(s int, level int, name int, val uintptr, vallen *_Socklen) (err error) = libsocket.getsockopt
  19
  20 use strict;
  21
  22 my $cmdline = "mksyscall_libc.pl " . join(' ', @ARGV);
  23 my $errors = 0;
  24 my $_32bit = "";
  25 my $tags = "";  # build tags
  26 my $newtags = ""; # new style build tags
  27 my $aix = 0;
  28 my $solaris = 0;
  29
  30 binmode STDOUT;
  31
  32 if($ARGV[0] eq "-b32") {
  33         $_32bit = "big-endian";
  34         shift;
  35 } elsif($ARGV[0] eq "-l32") {
  36         $_32bit = "little-endian";
  37         shift;
  38 }
  39 if($ARGV[0] eq "-aix") {
  40         $aix = 1;
  41         shift;
  42 }
  43 if($ARGV[0] eq "-solaris") {
  44         $solaris = 1;
  45         shift;
  46 }
  47 if($ARGV[0] eq "-tags") {
  48         shift;
  49         $tags = $ARGV[0];
  50         shift;
  51 }
  52
  53
  54 if($ARGV[0] =~ /^-/) {
  55         print STDERR "usage: mksyscall_libc.pl [-b32 | -l32] [-aix | -solaris] [-tags x,y] [file ...]\n";
  56         exit 1;
  57 }
  58
  59 sub parseparamlist($) {
  60         my ($list) = @_;
  61         $list =~ s/^\s*//;
  62         $list =~ s/\s*$//;
  63         if($list eq "") {
  64                 return ();
  65         }
  66         return split(/\s*,\s*/, $list);
  67 }
  68
  69 sub parseparam($) {
  70         my ($p) = @_;
  71         if($p !~ /^(\S*) (\S*)$/) {
  72                 print STDERR "$ARGV:$.: malformed parameter: $p\n";
  73                 $errors = 1;
  74                 return ("xx", "int");
  75         }
  76         return ($1, $2);
  77 }
  78
  79 my $package = "";
  80 my $text = "";
  81 my $dynimports = "";
  82 my $linknames = "";
  83 my @vars = ();
  84 while(<>) {
  85         chomp;
  86         s/\s+/ /g;
  87         s/^\s+//;
  88         s/\s+$//;
  89         $package = $1 if !$package && /^package (\S+)$/;
  90         my $nonblock = /^\/\/sysnb /;
  91         next if !/^\/\/sys / && !$nonblock;
  92
  93         my $syscalldot = "";
  94         $syscalldot = "syscall." if $package ne "syscall";
  95
  96         # Line must be of the form
  97         #       func Open(path string, mode int, perm int) (fd int, err error)
  98         # Split into name, in params, out params.
  99         if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*(?:(\w*)\.)?(\w*))?$/) {
 100                 print STDERR "$ARGV:$.: malformed //sys declaration\n";
 101                 $errors = 1;
 102                 next;
 103         }
 104         my ($nb, $func, $in, $out, $modname, $sysname) = ($1, $2, $3, $4, $5, $6);
 105
 106         # Split argument lists on comma.
 107         my @in = parseparamlist($in);
 108         my @out = parseparamlist($out);
 109
 110         # Try in vain to keep people from editing this file.
 111         # The theory is that they jump into the middle of the file
 112         # without reading the header.
 113         $text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n";
 114
 115         # So file name.
 116         if($aix) {
 117                 if($modname eq "") {
 118                         $modname = "libc.a/shr_64.o";
 119                 } else {
 120                         print STDERR "$func: only syscall using libc are available\n";
 121                         $errors = 1;
 122                         next;
 123                 }
 124
 125         }
 126         if($solaris) {
 127                 if($modname eq "") {
 128                         $modname = "libc";
 129                 }
 130                 $modname .= ".so";
 131
 132         }
 133
 134         # System call name.
 135         if($sysname eq "") {
 136                 $sysname = "$func";
 137         }
 138
 139         # System call pointer variable name.
 140         my $sysvarname = "libc_${sysname}";
 141
 142         my $strconvfunc = "BytePtrFromString";
 143         my $strconvtype = "*byte";
 144
 145         $sysname =~ y/A-Z/a-z/; # All libc functions are lowercase.
 146
 147         # Runtime import of function to allow cross-platform builds.
 148         if($dynimports !~ /\s+${sysvarname}\s+/) {
 149                 $dynimports .= "//go:cgo_import_dynamic ${sysvarname} ${sysname} \"$modname\"\n";
 150                 # Link symbol to proc address variable.
 151                 $linknames .= "//go:linkname ${sysvarname} ${sysvarname}\n";
 152                 # Library proc address variable.
 153                 push @vars, $sysvarname;
 154         }
 155
 156         # Go function header.
 157         $out = join(', ', @out);
 158         if($out ne "") {
 159                 $out = " ($out)";
 160         }
 161         if($text ne "") {
 162                 $text .= "\n"
 163         }
 164         $text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out;
 165
 166         # Check if err return available
 167         my $errvar = "";
 168         foreach my $p (@out) {
 169                 my ($name, $type) = parseparam($p);
 170                 if($type eq "error") {
 171                         $errvar = $name;
 172                         last;
 173                 }
 174         }
 175
 176         # Prepare arguments to Syscall.
 177         my @args = ();
 178         my $n = 0;
 179         foreach my $p (@in) {
 180                 my ($name, $type) = parseparam($p);
 181                 if($type =~ /^\*/) {
 182                         push @args, "uintptr(unsafe.Pointer($name))";
 183                 } elsif($type eq "string" && $errvar ne "") {
 184                         $text .= "\tvar _p$n $strconvtype\n";
 185                         $text .= "\t_p$n, $errvar = $strconvfunc($name)\n";
 186                         $text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
 187                         push @args, "uintptr(unsafe.Pointer(_p$n))";
 188                         $n++;
 189                 } elsif($type eq "string") {
 190                         print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
 191                         $text .= "\tvar _p$n $strconvtype\n";
 192                         $text .= "\t_p$n, _ = $strconvfunc($name)\n";
 193                         push @args, "uintptr(unsafe.Pointer(_p$n))";
 194                         $n++;
 195                 } elsif($type =~ /^\[\](.*)/) {
 196                         # Convert slice into pointer, length.
 197                         # Have to be careful not to take address of &a[0] if len == 0:
 198                         # pass nil in that case.
 199                         $text .= "\tvar _p$n *$1\n";
 200                         $text .= "\tif len($name) > 0 {\n\t\t_p$n = \&$name\[0]\n\t}\n";
 201                         push @args, "uintptr(unsafe.Pointer(_p$n))", "uintptr(len($name))";
 202                         $n++;
 203                 } elsif($type eq "int64" && $_32bit ne "") {
 204                         if($_32bit eq "big-endian") {
 205                                 push @args, "uintptr($name >> 32)", "uintptr($name)";
 206                         } else {
 207                                 push @args, "uintptr($name)", "uintptr($name >> 32)";
 208                         }
 209                 } elsif($type eq "bool") {
 210                         $text .= "\tvar _p$n uint32\n";
 211                         $text .= "\tif $name {\n\t\t_p$n = 1\n\t} else {\n\t\t_p$n = 0\n\t}\n";
 212                         push @args, "uintptr(_p$n)";
 213                         $n++;
 214                 } else {
 215                         push @args, "uintptr($name)";
 216                 }
 217         }
 218         my $nargs = @args;
 219
 220         my $asmfuncname="";
 221         my $asmrawfuncname="";
 222
 223         if($aix){
 224                 $asmfuncname="syscall6";
 225                 $asmrawfuncname="rawSyscall6";
 226         } else {
 227                 $asmfuncname="sysvicall6";
 228                 $asmrawfuncname="rawSysvicall6";
 229         }
 230
 231         # Determine which form to use; pad args with zeros.
 232         my $asm = "${syscalldot}${asmfuncname}";
 233         if ($nonblock) {
 234                 $asm = "${syscalldot}${asmrawfuncname}";
 235         }
 236         if(@args <= 6) {
 237                 while(@args < 6) {
 238                         push @args, "0";
 239                 }
 240         } else {
 241                 print STDERR "$ARGV:$.: too many arguments to system call\n";
 242         }
 243
 244         # Actual call.
 245         my $args = join(', ', @args);
 246         my $call = "$asm(uintptr(unsafe.Pointer(&$sysvarname)), $nargs, $args)";
 247
 248         # Assign return values.
 249         my $body = "";
 250         my $failexpr = "";
 251         my @ret = ("_", "_", "_");
 252         my @pout= ();
 253         my $do_errno = 0;
 254         for(my $i=0; $i<@out; $i++) {
 255                 my $p = $out[$i];
 256                 my ($name, $type) = parseparam($p);
 257                 my $reg = "";
 258                 if($name eq "err") {
 259                         $reg = "e1";
 260                         $ret[2] = $reg;
 261                         $do_errno = 1;
 262                 } else {
 263                         $reg = sprintf("r%d", $i);
 264                         $ret[$i] = $reg;
 265                 }
 266                 if($type eq "bool") {
 267                         $reg = "$reg != 0";
 268                 }
 269                 if($type eq "int64" && $_32bit ne "") {
 270                         # 64-bit number in r1:r0 or r0:r1.
 271                         if($i+2 > @out) {
 272                                 print STDERR "$ARGV:$.: not enough registers for int64 return\n";
 273                         }
 274                         if($_32bit eq "big-endian") {
 275                                 $reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
 276                         } else {
 277                                 $reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
 278                         }
 279                         $ret[$i] = sprintf("r%d", $i);
 280                         $ret[$i+1] = sprintf("r%d", $i+1);
 281                 }
 282                 if($reg ne "e1") {
 283                         $body .= "\t$name = $type($reg)\n";
 284                 }
 285         }
 286         if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
 287                 $text .= "\t$call\n";
 288         } else {
 289                 $text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
 290         }
 291         $text .= $body;
 292
 293         if ($do_errno) {
 294                 $text .= "\tif e1 != 0 {\n";
 295                 $text .= "\t\terr = errnoErr(e1)\n";
 296                 $text .= "\t}\n";
 297         }
 298         $text .= "\treturn\n";
 299         $text .= "}\n";
 300 }
 301
 302 if($errors) {
 303         exit 1;
 304 }
 305
 306 # TODO: this assumes tags are just simply comma separated. For now this is all the uses.
 307 $newtags = $tags =~ s/,/ && /r;
 308
 309 print <<EOF;
 310 // $cmdline
 311 // Code generated by the command above; DO NOT EDIT.
 312
 313 //go:build $newtags
 314
 315 package $package
 316
 317 import "unsafe"
 318 EOF
 319
 320 print "import \"syscall\"\n" if $package ne "syscall";
 321
 322 my $vardecls = "\t" . join(",\n\t", @vars);
 323 $vardecls .= " libcFunc";
 324
 325 chomp($_=<<EOF);
 326
 327 $dynimports
 328 $linknames
 329 type libcFunc uintptr
 330
 331 var (
 332 $vardecls
 333 )
 334
 335 $text
 336 EOF
 337 print $_;
 338 exit 0;