summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-05-29 17:16:56 +0000
committerFrancois Pons <fpons@mandriva.com>2000-05-29 17:16:56 +0000
commitd72ffade4e086fa3eb0f7904a4141dea3ad91705 (patch)
treebdbc9fce22747c2a19f980b087c2b5f0a3ae3618 /perl-install
parent436a081d985d376060908b1db436a6ad2691d593 (diff)
downloaddrakx-d72ffade4e086fa3eb0f7904a4141dea3ad91705.tar
drakx-d72ffade4e086fa3eb0f7904a4141dea3ad91705.tar.gz
drakx-d72ffade4e086fa3eb0f7904a4141dea3ad91705.tar.bz2
drakx-d72ffade4e086fa3eb0f7904a4141dea3ad91705.tar.xz
drakx-d72ffade4e086fa3eb0f7904a4141dea3ad91705.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog11
-rw-r--r--perl-install/Makefile2
-rw-r--r--perl-install/Makefile.config2
-rw-r--r--perl-install/Xconfigurator.pm4
-rw-r--r--perl-install/c/Makefile.PL2
-rw-r--r--perl-install/c/sbus.c123
-rw-r--r--perl-install/c/stuff.xs.pm45
-rw-r--r--perl-install/commands.pm6
-rw-r--r--perl-install/detect_devices.pm2
-rw-r--r--perl-install/install_steps_interactive.pm5
-rw-r--r--perl-install/modules.pm22
-rw-r--r--perl-install/my_gtk.pm3
-rw-r--r--perl-install/sbus_probing/main.pm156
13 files changed, 364 insertions, 19 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 75efebfac..bcf47c556 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,4 +1,15 @@
+2000-05-29 François Pons <fpons@mandrakesoft.com>
+
+ * Xconfigurator.pm: added support for SBUS card autodetection.
+ * commands.pm: added lssbus to list SBUS devices detected.
+ * detect_devices.pm: removed alpha restriction on USB.
+ * install_steps_interactive.pm: added SBUS support.
+ * c/sbus.c: initial revision, core SBUS support (inspired from kudzu).
+ * c/stuff.xs.pm: added wrapper for sbus.c interface.
+ * sbus_probing/main.pm: initial revision (inspired from kudzu).
+
2000-05-27 Adam Lebsack <adam@mandrakesoft.com>
+
* share/list.ppc: various PPC modifications, for HFS
* partition_table_mac.pm: bug fixes
* partition_table.pm: various HFS fixes, isHiddenMacPart()
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 3265325ce..5584ee23f 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -16,7 +16,7 @@ tar-drakxtools: clean
$(MAKE) -C ../tools clean
cd .. ; rm -rf drakxtools ; cp -af perl-install drakxtools ; cp -af tools/ddcprobe tools/serial_probe drakxtools
cd ../drakxtools ; rm -rf install* pkgs.pm ftp.pm t.pm */CVS ; mv Makefile.drakxtools Makefile ; mv -f standalone/* .
- cd .. ; tar cfy drakxtools.tar.bz2 --exclude CVS $(patsubst %,drakxtools/%,Makefile Makefile.config share/MonitorsDB share/Cards+ share/CardsNames Newt c ddcprobe serial_probe share/po pci_probing resize_fat share/diskdrake.rc $(STANDALONEPMS) icons *.pm)
+ cd .. ; tar cfy drakxtools.tar.bz2 --exclude CVS $(patsubst %,drakxtools/%,Makefile Makefile.config share/MonitorsDB share/Cards+ share/CardsNames Newt c ddcprobe serial_probe share/po pci_probing sbus_probing resize_fat share/diskdrake.rc $(STANDALONEPMS) icons *.pm)
cd .. ; rm -rf drakxtools
$(DIRS):
diff --git a/perl-install/Makefile.config b/perl-install/Makefile.config
index 14a71573a..5ebbadbbb 100644
--- a/perl-install/Makefile.config
+++ b/perl-install/Makefile.config
@@ -4,7 +4,7 @@ ARCH := $(patsubst sparc%,sparc,$(ARCH))
VERSION = 2.2.10-BOOT
SUDO = sudo
SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm Newt/*.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 g_auto_install
+PMS = *.pm Newt/*.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm sbus_probing/*.pm commands install2 g_auto_install
STANDALONEPMS= diskdrake XFdrake mousedrake lspcidrake printerdrake keyboarddrake netdrake drakxconf drakxservices draksec drakboot adduserdrake rpmdrake
PMS += $(STANDALONEPMS:%=standalone/%)
REP4PMS = /usr/bin/perl-install
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 19094c3b4..0a312f8eb 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -138,12 +138,11 @@ sub keepOnlyLegalModes {
} @$res;
delete $card->{depth}{$depth} if @$res == 0;
}
-
}
sub cardConfigurationAuto() {
my $card;
- if (my (@c) = pci_probing::main::probe("DISPLAY")) {
+ if (my (@c) = (pci_probing::main::probe("DISPLAY"), sbus_probing::main::probe("DISPLAY"))) {
local $_;
($card->{identifier}, $_) = @{$c[-1]};
$card->{type} = $1 if /Card:(.*)/;
@@ -153,6 +152,7 @@ sub cardConfigurationAuto() {
}
#- take a default on sparc if nothing has been found.
if (arch() =~ /^sparc/ && !$card->{server} && !$card->{type}) {
+ log::l("Using probe with /proc/fb as nothing has been found!");
local $_ = cat_("/proc/fb");
if (/Mach64/) { $card->{server} = "Mach64" }
elsif (/Permedia2/) { $card->{server} = "3DLabs" }
diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL
index 4e76dea67..e406f1fe4 100644
--- a/perl-install/c/Makefile.PL
+++ b/perl-install/c/Makefile.PL
@@ -10,7 +10,7 @@ WriteMakefile(
'NAME' => 'stuff',
'OPTIMIZE' => '-Os',
'MAKEFILE' => 'Makefile_c',
- 'OBJECT' => 'stuff.o smp.o md5.o md5_crypt.o',
+ 'OBJECT' => 'stuff.o smp.o md5.o md5_crypt.o sbus.o',
'VERSION_FROM' => 'stuff.pm', # finds $VERSION
'LIBS' => [$libs], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
diff --git a/perl-install/c/sbus.c b/perl-install/c/sbus.c
new file mode 100644
index 000000000..1fed1f886
--- /dev/null
+++ b/perl-install/c/sbus.c
@@ -0,0 +1,123 @@
+/* This file is inspired from source code of kudzu from Red Hat, Inc.
+ * It has been modified to keep only "what is needed" in C, the prom_walk
+ * has been rewritten in perl for convenience :-)
+ *
+ * Copyright notice from original version.
+ * sbus.c: Probe for Sun SBUS and UPA framebuffers using OpenPROM,
+ * SBUS SCSI and Ethernet cards and SBUS or EBUS audio chips.
+ *
+ * Copyright (C) 1998, 1999 Jakub Jelinek (jj@ultra.linux.cz)
+ * (C) 1999 Red Hat, Inc.
+ *
+ * This software may be freely redistributed under the terms of the GNU
+ * public license.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ *
+ */
+
+#ifdef __sparc__
+
+#include <fcntl.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/ioctl.h>
+#include <asm/openpromio.h>
+
+static char *promdev = "/dev/openprom";
+static int promfd = -1;
+static int prom_current_node;
+#define MAX_PROP 128
+#define MAX_VAL (4096-128-4)
+static char buf[4096];
+#define DECL_OP(size) struct openpromio *op = (struct openpromio *)buf; op->oprom_size = (size)
+
+int prom_open()
+{
+ int prom_root_node;
+
+ if (promfd == -1) {
+ promfd = open(promdev, O_RDONLY);
+ if (promfd == -1)
+ return 0;
+ }
+ prom_root_node = prom_getsibling(0);
+ if (!prom_root_node) {
+ close(promfd);
+ promfd = -1;
+ return 0;
+ }
+ return prom_root_node;
+}
+
+void prom_close()
+{
+ if (promfd != -1) {
+ close(promfd);
+ promfd = -1;
+ }
+}
+
+int prom_getsibling(int node)
+{
+ DECL_OP(sizeof(int));
+
+ if (node == -1) return 0;
+ *(int *)op->oprom_array = node;
+ if (ioctl (promfd, OPROMNEXT, op) < 0)
+ return 0;
+ prom_current_node = *(int *)op->oprom_array;
+ return *(int *)op->oprom_array;
+}
+
+int prom_getchild(int node)
+{
+ DECL_OP(sizeof(int));
+
+ if (!node || node == -1) return 0;
+ *(int *)op->oprom_array = node;
+ if (ioctl (promfd, OPROMCHILD, op) < 0)
+ return 0;
+ prom_current_node = *(int *)op->oprom_array;
+ return *(int *)op->oprom_array;
+}
+
+char *prom_getproperty(char *prop, int *lenp)
+{
+ DECL_OP(MAX_VAL);
+
+ strcpy (op->oprom_array, prop);
+ if (ioctl (promfd, OPROMGETPROP, op) < 0)
+ return 0;
+ if (lenp) *lenp = op->oprom_size;
+ return op->oprom_array;
+}
+
+int prom_getbool(char *prop)
+{
+ DECL_OP(0);
+
+ *(int *)op->oprom_array = 0;
+ for (;;) {
+ op->oprom_size = MAX_PROP;
+ if (ioctl(promfd, OPROMNXTPROP, op) < 0)
+ return 0;
+ if (!op->oprom_size)
+ return 0;
+ if (!strcmp (op->oprom_array, prop))
+ return 1;
+ }
+}
+
+#else
+int prom_open() { return 0; }
+void prom_close() {}
+int prom_getsibling(int node) { return 0; }
+int prom_getchild(int node) { return 0; }
+char *prom_getproperty(char *prop, int *lenp) { return NULL; }
+int prom_getbool(char *prop) { return 0; }
+#endif /* __sparc__ */
diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm
index 77c779c83..034996d21 100644
--- a/perl-install/c/stuff.xs.pm
+++ b/perl-install/c/stuff.xs.pm
@@ -311,6 +311,51 @@ del_loop(device)
OUTPUT:
RETVAL
+int
+prom_open()
+
+void
+prom_close()
+
+int
+prom_getsibling(node)
+ int node
+
+int
+prom_getchild(node)
+ int node
+
+void
+prom_getproperty(key)
+ char *key
+ PPCODE:
+ int lenp = 0;
+ char *value = NULL;
+ value = prom_getproperty(key, &lenp);
+ EXTEND(sp, 1);
+ if (value != NULL) {
+ PUSHs(sv_2mortal(newSVpv(value, 0)));
+ } else {
+ PUSHs(&PL_sv_undef);
+ }
+
+int
+prom_getbool(key)
+ char *key
+
+void
+prom_getint(key)
+ char *key
+ PPCODE:
+ int lenp = 0;
+ char *value = NULL;
+ value = prom_getproperty(key, &lenp);
+ EXTEND(sp, 1);
+ if (value != NULL && lenp == sizeof(int)) {
+ PUSHs(sv_2mortal(newSViv(*(int *)value)));
+ } else {
+ PUSHs(&PL_sv_undef);
+ }
';
$ENV{C_RPM} and print '
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 1bc534897..c6a784c93 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -3,7 +3,7 @@
#- true, false, cat, which, dirname, basename, rmdir, lsmod, grep, tr,
#- mount, umount, mkdir, mknod, ln, rm, chmod, chown, mkswap, swapon,
#- swapoff, ls, cp, ps, dd, head, tail, strings, hexdump, more, insmod,
-#- modprobe, route, df, kill, lspci, dmesg, sort, du,
+#- modprobe, route, df, kill, lspci, lssbus, dmesg, sort, du,
#-########################################################################
package commands;
@@ -517,6 +517,10 @@ sub lspci {
require 'pci_probing/main.pm';
print join "\n", pci_probing::main::list (), '';
}
+sub lssbus {
+ require 'sbus_probing/main.pm';
+ print join "\n", sbus_probing::main::list (), '';
+}
sub dmesg { print cat_("/tmp/syslog"); }
sub sort {
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 561ba1fd2..98ebcd403 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -254,7 +254,7 @@ sub probeUSB {
require pci_probing::main;
require modules;
defined($usb_interface) and return $usb_interface;
- arch() =~ /sparc|alpha/ and return $usb_interface = '';
+ arch() =~ /sparc/ and return $usb_interface = '';
if (($usb_interface) = grep { /usb-/ } map { $_->[1] } pci_probing::main::probe('')) {
eval { modules::load($usb_interface, "SERIAL_USB") };
if ($@) {
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 3023d8cb1..006f54377 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -1168,7 +1168,7 @@ sub setup_thiskind {
return if arch() eq "ppc";
my @l;
- my $allow_probe = !$::expert || $o->ask_yesorno('', _("Try to find PCI devices?"), 1);
+ my $allow_probe = !$::expert || $o->ask_yesorno('', _("Try to find %s devices?", "PCI" . (arch() =~ /sparc/ && "/SBUS")), 1);
if ($allow_probe) {
eval { @l = grep { !/ide-/ } $o->load_thiskind($type) };
@@ -1191,7 +1191,8 @@ sub setup_thiskind {
} else {
#-eval { commands::modprobe("isapnp") };
require pci_probing::main;
- $o->ask_warn('', [ pci_probing::main::list() ]); #-, scalar cat_("/proc/isapnp") ]);
+ require sbus_probing::main;
+ $o->ask_warn('', [ pci_probing::main::list(), sbus_probing::main::list() ]); #-, scalar cat_("/proc/isapnp") ]);
}
}
}
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 69b9a884e..a2cf61b2d 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -352,6 +352,7 @@ sub get_options {
sub add_alias($$) {
my ($alias, $name) = @_;
+ $name =~ /ignore/ and return;
/\Q$alias/ && $conf{$_}{alias} && $conf{$_}{alias} eq $name and return $_ foreach keys %conf;
$alias .= $scsi++ || '' if $alias eq 'scsi_hostadapter';
log::l("adding alias $alias to $name");
@@ -380,8 +381,6 @@ sub load {
} else {
$conf{$name}{loaded} and return;
-#- $type ||= ($drivers{$name} || { type => 'unknown'})->{type};
-
eval { load($_, 'prereq') } foreach @{$deps{$name}};
load_raw([ $name, @options ]);
}
@@ -421,8 +420,7 @@ sub unload($;$) {
}
sub load_raw {
- my @l = map { my ($i, @i) = @$_; [ $i, \@i ] } @_;
-
+ my @l = map { my ($i, @i) = @$_; [ $i, \@i ] } grep { $_->[0] !~ /ignore/ } @_;
my $cz = "/lib/modules" . (arch() eq 'sparc64' && "64") . ".cz"; -e $cz or $cz .= "2";
run_program::run("extract_archive", $cz, "/tmp", map { "$_->[0].o" } @l);
my @failed = grep {
@@ -528,17 +526,22 @@ sub read_stage1_conf {
sub load_thiskind($;&$) {
my ($type, $f, $pcic) = @_;
+ my %loaded_text;
require pci_probing::main;
my @pcidevs = pci_probing::main::probe($type);
log::l("pci probe found " . scalar @pcidevs . " $type devices");
+ require sbus_probing::main;
+ my @sbusdevs = sbus_probing::main::probe($type);
+ log::l("sbus probe found " . scalar @sbusdevs . " $type devices");
+
my @pcmciadevs = get_pcmcia_devices($type, $pcic);
log::l("pcmcia probe found " . scalar @pcmciadevs . " $type devices");
- my @devs = (@pcidevs, @pcmciadevs);
+ my @devs = (@pcidevs, @sbusdevs, @pcmciadevs);
- load("sd_mod") if $type eq 'scsi' && @devs;
+ load("sd_mod") if arch() !~ /sparc/ && $type eq 'scsi' && @devs;
my %devs; foreach (@devs) {
my ($text, $mod) = @$_;
@@ -547,6 +550,7 @@ sub load_thiskind($;&$) {
log::l("found driver for $mod");
&$f($text, $mod) if $f;
load($mod, $type);
+ $loaded_text{$mod} = $text;
}
if ($type eq 'scsi') {
@@ -558,17 +562,17 @@ sub load_thiskind($;&$) {
-d "/proc/scsi/usb" or unload("usb-storage");
}
#- probe for parport SCSI.
- if (arch() !~ /sparc|alpha/) {
+ if (arch() !~ /sparc/) {
foreach ("imm", "ppa") {
eval { load($_, $type) };
last if !$@;
}
}
- if (my ($c) = pci_probing::main::probe('AUDIO')) {
+ if (my ($c) = (pci_probing::main::probe('AUDIO'), sbus_probing::main::probe('AUDIO'))) {
add_alias("sound", $c->[1]) if pci_probing::main::check($c->[1]);
}
}
- @{$loaded{$type} || []};
+ map { $loaded_text{$_} || $_ } @{$loaded{$type} || []};
}
sub pcmcia_need_config($) {
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 200ada856..533dccb67 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -503,7 +503,8 @@ sub _ask_from_list {
my $c = chr($e->{keyval} & 0xff);
Gtk->timeout_remove($timeout) if $timeout; $timeout = '';
-
+
+ print ord($c), "<<<<<<<<<\n";
if ($e->{keyval} >= 0x100) {
&$leave if $c eq "\r" || $c eq "\x8d";
$starting_word = '' if $e->{keyval} != 0xffe4; # control
diff --git a/perl-install/sbus_probing/main.pm b/perl-install/sbus_probing/main.pm
new file mode 100644
index 000000000..fa40160ae
--- /dev/null
+++ b/perl-install/sbus_probing/main.pm
@@ -0,0 +1,156 @@
+package sbus_probing::main;
+
+use c;
+use log;
+
+my %sbus_table_network = (
+ hme => [ "Sun Happy Meal Ethernet", "sunhme" ],
+ le => [ "Sun Lance Ethernet", "ignore:lance" ],
+ qe => [ "Sun Quad Ethernet", "sunqe" ],
+ mlanai => [ "MyriCOM MyriNET Gigabit Ethernet", "myri_sbus" ],
+ myri => [ "MyriCOM MyriNET Gigabit Ethernet", "myri_sbus" ],
+ );
+my %sbus_table_scsi = (
+ soc => [ "Sun SPARCStorage Array", "fc4:soc:pluto" ],
+ socal => [ "Sun Enterprise Network Array", "fc4:socal:fcal" ],
+ esp => [ "Sun Enhanced SCSI Processor (ESP)", "ignore:esp" ],
+ fas => [ "Sun Swift (ESP)", "ignore:esp" ],
+ ptisp => [ "Performance Technologies ISP", "qlogicpti" ],
+ isp => [ "QLogic ISP", "qlogicpti" ],
+ );
+my %sbus_table_audio = (
+ audio => [ "AMD7930", "amd7930" ],
+ CS4231 => [ "CS4231 APC DMA (SBUS)", "cs4231" ],
+ CS4231_PCI => [ "CS4231 EB2 DMA (PCI)", "cs4231" ],
+ );
+my %sbus_table_video = (
+ bwtwo => [ "Sun|Monochrome (bwtwo)", "Server:SunMono" ],
+ cgthree => [ "Sun|Color3 (cgthree)", "Server:Sun" ],
+ cgeight => [ "Sun|CG8/RasterOps", "Server:Sun" ],
+ cgtwelve => [ "Sun|GS (cgtwelve)", "Server:Sun24" ],
+ gt => [ "Sun|Graphics Tower", "Server:Sun24" ],
+ mgx => [ "Sun|Quantum 3D MGXplus", "Server:Sun24" ],
+ mgx_4M => [ "Sun|Quantum 3D MGXplus with 4M VRAM", "Server:Sun24" ],
+ cgsix => [ "Sun|Unknown GX", "Server:Sun" ],
+ cgsix_dbl => [ "Sun|Double Width GX", "Server:Sun" ],
+ cgsix_sgl => [ "Sun|Single Width GX", "Server:Sun" ],
+ cgsix_t1M => [ "Sun|Turbo GX with 1M VSIMM", "Server:Sun" ],
+ cgsix_tp => [ "Sun|Turbo GX Plus", "Server:Sun" ],
+ cgsix_t => [ "Sun|Turbo GX", "Server:Sun" ],
+ cgfourteen => [ "Sun|SX", "Server:Sun24" ],
+ cgfourteen_4M => [ "Sun|SX with 4M VSIMM", "Server:Sun24" ],
+ cgfourteen_8M => [ "Sun|SX with 8M VSIMM", "Server:Sun24" ],
+ leo => [ "Sun|ZX or Turbo ZX", "Server:Sun24" ],
+ leo_t => [ "Sun|Turbo ZX", "Server:Sun24" ],
+ tcx => [ "Sun|TCX (S24)", "Server:Sun24" ],
+ tcx_8b => [ "Sun|TCX (8bit)", "Server:Sun" ],
+ afb => [ "Sun|Elite3D", "Server:Sun24" ],
+ afb_btx03 => [ "Sun|Elite3D-M6 Horizontal", "Server:Sun24" ],
+ ffb => [ "Sun|FFB", "Server:Sun24" ],
+ ffb_btx08 => [ "Sun|FFB 67Mhz Creator", "Server:Sun24" ],
+ ffb_btx0b => [ "Sun|FFB 67Mhz Creator 3D", "Server:Sun24" ],
+ ffb_btx1b => [ "Sun|FFB 75Mhz Creator 3D", "Server:Sun24" ],
+ ffb_btx20 => [ "Sun|FFB2 Vertical Creator", "Server:Sun24" ],
+ ffb_btx28 => [ "Sun|FFB2 Vertical Creator", "Server:Sun24" ],
+ ffb_btx23 => [ "Sun|FFB2 Vertical Creator 3D", "Server:Sun24" ],
+ ffb_btx2b => [ "Sun|FFB2 Vertical Creator 3D", "Server:Sun24" ],
+ ffb_btx30 => [ "Sun|FFB2+ Vertical Creator", "Server:Sun24" ],
+ ffb_btx33 => [ "Sun|FFB2+ Vertical Creator 3D", "Server:Sun24" ],
+ ffb_btx40 => [ "Sun|FFB2 Horizontal Creator", "Server:Sun24" ],
+ ffb_btx48 => [ "Sun|FFB2 Horizontal Creator", "Server:Sun24" ],
+ ffb_btx43 => [ "Sun|FFB2 Horizontal Creator 3D", "Server:Sun24" ],
+ ffb_btx4b => [ "Sun|FFB2 Horizontal Creator 3D", "Server:Sun24" ],
+ );
+
+1;
+
+#- update %sbus_probed according to SBUS detection.
+sub prom_walk($$$$) {
+ my ($sbus_probed, $node, $sbus, $ebus) = @_;
+ my ($prob_name, $prob_type) = (c::prom_getproperty("name"), c::prom_getproperty("device_type"));
+ my ($nextnode, $nsbus, $nebus) = (undef, $sbus, $ebus);
+
+ log::l("sbus probe at $node => $prob_name of type $prob_type on $sbus,$ebus");
+ #- probe for network devices.
+ if ($sbus && $prob_type eq 'network') {
+ $prob_name =~ s/[A-Z,]*(.*)/$1/;
+ $sbus_table_network{$prob_name} and push @$sbus_probed, [ "NETWORK", @{$sbus_table_network{$prob_name}} ];
+ #- TODO for Sun Quad Ethernet (qe)
+ }
+
+ #- probe for scsi devices.
+ if ($sbus && ($prob_type eq 'scsi' || $prob_name =~ /^(soc|socal)$/)) {
+ $prob_name =~ s/[A-Z,]*(.*)/$1/;
+ $sbus_table_scsi{$prob_name} and push @$sbus_probed, [ "SCSI", @{$sbus_table_scsi{$prob_name}} ];
+ }
+
+ #- probe for audio devices, there are no type to check here.
+ if ($sbus_table_audio{$prob_name}) {
+ $prob_name =~ /,/ and $prob_name =~ s/[A-Z,]*(.*)/$1/;
+ my $ext = $prob_name eq 'CS4231' && $ebus && "_PCI";
+ $sbus_table_audio{$prob_name . $ext} ?
+ push @$sbus_probed, [ "AUDIO", @{$sbus_table_audio{$prob_name . $ext}} ] :
+ push @$sbus_probed, [ "AUDIO", @{$sbus_table_audio{$prob_name}} ];
+ }
+
+ #- probe for video devices.
+ if ($prob_type eq 'display' && ($sbus || $prob_name =~ /^(ffb|afb|cgfourteen)$/)) {
+ $prob_name =~ s/[A-Z,]*(.*)/$1/;
+ my $ext = ($prob_name eq 'mgx' && c::prom_getint('fb_size') == 0x400000 && '_4M' ||
+ $prob_name eq 'cgsix' && do {
+ my ($chiprev, $vmsize) = (c::prom_getint('chiprev'), c::prom_getint('vmsize'));
+ my $result = '';
+ $chiprev >= 1 && $chiprev <= 4 and $result = '_dbl';
+ $chiprev >= 5 && $chiprev <= 9 and $result = '_sgl';
+ $chiprev == 11 && $vmsize == 2 and $result = '_t1M';
+ $chiprev == 11 && $vmsize == 4 and $result = '_tp';
+ $chiprev == 11 && !$result and $result = '_t';
+ $result;
+ } ||
+ $prob_name eq 'leo' && c::prom_getproperty('model') =~ /501-2503/ && '_t' ||
+ $prob_name eq 'tcx' && c::prom_getboot('tcx-8-bit') && '_8b' ||
+ $prob_name eq 'afb' && sprintf "_btx%x", c::prom_getint('board_type') ||
+ $prob_name eq 'ffb' && sprintf "_btx%x", c::prom_getint('board_type'));
+
+ $sbus_table_video{$prob_name . $ext} ?
+ push @$sbus_probed, [ "VIDEO", @{$sbus_table_video{$prob_name . $ext}} ] :
+ push @$sbus_probed, [ "VIDEO", @{$sbus_table_video{$prob_name}} ];
+ }
+
+ #- parse prom tree.
+ $prob_name eq 'sbus' || $prob_name eq 'sbi' and $nsbus = 1;
+ $prob_name eq 'ebus' and $nebus = 1;
+ $nextnode = c::prom_getchild($node) and prom_walk($sbus_probed, $nextnode, $nsbus, $nebus);
+ $nextnode = c::prom_getsibling($node) and prom_walk($sbus_probed, $nextnode, $sbus, $ebus);
+}
+
+sub check {
+ my $ok = $_[0] !~ /unknown/;
+ $ok or log::l("skipping $text, no module available (if you know one, please mail bugs\@linux-mandrake.com)");
+ $ok
+}
+
+sub probe($) {
+ my ($type) = @_;
+
+ my $root_node = c::prom_open();
+ my @l;
+
+ prom_walk(\@l, $root_node, 0, 0);
+ c::prom_close();
+
+ $type eq '.' ? @l : map { [ @$_[1..$#$_] ] } grep { !$type || $_->[0] =~ /$type/i } @l;
+}
+
+sub matching_desc($;$) {
+ my ($regexp) = @_;
+
+ my $root_node = c::prom_open();
+ my @l;
+
+ prom_walk(\@l, $root_node, 0, 0);
+ c::prom_close();
+ grep { !$type || $_->[1] =~ /$regexp/ } @l;
+}
+
+sub list { map { "$_->[1] ($_->[0] $_->[2])" } probe('.'); }