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.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"; |
|
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 "syscall" |
|
373 ) |
|
374 |
|
375 |
|
376 EOF |
|
377 |
|
378 print "import \"golang.org/x/sys/unix\"\n" if $package ne "unix"; |
|
379 |
|
380 chomp($_=<<EOF); |
|
381 |
|
382 $text |
|
383 EOF |
|
384 print $_; |
|
385 exit 0; |
|