github.com/fletavendor/sys@v0.0.0-20181107165924-66b7b1311ac8/unix/mksyscall_aix_ppc.pl (about) 1 #!/usr/bin/env perl 2 # Copyright 2018 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_aix.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_aix_ppc.pl " . join(' ', @ARGV); 23 my $errors = 0; 24 my $_32bit = ""; 25 my $tags = ""; # build tags 26 my $aix = 0; 27 my $solaris = 0; 28 29 binmode STDOUT; 30 31 if($ARGV[0] eq "-b32") { 32 $_32bit = "big-endian"; 33 shift; 34 } elsif($ARGV[0] eq "-l32") { 35 $_32bit = "little-endian"; 36 shift; 37 } 38 if($ARGV[0] eq "-aix") { 39 $aix = 1; 40 shift; 41 } 42 if($ARGV[0] eq "-tags") { 43 shift; 44 $tags = $ARGV[0]; 45 shift; 46 } 47 48 if($ARGV[0] =~ /^-/) { 49 print STDERR "usage: mksyscall_aix.pl [-b32 | -l32] [-tags x,y] [file ...]\n"; 50 exit 1; 51 } 52 53 sub parseparamlist($) { 54 my ($list) = @_; 55 $list =~ s/^\s*//; 56 $list =~ s/\s*$//; 57 if($list eq "") { 58 return (); 59 } 60 return split(/\s*,\s*/, $list); 61 } 62 63 sub parseparam($) { 64 my ($p) = @_; 65 if($p !~ /^(\S*) (\S*)$/) { 66 print STDERR "$ARGV:$.: malformed parameter: $p\n"; 67 $errors = 1; 68 return ("xx", "int"); 69 } 70 return ($1, $2); 71 } 72 73 my $package = ""; 74 my $text = ""; 75 my $c_extern = "/*\n#include <stdint.h>\n#include <stddef.h>\n"; 76 my @vars = (); 77 while(<>) { 78 chomp; 79 s/\s+/ /g; 80 s/^\s+//; 81 s/\s+$//; 82 $package = $1 if !$package && /^package (\S+)$/; 83 my $nonblock = /^\/\/sysnb /; 84 next if !/^\/\/sys / && !$nonblock; 85 86 # Line must be of the form 87 # func Open(path string, mode int, perm int) (fd int, err error) 88 # Split into name, in params, out params. 89 if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*(?:(\w*)\.)?(\w*))?$/) { 90 print STDERR "$ARGV:$.: malformed //sys declaration\n"; 91 $errors = 1; 92 next; 93 } 94 my ($nb, $func, $in, $out, $modname, $sysname) = ($1, $2, $3, $4, $5, $6); 95 96 # Split argument lists on comma. 97 my @in = parseparamlist($in); 98 my @out = parseparamlist($out); 99 100 $in = join(', ', @in); 101 $out = join(', ', @out); 102 103 # Try in vain to keep people from editing this file. 104 # The theory is that they jump into the middle of the file 105 # without reading the header. 106 $text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n"; 107 108 # Check if value return, err return available 109 my $errvar = ""; 110 my $retvar = ""; 111 my $rettype = ""; 112 foreach my $p (@out) { 113 my ($name, $type) = parseparam($p); 114 if($type eq "error") { 115 $errvar = $name; 116 } else { 117 $retvar = $name; 118 $rettype = $type; 119 } 120 } 121 122 # System call name. 123 #if($func ne "fcntl") { 124 125 if($sysname eq "") { 126 $sysname = "$func"; 127 } 128 129 $sysname =~ s/([a-z])([A-Z])/${1}_$2/g; 130 $sysname =~ y/A-Z/a-z/; # All libc functions are lowercase. 131 132 my $C_rettype = ""; 133 if($rettype eq "unsafe.Pointer") { 134 $C_rettype = "uintptr_t"; 135 } elsif($rettype eq "uintptr") { 136 $C_rettype = "uintptr_t"; 137 } elsif($rettype =~ /^_/) { 138 $C_rettype = "uintptr_t"; 139 } elsif($rettype eq "int") { 140 $C_rettype = "int"; 141 } elsif($rettype eq "int32") { 142 $C_rettype = "int"; 143 } elsif($rettype eq "int64") { 144 $C_rettype = "long long"; 145 } elsif($rettype eq "uint32") { 146 $C_rettype = "unsigned int"; 147 } elsif($rettype eq "uint64") { 148 $C_rettype = "unsigned long long"; 149 } else { 150 $C_rettype = "int"; 151 } 152 if($sysname eq "exit") { 153 $C_rettype = "void"; 154 } 155 156 # Change types to c 157 my @c_in = (); 158 foreach my $p (@in) { 159 my ($name, $type) = parseparam($p); 160 if($type =~ /^\*/) { 161 push @c_in, "uintptr_t"; 162 } elsif($type eq "string") { 163 push @c_in, "uintptr_t"; 164 } elsif($type =~ /^\[\](.*)/) { 165 push @c_in, "uintptr_t", "size_t"; 166 } elsif($type eq "unsafe.Pointer") { 167 push @c_in, "uintptr_t"; 168 } elsif($type eq "uintptr") { 169 push @c_in, "uintptr_t"; 170 } elsif($type =~ /^_/) { 171 push @c_in, "uintptr_t"; 172 } elsif($type eq "int") { 173 push @c_in, "int"; 174 } elsif($type eq "int32") { 175 push @c_in, "int"; 176 } elsif($type eq "int64") { 177 push @c_in, "long long"; 178 } elsif($type eq "uint32") { 179 push @c_in, "unsigned int"; 180 } elsif($type eq "uint64") { 181 push @c_in, "unsigned long long"; 182 } else { 183 push @c_in, "int"; 184 } 185 } 186 187 if ($func ne "fcntl" && $func ne "FcntlInt" && $func ne "readlen" && $func ne "writelen") { 188 # Imports of system calls from libc 189 $c_extern .= "$C_rettype $sysname"; 190 my $c_in = join(', ', @c_in); 191 $c_extern .= "($c_in);\n"; 192 } 193 194 # So file name. 195 if($aix) { 196 if($modname eq "") { 197 $modname = "libc.a/shr_64.o"; 198 } else { 199 print STDERR "$func: only syscall using libc are available\n"; 200 $errors = 1; 201 next; 202 } 203 } 204 205 my $strconvfunc = "C.CString"; 206 my $strconvtype = "*byte"; 207 208 # Go function header. 209 if($out ne "") { 210 $out = " ($out)"; 211 } 212 if($text ne "") { 213 $text .= "\n" 214 } 215 216 $text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out ; 217 218 # Prepare arguments to call. 219 my @args = (); 220 my $n = 0; 221 my $arg_n = 0; 222 foreach my $p (@in) { 223 my ($name, $type) = parseparam($p); 224 if($type =~ /^\*/) { 225 push @args, "C.uintptr_t(uintptr(unsafe.Pointer($name)))"; 226 } elsif($type eq "string" && $errvar ne "") { 227 $text .= "\t_p$n := uintptr(unsafe.Pointer($strconvfunc($name)))\n"; 228 push @args, "C.uintptr_t(_p$n)"; 229 $n++; 230 } elsif($type eq "string") { 231 print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n"; 232 $text .= "\t_p$n := uintptr(unsafe.Pointer($strconvfunc($name)))\n"; 233 push @args, "C.uintptr_t(_p$n)"; 234 $n++; 235 } elsif($type =~ /^\[\](.*)/) { 236 # Convert slice into pointer, length. 237 # Have to be careful not to take address of &a[0] if len == 0: 238 # pass nil in that case. 239 $text .= "\tvar _p$n *$1\n"; 240 $text .= "\tif len($name) > 0 {\n\t\t_p$n = \&$name\[0]\n\t}\n"; 241 push @args, "C.uintptr_t(uintptr(unsafe.Pointer(_p$n)))"; 242 $n++; 243 $text .= "\tvar _p$n int\n"; 244 $text .= "\t_p$n = len($name)\n"; 245 push @args, "C.size_t(_p$n)"; 246 $n++; 247 } elsif($type eq "int64" && $_32bit ne "") { 248 if($_32bit eq "big-endian") { 249 push @args, "uintptr($name >> 32)", "uintptr($name)"; 250 } else { 251 push @args, "uintptr($name)", "uintptr($name >> 32)"; 252 } 253 $n++; 254 } elsif($type eq "bool") { 255 $text .= "\tvar _p$n uint32\n"; 256 $text .= "\tif $name {\n\t\t_p$n = 1\n\t} else {\n\t\t_p$n = 0\n\t}\n"; 257 push @args, "_p$n"; 258 $n++; 259 } elsif($type =~ /^_/) { 260 push @args, "C.uintptr_t(uintptr($name))"; 261 } elsif($type eq "unsafe.Pointer") { 262 push @args, "C.uintptr_t(uintptr($name))"; 263 } elsif($type eq "int") { 264 if (($arg_n == 2) && (($func eq "readlen") || ($func eq "writelen"))) { 265 push @args, "C.size_t($name)"; 266 } elsif ($arg_n == 0 && $func eq "fcntl") { 267 push @args, "C.uintptr_t($name)"; 268 } elsif (($arg_n == 2) && (($func eq "fcntl") || ($func eq "FcntlInt"))) { 269 push @args, "C.uintptr_t($name)"; 270 } else { 271 push @args, "C.int($name)"; 272 } 273 } elsif($type eq "int32") { 274 push @args, "C.int($name)"; 275 } elsif($type eq "int64") { 276 push @args, "C.longlong($name)"; 277 } elsif($type eq "uint32") { 278 push @args, "C.uint($name)"; 279 } elsif($type eq "uint64") { 280 push @args, "C.ulonglong($name)"; 281 } elsif($type eq "uintptr") { 282 push @args, "C.uintptr_t($name)"; 283 } else { 284 push @args, "C.int($name)"; 285 } 286 $arg_n++; 287 } 288 my $nargs = @args; 289 290 291 # Determine which form to use; pad args with zeros. 292 if ($nonblock) { 293 } 294 295 my $args = join(', ', @args); 296 my $call = ""; 297 if ($sysname eq "exit") { 298 if ($errvar ne "") { 299 $call .= "er :="; 300 } else { 301 $call .= ""; 302 } 303 } elsif ($errvar ne "") { 304 $call .= "r0,er :="; 305 } elsif ($retvar ne "") { 306 $call .= "r0,_ :="; 307 } else { 308 $call .= "" 309 } 310 $call .= "C.$sysname($args)"; 311 312 # Assign return values. 313 my $body = ""; 314 my $failexpr = ""; 315 316 for(my $i=0; $i<@out; $i++) { 317 my $p = $out[$i]; 318 my ($name, $type) = parseparam($p); 319 my $reg = ""; 320 if($name eq "err") { 321 $reg = "e1"; 322 } else { 323 $reg = "r0"; 324 } 325 if($reg ne "e1" ) { 326 $body .= "\t$name = $type($reg)\n"; 327 } 328 } 329 330 # verify return 331 if ($sysname ne "exit" && $errvar ne "") { 332 if ($C_rettype =~ /^uintptr/) { 333 $body .= "\tif \(uintptr\(r0\) ==\^uintptr\(0\) && er != nil\) {\n"; 334 $body .= "\t\t$errvar = er\n"; 335 $body .= "\t}\n"; 336 } else { 337 $body .= "\tif \(r0 ==-1 && er != nil\) {\n"; 338 $body .= "\t\t$errvar = er\n"; 339 $body .= "\t}\n"; 340 } 341 } elsif ($errvar ne "") { 342 $body .= "\tif \(er != nil\) {\n"; 343 $body .= "\t\t$errvar = er\n"; 344 $body .= "\t}\n"; 345 } 346 347 $text .= "\t$call\n"; 348 $text .= $body; 349 350 $text .= "\treturn\n"; 351 $text .= "}\n"; 352 } 353 354 if($errors) { 355 exit 1; 356 } 357 358 print <<EOF; 359 // $cmdline 360 // Code generated by the command above; see README.md. DO NOT EDIT. 361 362 // +build $tags 363 364 package $package 365 366 367 $c_extern 368 */ 369 import "C" 370 import ( 371 "unsafe" 372 ) 373 374 375 EOF 376 377 print "import \"golang.org/x/sys/unix\"\n" if $package ne "unix"; 378 379 chomp($_=<<EOF); 380 381 $text 382 EOF 383 print $_; 384 exit 0;