#!/usr/bin/env perl

use strict;
use warnings;

use Sys::Mmap;
use POSIX;

use Data::Dumper;

my @pci_table = (
	[ "8086", "9d3e" ],	# Microsoft Surface Pro 4
);

# http://wiki.osdev.org/PCI#PCI_Device_Structure
# linux:include/uapi/linux/pci_regs.h
my %cfg = (
	ven	=> { adr => 0x00, len => 2 },
	dev	=> { adr => 0x02, len => 2 },
	cmd	=> { adr => 0x04, len => 2 },
	sta	=> { adr => 0x06, len => 2 },
	csize	=> { adr => 0x0c, len => 1 },
	lattim	=> { adr => 0x0d, len => 1 },
	bar0	=> { adr => 0x10, len => 4 },
	bar1	=> { adr => 0x14, len => 4 },
	bar2	=> { adr => 0x18, len => 4 },
	bar3	=> { adr => 0x1c, len => 4 },
	bar4	=> { adr => 0x20, len => 4 },
	bar5	=> { adr => 0x24, len => 4 },
	rom	=> { adr => 0x30, len => 4 },
	intlin	=> { adr => 0x3c, len => 1 },

	un0	=> { adr => 0x8e, len => 2 },	# unknown
);

# linux:include/uapi/linux/pci_regs.h
use constant PCI_COMMAND_MEMORY			=>    0x2;
use constant PCI_COMMAND_MASTER			=>    0x4;
use constant PCI_COMMAND_INTX_DISABLE		=>  0x400;
use constant PCI_STATUS_PARITY			=>  0x100;
use constant PCI_STATUS_SIG_TARGET_ABORT	=>  0x800;
use constant PCI_STATUS_REC_TARGET_ABORT	=> 0x1000;
use constant PCI_STATUS_REC_MASTER_ABORT	=> 0x2000;
use constant PCI_STATUS_SIG_SYSTEM_ERROR	=> 0x4000;
use constant PCI_STATUS_DETECTED_PARITY		=> 0x8000;

my %reg = (
	un0	=>  0x00,	# W
	un1	=>  0x04,	# RW
	un2	=>  0x08,	# R
	un3	=>  0x0c,	# R
	una	=> 0x800,	# RW
);

open my $lspci, 'lspci -mm -D -n |'
	or die "cannot run lspci: $!";

my ($slot, $ven, $dev);
while(<$lspci>) {
	chomp;
	my @line = split / /;

	$line[2] =~ s/"//g;
	$line[3] =~ s/"//g;

	foreach my $t (@pci_table) {
		next unless ($line[2] eq $t->[0] && $line[3] eq $t->[1]);

		$slot = $line[0];
		$ven = $line[2];
		$dev = $line[3];
		last;
	}
}

close $lspci;

die 'unable to find supported PCI device'
	unless defined $slot;

open my $uio_pci, '> /sys/bus/pci/drivers/uio_pci_generic/new_id'
	or die "unable to open uio_pci_generic/new_id: $!";
print $uio_pci "$ven $dev\n";
close $uio_pci;

my $part = substr $slot, 0, rindex($slot, ':');
opendir my $pci, "/sys/devices/pci$part/$slot/uio";
my $uioid = (grep { /^uio[0-9]+$/ } readdir $pci)[0];
closedir $pci;

open my $uiofd, "< /dev/$uioid"
	or die "cannot open uio: $!";

open my $cfgfd, "+< /sys/class/uio/$uioid/device/config"
	or die "cannot open config: $!";

open my $resfd, "+< /sys/class/uio/$uioid/device/resource0"
	or die "cannot open resource0: $!";
mmap my $res, 0, PROT_READ|PROT_WRITE, MAP_SHARED, $resfd
	or die "mmap resource0: $!";

precise_reset();
precise_init();

region_read('una');

exit 0;

while(my $nread = sysread $uiofd, my $buf, 4) {
	print "$nread\n";
	print "$buf\n";
}

exit 0;

