#!/usr/bin/perl
use strict;
use MaxAs::Cubin;
use MaxAs::MaxAs;
use Data::Dumper;
use File::Spec;

require 5.10.0;

$Data::Dumper::Sortkeys = 1;

my $mode = shift;

# List cubin contents
if ($mode =~ /^\-?\-l/i)
{
    my $cubinFile = shift or usage();

    my $cubin = MaxAs::Cubin->new($cubinFile);

    my $arch    = $cubin->arch;
    my $class   = $cubin->class;
    my $asize   = $cubin->address_size;
    my $kernels = $cubin->listKernels;
    my $symbols = $cubin->listSymbols;

    printf "%s: arch:sm_%d machine:%dbit address_size:%dbit\n", $cubinFile, $arch, $class, $asize;

    foreach my $ker (sort keys %$kernels)
    {
        printf "Kernel: %s (Linkage: %s, Params: %d, Size: %d, Registers: %d, SharedMem: %d, Barriers: %d)\n", $ker, @{$kernels->{$ker}}{qw(Linkage ParamCnt size RegCnt SharedSize BarCnt)};
    }
    foreach my $sym (sort keys %$symbols)
    {
        printf "Symbol: %s\n", $sym;
    }
}
# Test that the assembler can reproduce the op codes this cubin or sass contains
elsif ($mode =~ /^\-?\-t/i)
{
    my $reg  = shift if $ARGV[0] =~ /^\-?\-r/i;
    my $all  = shift if $ARGV[0] =~ /^\-?\-a/i;
    my $file = shift or usage();
    my $fh;
    # sass file
    if (-T $file)
    {
        open $fh, $file or die "$file: $!";
    }
    # cubin file
    else
    {
        my $cubin = MaxAs::Cubin->new($file);
        my $arch  = $cubin->arch;

        open $fh, "cuobjdump -arch sm_$arch -sass $file |" or die "cuobjdump -arch sm_$arch -sass $file: $!";
        my $first = <$fh>;
        if ($first =~ /cuobjdump fatal/)
        {
            print $first;
            exit(1);
        }
    }
    exit(MaxAs::MaxAs::Test($fh, $reg, $all) ? 1 : 0);
}
# Extract an asm file containing the desired kernel
elsif ($mode =~ /^\-?\-e/i)
{
    my $kernelName;
    if ($ARGV[0] =~ /^\-?\-k/i)
    {
        shift;
        $kernelName = shift or usage();
    }
    my $cubinFile = shift or usage();
    my $asmFile   = shift;
    my $cubin     = MaxAs::Cubin->new($cubinFile);
    my $arch      = $cubin->arch;
    my $kernels   = $cubin->listKernels;

    #default the kernel name if not specified.
    $kernelName ||= (sort keys %$kernels)[0];

    my $kernel = $kernels->{$kernelName} or die "bad kernel: $kernelName";

    open my $in, "cuobjdump -arch sm_$arch -sass -fun $kernelName $cubinFile |" or die "cuobjdump -arch sm_50 -sass -fun $kernelName $cubinFile: $!";
    my $first = <$in>;
    if ($first =~ /cuobjdump fatal/)
    {
        print $first;
        exit(1);
    }
    my $out;
    if ($asmFile)
    {
        open $out, ">$asmFile" or die "$asmFile: $!";
    }
    else
    {
        $out = \*STDOUT;
    }

    print $out "# Kernel: $kernelName\n# Arch: sm_$arch\n";

    print $out "# $_: $kernel->{$_}\n" foreach (qw(InsCnt RegCnt SharedSize BarCnt));

    print $out "# Params($kernel->{ParamCnt}):\n#\tord:addr:size:align\n";

    print $out join('', map "#\t$_\n", @{$kernel->{Params}}) if $kernel->{Params};

    print $out "#\n# Instructions:\n\n";

    MaxAs::MaxAs::Extract($in, $out, $kernel->{Params});

    close $out if $asmFile;
    close $in;
}
# Extract a kernel from a sass dump
elsif ($mode =~ /^\-?\-s/i)
{
    my $sassFile  = shift or usage();
    my $asmFile   = shift;

    open my $in, $sassFile or die "$sassFile: $!";

    my $out;
    if ($asmFile)
    {
        open $out, ">$asmFile" or die "$asmFile: $!";
    }
    else
    {
        $out = \*STDOUT;
    }

    MaxAs::MaxAs::Extract($in, $out, []);

    close $out if $asmFile;
    close $in;
}
# Insert the kernel asm back into the cubin:
elsif ($mode =~ /^\-?\-i/i)
{
    my $nowarn;
    if ($ARGV[0] =~ /^\-?\-w/i)
    {
        $nowarn = shift;
    }
    my $kernelName;
    if ($ARGV[0] =~ /^\-?\-k/i)
    {
        shift;
        $kernelName = shift or usage();
    }
    my $noReuse   = shift if $ARGV[0] =~ /^\-?\-n/i;
    while ($ARGV[0] =~ /^\-?\-D(\w+)/)
    {
        shift;
        my $name  = $1;
        my $value = shift;
        eval "package MaxAs::MaxAs::CODE; our \$$name = '$value';"
    }

    my $asmFile   = shift or usage();
    my $cubinFile = shift or usage();
    my $newCubin  = shift || $cubinFile;

    my $file;
    if (open my $fh, $asmFile)
    {
        local $/;
        $file = <$fh>;
        close $fh;
    }
    else { die "$asmFile: $!" }

    my ($vol,$dir) = File::Spec->splitpath($asmFile);
    my $include = [$vol, $dir];

    # extract the kernel name from the file
    ($kernelName) = $file =~ /^# Kernel: (\w+)/ unless $kernelName;
    die "asm file missing kernel name or is badly formatted" unless $kernelName;

    my $kernel = MaxAs::MaxAs::Assemble($file, $include, !$noReuse, $nowarn);

    my $cubin  = MaxAs::Cubin->new($cubinFile);
    $kernel->{Kernel} = $cubin->getKernel($kernelName) or die "cubin does not contain kernel: $kernelName";

    $cubin->modifyKernel(%$kernel);

    $cubin->write($newCubin);

    printf "Kernel: $kernelName, Instructions: %d, Register Count: %d, Bank Conflicts: %d, Reuse: %.1f% (%d/%d)\n",
        @{$kernel}{qw(InsCnt RegCnt ConflictCnt ReusePct ReuseCnt ReuseTot)};

}
# Preprocessing:
elsif ($mode =~ /^\-?\-p/i)
{
    while ($ARGV[0] =~ /^\-?\-D(\w+)/)
    {
        shift;
        my $name  = $1;
        my $value = shift;
        eval "package MaxAs::MaxAs::CODE; our \$$name = '$value';";
    }
    my $debug     = shift if $ARGV[0] =~ /^\-?\-d/i;
    my $asmFile   = shift or usage();
    my $asmFile2  = shift;

    die "source and destination probably shouldn't be the same file\n" if $asmFile eq $asmFile2;

    open my $fh,  $asmFile or die "$asmFile: $!";
    local $/;
    my $file = <$fh>;
    close $fh;

    my ($vol,$dir) = File::Spec->splitpath($asmFile);
    my $include = [$vol, $dir];

    if ($asmFile2)
    {
        open $fh, ">$asmFile2" or die "$asmFile2: $!";
    }
    else
    {
        $fh = \*STDOUT;
    }
    print $fh MaxAs::MaxAs::Preprocess($file, $include, $debug);
    close $fh;
}
# get version information
elsif ($mode =~ /^\-?\-v/i)
{
    print "$MaxAs::MaxAs::VERSION\n";
}
else
{
    print "$mode\n";
    usage();
}

exit(0);

sub usage
{
    print <<EOF;
Usage:

  List kernels and symbols:

    maxas.pl --list|-l <cubin_file>

  Test a cubin or sass file to to see if the assembler can reproduce all of the contained opcodes.
  Also useful for extending the missing grammar rules.  Defaults to only showing failures without --all.
  With the --reg flag it will show register bank conflicts not hidden by reuse flags.

    maxas.pl --test|-t [--reg|-r] [--all|-a] <cubin_file | cuobjdump_sass_file>

  Extract a single kernel into an asm file from a cubin.
  Works much like cuobjdump but outputs in a format that can be re-assembled back into the cubin.

    maxas.pl --extract|-e [--kernel|-k kernel_name] <cubin_file> [asm_file]

  Preprocess the asm: expand CODE sections, perform scheduling. Mainly used for debugging purposes.
  Include the debug flag to print out detailed scheduler info.

    maxas.pl --pre|-p [--debug|-d] <asm_file> [new_asm_file]

  Insert the kernel asm back into the cubin.  Overwrite existing or create new cubin.
  Optionally you can skip register reuse flag auto insertion.  This allows you to observe
  performance without any reuse or you can use it to set the flags manually in your sass.

    maxas.pl --insert|-i [--noreuse|-n] <asm_file> <cubin_file> [new_cubin_file]

  Display version information and exit:

    maxas.pl --version|-v

EOF
    exit(1);
}

__END__


#!/usr/bin/perl
# Convert SGF file to a sequence of GTP games, one game per each variation
# that ends with /GOOD/ comment.

use warnings;
use strict;

