github.com/varialus/godfly@v0.0.0-20130904042352-1934f9f095ab/src/pkg/syscall/mksyscall_windows.pl (about) 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_darwin.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 from it's winapi dll name, 16 # the winapi name could be specified at the end, after "=" sign, like 17 # //sys LoadLibrary(libname string) (handle uint32, err error) = LoadLibraryA 18 # * Each function that returns err needs to supply a condition, 19 # that return value of winapi will be tested against to 20 # detect failure. This would set err to windows "last-error", 21 # otherwise it will be nil. The value can be provided 22 # at end of //sys declaration, like 23 # //sys LoadLibrary(libname string) (handle uint32, err error) [failretval==-1] = LoadLibraryA 24 # and is [failretval==0] by default. 25 26 use strict; 27 28 my $cmdline = "mksyscall_windows.pl " . join(' ', @ARGV); 29 my $errors = 0; 30 my $_32bit = ""; 31 32 binmode STDOUT; 33 34 if($ARGV[0] eq "-b32") { 35 $_32bit = "big-endian"; 36 shift; 37 } elsif($ARGV[0] eq "-l32") { 38 $_32bit = "little-endian"; 39 shift; 40 } 41 42 if($ARGV[0] =~ /^-/) { 43 print STDERR "usage: mksyscall_windows.pl [-b32 | -l32] [file ...]\n"; 44 exit 1; 45 } 46 47 sub parseparamlist($) { 48 my ($list) = @_; 49 $list =~ s/^\s*//; 50 $list =~ s/\s*$//; 51 if($list eq "") { 52 return (); 53 } 54 return split(/\s*,\s*/, $list); 55 } 56 57 sub parseparam($) { 58 my ($p) = @_; 59 if($p !~ /^(\S*) (\S*)$/) { 60 print STDERR "$ARGV:$.: malformed parameter: $p\n"; 61 $errors = 1; 62 return ("xx", "int"); 63 } 64 return ($1, $2); 65 } 66 67 my $package = ""; 68 my $text = ""; 69 my $vars = ""; 70 my $mods = ""; 71 my $modnames = ""; 72 while(<>) { 73 chomp; 74 s/\s+/ /g; 75 s/^\s+//; 76 s/\s+$//; 77 $package = $1 if !$package && /^package (\S+)$/; 78 next if !/^\/\/sys /; 79 80 my $syscalldot = ""; 81 $syscalldot = "syscall." if $package ne "syscall"; 82 83 # Line must be of the form 84 # func Open(path string, mode int, perm int) (fd int, err error) 85 # Split into name, in params, out params. 86 if(!/^\/\/sys (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:\[failretval(.*)\])?\s*(?:=\s*(?:(\w*)\.)?(\w*))?$/) { 87 print STDERR "$ARGV:$.: malformed //sys declaration\n"; 88 $errors = 1; 89 next; 90 } 91 my ($func, $in, $out, $failcond, $modname, $sysname) = ($1, $2, $3, $4, $5, $6); 92 93 # Split argument lists on comma. 94 my @in = parseparamlist($in); 95 my @out = parseparamlist($out); 96 97 # Dll file name. 98 if($modname eq "") { 99 $modname = "kernel32"; 100 } 101 my $modvname = "mod$modname"; 102 if($modnames !~ /$modname/) { 103 $modnames .= ".$modname"; 104 $mods .= "\t$modvname = ${syscalldot}NewLazyDLL(\"$modname.dll\")\n"; 105 } 106 107 # System call name. 108 if($sysname eq "") { 109 $sysname = "$func"; 110 } 111 112 # System call pointer variable name. 113 my $sysvarname = "proc$sysname"; 114 115 # Returned value when failed 116 if($failcond eq "") { 117 $failcond = "== 0"; 118 } 119 120 # Decide which version of api is used: ascii or unicode. 121 my $strconvfunc = $sysname !~ /W$/ ? "BytePtrFromString" : "UTF16PtrFromString"; 122 my $strconvtype = $sysname !~ /W$/ ? "*byte" : "*uint16"; 123 124 # Winapi proc address variable. 125 $vars .= "\t$sysvarname = $modvname.NewProc(\"$sysname\")\n"; 126 127 # Go function header. 128 $out = join(', ', @out); 129 if($out ne "") { 130 $out = " ($out)"; 131 } 132 if($text ne "") { 133 $text .= "\n" 134 } 135 $text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out; 136 137 # Check if err return available 138 my $errvar = ""; 139 foreach my $p (@out) { 140 my ($name, $type) = parseparam($p); 141 if($type eq "error") { 142 $errvar = $name; 143 last; 144 } 145 } 146 147 # Prepare arguments to Syscall. 148 my @args = (); 149 my $n = 0; 150 my @pin= (); 151 foreach my $p (@in) { 152 my ($name, $type) = parseparam($p); 153 if($type =~ /^\*/) { 154 push @args, "uintptr(unsafe.Pointer($name))"; 155 } elsif($type eq "string" && $errvar ne "") { 156 $text .= "\tvar _p$n $strconvtype\n"; 157 $text .= "\t_p$n, $errvar = $strconvfunc($name)\n"; 158 $text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n"; 159 push @args, "uintptr(unsafe.Pointer(_p$n))"; 160 $n++; 161 } elsif($type eq "string") { 162 print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n"; 163 $text .= "\tvar _p$n $strconvtype\n"; 164 $text .= "\t_p$n, _ = $strconvfunc($name)\n"; 165 push @args, "uintptr(unsafe.Pointer(_p$n))"; 166 $n++; 167 } elsif($type =~ /^\[\](.*)/) { 168 # Convert slice into pointer, length. 169 # Have to be careful not to take address of &a[0] if len == 0: 170 # pass nil in that case. 171 $text .= "\tvar _p$n *$1\n"; 172 $text .= "\tif len($name) > 0 {\n\t\t_p$n = \&$name\[0]\n\t}\n"; 173 push @args, "uintptr(unsafe.Pointer(_p$n))", "uintptr(len($name))"; 174 $n++; 175 } elsif($type eq "int64" && $_32bit ne "") { 176 if($_32bit eq "big-endian") { 177 push @args, "uintptr($name >> 32)", "uintptr($name)"; 178 } else { 179 push @args, "uintptr($name)", "uintptr($name >> 32)"; 180 } 181 } elsif($type eq "bool") { 182 $text .= "\tvar _p$n uint32\n"; 183 $text .= "\tif $name {\n\t\t_p$n = 1\n\t} else {\n\t\t_p$n = 0\n\t}\n"; 184 push @args, "uintptr(_p$n)"; 185 $n++; 186 } else { 187 push @args, "uintptr($name)"; 188 } 189 push @pin, sprintf "\"%s=\", %s, ", $name, $name; 190 } 191 my $nargs = @args; 192 193 # Determine which form to use; pad args with zeros. 194 my $asm = "${syscalldot}Syscall"; 195 if(@args <= 3) { 196 while(@args < 3) { 197 push @args, "0"; 198 } 199 } elsif(@args <= 6) { 200 $asm = "${syscalldot}Syscall6"; 201 while(@args < 6) { 202 push @args, "0"; 203 } 204 } elsif(@args <= 9) { 205 $asm = "${syscalldot}Syscall9"; 206 while(@args < 9) { 207 push @args, "0"; 208 } 209 } elsif(@args <= 12) { 210 $asm = "${syscalldot}Syscall12"; 211 while(@args < 12) { 212 push @args, "0"; 213 } 214 } elsif(@args <= 15) { 215 $asm = "${syscalldot}Syscall15"; 216 while(@args < 15) { 217 push @args, "0"; 218 } 219 } else { 220 print STDERR "$ARGV:$.: too many arguments to system call\n"; 221 } 222 223 # Actual call. 224 my $args = join(', ', @args); 225 my $call = "$asm($sysvarname.Addr(), $nargs, $args)"; 226 227 # Assign return values. 228 my $body = ""; 229 my $failexpr = ""; 230 my @ret = ("_", "_", "_"); 231 my @pout= (); 232 for(my $i=0; $i<@out; $i++) { 233 my $p = $out[$i]; 234 my ($name, $type) = parseparam($p); 235 my $reg = ""; 236 if($name eq "err") { 237 $reg = "e1"; 238 $ret[2] = $reg; 239 } else { 240 $reg = sprintf("r%d", $i); 241 $ret[$i] = $reg; 242 } 243 if($type eq "bool") { 244 $reg = "$reg != 0"; 245 } 246 if($type eq "int64" && $_32bit ne "") { 247 # 64-bit number in r1:r0 or r0:r1. 248 if($i+2 > @out) { 249 print STDERR "$ARGV:$.: not enough registers for int64 return\n"; 250 } 251 if($_32bit eq "big-endian") { 252 $reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1); 253 } else { 254 $reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i); 255 } 256 $ret[$i] = sprintf("r%d", $i); 257 $ret[$i+1] = sprintf("r%d", $i+1); 258 } 259 my $rettype = $type; 260 if($type =~ /^\*/) { 261 $reg = "unsafe.Pointer($reg)"; 262 $rettype = "($rettype)"; 263 } 264 if($i == 0) { 265 if($type eq "bool") { 266 $failexpr = "!$name"; 267 } elsif($name eq "err") { 268 $ret[$i] = "r1"; 269 $failexpr = "r1 $failcond"; 270 } else { 271 $failexpr = "$name $failcond"; 272 } 273 } 274 $failexpr =~ s/(=)([0-9A-Za-z\-+])/$1 $2/; # gofmt compatible 275 if($name eq "err") { 276 # Set err to "last error" only if returned value indicate failure 277 $body .= "\tif $failexpr {\n"; 278 $body .= "\t\tif $reg != 0 {\n"; 279 $body .= "\t\t\t$name = $type($reg)\n"; 280 $body .= "\t\t} else {\n"; 281 $body .= "\t\t\t$name = ${syscalldot}EINVAL\n"; 282 $body .= "\t\t}\n"; 283 $body .= "\t}\n"; 284 } elsif($rettype eq "error") { 285 # Set $reg to "error" only if returned value indicate failure 286 $body .= "\tif $reg != 0 {\n"; 287 $body .= "\t\t$name = ${syscalldot}Errno($reg)\n"; 288 $body .= "\t}\n"; 289 } else { 290 $body .= "\t$name = $rettype($reg)\n"; 291 } 292 push @pout, sprintf "\"%s=\", %s, ", $name, $name; 293 } 294 if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") { 295 $text .= "\t$call\n"; 296 } else { 297 $text .= "\t$ret[0], $ret[1], $ret[2] := $call\n"; 298 } 299 $text .= $body; 300 if(0) { 301 $text .= sprintf 'print("SYSCALL: %s(", %s") (", %s")\n")%s', $func, join('", ", ', @pin), join('", ", ', @pout), "\n"; 302 } 303 304 $text .= "\treturn\n"; 305 $text .= "}\n"; 306 } 307 308 if($errors) { 309 exit 1; 310 } 311 312 print <<EOF; 313 // $cmdline 314 // MACHINE GENERATED BY THE COMMAND ABOVE; DO NOT EDIT 315 316 package $package 317 318 import "unsafe" 319 EOF 320 321 print "import \"syscall\"\n" if $package ne "syscall"; 322 323 print <<EOF; 324 325 var ( 326 $mods 327 $vars 328 ) 329 330 $text 331 332 EOF 333 exit 0;