package pci_probing::main; # $Id: main.pm,v 1.24 2000/09/28 00:38:31 prigaux Exp $

use pci_probing::pcitable;
use pci_probing::pci_class;
use log;

1;

sub get_type {
    my ($first_num) = @_;
    my ($bus) = $first_num >> 8;
    $first_num &= 0xff;
    my ($device) = $first_num >> 3;
    my ($function) = $first_num & 0x7;

    local *F;
    open F, sprintf("/proc/bus/pci/%02x/%02x.%x", $bus, $device, $function) or die '';
    seek F, 0xa, 0 or die '';
    my $a; read(F, $a, 2) or die '';

    my $b; seek F, 0x2c, 0 and read(F, $b, 4);

    $pci_probing::pci_class::classes{unpack "v", $a} || 'unknown', unpack("vv", $b); 
}

# probe_type true means detect the type of hardware, this is unsafe! (bug in kernel&hardware)
sub probe {
    my ($probe_type) = @_;
    my @l;
    $::nopci and return;
    my $f = "/proc/bus/pci/devices";
    local *F;
    open F, $f or log::l("can't open $f"), return;
    foreach (<F>) {
	my ($a, $b) = /(\S+)\s+(\S+)/ or next;
	my %l;
	$l{verbatim} = $_;
	($l{type}, $l{subvendor}, $l{subid}) = get_type(hex $a) if $probe_type;
	/\S+\s+(.{4})(.{4})/;
	$l{vendor} = $1;
	$l{id} = $2;
        @l{"description", "driver"} = @{ $pci_probing::pcitable::ids{hex $b} || 
					 [ sprintf("Vendor=0x%s Device=0x%s",$l{vendor}, $l{id}), "unknown" ] };
	push @l, \%l;
    }
    @l;
}