sub printgame
{
	my ($sgf) = @_;
	my $pt = $sgf->getAddress();

	my @moves;
	do {
		my ($b, $w) = ($sgf->property('B'), $sgf->property('W'));
		if ($b) { push @moves, ['b', $_] foreach @$b; }
		if ($w) { push @moves, ['w', $_] foreach @$w; }
	} while ($sgf->prev());

	print "boardsize 19\nclear_board\n";
	for my $move (reverse @moves) {
		my ($sx, $sy) = @{$move->[1]};
		my @abcd = split(//, "abcdefghjklmnopqrstuvwxyz");
		my $x = $sy + 1; my $y = $abcd[18 - $sx];
		if ("$y$x" eq "z20") {
			$y = "pass"; $x = "";
		}
		print "play ".$move->[0]." $y$x\n";
	}

	$sgf->goto($pt);
}

sub recurse
{
	my ($sgf) = @_;
	my $c = $sgf->property('C');
	if ($c and $c->[0] =~ /GOOD/) {
		printgame($sgf);
	}
	for (0 .. $sgf->branches()-1) {
		$sgf->gotoBranch($_);
		recurse($sgf);
		$sgf->prev();
	}
}

use Games::SGF::Go;
my $sgf = new Games::SGF::Go;

$sgf->readFile($ARGV[0]);

$sgf->gotoRoot();
recurse($sgf);


#!/usr/bin/perl -ln
#
# kgslog2gtp - Convert kgsGtp log file to GTP command stream
#
# The command stream contains two special GTP commands intended
# for further script processing (unrecognized by Pachi itself):
#
#	pachi-mygame COLOR OPPONENT DATE TIME
#	pachi-mymove COORD VALUE
#
# (You probably want to convert pachi-mymove to play.)

chomp;

# 19.1.2012 20:47:47 com.gokgs.client.gtp.a <init>
if (s/^(\S+ \S+) com.gokgs.client.gtp.a <init>$/$1/) {
	$a = $1;

# FINE: Starting game as white against Mateman
} elsif (s/^FINE:.*as (\S+) against (\w+)/$1 $2/) {
	print "pachi-mygame $_ $a";

# IN: play b o3
} elsif (s/^IN: // and not /genmove/ and not /kgs-chat/ and not /time/) {
	print $_;

# *** WINNER is C4 (3,4) with score 0.4333 (49243/93153:93153/93393 games), extra komi 0.000000
} elsif (s/^\*\*\* WINNER is (\S+) .*score (\S+) .*komi 0\.0.*/$1 $2/) {
	print "pachi-mymove $_";
}


#!/usr/bin/perl
# ./pattern3_show.pl PATNUM

use warnings;
no warnings "qw";
use strict;

my $pat = shift @ARGV;
my @s = qw(. X O #);

my @p = map { ($pat >> (2*$_)) & 3 } (0..7);
splice @p, 4, 0, (0);
for my $y (0..2) {
	for my $x (reverse 0..2) {
		print $s[$p[$x + $y*3]];
	}
	print "\n";
}


#!/usr/bin/perl -n
#
# pattern_getdrops - Find significant value drops in kgslog GTP stream
# and convert them to lead-in game records for pattern learning
#
# Run as pipeline:
# 	tools/kgslog2gtp.pl | tools/pattern_getdrops.pl | tools/pattern_bayes_gen.sh -

BEGIN {
	use vars qw(@game $lastval $valthres $valfrac);
	$valthres = 0.8;
	$valfrac = 0.95;
}

chomp;
@_ = split(/\s+/);

if ($_[0] eq 'pachi-mygame') {
	@game = @_[1..4];
	print STDERR "*** new game [@game]\n";
	$lastval = 0;
	@commands = ();

} elsif ($_[0] eq 'pachi-mymove') {
	if ($lastval > 0 and $lastval < $valthres and $_[2] / $lastval < $valfrac) {
		print STDERR "large value drop $lastval -> $_[2] [@game :: @_]\n";
		print "$_\n" for @commands;
		print "play $game[0] $_[1] 1\n";
	}
	$lastval = $_[2];
	my $cmd = "play $game[0] $_[1] 0 $_[2]";
	push @commands, $cmd;

} elsif ($_[0] eq 'play') {
	push @_, 0;
	push @commands, "@_";

} else {
	push @commands, "@_";
}


#!/usr/bin/perl
# pattern_spatial_show: Show given spatial dictionary entry on board

my $f = "patterns.spat";
my $id = $ARGV[0];

my @ofs = ();

open D, "$f" or die "$f: $!";
while (<D>) {
	chomp;
	if (s/^# Point order: d=(\d+) //) {
		my $d = $1; next if ($d < 1);
		# XXX: Distances must be in proper order!
		s/ *$//;
		push @ofs, map { [ split(/,/, $_) ] } split(/ /, $_);
		# print "#### $_\n";
		# print "[$d] ($#ofs) " . join(' ', map { $_->[0].",".$_->[1] } @ofs) . "\n";
		next;
	}
	/^#/ and next;
	my ($lid, $d, $pat, @hashes) = split (/\s+/, $_);
	if ($id == $lid) {
		print "$d $pat\n";
		my @b;
		my @pc = split (//, $pat);
		for my $i (0 .. $#pc) {
			# print "$i: $pc[$i] -> $ofs[$i][1],$ofs[$i][0]\n";
			$b[$d + $ofs[$i][1]][$d + $ofs[$i][0]] = $pc[$i];
		}
		$b[$d][$d] = '_';
		for my $y (0 .. 2 * $d) {
			for my $x (0 .. 2 * $d) {
				print $b[2 * $d - $y][$x] || ' ';
				print ' ';
			}
			print "\n";
		}
		last;
	}
}


#!/usr/bin/perl
# Simple script using Pachi for game analysis of SGF.
# Pachi will analyse each move in the SGF and suggest the winrate
# for either player and winrate it estimated for in-game followup.
#
# Usage: tools/sgf-analyse.pl COLOR SGF PACHIARGS...
#
# Note that this script assumes dynkomi=none and does not show
# dynamic komi information. (Would be trivial to add but it's tricky
# to interpret the data.)
#
# This script is dirty and insecure for untrusted input!
#
# Example: tools/sgf-analyse.pl W progame.sgf -t =2000 -d 0 dynkomi=none
# ...to get 2000 simulations per move, and winrates from white perspective.
#
# To plot the output in gnuplot:
# 	set yr [0:1]
# 	set ytics 0,0.25,1
# 	plot "datafile.csv" using 1:5 with lines

use warnings;
use strict;

my $mcolor = shift @ARGV;
my $sgf = shift @ARGV;

sub one {
	my ($move) = @_;

	# Move of the other color - supposedly.
	return if ($move % 2 == ($mcolor eq 'B' ? 0 : 1));

	# Get pachi output from GTP stream that contains the SGF up to
	# given move, with information about the originally made move
	# included.
	my $line = $move + 3; # board_size, clearboard, komi
	my $rest = $line + 1;
	open my $g, "tools/sgf2gtp.pl < \"$sgf\" | sed -e '$line s/play \\(.*\\) \\(.*\\)/1 echo \\1 \\2\\n2 genmove \\1\\n3 pachi-result/' -e '$rest,\$ d' | ./pachi @ARGV |" or die $!;

	# Parse the GTP output.
	my ($color, $realmove, $genmove, $winrate) = @_;
	while (<$g>) {
		chomp;
		if (/^=1 (.*) (.*)/) {
			$color = $1; $realmove = uc $2;
		} elsif (/^=2 (.*)/) {
			$genmove = $1;
		} elsif (/^=3 (.*) (.*) (.*) (.*)/) {
			$winrate = $mcolor eq $color ? $3 : 1.0 - $3;
		}
	}

	# Pass value is not interesting since Pachi might want
	# to clarify some groups yet.
	return if $realmove eq 'PASS';

	# Generate summary line.
	print join(', ', $move, $color, $realmove, $genmove, $winrate) . "\n";
}

print "# $sgf @ARGV\n";

my $moves = `tools/sgf2gtp.pl < \"$sgf\" | wc -l` - 3;
one($_) for (1 .. $moves);


#!/usr/bin/perl -l
#
# sgf2gtp - Convert SGF game record to GTP command stream
#
# Usage: sgf2gtp [-g] [-n MOVENUM] [FILENAME]
#
# This is a naive Perl script that will convert SGF files to GTP
# format so that you can feed them to Pachi, insert genmove at
# the right places etc. Might not work on obscure SGF files,
# and of course there must be no variations.
#
# When called with a filename argument, it will create the output
# file with .gtp extension instead of .sgf.
#
# -g: Automatically append genmove command for the other color.
# -n MOVENUM: Output at most first MOVENUM moves.

use warnings;

my $genmove;
if ($ARGV[0] and $ARGV[0] eq '-g') {
	shift @ARGV;
	$genmove = 1;
}

my $maxmoves;
if ($ARGV[0] and $ARGV[0] eq '-n') {
	shift @ARGV;
	$maxmoves = shift @ARGV;
}

if ($ARGV[0]) {
	open STDIN, "$ARGV[0]" or die "$ARGV[0]: $!";
	my $ofile = $ARGV[0]; $ofile =~ s/sgf$//i; $ofile .= 'gtp';
	open STDOUT, ">$ofile" or die "$ofile: $!";
}

local $/ = undef; my $sgf = <>;
my $size = ($sgf =~ /SZ\[(\d+)\]/)[0];
$size ||= 19;
$sgf =~ s/\bC\[.*?\]//gs; # no comments
#$sgf =~ s/\).*//gs; # cut at end of principal branch

print "boardsize " . $size;
print "clear_board";
if ($sgf =~ s/\bKM\[([\d.]+)\]//gs) {
	print "komi $1";
}
if ($sgf =~ s/\bHA\[(\d+)\]//gs and $1 > 0) {
	print "fixed_handicap $1";
}

my $abcd = "abcdefghijklmnopqrstuvwxyz";
my $movenum = 0;
my $last_color = 'w';

my @m = split /;/, $sgf;
foreach (@m) {
	$maxmoves and $movenum >= $maxmoves and last;

	if (/^([BW])\[\]/) {
		$last_color = $1;
		$movenum++;
		print "play $1 pass";
		next;
	}
	unless (/^([BW])\[(\w\w)\]/) {
		next;
	}

	my ($color, $coord) = ($1, $2);
	my ($x, $y) = split //, $coord;
	($x ge 'i') and $x++;
	$y = $size - index($abcd, $y);

	$last_color = $color;
	$movenum++;
	print "play $color $x$y";
}

if ($genmove) {
	print "genmove ".(uc $last_color eq 'W' ? 'B' : 'W');
}


#!/usr/bin/perl

# Locate the 'PropSet' module
use FindBin;
use lib "$FindBin::Bin";
use PropSet;

my $infile  = "";
my $outfile = "";

if (@ARGV != 2)
{
  if (@ARGV == 1 && $ARGV[0] == "-help")
  {
    usage();
  }
  # Saves me from having to type these paths *every single time*
  $infile  = "src/emucore/stella.pro";
  $outfile = "src/emucore/DefProps.hxx";
}
else
{
  $infile  = $ARGV[0];
  $outfile = $ARGV[1];
}

my %propset = PropSet::load_prop_set($infile);
my $setsize = keys (%propset);
my $typesize = PropSet::num_prop_types();

printf "Valid properties found: $setsize\n";

# Construct the output file in C++ format
open(OUTFILE, ">$outfile");
print OUTFILE "//============================================================================\n";
print OUTFILE "//\n";
print OUTFILE "//   SSSS    tt          lll  lll\n";
print OUTFILE "//  SS  SS   tt           ll   ll\n";
print OUTFILE "//  SS     tttttt  eeee   ll   ll   aaaa\n";
print OUTFILE "//   SSSS    tt   ee  ee  ll   ll      aa\n";
print OUTFILE "//      SS   tt   eeeeee  ll   ll   aaaaa  --  \"An Atari 2600 VCS Emulator\"\n";
print OUTFILE "//  SS  SS   tt   ee      ll   ll  aa  aa\n";
print OUTFILE "//   SSSS     ttt  eeeee llll llll  aaaaa\n";
print OUTFILE "//\n";
print OUTFILE "// Copyright (c) 1995-2014 by Bradford W. Mott, Stephen Anthony\n";
print OUTFILE "// and the Stella Team\n";
print OUTFILE "//\n";
print OUTFILE "// See the file \"License.txt\" for information on usage and redistribution of\n";
print OUTFILE "// this file, and for a DISCLAIMER OF ALL WARRANTIES.\n";
print OUTFILE "//\n";
print OUTFILE "// \$Id\$\n";
print OUTFILE "//============================================================================\n";
print OUTFILE "\n";
print OUTFILE "#ifndef DEF_PROPS_HXX\n";
print OUTFILE "#define DEF_PROPS_HXX\n";
print OUTFILE "\n";
print OUTFILE "/**\n";
print OUTFILE "  This code is generated using the 'create_props.pl' script,\n";
print OUTFILE "  located in the src/tools directory.  All properties changes\n";
print OUTFILE "  should be made in stella.pro, and then this file should be\n";
print OUTFILE "  regenerated and the application recompiled.\n";
print OUTFILE "*/\n";
print OUTFILE "\n#define DEF_PROPS_SIZE " . $setsize;
print OUTFILE "\n\n";
print OUTFILE "static const char* DefProps[DEF_PROPS_SIZE][" . $typesize . "] = {\n";

# Walk the hash map and print each item in order of md5sum
my $idx = 0;
for my $key ( sort keys %propset )
{
  print OUTFILE PropSet::build_prop_string(@{ $propset{$key} });

  if ($idx+1 < $setsize) {
    print OUTFILE ", ";
  }
  print OUTFILE "\n";
  $idx++;
}

print OUTFILE "};\n";
print OUTFILE "\n";
print OUTFILE "#endif\n";

close(OUTFILE);

sub usage {
  print "create_props.pl <INPUT properties file> <OUTPUT C++ header>\n";
  print "\n";
  print "Convert the given properties file into a C++ compatible header file.\n";
  exit(0);
}


#!/usr/bin/perl

# Locate the 'PropSet' module
use FindBin;
use lib "$FindBin::Bin";
use PropSet;

my $usr_file  = "";
my $sys_file = "";

if (@ARGV != 2)
{
  if (@ARGV == 1 && $ARGV[0] == "-help")
  {
    usage();
  }
  # Saves me from having to type these paths *every single time*
  $usr_file  = "$ENV{HOME}/.stella/stella.pro";
  $sys_file = "src/emucore/stella.pro";
}
else
{
  $usr_file = $ARGV[0];
  $sys_file = $ARGV[1];
}

print "$usr_file\n";

my %usr_propset = PropSet::load_prop_set($usr_file);
my %sys_propset = PropSet::load_prop_set($sys_file);

print "\n";
print "Valid properties found in user file: " . keys (%usr_propset) . "\n";
print "Valid properties found in system file: " . keys (%sys_propset) . "\n";

# Determine which properties exist in both files
for my $key ( keys %usr_propset ) {
  if (defined $sys_propset{$key}) {
    $sys_propset{$key} = $usr_propset{$key};
    delete $usr_propset{$key};
  }
}

print "\n";
print "Updated properties found in user file: " . keys (%usr_propset) . "\n";
print "Updated properties found in system file: " . keys (%sys_propset) . "\n";
print "\n";

# Write both files back to disk
PropSet::save_prop_set($usr_file, \%usr_propset);
PropSet::save_prop_set($sys_file, \%sys_propset);

print "\nRun create_props [yN]: ";
chomp ($input = <STDIN>);
if($input eq 'y')
{
  system("./src/tools/create_props.pl");
}

sub usage {
  print "merge_props.pl <USER properties file> <SYSTEM properties file>\n";
  print "\n";
  print "Scan both properties files, and for every entry found in both files,\n";
  print "remove it from the USER file and overwrite it in the SYSTEM file.\n";
  exit(0);
}


#!/usr/bin/perl

use File::Basename;

usage() if @ARGV < 2;

my %builtin = ();
my %directory = ();

my @missing = ();
my @delete = ();

# Get all snapshot files from the built-in database in Stella
# This data comes from 'stella -listrominfo' (first commandline arg)
# We use a hashmap to get constant lookup time
open(INFILE, "$ARGV[0]");
foreach $line (<INFILE>)
{
  if($line =~ /\|/)
  {
    chomp $line;
    ($md5, $name, $other) = split (/\|/, $line);
    $key = $name . ".png";
    $builtin{$key} = $key;
  }
}
close(INFILE);

# Get all snapshot files from the actual directory (second commandline arg)
# We use a hashmap to get constant lookup time
opendir(SNAPDIR, $ARGV[1]) or die "Directory '$ARGV[1]' not found\n";
my @files = grep !/^\.\.?$/, readdir SNAPDIR;
close(SNAPDIR);
foreach $file (@files)
{
  ($base,$path,$type) = fileparse($file);
  $directory{$base} = $base;
}

# All files in %builtin but not in %directory are 'missing' snapshots
while(($key, $value) = each(%builtin))
{
  if(!defined $directory{$key})
  {
    push(@missing, $key);
  }
}

# All files in %directory but not in %builtin are redundant, and should be deleted
while(($key, $value) = each(%directory))
{
  if(!defined $builtin{$key})
  {
    $file = $ARGV[1] . "/" . $key;
    push(@delete, $file);
  }
}

$size = @missing;
print "Missing snapshots: ($size)\n\n";
if($size > 0)
{
  @missing = sort(@missing);
  foreach $file (@missing)
  {
    print "$file\n";
  }
}

$size = @delete;
print "\n\nExtra snapshots: ($size)\n\n";
if($size > 0)
{
  @delete = sort(@delete);
  foreach $file (@delete)
  {
    print "$file\n";
  }

  print "\nDelete extra snapshots [yN]: ";
  chomp ($input = <STDIN>);
  if($input eq 'y')
  {
    foreach $file (@delete)
    {
      $cmd = "rm \"$file\"";
      system($cmd);
    }
  }
}

sub usage {
  print "prune_snapshots.pl [listrominfo data] [snapshot dir]\n";
  exit(0);
}


#!/usr/bin/perl

use File::Basename;

usage() if @ARGV != 2;

# Generate md5sums for source and destination directories
my @src_files = `md5sum $ARGV[0]/*`;
my @dest_files = `md5sum $ARGV[1]/*`;

# Build hash for source ROMs
my %src_md5 = ();
foreach $file (@src_files) {
  chomp $file;
  ($md5, $name) = split("  ", $file);
  $src_md5{ $md5 } = $name;
}
print "Found " . keys( %src_md5 ) . " ROMs in " . $ARGV[0] . "\n";

# Build hash for destination ROMs
my %dest_md5 = ();
foreach $file (@dest_files) {
  chomp $file;
  ($md5, $name) = split("  ", $file);
  $dest_md5{ $md5 } = $name;
}
print "Found " . keys( %dest_md5 ) . " ROMs in " . $ARGV[1] . "\n";

my @added = (), @removed = (), @changed = ();

# Check for added ROMs
for my $key ( keys %dest_md5 ) {
  if (defined $src_md5{$key}) {
    ($src_rom,$path,$type) = fileparse($src_md5{$key});
    ($dest_rom,$path,$type) = fileparse($dest_md5{$key});
    if($src_rom ne $dest_rom) {
      push(@changed, $dest_md5{$key});
    }
  }
  else {
    push(@added, $dest_md5{$key});
  }
}

# Check for removed ROMs
for my $key ( keys %src_md5 ) {
  if (!defined $dest_md5{$key}) {
    push(@removed, $src_md5{$key});
  }
}

# Report our findings, create directories and copy files
print "\n";
my $numAdded = @added;
print "Added ROMs: $numAdded\n";
if ($numAdded > 0) {
  system("mkdir -p ADDED");
  foreach $rom (@added) {
    system("cp \"$rom\" ADDED/");
  }
}
my $numRemoved = @removed;
print "Removed ROMs: $numRemoved\n";
if ($numRemoved > 0) {
  system("mkdir -p REMOVED");
  foreach $rom (@removed) {
    system("cp \"$rom\" REMOVED/");
  }
}
my $numChanged = @changed;
print "Changed ROMs: $numChanged\n";
if ($numChanged > 0) {
  system("mkdir -p CHANGED");
  foreach $rom (@changed) {
    system("cp \"$rom\" CHANGED/");
  }
}

sub usage {
  print "rom_diff.pl <source directory> <destination directory>\n";
  print "\n";
  print "Analyze the ROMs in both directories by md5sum and name.\n";
  print "Three directories are created named 'ADDED', 'REMOVED' and 'CHANGED',\n";
  print "indicating the differences in ROMs from the source and destination\n";
  print "directories.  ROMs are then copied into these new directories as specified.\n";
  exit(0);
}


#!/usr/bin/perl

die if(@ARGV != 1);

open( FILES, $ARGV[0]);
@files = <FILES>;
close( FILES );

foreach $infile (@files)
{
  chomp $infile;
  print "Processing file $infile\n";
  $outfile = $infile . "___";

  open(IN, "$infile");
  open(OUT, ">$outfile");

  # Update date
  foreach $line (<IN>)
  {
    $line =~ s/1995-2014/1995-2013/;
    print OUT $line;
  }

  close(IN);
  close(OUT);

  # Put back into original file
  system( "mv \"$outfile\" \"$infile\"" );
}


#!/usr/bin/env perl
# Haiku OS: we don't care!

use strict;

my $in = 'cmake-config.h.in';
my $out = "$in.$$";

my ($fin, $fout);
open $fin, "< $in" or die "can't open $in: $!";
open $fout, "> $out" or die "can't create $out: $!";

my $zipconf_defines = read_zipconf_defines();

my $in_defines = 0;
while (my $line = <$fin>) {
	if ($in_defines) {
		if ($line =~ m,/* END DEFINES,) {
			$in_defines = 0;
		}
		else {
			next;
		}
	}
	print $fout $line;
	if ($line =~ m,/\* BEGIN DEFINES,) {
		$in_defines = 1;
		add_defines($fout, $zipconf_defines);
	}
}

close $fin;
close $fout;

rename($out, $in);

sub add_defines {
	my ($fout, $zipconf_defines) = @_;

	my $fin;
	open $fin, "< CMakeLists.txt" or die "can't open CMakeLists.txt: $!";

	while (my $line = <$fin>) {
		my ($key, $value);

		if ($line =~ m/CHECK_TYPE_SIZE\(.* (\S*)\)/) {
			$key = $1;
			$value = "\${$1}";
		}
		elsif ($line =~ m/CHECK_\S*\(.* (\S*)\)/) {
			$key = $1;
		}

		if (defined($key) && !defined($zipconf_defines->{$key})) {
			print $fout "#cmakedefine $key" . ($value ? " $value" : "") . "\n";
		}
	}

	close $fin;
}

sub read_zipconf_defines {
	my %zipconf_defines = ();

	my $fin;
	open $fin, "< cmake-zipconf.h.in" or die "can't open cmake-zipconf.h.in: $!";

	while (my $line = <$fin>) {
		if ($line =~ m/#cmakedefine\s+(\S+)/) {
			$zipconf_defines{$1} = 1;
		}
	}

	close $fin;

	return \%zipconf_defines;
}


#!/usr/bin/env perl

use strict;

my $DOCSETUTIL = '/Applications/Xcode.app/Contents/Developer/usr/bin/docsetutil';

my $BASE_URL = 'http://nih.at/libzip';
my $BUNDLE_ID = 'at.nih.libzip';

my $SRCDIR = $ENV{SRCDIR} // '.';

my @files = @ARGV;

my $docset = 'at.nih.libzip.docset';
my @sh_nodes = qw(zipcmp zipmerge ziptool);

(system('rm', '-rf', $docset) == 0) or die "can't remove old version of docset: $!";

mkdir($docset) or die "can't create docset directory: $!";
mkdir("$docset/Contents") or die "can't create docset directory: $!";
mkdir("$docset/Contents/Resources") or die "can't create docset directory: $!";
mkdir("$docset/Contents/Resources/Documents") or die "can't create docset directory: $!";

my $version = `sed -n 's/#define PACKAGE_VERSION "\\(.*\\)"/\\1/p' ../config.h`;
chomp $version;

my $suffix = '';
$suffix = '-hg' if ($version =~ /[a-z]$/);

my $package_file = "$BUNDLE_ID-$version.xar";
my $download_url = "$BASE_URL/$package_file";
my $feed_url = "$BASE_URL/at.nih.libzip$suffix.atom";

open I, "> $docset/Contents/Info.plist" or die "can't create Info.plist: $!";
print I <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
<plist version="1.0">
<dict>
	<key>CFBundleIdentifier</key>
	<string>$BUNDLE_ID.docset</string>
	<key>CFBundleName</key>
	<string>libzip</string>
	<key>DocSetPublisherIdentifier</key>
	<string>at.nih</string>
	<key>DocSetPublisherName</key>
	<string>NiH</string>
        <key>NSHumanReadableCopyright</key>
        <string>Copyright Â© 2016 Dieter Baron and Thomas Klausner</string>
	<key>CFBundleVersion</key>
	<string>$version</string>
	<key>DocSetFeedURL</key>
	<string>$feed_url</string>
	<key>DocSetFeedName</key>
	<string>libzip</string>
</dict>
</plist>
EOF
close I;

open N, "> $docset/Contents/Resources/Nodes.xml" or die "can't create Nodes.xml: $!";

my %tl_nodes = (libzip => 1);

for (@sh_nodes) {
    $tl_nodes{$_} = 1;
}

my @tokens = ();

print N <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<DocSetNodes version="1.0">
  <TOC>
    <Node noindex="1" type="folder">
      <Name>libzip package</Name>
      <Subnodes>
        <Node noindex="1" type="folder">
          <Name>Library</Name>
          <Path>libzip.html</Path>
          <Subnodes>
EOF

my $id = 1001;

for my $html (@files) {
    my $name = $html;
    $name =~ s/.html//;

    if ($tl_nodes{$name}) {
	next;
    }

    process_file($html, 'c', $id++);
}

print N "          </Subnodes>\n";
print N "        </Node>\n";
print N "        <Node noindex=\"1\" type=\"folder\">\n";
print N "          <Name>Commands</Name>\n";
print N "          <Subnodes>\n";

$id = 2;

for my $name (@sh_nodes) {
    process_file("$name.html", 'c', $id++);
}

print N "          </Subnodes>\n";
print N "        </Node>\n";
print N "      </Subnodes>\n";
print N "    </Node>\n";
print N "  </TOC>\n";
print N "</DocSetNodes>\n";

close N;

link("$SRCDIR/nih-man.css", "$docset/Contents/Resources/Documents/nih-man.css") or die "can't link css file: $!";
copy_html('libzip.html', "$docset/Contents/Resources/Documents/libzip.html");

write_tokens();

system($DOCSETUTIL, 'index', $docset) == 0 or die "can't index docset: $!";
system($DOCSETUTIL, 'validate', $docset) == 0 or die "can't validate docset: $!";

unlink("$docset/Contents/Resources/Nodes.xml");
unlink("$docset/Contents/Resources/Tokens.xml");

system($DOCSETUTIL, 'package', '-output', "at.nih.libzip-$version.xar", '-atom', "at.nih.libzip$suffix.atom", '-download-url', "$BASE_URL/at.nih.libzip-$version.xar", $docset);

sub copy_html {
    my ($src, $dst) = @_;

    my $content = `cat $src`;
    $content =~ s,,<meta name="viewport" content="width=device-width">,;
    $content =~ s,../nih-man.css,nih-man.css,;

    # remove header and footer
    $content =~ s,
]*class="(heade?r?|foote?r?)".*?
,,sg;

    $content =~ s,(<div class="sec-body") style="margin-left: 5.00ex;",$1,g;
    $content =~ s,(
 $dst" or die "can't create $dst: $!";
    print X $content;
    close X;
}

sub process_file {
    my ($html, $lang, $id) = @_;

    my $name = $html;
    $name =~ s/.html//;
    my $mdoc = "$SRCDIR/$name.mdoc";

    my $description;
    my @names = ();

    open MD, "< $mdoc" or die "can't open $mdoc: $!";

    while (my $line = <MD>) {
	if ($line =~ m/^.Nm (.*?)( ,)?$/) {
	    push @names, $1;
	}
	elsif ($line =~ m/^.Nd (.*)/) {
	    $description = $1;
	}
	elsif ($line =~ m/^.Sh SYNOPSIS/) {
	    last;
	}
    }

    close MD;

    print N "            <Node id=\"$id\">\n";
    print N "              <Name>$name</Name>\n";
    print N "              <Path>$html</Path>\n";
    print N "            </Node>\n";

    for my $name (@names) {
	push @tokens, { type => "//apple_ref/$lang/func",
			path => $html,
			name => $name,
			description => $description,
			id => $id };
    }

    copy_html($html, "$docset/Contents/Resources/Documents/$html");
}

sub write_token {
    my ($T, $token) = @_;

    print $T "  <Token>\n";
    print $T "    <TokenIdentifier>$token->{type}/$token->{name}</TokenIdentifier>\n";
    print $T "    <Path>$token->{path}</Path>\n";
    print $T "    <Abstract>$token->{description}</Abstract>\n";
    print $T "    <NodeRef refid=\"$token->{id}\" />\n";
    print $T "  </Token>\n";
}

sub write_tokens {
    open my $T, "> $docset/Contents/Resources/Tokens.xml" or die "can't create Tokens.xml: $!";
    print $T "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
    print $T "<Tokens version=\"1.0\">\n";

    for my $token (sort { $a->{name} cmp $b->{name} } @tokens) {
	write_token($T, $token);
    }

    print $T "</Tokens>\n";

    close $T;
}


#!/usr/bin/perl
#------------------------------------------------------------------------
#  Copyright 2009 (c) Jeff Brown <spadix@users.sourceforge.net>
#
#  This file is part of the ZBar Bar Code Reader.
#
#  The ZBar Bar Code Reader is free software; you can redistribute it
#  and/or modify it under the terms of the GNU Lesser Public License as
#  published by the Free Software Foundation; either version 2.1 of
#  the License, or (at your option) any later version.
#
#  The ZBar Bar Code Reader is distributed in the hope that it will be
#  useful, but WITHOUT ANY WARRANTY; without even the implied warranty
#  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU Lesser Public License for more details.
#
#  You should have received a copy of the GNU Lesser Public License
#  along with the ZBar Bar Code Reader; if not, write to the Free
#  Software Foundation, Inc., 51 Franklin St, Fifth Floor,
#  Boston, MA  02110-1301  USA
#
#  http://sourceforge.net/projects/zbar
#------------------------------------------------------------------------
use warnings;
use strict;

use Barcode::ZBar;
use Image::Magick;

warn("no input files specified?\n") if(!@ARGV);

# running output document
my $out = undef;

# barcode scanner
my $scanner = Barcode::ZBar::ImageScanner->new();

foreach my $file (@ARGV) {
    print "scanning from \"$file\"\n";
    my $imseq = Image::Magick->new();
    my $err = $imseq->Read($file);
    warn($err) if($err);

    foreach my $page (@$imseq) {
        # convert ImageMagick page to ZBar image
        my $zimg = Barcode::ZBar::Image->new();
        $zimg->set_format('Y800');
        $zimg->set_size($page->Get(qw(columns rows)));
        $zimg->set_data($page->Clone()->ImageToBlob(magick => 'GRAY', depth => 8));

        # scan for barcodes
        if($scanner->scan_image($zimg)) {
            # write out previous document
            $out->write() if($out);

            # use first symbol found to name next image (FIXME sanitize)
            my $data = ($zimg->get_symbols())[0]->get_data();
            my $idx = $page->Get('scene') + 1;
            print "splitting $data from page $idx\n";

            # create new output document
            $out = Image::Magick->new(filename => $data);
        }

        # append this page to current output
        push(@$out, $page) if($out);
    }

    # write out final document
    $out->write() if($out);
}


#!/usr/bin/env perl
use warnings;
use strict;
require Barcode::ZBar;

# create a Processor
my $proc = Barcode::ZBar::Processor->new();

# configure the Processor
$proc->parse_config("enable");

# initialize the Processor
$proc->init($ARGV[0] || '/dev/video0');

# setup a callback
sub my_handler {
    my ($proc, $image, $closure) = @_;

    # extract results
    foreach my $symbol ($proc->get_results()) {
        # do something useful with results
        print('decoded ' . $symbol->get_type() .
              ' symbol "' . $symbol->get_data() . "\"\n");
    }
}
$proc->set_data_handler(\&my_handler);

# enable the preview window
$proc->set_visible();

# initiate scanning
$proc->set_active();

# keep scanning until user provides key/mouse input
$proc->user_wait();


#!/usr/bin/env perl
use warnings;
use strict;
require Barcode::ZBar;

# create a Processor
my $proc = Barcode::ZBar::Processor->new();

# configure the Processor
$proc->parse_config("enable");

# initialize the Processor
$proc->init($ARGV[0] || '/dev/video0');

# enable the preview window
$proc->set_visible();

# read at least one barcode (or until window closed)
$proc->process_one();

# hide the preview window
$proc->set_visible(0);

# extract results
foreach my $symbol ($proc->get_results()) {
  # do something useful with results
  print('decoded ' . $symbol->get_type() .
        ' symbol "' . $symbol->get_data() . "\"\n");
}


#!/usr/bin/perl
use warnings;
use strict;
require Image::Magick;
require Barcode::ZBar;

$ARGV[0] || die;

# create a reader
my $scanner = Barcode::ZBar::ImageScanner->new();

# configure the reader
$scanner->parse_config("enable");

# obtain image data
my $magick = Image::Magick->new();
$magick->Read($ARGV[0]) && die;
my $raw = $magick->ImageToBlob(magick => 'GRAY', depth => 8);

# wrap image data
my $image = Barcode::ZBar::Image->new();
$image->set_format('Y800');
$image->set_size($magick->Get(qw(columns rows)));
$image->set_data($raw);

# scan the image for barcodes
my $n = $scanner->scan_image($image);

# extract results
foreach my $symbol ($image->get_symbols()) {
    # do something useful with results
    print('decoded ' . $symbol->get_type() .
          ' symbol "' . $symbol->get_data() . "\"\n");
}

# clean up
undef($image);


#!/usr/bin/perl
use warnings;
use strict;
use Frontier::Client;
use Data::Dumper;
my $s = Frontier::Client->new('url' => 'http://dev.upcdatabase.com/rpc');

$| = 1; # autoflush

foreach (@ARGV) {
  lookup($_);
}
if(!-t) {
  while(1) {
    my $decode = <STDIN>;
    last unless(defined($decode));
    chomp($decode);
    lookup($decode);
  }
}

sub lookup {
  my $decode = shift;
  if($decode =~ m[^(EAN-13:|UPC-A:)?(\d{11,13})$] &&
    ($1 && $1 eq "UPC-A:") || ($2 && length($2) > 11)) {
    my $ean = $2;
    $ean = "0" . $ean
      if($1 && $1 eq "UPC-A:");
    $ean = $s->call('calculateCheckDigit', $ean . "C")
      if(length($ean) == 12);
    print("[$decode] ");
    my $result = $s->call('lookupEAN', $s->string($ean));
    if(ref($result)) {
      print((!$result->{found} ||
            (ref($result->{found}) && !$result->{found}->value()))
            ? "not found\n"
            : "$result->{description}\n")
    }
    else {
      print("$result\n");
    }
  }
  else {
    print("$decode\n");
  }
}


#!/usr/bin/env perl
#------------------------------------------------------------------------
#  Copyright 2008-2009 (c) Jeff Brown <spadix@users.sourceforge.net>
#
#  This file is part of the ZBar Bar Code Reader.
#
#  The ZBar Bar Code Reader is free software; you can redistribute it
#  and/or modify it under the terms of the GNU Lesser Public License as
#  published by the Free Software Foundation; either version 2.1 of
#  the License, or (at your option) any later version.
#
#  The ZBar Bar Code Reader is distributed in the hope that it will be
#  useful, but WITHOUT ANY WARRANTY; without even the implied warranty
#  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU Lesser Public License for more details.
#
#  You should have received a copy of the GNU Lesser Public License
#  along with the ZBar Bar Code Reader; if not, write to the Free
#  Software Foundation, Inc., 51 Franklin St, Fifth Floor,
#  Boston, MA  02110-1301  USA
#
#  http://sourceforge.net/projects/zbar
#------------------------------------------------------------------------

use 5.006;
use warnings;
use strict;

use Barcode::ZBar;

Barcode::ZBar::set_verbosity(15);

my $proc = Barcode::ZBar::Processor->new(1);

$proc->init($ARGV[0] || '/dev/video0');

$proc->set_visible();
$proc->user_wait(2);

$proc->set_active();
$proc->user_wait(5);

$proc->set_active(0);
$proc->user_wait(2);

$proc->process_one();
$proc->user_wait(1);


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

# This program reads a file containing function prototypes
# (like syscall_darwin.go) and generates system call bodies.
# The prototypes are marked by lines beginning with "//sys"
# and read like func declarations if //sys is replaced by func, but:
#	* The parameter lists must give a name for each argument.
#	  This includes return parameters.
#	* The parameter lists must give a type for each argument:
#	  the (x, y, z int) shorthand is not allowed.
#	* If the return parameter is an error number, it must be named errno.

# A line beginning with //sysnb is like //sys, except that the
# goroutine will not be suspended during the execution of the system
# call.  This must only be used for system calls which can never
# block, as otherwise the system call could cause all goroutines to
# hang.

use strict;

my $cmdline = "mksyscall.pl " . join(' ', @ARGV);
my $errors = 0;
my $_32bit = "";
my $plan9 = 0;
my $openbsd = 0;
my $netbsd = 0;
my $dragonfly = 0;
my $arm = 0; # 64-bit value should use (even, odd)-pair
my $tags = "";  # build tags

if($ARGV[0] eq "-b32") {
	$_32bit = "big-endian";
	shift;
} elsif($ARGV[0] eq "-l32") {
	$_32bit = "little-endian";
	shift;
}
if($ARGV[0] eq "-plan9") {
	$plan9 = 1;
	shift;
}
if($ARGV[0] eq "-openbsd") {
	$openbsd = 1;
	shift;
}
if($ARGV[0] eq "-netbsd") {
	$netbsd = 1;
	shift;
}
if($ARGV[0] eq "-dragonfly") {
	$dragonfly = 1;
	shift;
}
if($ARGV[0] eq "-arm") {
	$arm = 1;
	shift;
}
if($ARGV[0] eq "-tags") {
	shift;
	$tags = $ARGV[0];
	shift;
}

if($ARGV[0] =~ /^-/) {
	print STDERR "usage: mksyscall.pl [-b32 | -l32] [-tags x,y] [file ...]\n";
	exit 1;
}

# Check that we are using the new build system if we should
if($ENV{'GOOS'} eq "linux" && $ENV{'GOARCH'} ne "sparc64") {
	if($ENV{'GOLANG_SYS_BUILD'} ne "docker") {
		print STDERR "In the new build system, mksyscall should not be called directly.\n";
		print STDERR "See README.md\n";
		exit 1;
	}
}

sub parseparamlist($) {
	my ($list) = @_;
	$list =~ s/^\s*//;
	$list =~ s/\s*$//;
	if($list eq "") {
		return ();
	}
	return split(/\s*,\s*/, $list);
}

sub parseparam($) {
	my ($p) = @_;
	if($p !~ /^(\S*) (\S*)$/) {
		print STDERR "$ARGV:$.: malformed parameter: $p\n";
		$errors = 1;
		return ("xx", "int");
	}
	return ($1, $2);
}

my $text = "";
while(<>) {
	chomp;
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	my $nonblock = /^\/\/sysnb /;
	next if !/^\/\/sys / && !$nonblock;

	# Line must be of the form
	#	func Open(path string, mode int, perm int) (fd int, errno error)
	# Split into name, in params, out params.
	if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*((?i)SYS_[A-Z0-9_]+))?$/) {
		print STDERR "$ARGV:$.: malformed //sys declaration\n";
		$errors = 1;
		next;
	}
	my ($func, $in, $out, $sysname) = ($2, $3, $4, $5);

	# Split argument lists on comma.
	my @in = parseparamlist($in);
	my @out = parseparamlist($out);

	# Try in vain to keep people from editing this file.
	# The theory is that they jump into the middle of the file
	# without reading the header.
	$text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n";

	# Go function header.
	my $out_decl = @out ? sprintf(" (%s)", join(', ', @out)) : "";
	$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out_decl;

	# Check if err return available
	my $errvar = "";
	foreach my $p (@out) {
		my ($name, $type) = parseparam($p);
		if($type eq "error") {
			$errvar = $name;
			last;
		}
	}

	# Prepare arguments to Syscall.
	my @args = ();
	my $n = 0;
	foreach my $p (@in) {
		my ($name, $type) = parseparam($p);
		if($type =~ /^\*/) {
			push @args, "uintptr(unsafe.Pointer($name))";
		} elsif($type eq "string" && $errvar ne "") {
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, $errvar = BytePtrFromString($name)\n";
			$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type eq "string") {
			print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, _ = BytePtrFromString($name)\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type =~ /^\[\](.*)/) {
			# Convert slice into pointer, length.
			# Have to be careful not to take address of &a[0] if len == 0:
			# pass dummy pointer in that case.
			# Used to pass nil, but some OSes or simulators reject write(fd, nil, 0).
			$text .= "\tvar _p$n unsafe.Pointer\n";
			$text .= "\tif len($name) > 0 {\n\t\t_p$n = unsafe.Pointer(\&${name}[0])\n\t}";
			$text .= " else {\n\t\t_p$n = unsafe.Pointer(&_zero)\n\t}";
			$text .= "\n";
			push @args, "uintptr(_p$n)", "uintptr(len($name))";
			$n++;
		} elsif($type eq "int64" && ($openbsd || $netbsd)) {
			push @args, "0";
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $dragonfly) {
			if ($func !~ /^extp(read|write)/i) {
				push @args, "0";
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $_32bit ne "") {
			if(@args % 2 && $arm) {
				# arm abi specifies 64-bit argument uses
				# (even, odd) pair
				push @args, "0"
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} else {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			}
		} else {
			push @args, "uintptr($name)";
		}
	}

	# Determine which form to use; pad args with zeros.
	my $asm = "Syscall";
	if ($nonblock) {
		if ($errvar ne "") {
			$asm = "RawSyscall";
		} else {
			$asm = "RawSyscallNoError";
		}
	} else {
		if ($errvar eq "") {
			$asm = "SyscallNoError";
		}
	}
	if(@args <= 3) {
		while(@args < 3) {
			push @args, "0";
		}
	} elsif(@args <= 6) {
		$asm .= "6";
		while(@args < 6) {
			push @args, "0";
		}
	} elsif(@args <= 9) {
		$asm .= "9";
		while(@args < 9) {
			push @args, "0";
		}
	} else {
		print STDERR "$ARGV:$.: too many arguments to system call\n";
	}

	# System call number.
	if($sysname eq "") {
		$sysname = "SYS_$func";
		$sysname =~ s/([a-z])([A-Z])/${1}_$2/g;	# turn FooBar into Foo_Bar
		$sysname =~ y/a-z/A-Z/;
	}

	# Actual call.
	my $args = join(', ', @args);
	my $call = "$asm($sysname, $args)";

	# Assign return values.
	my $body = "";
	my @ret = ("_", "_", "_");
	my $do_errno = 0;
	for(my $i=0; $i<@out; $i++) {
		my $p = $out[$i];
		my ($name, $type) = parseparam($p);
		my $reg = "";
		if($name eq "err" && !$plan9) {
			$reg = "e1";
			$ret[2] = $reg;
			$do_errno = 1;
		} elsif($name eq "err" && $plan9) {
			$ret[0] = "r0";
			$ret[2] = "e1";
			next;
		} else {
			$reg = sprintf("r%d", $i);
			$ret[$i] = $reg;
		}
		if($type eq "bool") {
			$reg = "$reg != 0";
		}
		if($type eq "int64" && $_32bit ne "") {
			# 64-bit number in r1:r0 or r0:r1.
			if($i+2 > @out) {
				print STDERR "$ARGV:$.: not enough registers for int64 return\n";
			}
			if($_32bit eq "big-endian") {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
			} else {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
			}
			$ret[$i] = sprintf("r%d", $i);
			$ret[$i+1] = sprintf("r%d", $i+1);
		}
		if($reg ne "e1" || $plan9) {
			$body .= "\t$name = $type($reg)\n";
		}
	}
	if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
		$text .= "\t$call\n";
	} else {
		if ($errvar ne "") {
			$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
		} else {
			$text .= "\t$ret[0], $ret[1] := $call\n";
		}
	}
	$text .= $body;

	if ($plan9 && $ret[2] eq "e1") {
		$text .= "\tif int32(r0) == -1 {\n";
		$text .= "\t\terr = e1\n";
		$text .= "\t}\n";
	} elsif ($do_errno) {
		$text .= "\tif e1 != 0 {\n";
		$text .= "\t\terr = errnoErr(e1)\n";
		$text .= "\t}\n";
	}
	$text .= "\treturn\n";
	$text .= "}\n\n";
}

chomp $text;
chomp $text;

if($errors) {
	exit 1;
}

print <<EOF;
// $cmdline
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $tags

package unix

import (
	"syscall"
	"unsafe"
)

var _ syscall.Errno

$text
EOF
exit 0;


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

# This program reads a file containing function prototypes
# (like syscall_solaris.go) and generates system call bodies.
# The prototypes are marked by lines beginning with "//sys"
# and read like func declarations if //sys is replaced by func, but:
#	* The parameter lists must give a name for each argument.
#	  This includes return parameters.
#	* The parameter lists must give a type for each argument:
#	  the (x, y, z int) shorthand is not allowed.
#	* If the return parameter is an error number, it must be named err.
#	* If go func name needs to be different than its libc name,
#	* or the function is not in libc, name could be specified
#	* at the end, after "=" sign, like
#	  //sys getsockopt(s int, level int, name int, val uintptr, vallen *_Socklen) (err error) = libsocket.getsockopt

use strict;

my $cmdline = "mksyscall_solaris.pl " . join(' ', @ARGV);
my $errors = 0;
my $_32bit = "";
my $tags = "";  # build tags

binmode STDOUT;

if($ARGV[0] eq "-b32") {
	$_32bit = "big-endian";
	shift;
} elsif($ARGV[0] eq "-l32") {
	$_32bit = "little-endian";
	shift;
}
if($ARGV[0] eq "-tags") {
	shift;
	$tags = $ARGV[0];
	shift;
}

if($ARGV[0] =~ /^-/) {
	print STDERR "usage: mksyscall_solaris.pl [-b32 | -l32] [-tags x,y] [file ...]\n";
	exit 1;
}

sub parseparamlist($) {
	my ($list) = @_;
	$list =~ s/^\s*//;
	$list =~ s/\s*$//;
	if($list eq "") {
		return ();
	}
	return split(/\s*,\s*/, $list);
}

sub parseparam($) {
	my ($p) = @_;
	if($p !~ /^(\S*) (\S*)$/) {
		print STDERR "$ARGV:$.: malformed parameter: $p\n";
		$errors = 1;
		return ("xx", "int");
	}
	return ($1, $2);
}

my $package = "";
my $text = "";
my $dynimports = "";
my $linknames = "";
my @vars = ();
while(<>) {
	chomp;
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	$package = $1 if !$package && /^package (\S+)$/;
	my $nonblock = /^\/\/sysnb /;
	next if !/^\/\/sys / && !$nonblock;

	# Line must be of the form
	#	func Open(path string, mode int, perm int) (fd int, err error)
	# Split into name, in params, out params.
	if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*(?:(\w*)\.)?(\w*))?$/) {
		print STDERR "$ARGV:$.: malformed //sys declaration\n";
		$errors = 1;
		next;
	}
	my ($nb, $func, $in, $out, $modname, $sysname) = ($1, $2, $3, $4, $5, $6);

	# Split argument lists on comma.
	my @in = parseparamlist($in);
	my @out = parseparamlist($out);

	# So file name.
	if($modname eq "") {
		$modname = "libc";
	}

	# System call name.
	if($sysname eq "") {
		$sysname = "$func";
	}

	# System call pointer variable name.
	my $sysvarname = "proc$sysname";

	my $strconvfunc = "BytePtrFromString";
	my $strconvtype = "*byte";

	$sysname =~ y/A-Z/a-z/; # All libc functions are lowercase.

	# Runtime import of function to allow cross-platform builds.
	$dynimports .= "//go:cgo_import_dynamic libc_${sysname} ${sysname} \"$modname.so\"\n";
	# Link symbol to proc address variable.
	$linknames .= "//go:linkname ${sysvarname} libc_${sysname}\n";
	# Library proc address variable.
	push @vars, $sysvarname;

	# Go function header.
	$out = join(', ', @out);
	if($out ne "") {
		$out = " ($out)";
	}
	if($text ne "") {
		$text .= "\n"
	}
	$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out;

	# Check if err return available
	my $errvar = "";
	foreach my $p (@out) {
		my ($name, $type) = parseparam($p);
		if($type eq "error") {
			$errvar = $name;
			last;
		}
	}

	# Prepare arguments to Syscall.
	my @args = ();
	my $n = 0;
	foreach my $p (@in) {
		my ($name, $type) = parseparam($p);
		if($type =~ /^\*/) {
			push @args, "uintptr(unsafe.Pointer($name))";
		} elsif($type eq "string" && $errvar ne "") {
			$text .= "\tvar _p$n $strconvtype\n";
			$text .= "\t_p$n, $errvar = $strconvfunc($name)\n";
			$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type eq "string") {
			print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
			$text .= "\tvar _p$n $strconvtype\n";
			$text .= "\t_p$n, _ = $strconvfunc($name)\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type =~ /^\[\](.*)/) {
			# Convert slice into pointer, length.
			# Have to be careful not to take address of &a[0] if len == 0:
			# pass nil in that case.
			$text .= "\tvar _p$n *$1\n";
			$text .= "\tif len($name) > 0 {\n\t\t_p$n = \&$name\[0]\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))", "uintptr(len($name))";
			$n++;
		} elsif($type eq "int64" && $_32bit ne "") {
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name >> 32)", "uintptr($name)";
			} else {
				push @args, "uintptr($name)", "uintptr($name >> 32)";
			}
		} elsif($type eq "bool") {
 			$text .= "\tvar _p$n uint32\n";
			$text .= "\tif $name {\n\t\t_p$n = 1\n\t} else {\n\t\t_p$n = 0\n\t}\n";
			push @args, "uintptr(_p$n)";
			$n++;
		} else {
			push @args, "uintptr($name)";
		}
	}
	my $nargs = @args;

	# Determine which form to use; pad args with zeros.
	my $asm = "sysvicall6";
	if ($nonblock) {
		$asm = "rawSysvicall6";
	}
	if(@args <= 6) {
		while(@args < 6) {
			push @args, "0";
		}
	} else {
		print STDERR "$ARGV:$.: too many arguments to system call\n";
	}

	# Actual call.
	my $args = join(', ', @args);
	my $call = "$asm(uintptr(unsafe.Pointer(&$sysvarname)), $nargs, $args)";

	# Assign return values.
	my $body = "";
	my $failexpr = "";
	my @ret = ("_", "_", "_");
	my @pout= ();
	my $do_errno = 0;
	for(my $i=0; $i<@out; $i++) {
		my $p = $out[$i];
		my ($name, $type) = parseparam($p);
		my $reg = "";
		if($name eq "err") {
			$reg = "e1";
			$ret[2] = $reg;
			$do_errno = 1;
		} else {
			$reg = sprintf("r%d", $i);
			$ret[$i] = $reg;
		}
		if($type eq "bool") {
			$reg = "$reg != 0";
		}
		if($type eq "int64" && $_32bit ne "") {
			# 64-bit number in r1:r0 or r0:r1.
			if($i+2 > @out) {
				print STDERR "$ARGV:$.: not enough registers for int64 return\n";
			}
			if($_32bit eq "big-endian") {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
			} else {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
			}
			$ret[$i] = sprintf("r%d", $i);
			$ret[$i+1] = sprintf("r%d", $i+1);
		}
		if($reg ne "e1") {
			$body .= "\t$name = $type($reg)\n";
		}
	}
	if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
		$text .= "\t$call\n";
	} else {
		$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
	}
	$text .= $body;

	if ($do_errno) {
		$text .= "\tif e1 != 0 {\n";
		$text .= "\t\terr = e1\n";
		$text .= "\t}\n";
	}
	$text .= "\treturn\n";
	$text .= "}\n";
}

