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
20use strict;
21
22my $cmdline = "mksyscall_aix_ppc.pl " . join(' ', @ARGV);
23my $errors = 0;
24my $_32bit = "";
25my $tags = "";  # build tags
26my $aix = 0;
27my $solaris = 0;
28
29binmode STDOUT;
30
31if($ARGV[0] eq "-b32") {
32	$_32bit = "big-endian";
33	shift;
34} elsif($ARGV[0] eq "-l32") {
35	$_32bit = "little-endian";
36	shift;
37}
38if($ARGV[0] eq "-aix") {
39	$aix = 1;
40	shift;
41}
42if($ARGV[0] eq "-tags") {
43	shift;
44	$tags = $ARGV[0];
45	shift;
46}
47
48if($ARGV[0] =~ /^-/) {
49	print STDERR "usage: mksyscall_aix.pl [-b32 | -l32] [-tags x,y] [file ...]\n";
50	exit 1;
51}
52
53sub 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
63sub 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
73my $package = "";
74my $text = "";
75my $c_extern = "/*\n#include <stdint.h>\n#include <stddef.h>\n";
76my @vars = ();
77while(<>) {
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
354if($errors) {
355	exit 1;
356}
357
358print <<EOF;
359// $cmdline
360// Code generated by the command above; see README.md. DO NOT EDIT.
361
362// +build $tags
363
364package $package
365
366
367$c_extern
368*/
369import "C"
370import (
371	"unsafe"
372)
373
374
375EOF
376
377print "import \"golang.org/x/sys/unix\"\n" if $package ne "unix";
378
379chomp($_=<<EOF);
380
381$text
382EOF
383print $_;
384exit 0;
385