...
Run Format

Text file src/syscall/mksyscall.pl

Documentation: syscall

     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 errno.
    15	
    16	# A line beginning with //sysnb is like //sys, except that the
    17	# goroutine will not be suspended during the execution of the system
    18	# call.  This must only be used for system calls which can never
    19	# block, as otherwise the system call could cause all goroutines to
    20	# hang.
    21	
    22	use strict;
    23	
    24	my $cmdline = "mksyscall.pl " . join(' ', @ARGV);
    25	my $errors = 0;
    26	my $_32bit = "";
    27	my $plan9 = 0;
    28	my $openbsd = 0;
    29	my $netbsd = 0;
    30	my $dragonfly = 0;
    31	my $nacl = 0;
    32	my $arm = 0; # 64-bit value should use (even, odd)-pair
    33	my $tags = "";  # build tags
    34	
    35	if($ARGV[0] eq "-b32") {
    36		$_32bit = "big-endian";
    37		shift;
    38	} elsif($ARGV[0] eq "-l32") {
    39		$_32bit = "little-endian";
    40		shift;
    41	}
    42	if($ARGV[0] eq "-plan9") {
    43		$plan9 = 1;
    44		shift;
    45	}
    46	if($ARGV[0] eq "-openbsd") {
    47		$openbsd = 1;
    48		shift;
    49	}
    50	if($ARGV[0] eq "-netbsd") {
    51		$netbsd = 1;
    52		shift;
    53	}
    54	if($ARGV[0] eq "-dragonfly") {
    55		$dragonfly = 1;
    56		shift;
    57	}
    58	if($ARGV[0] eq "-nacl") {
    59		$nacl = 1;
    60		shift;
    61	}
    62	if($ARGV[0] eq "-arm") {
    63		$arm = 1;
    64		shift;
    65	}
    66	if($ARGV[0] eq "-tags") {
    67		shift;
    68		$tags = $ARGV[0];
    69		shift;
    70	}
    71	
    72	if($ARGV[0] =~ /^-/) {
    73		print STDERR "usage: mksyscall.pl [-b32 | -l32] [-tags x,y] [file ...]\n";
    74		exit 1;
    75	}
    76	
    77	sub parseparamlist($) {
    78		my ($list) = @_;
    79		$list =~ s/^\s*//;
    80		$list =~ s/\s*$//;
    81		if($list eq "") {
    82			return ();
    83		}
    84		return split(/\s*,\s*/, $list);
    85	}
    86	
    87	sub parseparam($) {
    88		my ($p) = @_;
    89		if($p !~ /^(\S*) (\S*)$/) {
    90			print STDERR "$ARGV:$.: malformed parameter: $p\n";
    91			$errors = 1;
    92			return ("xx", "int");
    93		}
    94		return ($1, $2);
    95	}
    96	
    97	my $text = "";
    98	while(<>) {
    99		chomp;
   100		s/\s+/ /g;
   101		s/^\s+//;
   102		s/\s+$//;
   103		my $nonblock = /^\/\/sysnb /;
   104		next if !/^\/\/sys / && !$nonblock;
   105	
   106		# Line must be of the form
   107		#	func Open(path string, mode int, perm int) (fd int, errno error)
   108		# Split into name, in params, out params.
   109		if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*((?i)_?SYS_[A-Z0-9_]+))?$/) {
   110			print STDERR "$ARGV:$.: malformed //sys declaration\n";
   111			$errors = 1;
   112			next;
   113		}
   114		my ($func, $in, $out, $sysname) = ($2, $3, $4, $5);
   115	
   116		# Split argument lists on comma.
   117		my @in = parseparamlist($in);
   118		my @out = parseparamlist($out);
   119	
   120		# Try in vain to keep people from editing this file.
   121		# The theory is that they jump into the middle of the file
   122		# without reading the header.
   123		$text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n";
   124	
   125		# Go function header.
   126		my $out_decl = @out ? sprintf(" (%s)", join(', ', @out)) : "";
   127		$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out_decl;
   128	
   129		# Check if err return available
   130		my $errvar = "";
   131		foreach my $p (@out) {
   132			my ($name, $type) = parseparam($p);
   133			if($type eq "error") {
   134				$errvar = $name;
   135				last;
   136			}
   137		}
   138	
   139		# Prepare arguments to Syscall.
   140		my @args = ();
   141		my $n = 0;
   142		foreach my $p (@in) {
   143			my ($name, $type) = parseparam($p);
   144			if($type =~ /^\*/) {
   145				push @args, "uintptr(unsafe.Pointer($name))";
   146			} elsif($type eq "string" && $errvar ne "") {
   147				$text .= "\tvar _p$n *byte\n";
   148				$text .= "\t_p$n, $errvar = BytePtrFromString($name)\n";
   149				$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
   150				push @args, "uintptr(unsafe.Pointer(_p$n))";
   151				$n++;
   152			} elsif($type eq "string") {
   153				print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
   154				$text .= "\tvar _p$n *byte\n";
   155				$text .= "\t_p$n, _ = BytePtrFromString($name)\n";
   156				push @args, "uintptr(unsafe.Pointer(_p$n))";
   157				$n++;
   158			} elsif($type =~ /^\[\](.*)/) {
   159				# Convert slice into pointer, length.
   160				# Have to be careful not to take address of &a[0] if len == 0:
   161				# pass dummy pointer in that case.
   162				# Used to pass nil, but some OSes or simulators reject write(fd, nil, 0).
   163				$text .= "\tvar _p$n unsafe.Pointer\n";
   164				$text .= "\tif len($name) > 0 {\n\t\t_p$n = unsafe.Pointer(\&${name}[0])\n\t}";
   165				$text .= " else {\n\t\t_p$n = unsafe.Pointer(&_zero)\n\t}";
   166				$text .= "\n";
   167				push @args, "uintptr(_p$n)", "uintptr(len($name))";
   168				$n++;
   169			} elsif($type eq "int64" && ($openbsd || $netbsd)) {
   170				push @args, "0";
   171				if($_32bit eq "big-endian") {
   172					push @args, "uintptr($name>>32)", "uintptr($name)";
   173				} elsif($_32bit eq "little-endian") {
   174					push @args, "uintptr($name)", "uintptr($name>>32)";
   175				} else {
   176					push @args, "uintptr($name)";
   177				}
   178			} elsif($type eq "int64" && $dragonfly) {
   179				if ($func !~ /^extp(read|write)/i) {
   180					push @args, "0";
   181				}
   182				if($_32bit eq "big-endian") {
   183					push @args, "uintptr($name>>32)", "uintptr($name)";
   184				} elsif($_32bit eq "little-endian") {
   185					push @args, "uintptr($name)", "uintptr($name>>32)";
   186				} else {
   187					push @args, "uintptr($name)";
   188				}
   189			} elsif($type eq "int64" && $_32bit ne "") {
   190				if(@args % 2 && $arm) {
   191					# arm abi specifies 64-bit argument uses
   192					# (even, odd) pair
   193					push @args, "0"
   194				}
   195				if($_32bit eq "big-endian") {
   196					push @args, "uintptr($name>>32)", "uintptr($name)";
   197				} else {
   198					push @args, "uintptr($name)", "uintptr($name>>32)";
   199				}
   200			} else {
   201				push @args, "uintptr($name)";
   202			}
   203		}
   204	
   205		# Determine which form to use; pad args with zeros.
   206		my $asm = "Syscall";
   207		if ($nonblock) {
   208			$asm = "RawSyscall";
   209		}
   210		if(@args <= 3) {
   211			while(@args < 3) {
   212				push @args, "0";
   213			}
   214		} elsif(@args <= 6) {
   215			$asm .= "6";
   216			while(@args < 6) {
   217				push @args, "0";
   218			}
   219		} elsif(@args <= 9) {
   220			$asm .= "9";
   221			while(@args < 9) {
   222				push @args, "0";
   223			}
   224		} else {
   225			print STDERR "$ARGV:$.: too many arguments to system call\n";
   226		}
   227	
   228		# System call number.
   229		if($sysname eq "") {
   230			$sysname = "SYS_$func";
   231			$sysname =~ s/([a-z])([A-Z])/${1}_$2/g;	# turn FooBar into Foo_Bar
   232			$sysname =~ y/a-z/A-Z/;
   233			if($nacl) {
   234				$sysname =~ y/A-Z/a-z/;
   235			}
   236		}
   237	
   238		# Actual call.
   239		my $args = join(', ', @args);
   240		my $call = "$asm($sysname, $args)";
   241	
   242		# Assign return values.
   243		my $body = "";
   244		my @ret = ("_", "_", "_");
   245		my $do_errno = 0;
   246		for(my $i=0; $i<@out; $i++) {
   247			my $p = $out[$i];
   248			my ($name, $type) = parseparam($p);
   249			my $reg = "";
   250			if($name eq "err" && !$plan9) {
   251				$reg = "e1";
   252				$ret[2] = $reg;
   253				$do_errno = 1;
   254			} elsif($name eq "err" && $plan9) {
   255				$ret[0] = "r0";
   256				$ret[2] = "e1";
   257				next;
   258			} else {
   259				$reg = sprintf("r%d", $i);
   260				$ret[$i] = $reg;
   261			}
   262			if($type eq "bool") {
   263				$reg = "$reg != 0";
   264			}
   265			if($type eq "int64" && $_32bit ne "") {
   266				# 64-bit number in r1:r0 or r0:r1.
   267				if($i+2 > @out) {
   268					print STDERR "$ARGV:$.: not enough registers for int64 return\n";
   269				}
   270				if($_32bit eq "big-endian") {
   271					$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
   272				} else {
   273					$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
   274				}
   275				$ret[$i] = sprintf("r%d", $i);
   276				$ret[$i+1] = sprintf("r%d", $i+1);
   277			}
   278			if($reg ne "e1" || $plan9) {
   279				$body .= "\t$name = $type($reg)\n";
   280			}
   281		}
   282		if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
   283			$text .= "\t$call\n";
   284		} else {
   285			$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
   286		}
   287		$text .= $body;
   288	
   289		if ($plan9 && $ret[2] eq "e1") {
   290			$text .= "\tif int32(r0) == -1 {\n";
   291			$text .= "\t\terr = e1\n";
   292			$text .= "\t}\n";
   293		} elsif ($do_errno) {
   294			$text .= "\tif e1 != 0 {\n";
   295			$text .= "\t\terr = errnoErr(e1)\n";
   296			$text .= "\t}\n";
   297		}
   298		$text .= "\treturn\n";
   299		$text .= "}\n\n";
   300	}
   301	
   302	chomp $text;
   303	chomp $text;
   304	
   305	if($errors) {
   306		exit 1;
   307	}
   308	
   309	print <<EOF;
   310	// $cmdline
   311	// MACHINE GENERATED BY THE COMMAND ABOVE; DO NOT EDIT
   312	
   313	// +build $tags
   314	
   315	package syscall
   316	
   317	import "unsafe"
   318	
   319	$text
   320	EOF
   321	exit 0;

View as plain text