if($errors) {
	exit 1;
}

print <<EOF;
// $cmdline
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $tags

package $package

import (
	"syscall"
	"unsafe"
)
EOF

print "import \"golang.org/x/sys/unix\"\n" if $package ne "unix";

my $vardecls = "\t" . join(",\n\t", @vars);
$vardecls .= " syscallFunc";

chomp($_=<<EOF);

$dynimports
$linknames
var (
$vardecls
)

$text
EOF
print $_;
exit 0;


#!/usr/bin/env perl

# Copyright 2011 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

#
# Parse the header files for OpenBSD and generate a Go usable sysctl MIB.
#
# Build a MIB with each entry being an array containing the level, type and
# a hash that will contain additional entries if the current entry is a node.
# We then walk this MIB and create a flattened sysctl name to OID hash.
#

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $debug = 0;
my %ctls = ();

my @headers = qw (
	sys/sysctl.h
	sys/socket.h
	sys/tty.h
	sys/malloc.h
	sys/mount.h
	sys/namei.h
	sys/sem.h
	sys/shm.h
	sys/vmmeter.h
	uvm/uvm_param.h
	uvm/uvm_swap_encrypt.h
	ddb/db_var.h
	net/if.h
	net/if_pfsync.h
	net/pipex.h
	netinet/in.h
	netinet/icmp_var.h
	netinet/igmp_var.h
	netinet/ip_ah.h
	netinet/ip_carp.h
	netinet/ip_divert.h
	netinet/ip_esp.h
	netinet/ip_ether.h
	netinet/ip_gre.h
	netinet/ip_ipcomp.h
	netinet/ip_ipip.h
	netinet/pim_var.h
	netinet/tcp_var.h
	netinet/udp_var.h
	netinet6/in6.h
	netinet6/ip6_divert.h
	netinet6/pim6_var.h
	netinet/icmp6.h
	netmpls/mpls.h
);

