]>
Commit | Line | Data |
---|---|---|
15c0b25d AP |
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; |