# mmap() is not supported
sub pci_read_config {
	my ($key) = @_;

	die "unknown key: $key"
		unless defined $cfg{$key};

	printf STDERR "pci_read_config(\@0x%x [%s], len=0x%x) = ", $cfg{$key}{adr}, $key, $cfg{$key}{len};

	seek $cfgfd, $cfg{$key}{adr}, 0;

	my $nread = sysread $cfgfd, my $buf, $cfg{$key}{len};
	unless ($nread == $cfg{$key}{len}) {
		print STDERR "FAILED\n";
		return;
	}

	my $val;
	if ($cfg{$key}{len} == 1) {
		$val = unpack "C", $buf;
	} elsif ($cfg{$key}{len} == 2) {
		$val = unpack "v", $buf;
	} elsif ($cfg{$key}{len} == 4) {
		$val = unpack "V", $buf;
	} else {
		die 'unknown length: ' . $cfg{$key}{len};
	}

	printf STDERR "0x%x\n", $val;

	return $val;
}
sub pci_write_config {
	my ($key, $val) = @_;

	die "unknown key: $key"
		unless defined $cfg{$key};

	printf STDERR "pci_write_config(\@0x%x [%s], val=0x%x, len=0x%x)\n", $cfg{$key}{adr}, $key, $val, $cfg{$key}{len};

	seek $cfgfd, $cfg{$key}{adr}, 0;

	my $buf;
	if ($cfg{$key}{len} == 1) {
		$buf = pack "C", $val;
	} elsif ($cfg{$key}{len} == 2) {
		$buf = pack "v", $val;
	} elsif ($cfg{$key}{len} == 4) {
		$buf = pack "V", $val;
	} else {
		die 'unknown length: ' . $cfg{$key}{len};
	}
	
	syswrite($cfgfd, $buf, length($buf)) == length($buf) ;
}

sub region_read {
	my ($key) = @_;

	die "unknown key: $key"
		unless defined $reg{$key};

	my $val = unpack "V", substr($res, $reg{$key}, 4);

	printf STDERR "region_read(\@0x%x [%s]) = 0x%x\n", $reg{$key}, $key, $val;

	return $val;
}
sub region_write {
	my ($key, $val) = @_;

	die "unknown key: $key"
		unless defined $reg{$key};

	printf STDERR "region_write(\@0x%x [%s], val=0x%x)\n", $reg{$key}, $key, $val;

	substr($res, $reg{$key}, 4) = pack "V", $val;
}

sub precise_init {
	open my $barfd, "< /sys/class/uio/$uioid/device/resource"
		or die "cannot open resource: $!";
	my @bar = split / /, <$barfd>;
	close $barfd;
	pci_write_config('bar0', hex($bar[0]));	# device sets (x & 0xfffff000) | 0x4

	pci_write_config('bar1', 0);
	pci_write_config('bar2', 0);
	pci_write_config('bar3', 0);
	pci_write_config('bar4', 0);
	pci_write_config('bar5', 0);

	pci_write_config('rom', 0);

	open my $irqfd, "< /sys/class/uio/$uioid/device/irq"
		or die "cannot open irq: $!";
	my $irq = <$irqfd>;
	close $irqfd;
	chomp $irq;
	$irq = int $irq;
	pci_write_config('intlin', $irq);

	pci_write_config('csize', 0);
	pci_write_config('lattim', 0);

	pci_write_config('cmd', PCI_COMMAND_INTX_DISABLE
				| PCI_COMMAND_MASTER
				| PCI_COMMAND_MEMORY);

	pci_write_config('sta', PCI_STATUS_PARITY
				| PCI_STATUS_SIG_TARGET_ABORT
				| PCI_STATUS_REC_TARGET_ABORT
				| PCI_STATUS_REC_MASTER_ABORT
				| PCI_STATUS_SIG_SYSTEM_ERROR
				| PCI_STATUS_DETECTED_PARITY);

	pci_write_config('un0', 0x80)
		while (pci_read_config('un0') != 0x80);

	pci_write_config('cmd', PCI_COMMAND_MASTER
				| PCI_COMMAND_MEMORY)
}

sub precise_reset {
	pci_write_config('intlin', 255);
	pci_write_config('cmd', 0);
}

exit 0;