my @ctls = qw (
	kern
	vm
	fs
	net
	#debug				# Special handling required
	hw
	#machdep			# Arch specific
	user
	ddb
	#vfs				# Special handling required
	fs.posix
	kern.forkstat
	kern.intrcnt
	kern.malloc
	kern.nchstats
	kern.seminfo
	kern.shminfo
	kern.timecounter
	kern.tty
	kern.watchdog
	net.bpf
	net.ifq
	net.inet
	net.inet.ah
	net.inet.carp
	net.inet.divert
	net.inet.esp
	net.inet.etherip
	net.inet.gre
	net.inet.icmp
	net.inet.igmp
	net.inet.ip
	net.inet.ip.ifq
	net.inet.ipcomp
	net.inet.ipip
	net.inet.mobileip
	net.inet.pfsync
	net.inet.pim
	net.inet.tcp
	net.inet.udp
	net.inet6
	net.inet6.divert
	net.inet6.ip6
	net.inet6.icmp6
	net.inet6.pim6
	net.inet6.tcp6
	net.inet6.udp6
	net.mpls
	net.mpls.ifq
	net.key
	net.pflow
	net.pfsync
	net.pipex
	net.rt
	vm.swapencrypt
	#vfsgenctl			# Special handling required
);

# Node name "fixups"
my %ctl_map = (
	"ipproto" => "net.inet",
	"net.inet.ipproto" => "net.inet",
	"net.inet6.ipv6proto" => "net.inet6",
	"net.inet6.ipv6" => "net.inet6.ip6",
	"net.inet.icmpv6" => "net.inet6.icmp6",
	"net.inet6.divert6" => "net.inet6.divert",
	"net.inet6.tcp6" => "net.inet.tcp",
	"net.inet6.udp6" => "net.inet.udp",
	"mpls" => "net.mpls",
	"swpenc" => "vm.swapencrypt"
);

# Node mappings
my %node_map = (
	"net.inet.ip.ifq" => "net.ifq",
	"net.inet.pfsync" => "net.pfsync",
	"net.mpls.ifq" => "net.ifq"
);

my $ctlname;
my %mib = ();
my %sysctl = ();
my $node;

sub debug() {
	print STDERR "$_[0]\n" if $debug;
}

# Walk the MIB and build a sysctl name to OID mapping.
sub build_sysctl() {
	my ($node, $name, $oid) = @_;
	my %node = %{$node};
	my @oid = @{$oid};

	foreach my $key (sort keys %node) {
		my @node = @{$node{$key}};
		my $nodename = $name.($name ne '' ? '.' : '').$key;
		my @nodeoid = (@oid, $node[0]);
		if ($node[1] eq 'CTLTYPE_NODE') {
			if (exists $node_map{$nodename}) {
				$node = \%mib;
				$ctlname = $node_map{$nodename};
				foreach my $part (split /\./, $ctlname) {
					$node = \%{@{$$node{$part}}[2]};
				}
			} else {
				$node = $node[2];
			}
			&build_sysctl($node, $nodename, \@nodeoid);
		} elsif ($node[1] ne '') {
			$sysctl{$nodename} = \@nodeoid;
		}
	}
}

foreach my $ctl (@ctls) {
	$ctls{$ctl} = $ctl;
}

# Build MIB
foreach my $header (@headers) {
	&debug("Processing $header...");
	open HEADER, "/usr/include/$header" ||
	    print STDERR "Failed to open $header\n";
	while (<HEADER>) {
		if ($_ =~ /^#define\s+(CTL_NAMES)\s+{/ ||
		    $_ =~ /^#define\s+(CTL_(.*)_NAMES)\s+{/ ||
		    $_ =~ /^#define\s+((.*)CTL_NAMES)\s+{/) {
			if ($1 eq 'CTL_NAMES') {
				# Top level.
				$node = \%mib;
			} else {
				# Node.
				my $nodename = lc($2);
				if ($header =~ /^netinet\//) {
					$ctlname = "net.inet.$nodename";
				} elsif ($header =~ /^netinet6\//) {
					$ctlname = "net.inet6.$nodename";
				} elsif ($header =~ /^net\//) {
					$ctlname = "net.$nodename";
				} else {
					$ctlname = "$nodename";
					$ctlname =~ s/^(fs|net|kern)_/$1\./;
				}
				if (exists $ctl_map{$ctlname}) {
					$ctlname = $ctl_map{$ctlname};
				}
				if (not exists $ctls{$ctlname}) {
					&debug("Ignoring $ctlname...");
					next;
				}

				# Walk down from the top of the MIB.
				$node = \%mib;
				foreach my $part (split /\./, $ctlname) {
					if (not exists $$node{$part}) {
						&debug("Missing node $part");
						$$node{$part} = [ 0, '', {} ];
					}
					$node = \%{@{$$node{$part}}[2]};
				}
			}

			# Populate current node with entries.
			my $i = -1;
			while (defined($_) && $_ !~ /^}/) {
				$_ = <HEADER>;
				$i++ if $_ =~ /{.*}/;
				next if $_ !~ /{\s+"(\w+)",\s+(CTLTYPE_[A-Z]+)\s+}/;
				$$node{$1} = [ $i, $2, {} ];
			}
		}
	}
	close HEADER;
}

&build_sysctl(\%mib, "", []);

print <<EOF;
// mksysctl_openbsd.pl
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix;

type mibentry struct {
	ctlname string
	ctloid []_C_int
}

var sysctlMib = []mibentry {
EOF

foreach my $name (sort keys %sysctl) {
	my @oid = @{$sysctl{$name}};
	print "\t{ \"$name\", []_C_int{ ", join(', ', @oid), " } }, \n";
}

print <<EOF;
}
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for Darwin from sys/syscall.h

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_darwin.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^#define\s+SYS_(\w+)\s+([0-9]+)/){
		my $name = $1;
		my $num = $2;
		$name =~ y/a-z/A-Z/;
		print "	SYS_$name = $num;"
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for DragonFly from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_dragonfly.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+STD\s+({ \S+\s+(\w+).*)$/){
		my $num = $1;
		my $proto = $2;
		my $name = "SYS_$3";
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}

		print "	$name = $num;  // $proto\n";
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for FreeBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_freebsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+\S+\s+STD\s+({ \S+\s+(\w+).*)$/){
		my $num = $1;
		my $proto = $2;
		my $name = "SYS_$3";
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}

		print "	$name = $num;  // $proto\n";
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for OpenBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_netbsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

my $line = '';
while(<>){
	if($line =~ /^(.*)\\$/) {
		# Handle continuation
		$line = $1;
		$_ =~ s/^\s+//;
		$line .= $_;
	} else {
		# New line
		$line = $_;
	}
	next if $line =~ /\\$/;
	if($line =~ /^([0-9]+)\s+((STD)|(NOERR))\s+(RUMP\s+)?({\s+\S+\s*\*?\s*\|(\S+)\|(\S*)\|(\w+).*\s+})(\s+(\S+))?$/) {
		my $num = $1;
		my $proto = $6;
		my $compat = $8;
		my $name = "$7_$9";

		$name = "$7_$11" if $11 ne '';
		$name =~ y/a-z/A-Z/;

		if($compat eq '' || $compat eq '13' || $compat eq '30' || $compat eq '50') {
			print "	$name = $num;  // $proto\n";
		}
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for OpenBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_openbsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+STD\s+(NOLOCK\s+)?({ \S+\s+\*?(\w+).*)$/){
		my $num = $1;
		my $proto = $3;
		my $name = $4;
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}

		print "	$name = $num;  // $proto\n";
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

# This program reads a file containing function prototypes
# (like syscall_darwin.go) and generates system call bodies.
# The prototypes are marked by lines beginning with "//sys"
# and read like func declarations if //sys is replaced by func, but:
#	* The parameter lists must give a name for each argument.
#	  This includes return parameters.
#	* The parameter lists must give a type for each argument:
#	  the (x, y, z int) shorthand is not allowed.
#	* If the return parameter is an error number, it must be named errno.

# A line beginning with //sysnb is like //sys, except that the
# goroutine will not be suspended during the execution of the system
# call.  This must only be used for system calls which can never
# block, as otherwise the system call could cause all goroutines to
# hang.

use strict;

my $cmdline = "mksyscall.pl " . join(' ', @ARGV);
my $errors = 0;
my $_32bit = "";
my $plan9 = 0;
my $openbsd = 0;
my $netbsd = 0;
my $dragonfly = 0;
my $arm = 0; # 64-bit value should use (even, odd)-pair

if($ARGV[0] eq "-b32") {
	$_32bit = "big-endian";
	shift;
} elsif($ARGV[0] eq "-l32") {
	$_32bit = "little-endian";
	shift;
}
if($ARGV[0] eq "-plan9") {
	$plan9 = 1;
	shift;
}
if($ARGV[0] eq "-openbsd") {
	$openbsd = 1;
	shift;
}
if($ARGV[0] eq "-netbsd") {
	$netbsd = 1;
	shift;
}
if($ARGV[0] eq "-dragonfly") {
	$dragonfly = 1;
	shift;
}
if($ARGV[0] eq "-arm") {
	$arm = 1;
	shift;
}

if($ARGV[0] =~ /^-/) {
	print STDERR "usage: mksyscall.pl [-b32 | -l32] [file ...]\n";
	exit 1;
}

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

sub parseparamlist($) {
	my ($list) = @_;
	$list =~ s/^\s*//;
	$list =~ s/\s*$//;
	if($list eq "") {
		return ();
	}
	return split(/\s*,\s*/, $list);
}

sub parseparam($) {
	my ($p) = @_;
	if($p !~ /^(\S*) (\S*)$/) {
		print STDERR "$ARGV:$.: malformed parameter: $p\n";
		$errors = 1;
		return ("xx", "int");
	}
	return ($1, $2);
}

my $text = "";
while(<>) {
	chomp;
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	my $nonblock = /^\/\/sysnb /;
	next if !/^\/\/sys / && !$nonblock;

	# Line must be of the form
	#	func Open(path string, mode int, perm int) (fd int, errno error)
	# Split into name, in params, out params.
	if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*((?i)SYS_[A-Z0-9_]+))?$/) {
		print STDERR "$ARGV:$.: malformed //sys declaration\n";
		$errors = 1;
		next;
	}
	my ($func, $in, $out, $sysname) = ($2, $3, $4, $5);

	# Split argument lists on comma.
	my @in = parseparamlist($in);
	my @out = parseparamlist($out);

	# Try in vain to keep people from editing this file.
	# The theory is that they jump into the middle of the file
	# without reading the header.
	$text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n";

	# Go function header.
	my $out_decl = @out ? sprintf(" (%s)", join(', ', @out)) : "";
	$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out_decl;

	# Check if err return available
	my $errvar = "";
	foreach my $p (@out) {
		my ($name, $type) = parseparam($p);
		if($type eq "error") {
			$errvar = $name;
			last;
		}
	}

	# Prepare arguments to Syscall.
	my @args = ();
	my @uses = ();
	my $n = 0;
	foreach my $p (@in) {
		my ($name, $type) = parseparam($p);
		if($type =~ /^\*/) {
			push @args, "uintptr(unsafe.Pointer($name))";
		} elsif($type eq "string" && $errvar ne "") {
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, $errvar = BytePtrFromString($name)\n";
			$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			push @uses, "use(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type eq "string") {
			print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, _ = BytePtrFromString($name)\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			push @uses, "use(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type =~ /^\[\](.*)/) {
			# Convert slice into pointer, length.
			# Have to be careful not to take address of &a[0] if len == 0:
			# pass dummy pointer in that case.
			# Used to pass nil, but some OSes or simulators reject write(fd, nil, 0).
			$text .= "\tvar _p$n unsafe.Pointer\n";
			$text .= "\tif len($name) > 0 {\n\t\t_p$n = unsafe.Pointer(\&${name}[0])\n\t}";
			$text .= " else {\n\t\t_p$n = unsafe.Pointer(&_zero)\n\t}";
			$text .= "\n";
			push @args, "uintptr(_p$n)", "uintptr(len($name))";
			$n++;
		} elsif($type eq "int64" && ($openbsd || $netbsd)) {
			push @args, "0";
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $dragonfly) {
			if ($func !~ /^extp(read|write)/i) {
				push @args, "0";
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $_32bit ne "") {
			if(@args % 2 && $arm) {
				# arm abi specifies 64-bit argument uses
				# (even, odd) pair
				push @args, "0"
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} else {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			}
		} else {
			push @args, "uintptr($name)";
		}
	}

	# Determine which form to use; pad args with zeros.
	my $asm = "Syscall";
	if ($nonblock) {
		$asm = "RawSyscall";
	}
	if(@args <= 3) {
		while(@args < 3) {
			push @args, "0";
		}
	} elsif(@args <= 6) {
		$asm .= "6";
		while(@args < 6) {
			push @args, "0";
		}
	} elsif(@args <= 9) {
		$asm .= "9";
		while(@args < 9) {
			push @args, "0";
		}
	} else {
		print STDERR "$ARGV:$.: too many arguments to system call\n";
	}

	# System call number.
	if($sysname eq "") {
		$sysname = "SYS_$func";
		$sysname =~ s/([a-z])([A-Z])/${1}_$2/g;	# turn FooBar into Foo_Bar
		$sysname =~ y/a-z/A-Z/;
	}

	# Actual call.
	my $args = join(', ', @args);
	my $call = "$asm($sysname, $args)";

	# Assign return values.
	my $body = "";
	my @ret = ("_", "_", "_");
	my $do_errno = 0;
	for(my $i=0; $i<@out; $i++) {
		my $p = $out[$i];
		my ($name, $type) = parseparam($p);
		my $reg = "";
		if($name eq "err" && !$plan9) {
			$reg = "e1";
			$ret[2] = $reg;
			$do_errno = 1;
		} elsif($name eq "err" && $plan9) {
			$ret[0] = "r0";
			$ret[2] = "e1";
			next;
		} else {
			$reg = sprintf("r%d", $i);
			$ret[$i] = $reg;
		}
		if($type eq "bool") {
			$reg = "$reg != 0";
		}
		if($type eq "int64" && $_32bit ne "") {
			# 64-bit number in r1:r0 or r0:r1.
			if($i+2 > @out) {
				print STDERR "$ARGV:$.: not enough registers for int64 return\n";
			}
			if($_32bit eq "big-endian") {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
			} else {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
			}
			$ret[$i] = sprintf("r%d", $i);
			$ret[$i+1] = sprintf("r%d", $i+1);
		}
		if($reg ne "e1" || $plan9) {
			$body .= "\t$name = $type($reg)\n";
		}
	}
	if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
		$text .= "\t$call\n";
	} else {
		$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
	}
	foreach my $use (@uses) {
		$text .= "\t$use\n";
	}
	$text .= $body;

	if ($plan9 && $ret[2] eq "e1") {
		$text .= "\tif int32(r0) == -1 {\n";
		$text .= "\t\terr = e1\n";
		$text .= "\t}\n";
	} elsif ($do_errno) {
		$text .= "\tif e1 != 0 {\n";
		$text .= "\t\terr = errnoErr(e1)\n";
		$text .= "\t}\n";
	}
	$text .= "\treturn\n";
	$text .= "}\n\n";
}

chomp $text;
chomp $text;

if($errors) {
	exit 1;
}

print <<EOF;
// $cmdline
// MACHINE GENERATED BY THE COMMAND ABOVE; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

import (
	"syscall"
	"unsafe"
)

var _ syscall.Errno

$text
EOF
exit 0;


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

# This program reads a file containing function prototypes
# (like syscall_solaris.go) and generates system call bodies.
# The prototypes are marked by lines beginning with "//sys"
# and read like func declarations if //sys is replaced by func, but:
#	* The parameter lists must give a name for each argument.
#	  This includes return parameters.
#	* The parameter lists must give a type for each argument:
#	  the (x, y, z int) shorthand is not allowed.
#	* If the return parameter is an error number, it must be named err.
#	* If go func name needs to be different than its libc name,
#	* or the function is not in libc, name could be specified
#	* at the end, after "=" sign, like
#	  //sys getsockopt(s int, level int, name int, val uintptr, vallen *_Socklen) (err error) = libsocket.getsockopt

use strict;

my $cmdline = "mksyscall_solaris.pl " . join(' ', @ARGV);
my $errors = 0;
my $_32bit = "";

binmode STDOUT;

if($ARGV[0] eq "-b32") {
	$_32bit = "big-endian";
	shift;
} elsif($ARGV[0] eq "-l32") {
	$_32bit = "little-endian";
	shift;
}

if($ARGV[0] =~ /^-/) {
	print STDERR "usage: mksyscall_solaris.pl [-b32 | -l32] [file ...]\n";
	exit 1;
}

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

sub parseparamlist($) {
	my ($list) = @_;
	$list =~ s/^\s*//;
	$list =~ s/\s*$//;
	if($list eq "") {
		return ();
	}
	return split(/\s*,\s*/, $list);
}

sub parseparam($) {
	my ($p) = @_;
	if($p !~ /^(\S*) (\S*)$/) {
		print STDERR "$ARGV:$.: malformed parameter: $p\n";
		$errors = 1;
		return ("xx", "int");
	}
	return ($1, $2);
}

my $package = "";
my $text = "";
my $dynimports = "";
my $linknames = "";
my @vars = ();
while(<>) {
	chomp;
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	$package = $1 if !$package && /^package (\S+)$/;
	my $nonblock = /^\/\/sysnb /;
	next if !/^\/\/sys / && !$nonblock;

	# Line must be of the form
	#	func Open(path string, mode int, perm int) (fd int, err error)
	# Split into name, in params, out params.
	if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*(?:(\w*)\.)?(\w*))?$/) {
		print STDERR "$ARGV:$.: malformed //sys declaration\n";
		$errors = 1;
		next;
	}
	my ($nb, $func, $in, $out, $modname, $sysname) = ($1, $2, $3, $4, $5, $6);

	# Split argument lists on comma.
	my @in = parseparamlist($in);
	my @out = parseparamlist($out);

	# So file name.
	if($modname eq "") {
		$modname = "libc";
	}

	# System call name.
	if($sysname eq "") {
		$sysname = "$func";
	}

	# System call pointer variable name.
	my $sysvarname = "proc$sysname";

	my $strconvfunc = "BytePtrFromString";
	my $strconvtype = "*byte";

	$sysname =~ y/A-Z/a-z/; # All libc functions are lowercase.

	# Runtime import of function to allow cross-platform builds.
	$dynimports .= "//go:cgo_import_dynamic libc_${sysname} ${sysname} \"$modname.so\"\n";
	# Link symbol to proc address variable.
	$linknames .= "//go:linkname ${sysvarname} libc_${sysname}\n";
	# Library proc address variable.
	push @vars, $sysvarname;

	# Go function header.
	$out = join(', ', @out);
	if($out ne "") {
		$out = " ($out)";
	}
	if($text ne "") {
		$text .= "\n"
	}
	$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out;

	# Check if err return available
	my $errvar = "";
	foreach my $p (@out) {
		my ($name, $type) = parseparam($p);
		if($type eq "error") {
			$errvar = $name;
			last;
		}
	}

	# Prepare arguments to Syscall.
	my @args = ();
	my @uses = ();
	my $n = 0;
	foreach my $p (@in) {
		my ($name, $type) = parseparam($p);
		if($type =~ /^\*/) {
			push @args, "uintptr(unsafe.Pointer($name))";
		} elsif($type eq "string" && $errvar ne "") {
			$text .= "\tvar _p$n $strconvtype\n";
			$text .= "\t_p$n, $errvar = $strconvfunc($name)\n";
			$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			push @uses, "use(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type eq "string") {
			print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
			$text .= "\tvar _p$n $strconvtype\n";
			$text .= "\t_p$n, _ = $strconvfunc($name)\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			push @uses, "use(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type =~ /^\[\](.*)/) {
			# Convert slice into pointer, length.
			# Have to be careful not to take address of &a[0] if len == 0:
			# pass nil in that case.
			$text .= "\tvar _p$n *$1\n";
			$text .= "\tif len($name) > 0 {\n\t\t_p$n = \&$name\[0]\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))", "uintptr(len($name))";
			$n++;
		} elsif($type eq "int64" && $_32bit ne "") {
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name >> 32)", "uintptr($name)";
			} else {
				push @args, "uintptr($name)", "uintptr($name >> 32)";
			}
		} elsif($type eq "bool") {
 			$text .= "\tvar _p$n uint32\n";
			$text .= "\tif $name {\n\t\t_p$n = 1\n\t} else {\n\t\t_p$n = 0\n\t}\n";
			push @args, "uintptr(_p$n)";
			$n++;
		} else {
			push @args, "uintptr($name)";
		}
	}
	my $nargs = @args;

	# Determine which form to use; pad args with zeros.
	my $asm = "sysvicall6";
	if ($nonblock) {
		$asm = "rawSysvicall6";
	}
	if(@args <= 6) {
		while(@args < 6) {
			push @args, "0";
		}
	} else {
		print STDERR "$ARGV:$.: too many arguments to system call\n";
	}

	# Actual call.
	my $args = join(', ', @args);
	my $call = "$asm(uintptr(unsafe.Pointer(&$sysvarname)), $nargs, $args)";

	# Assign return values.
	my $body = "";
	my $failexpr = "";
	my @ret = ("_", "_", "_");
	my @pout= ();
	my $do_errno = 0;
	for(my $i=0; $i<@out; $i++) {
		my $p = $out[$i];
		my ($name, $type) = parseparam($p);
		my $reg = "";
		if($name eq "err") {
			$reg = "e1";
			$ret[2] = $reg;
			$do_errno = 1;
		} else {
			$reg = sprintf("r%d", $i);
			$ret[$i] = $reg;
		}
		if($type eq "bool") {
			$reg = "$reg != 0";
		}
		if($type eq "int64" && $_32bit ne "") {
			# 64-bit number in r1:r0 or r0:r1.
			if($i+2 > @out) {
				print STDERR "$ARGV:$.: not enough registers for int64 return\n";
			}
			if($_32bit eq "big-endian") {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
			} else {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
			}
			$ret[$i] = sprintf("r%d", $i);
			$ret[$i+1] = sprintf("r%d", $i+1);
		}
		if($reg ne "e1") {
			$body .= "\t$name = $type($reg)\n";
		}
	}
	if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
		$text .= "\t$call\n";
	} else {
		$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
	}
	foreach my $use (@uses) {
		$text .= "\t$use\n";
	}
	$text .= $body;

	if ($do_errno) {
		$text .= "\tif e1 != 0 {\n";
		$text .= "\t\terr = e1\n";
		$text .= "\t}\n";
	}
	$text .= "\treturn\n";
	$text .= "}\n";
}

if($errors) {
	exit 1;
}

print <<EOF;
// $cmdline
// MACHINE GENERATED BY THE COMMAND ABOVE; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package $package

import (
	"syscall"
	"unsafe"
)
EOF

print "import \"golang.org/x/sys/unix\"\n" if $package ne "unix";

my $vardecls = "\t" . join(",\n\t", @vars);
$vardecls .= " syscallFunc";

chomp($_=<<EOF);

$dynimports
$linknames
var (
$vardecls
)

$text
EOF
print $_;
exit 0;


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for Darwin from sys/syscall.h

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_darwin.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^#define\s+SYS_(\w+)\s+([0-9]+)/){
		my $name = $1;
		my $num = $2;
		$name =~ y/a-z/A-Z/;
		print "	SYS_$name = $num;"
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for DragonFly from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_dragonfly.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+STD\s+({ \S+\s+(\w+).*)$/){
		my $num = $1;
		my $proto = $2;
		my $name = "SYS_$3";
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}

		print "	$name = $num;  // $proto\n";
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for FreeBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_freebsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+\S+\s+STD\s+({ \S+\s+(\w+).*)$/){
		my $num = $1;
		my $proto = $2;
		my $name = "SYS_$3";
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}
		if($name =~ /^SYS_CAP_+/ || $name =~ /^SYS___CAP_+/){
			next
		}

		print "	$name = $num;  // $proto\n";

		# We keep Capsicum syscall numbers for FreeBSD
		# 9-STABLE here because we are not sure whether they
		# are mature and stable.
		if($num == 513){
			print " SYS_CAP_NEW = 514 // { int cap_new(int fd, uint64_t rights); }\n";
			print " SYS_CAP_GETRIGHTS = 515 // { int cap_getrights(int fd, \\\n";
			print " SYS_CAP_ENTER = 516 // { int cap_enter(void); }\n";
			print " SYS_CAP_GETMODE = 517 // { int cap_getmode(u_int *modep); }\n";
		}
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_linux.pl ". join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const(
EOF

sub fmt {
	my ($name, $num) = @_;
	if($num > 999){
		# ignore deprecated syscalls that are no longer implemented
		# https://git.kernel.org/cgit/linux/kernel/git/torvalds/linux.git/tree/include/uapi/asm-generic/unistd.h?id=refs/heads/master#n716
		return;
	}
	$name =~ y/a-z/A-Z/;
	print "	SYS_$name = $num;\n";
}

my $prev;
open(GCC, "gcc -E -dD $ARGV[0] |") || die "can't run gcc";
while(<GCC>){
	if(/^#define __NR_syscalls\s+/) {
		# ignore redefinitions of __NR_syscalls
	}
	elsif(/^#define __NR_(\w+)\s+([0-9]+)/){
		$prev = $2;
		fmt($1, $2);
	}
	elsif(/^#define __NR3264_(\w+)\s+([0-9]+)/){
		$prev = $2;
		fmt($1, $2);
	}
	elsif(/^#define __NR_(\w+)\s+\(\w+\+\s*([0-9]+)\)/){
		fmt($1, $prev+$2)
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for OpenBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_netbsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

my $line = '';
while(<>){
	if($line =~ /^(.*)\\$/) {
		# Handle continuation
		$line = $1;
		$_ =~ s/^\s+//;
		$line .= $_;
	} else {
		# New line
		$line = $_;
	}
	next if $line =~ /\\$/;
	if($line =~ /^([0-9]+)\s+((STD)|(NOERR))\s+(RUMP\s+)?({\s+\S+\s*\*?\s*\|(\S+)\|(\S*)\|(\w+).*\s+})(\s+(\S+))?$/) {
		my $num = $1;
		my $proto = $6;
		my $compat = $8;
		my $name = "$7_$9";

		$name = "$7_$11" if $11 ne '';
		$name =~ y/a-z/A-Z/;

		if($compat eq '' || $compat eq '30' || $compat eq '50') {
			print "	$name = $num;  // $proto\n";
		}
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for OpenBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_openbsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// MACHINE GENERATED BY THE ABOVE COMMAND; DO NOT EDIT

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+STD\s+(NOLOCK\s+)?({ \S+\s+\*?(\w+).*)$/){
		my $num = $1;
		my $proto = $3;
		my $name = $4;
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}

		print "	$name = $num;  // $proto\n";
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.

# This program reads a file containing function prototypes
# (like syscall_darwin.go) and generates system call bodies.
# The prototypes are marked by lines beginning with "//sys"
# and read like func declarations if //sys is replaced by func, but:
#	* The parameter lists must give a name for each argument.
#	  This includes return parameters.
#	* The parameter lists must give a type for each argument:
#	  the (x, y, z int) shorthand is not allowed.
#	* If the return parameter is an error number, it must be named errno.

# A line beginning with //sysnb is like //sys, except that the
# goroutine will not be suspended during the execution of the system
# call.  This must only be used for system calls which can never
# block, as otherwise the system call could cause all goroutines to
# hang.

use strict;

my $cmdline = "mksyscall.pl " . join(' ', @ARGV);
my $errors = 0;
my $_32bit = "";
my $plan9 = 0;
my $openbsd = 0;
my $netbsd = 0;
my $dragonfly = 0;
my $arm = 0; # 64-bit value should use (even, odd)-pair
my $tags = "";  # build tags

if($ARGV[0] eq "-b32") {
	$_32bit = "big-endian";
	shift;
} elsif($ARGV[0] eq "-l32") {
	$_32bit = "little-endian";
	shift;
}
if($ARGV[0] eq "-plan9") {
	$plan9 = 1;
	shift;
}
if($ARGV[0] eq "-openbsd") {
	$openbsd = 1;
	shift;
}
if($ARGV[0] eq "-netbsd") {
	$netbsd = 1;
	shift;
}
if($ARGV[0] eq "-dragonfly") {
	$dragonfly = 1;
	shift;
}
if($ARGV[0] eq "-arm") {
	$arm = 1;
	shift;
}
if($ARGV[0] eq "-tags") {
	shift;
	$tags = $ARGV[0];
	shift;
}

if($ARGV[0] =~ /^-/) {
	print STDERR "usage: mksyscall.pl [-b32 | -l32] [-tags x,y] [file ...]\n";
	exit 1;
}

# Check that we are using the new build system if we should
if($ENV{'GOOS'} eq "linux" && $ENV{'GOARCH'} ne "sparc64") {
	if($ENV{'GOLANG_SYS_BUILD'} ne "docker") {
		print STDERR "In the new build system, mksyscall should not be called directly.\n";
		print STDERR "See README.md\n";
		exit 1;
	}
}

sub parseparamlist($) {
	my ($list) = @_;
	$list =~ s/^\s*//;
	$list =~ s/\s*$//;
	if($list eq "") {
		return ();
	}
	return split(/\s*,\s*/, $list);
}

sub parseparam($) {
	my ($p) = @_;
	if($p !~ /^(\S*) (\S*)$/) {
		print STDERR "$ARGV:$.: malformed parameter: $p\n";
		$errors = 1;
		return ("xx", "int");
	}
	return ($1, $2);
}

my $text = "";
while(<>) {
	chomp;
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	my $nonblock = /^\/\/sysnb /;
	next if !/^\/\/sys / && !$nonblock;

	# Line must be of the form
	#	func Open(path string, mode int, perm int) (fd int, errno error)
	# Split into name, in params, out params.
	if(!/^\/\/sys(nb)? (\w+)\(([^()]*)\)\s*(?:\(([^()]+)\))?\s*(?:=\s*((?i)SYS_[A-Z0-9_]+))?$/) {
		print STDERR "$ARGV:$.: malformed //sys declaration\n";
		$errors = 1;
		next;
	}
	my ($func, $in, $out, $sysname) = ($2, $3, $4, $5);

	# Split argument lists on comma.
	my @in = parseparamlist($in);
	my @out = parseparamlist($out);

	# Try in vain to keep people from editing this file.
	# The theory is that they jump into the middle of the file
	# without reading the header.
	$text .= "// THIS FILE IS GENERATED BY THE COMMAND AT THE TOP; DO NOT EDIT\n\n";

	# Go function header.
	my $out_decl = @out ? sprintf(" (%s)", join(', ', @out)) : "";
	$text .= sprintf "func %s(%s)%s {\n", $func, join(', ', @in), $out_decl;

	# Check if err return available
	my $errvar = "";
	foreach my $p (@out) {
		my ($name, $type) = parseparam($p);
		if($type eq "error") {
			$errvar = $name;
			last;
		}
	}

	# Prepare arguments to Syscall.
	my @args = ();
	my $n = 0;
	foreach my $p (@in) {
		my ($name, $type) = parseparam($p);
		if($type =~ /^\*/) {
			push @args, "uintptr(unsafe.Pointer($name))";
		} elsif($type eq "string" && $errvar ne "") {
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, $errvar = BytePtrFromString($name)\n";
			$text .= "\tif $errvar != nil {\n\t\treturn\n\t}\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type eq "string") {
			print STDERR "$ARGV:$.: $func uses string arguments, but has no error return\n";
			$text .= "\tvar _p$n *byte\n";
			$text .= "\t_p$n, _ = BytePtrFromString($name)\n";
			push @args, "uintptr(unsafe.Pointer(_p$n))";
			$n++;
		} elsif($type =~ /^\[\](.*)/) {
			# Convert slice into pointer, length.
			# Have to be careful not to take address of &a[0] if len == 0:
			# pass dummy pointer in that case.
			# Used to pass nil, but some OSes or simulators reject write(fd, nil, 0).
			$text .= "\tvar _p$n unsafe.Pointer\n";
			$text .= "\tif len($name) > 0 {\n\t\t_p$n = unsafe.Pointer(\&${name}[0])\n\t}";
			$text .= " else {\n\t\t_p$n = unsafe.Pointer(&_zero)\n\t}";
			$text .= "\n";
			push @args, "uintptr(_p$n)", "uintptr(len($name))";
			$n++;
		} elsif($type eq "int64" && ($openbsd || $netbsd)) {
			push @args, "0";
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $dragonfly) {
			if ($func !~ /^extp(read|write)/i) {
				push @args, "0";
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} elsif($_32bit eq "little-endian") {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			} else {
				push @args, "uintptr($name)";
			}
		} elsif($type eq "int64" && $_32bit ne "") {
			if(@args % 2 && $arm) {
				# arm abi specifies 64-bit argument uses
				# (even, odd) pair
				push @args, "0"
			}
			if($_32bit eq "big-endian") {
				push @args, "uintptr($name>>32)", "uintptr($name)";
			} else {
				push @args, "uintptr($name)", "uintptr($name>>32)";
			}
		} else {
			push @args, "uintptr($name)";
		}
	}

	# Determine which form to use; pad args with zeros.
	my $asm = "Syscall";
	if ($nonblock) {
		$asm = "RawSyscall";
	}
	if(@args <= 3) {
		while(@args < 3) {
			push @args, "0";
		}
	} elsif(@args <= 6) {
		$asm .= "6";
		while(@args < 6) {
			push @args, "0";
		}
	} elsif(@args <= 9) {
		$asm .= "9";
		while(@args < 9) {
			push @args, "0";
		}
	} else {
		print STDERR "$ARGV:$.: too many arguments to system call\n";
	}

	# System call number.
	if($sysname eq "") {
		$sysname = "SYS_$func";
		$sysname =~ s/([a-z])([A-Z])/${1}_$2/g;	# turn FooBar into Foo_Bar
		$sysname =~ y/a-z/A-Z/;
	}

	# Actual call.
	my $args = join(', ', @args);
	my $call = "$asm($sysname, $args)";

	# Assign return values.
	my $body = "";
	my @ret = ("_", "_", "_");
	my $do_errno = 0;
	for(my $i=0; $i<@out; $i++) {
		my $p = $out[$i];
		my ($name, $type) = parseparam($p);
		my $reg = "";
		if($name eq "err" && !$plan9) {
			$reg = "e1";
			$ret[2] = $reg;
			$do_errno = 1;
		} elsif($name eq "err" && $plan9) {
			$ret[0] = "r0";
			$ret[2] = "e1";
			next;
		} else {
			$reg = sprintf("r%d", $i);
			$ret[$i] = $reg;
		}
		if($type eq "bool") {
			$reg = "$reg != 0";
		}
		if($type eq "int64" && $_32bit ne "") {
			# 64-bit number in r1:r0 or r0:r1.
			if($i+2 > @out) {
				print STDERR "$ARGV:$.: not enough registers for int64 return\n";
			}
			if($_32bit eq "big-endian") {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i, $i+1);
			} else {
				$reg = sprintf("int64(r%d)<<32 | int64(r%d)", $i+1, $i);
			}
			$ret[$i] = sprintf("r%d", $i);
			$ret[$i+1] = sprintf("r%d", $i+1);
		}
		if($reg ne "e1" || $plan9) {
			$body .= "\t$name = $type($reg)\n";
		}
	}
	if ($ret[0] eq "_" && $ret[1] eq "_" && $ret[2] eq "_") {
		$text .= "\t$call\n";
	} else {
		$text .= "\t$ret[0], $ret[1], $ret[2] := $call\n";
	}
	$text .= $body;

	if ($plan9 && $ret[2] eq "e1") {
		$text .= "\tif int32(r0) == -1 {\n";
		$text .= "\t\terr = e1\n";
		$text .= "\t}\n";
	} elsif ($do_errno) {
		$text .= "\tif e1 != 0 {\n";
		$text .= "\t\terr = errnoErr(e1)\n";
		$text .= "\t}\n";
	}
	$text .= "\treturn\n";
	$text .= "}\n\n";
}

chomp $text;
chomp $text;

if($errors) {
	exit 1;
}

print <<EOF;
// $cmdline
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $tags

package unix

import (
	"syscall"
	"unsafe"
)

var _ syscall.Errno

$text
EOF
exit 0;


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for FreeBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_freebsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

while(<>){
	if(/^([0-9]+)\s+\S+\s+STD\s+({ \S+\s+(\w+).*)$/){
		my $num = $1;
		my $proto = $2;
		my $name = "SYS_$3";
		$name =~ y/a-z/A-Z/;

		# There are multiple entries for enosys and nosys, so comment them out.
		if($name =~ /^SYS_E?NOSYS$/){
			$name = "// $name";
		}
		if($name eq 'SYS_SYS_EXIT'){
			$name = 'SYS_EXIT';
		}
		if($name =~ /^SYS_CAP_+/ || $name =~ /^SYS___CAP_+/){
			next
		}

		print "	$name = $num;  // $proto\n";

		# We keep Capsicum syscall numbers for FreeBSD
		# 9-STABLE here because we are not sure whether they
		# are mature and stable.
		if($num == 513){
			print " SYS_CAP_NEW = 514 // { int cap_new(int fd, uint64_t rights); }\n";
			print " SYS_CAP_GETRIGHTS = 515 // { int cap_getrights(int fd, \\\n";
			print " SYS_CAP_ENTER = 516 // { int cap_enter(void); }\n";
			print " SYS_CAP_GETMODE = 517 // { int cap_getmode(u_int *modep); }\n";
		}
	}
}

print <<EOF;
)
EOF


#!/usr/bin/env perl
# Copyright 2009 The Go Authors. All rights reserved.
# Use of this source code is governed by a BSD-style
# license that can be found in the LICENSE file.
#
# Generate system call table for OpenBSD from master list
# (for example, /usr/src/sys/kern/syscalls.master).

use strict;

if($ENV{'GOARCH'} eq "" || $ENV{'GOOS'} eq "") {
	print STDERR "GOARCH or GOOS not defined in environment\n";
	exit 1;
}

my $command = "mksysnum_netbsd.pl " . join(' ', @ARGV);

print <<EOF;
// $command
// Code generated by the command above; see README.md. DO NOT EDIT.

// +build $ENV{'GOARCH'},$ENV{'GOOS'}

package unix

const (
EOF

my $line = '';
while(<>){
	if($line =~ /^(.*)\\$/) {
		# Handle continuation
		$line = $1;
		$_ =~ s/^\s+//;
		$line .= $_;
	} else {
		# New line
		$line = $_;
	}
	next if $line =~ /\\$/;
	if($line =~ /^([0-9]+)\s+((STD)|(NOERR))\s+(RUMP\s+)?({\s+\S+\s*\*?\s*\|(\S+)\|(\S*)\|(\w+).*\s+})(\s+(\S+))?$/) {
		my $num = $1;
		my $proto = $6;
		my $compat = $8;
		my $name = "$7_$9";

		$name = "$7_$11" if $11 ne '';
		$name =~ y/a-z/A-Z/;

		if($compat eq '' || $compat eq '30' || $compat eq '50') {
			print "	$name = $num;  // $proto\n";
		}
	}
}

print <<EOF;
)
EOF