1#!/usr/bin/perl
2#
3#	int2info.pl
4#	converts Ralf Brown's Interrupt List to TexInfo files
5#
6#	Copyright (C) 2002 Stefan Weyergraf
7#
8#	This program is distributed in the hope that it will be useful,
9#	but WITHOUT ANY WARRANTY; without even the implied warranty of
10#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
11#	This program is freeware, which means that you may distribute
12#	it as long as this disclaimer and the copyright notice remain
13#	unmodified.
14#
15
16$max_entries_per_file = 512;
17
18$infoprefix = "";
19$infosuffix = ".info";
20
21%int_keys = ();
22%table_keys = ();
23%memmap_keys = ();
24%msr_keys = ();
25%port_keys = ();
26%farcall_keys = ();
27
28%nodes = ();
29%descs = ();
30%files = ();
31%file_contents = ();
32%file_entries = ();
33
34$index_file = "intidx";
35$index_file = $infoprefix.$index_file.$infosuffix;
36
37while (<>) {
38again:
39	if (/^--------(.*)/) {
40		$_ = $1;
41		$_ =~ s/\r//g;
42		if (/^\!/) {
43		} elsif (/^(.-[0-9a-fA-F].*?)\-*$/) {
44			consume_int($1);
45			goto again;
46		} elsif (/^(.-[Mm].*?)\-*$/) {
47			consume_mem($1);
48			goto again;
49		} elsif (/^(.-S.*?)\-*$/) {
50			consume_msr($1);
51			goto again;
52		} elsif (/^(.-P.*?)\-*$/) {
53			consume_port($1);
54			goto again;
55		} elsif (/^(.-\@.*?)\-*$/) {
56			consume_farcall($1);
57			goto again;
58		} elsif (/^---/) {
59			# ignore
60		} else {
61			print STDERR "unmatched: $_\n";
62			last;
63		}
64	}
65}
66
67partition_all();
68gen_index();
69gen_all();
70
71foreach $f (keys %file_contents) {
72	open(A, ">$f");
73	print A $file_contents{$f};
74	close(A);
75}
76exit;
77
78sub write_file
79{
80	my ($f, $s) = @_;
81	$file_contents{$f} .= $s;
82}
83
84sub partition_all
85{
86	partition(\%int_keys, \&compare_wo_section, "int");
87	partition(\%table_keys, \&compare, "table");
88	partition(\%memmap_keys, \&compare_wo_section, "memmap");
89	partition(\%msr_keys, \&compare_wo_section, "msr");
90	partition(\%port_keys, \&compare_wo_section, "port");
91	partition(\%farcall_keys, \&compare_wo_section, "farcall");
92}
93
94sub partition
95{
96	my ($kref, $cref, $file) = @_;
97	my $f = $infoprefix.$file.$infosuffix;
98	my $i = 1;
99	foreach $key (sort {&$cref} keys %$kref) {
100		while ($file_entries{$f} >= $max_entries_per_file-1) {
101			$f = sprintf("%s%s%d%s", $infoprefix, $file, $i++, $infosuffix);
102		}
103		$files{$key} = $f;
104		$file_entries{$f}++;
105	}
106}
107
108sub gen_idx_section
109{
110	my ($index_file, $file, $desc, $cref, $kref) = @_;
111	$file = $infoprefix.$file.$infosuffix;
112	write_file($index_file, gen_xref($index_file, $desc, $file, $desc));
113	write_file($file, gen_header($file, $desc, "(dir)", "(dir)"));
114	write_file($file, "* Menu:\n\n");
115	foreach $key (sort { &$cref; } keys %$kref) {
116		write_file($file, gen_xref($file, $descs{$key}, $files{$key}, $key));
117	}
118}
119
120sub gen_index
121{
122	write_file($index_file, gen_header($index_file, "Top", "(dir)", "(dir)"));
123	write_file($index_file, "* Menu:\n\n");
124
125	gen_idx_section($index_file, "ibcidx", "Interrupts By Category", \&compare, \%int_keys);
126	gen_idx_section($index_file, "ibnidx", "Interrupts By Number", \&compare_wo_section, \%int_keys);
127	gen_idx_section($index_file, "tabidx", "Tables", \&compare, \%table_keys);
128	gen_idx_section($index_file, "memidx", "Memory Maps", \&compare_wo_section, \%memmap_keys);
129	gen_idx_section($index_file, "portidx", "Ports", \&compare_wo_section, \%port_keys);
130	gen_idx_section($index_file, "msridx", "MSRs", \&compare_wo_section, \%msr_keys);
131	gen_idx_section($index_file, "fcidx", "Far Calls", \&compare_wo_section, \%farcall_keys);
132}
133
134sub gen_all
135{
136	foreach $key (keys %all) {
137		$gthisfile = $files{$key};
138		gen_section($files{$key}, $key);
139	}
140}
141
142sub gen_section
143{
144	my ($file, $key) = @_;
145	write_file($file, gen_header($file, $key, "(Dir)", "(Dir)"));
146	if ($int_keys{$key} && ($key =~ /^.-(..).*/)) {
147		write_file($file, genlinks($all{$key}, $1));
148	} else {
149		write_file($file, genlinks($all{$key}));
150	}
151}
152
153sub membyaddr
154{
155	my ($a1, $b1) = ($a, $b);
156	$a1=~s/.-(.*)/$1/;
157	$b1=~s/.-(.*)/$1/;
158	return $a1 cmp $b1;
159}
160
161sub compare_wo_section
162{
163	my ($a1, $b1) = ($a, $b);
164	$a1=~s/.-(.*)/$1/;
165	$b1=~s/.-(.*)/$1/;
166	return $a1 cmp $b1;
167}
168
169sub compare
170{
171	return $a cmp $b;
172}
173
174sub gen_xref
175{
176	my ($thisfile, $desc, $file, $node) = @_;
177	if ($thisfile eq $file) {
178		if ($desc eq $node) {
179			return "* ".$desc."\::\n"
180		} else {
181			return "* ".$desc."\: $node.\n"
182		}
183	} else {
184		return "* ".$desc."\: ($file)$node.\n"
185	}
186}
187
188sub gen_xref2
189{
190	my ($thisfile, $desc, $file, $node) = @_;
191	if ($thisfile eq $file) {
192		if ($desc eq $node) {
193			return "*Note ".$desc."\::"
194		} else {
195			return "*Note ".$desc."\: $node."
196		}
197	} else {
198		return "*Note ".$desc."\: ($file)$node."
199	}
200}
201
202sub gen_header
203{
204	my ($f, $n, $p, $u)=@_;
205	return "\x1f\nFile:$f,Node:$n,Prev:$p,Up:$u\n";
206}
207
208sub genmemlink1616
209{
210	my ($desc, $id) = @_;
211	$cs = catsearch(\%memmap_keys, $desc, "-M".$id);
212	if ($cs == 42) {
213		return $desc;
214	}
215	return $cs;
216}
217
218sub genfarcalllink
219{
220	my ($desc, $id) = @_;
221	$cs = catsearch(\%farcall_keys, $desc, "-@".$id);
222	if ($cs == 42) {
223		return $desc;
224	}
225	return $cs;
226}
227
228sub genmemlink32
229{
230	my ($desc, $id) = @_;
231	$cs = catsearch(\%memmap_keys, $desc, "-m".$id);
232	if ($cs == 42) {
233		return $desc;
234	}
235	return $cs;
236}
237
238sub genmsrlink
239{
240	my ($desc, $id) = @_;
241	$cs = catsearch(\%msr_keys, $desc, "-S".$id);
242	if ($cs == 42) {
243		return $desc;
244	}
245	return $cs;
246}
247
248sub genportlink
249{
250	my ($desc, $id) = @_;
251	$cs = catsearch(\%port_keys, $desc, "-P".$id);
252	if ($cs == 42) {
253		return $desc;
254	}
255	return $cs;
256}
257
258sub gentablelink
259{
260	my ($id) = @_;
261	return gen_xref2($gthisfile, $id, $files{$id}, $id);
262}
263
264sub genintlink
265{
266	my ($k, $int) = @_;
267	if ($k =~ /^\*note/i) { return $k; }
268	my $os = $k;
269	my $matched = 0;
270	$k =~ s/(".*")$//;
271	my $ax = "----";
272	my $extra_name = "", $extra_value = "";
273	while (1) {
274		if ($k =~ s/INT ([0-9a-fA-F]{2})h?//) {
275			$int = $1;
276		} elsif ($k =~ s/AH=([0-9a-fA-F]{2})//) {
277			$l = $1;
278			$ax =~ /(.{2})(.{2})/;
279			$ax = $l.$2;
280		} elsif ($k =~ s/AL=([0-9a-fA-F]{2})//) {
281			$l = $1;
282			$ax =~ /(.{2})(.{2})/;
283			$ax = $1.$l;
284		} elsif ($k =~ s/AX=([0-9a-fA-F]{4})//) {
285			$ax = $1;
286		} elsif ($k =~ s/([^A].)=([0-9a-fA-F]{2,4})//) {
287			$extra_name=$1;
288			$extra_value=$2;
289		} else {
290			last;
291		}
292		$matched = 1;
293	}
294	if (!$matched) { return $os; }
295	my $extra = $extra_name.$extra_value;
296	my $search = sprintf("%s-%2s%4s%s", '*', $int, $ax, $extra);
297	$search =~ s/^(.*?)\-*$/$1/;
298	$cs = catsearch(\%int_keys, $os, sprintf("-%2s%4s%s", $int, $ax, $extra));
299	if ($cs == 42) {
300		return $os;
301	} else {
302		return $cs;
303	}
304}
305
306sub catsearch
307{
308	my ($href, $desc, $suffix) = @_;
309	$desc =~ s/:/./g;
310	foreach $c ('a'..'z') {
311		my $search = $c.$suffix;
312		$search =~ s/^(.*?)\-*$/$1/;
313		if (defined $$href{$search}) {
314			return gen_xref2($gthisfile, $desc, $files{$search}, $search);
315		}
316	}
317	foreach $c ('A'..'Z') {
318		my $search = $c.$suffix;
319		$search =~ s/^(.*?)\-*$/$1/;
320		if (defined $$href{$search}) {
321			return gen_xref2($gthisfile, $desc, $files{$search}, $search);
322		}
323	}
324	$c = '-';
325		my $search = $c.$suffix;
326		$search =~ s/^(.*?)\-*$/$1/;
327		if (defined $$href{$search}) {
328			return gen_xref2($gthisfile, $desc, $files{$search}, $search);
329		}
330	$c = '*';
331		my $search = $c.$suffix;
332		$search =~ s/^(.*?)\-*$/$1/;
333		if (defined $$href{$search}) {
334			return gen_xref2($gthisfile, $desc, $files{$search}, $search);
335		}
336	return 42;
337}
338
339sub genlinks2
340{
341	my ($s, $int) = @_;
342	my @t = split(/,/, $s);
343	my $r = "", $p = "";
344	foreach $k (@t) {
345		if ($k =~ s/(".*")$//) {
346			   $p = $1;
347		}
348		if ($k =~ s/#(.\d{4})/gentablelink($1)/ge) {
349		} elsif ($k =~ s/MEM (.{4})h?:(.{4})h?/genmemlink1616($k, $1.$2)/ge) {
350		} elsif ($k =~ s/MEM (.{8})h?/genmemlink32($k, $1)/ge) {
351		} elsif ($k =~ s/MSR (.{8})h?/genmsrlink($k, $1)/ge) {
352		} elsif ($k =~ s/PORT (.{4})h?-(.{4})h?/genportlink($k, $1.$2)/ge) {
353		} elsif ($k =~ s/PORT (.{4})h?/genportlink($k, $1)/ge) {
354		} elsif ($k =~ s/@(.{4})h?:(.{4})h?/genfarcalllink($k, $1.$2)/ge) {
355		} elsif ($k =~ s/([^,]+)/genintlink($1, $int)/ge) {
356		}
357		$r .= $k.$p.',';
358	}
359	chop $r;
360	return $r;
361}
362
363sub genlinks
364{
365	my ($s, $int) = @_;
366	$s =~ s/(\(see (also )?)(.*)(\))/$1.genlinks2($3, $int).$4/ge;
367	$s =~ s/(SeeAlso: )(.*)/$1.genlinks2($2, $int)/ge;
368	return $s;
369}
370
371sub consume_int
372{
373	my ($id) = @_;
374	my $b = consume_body();
375	$int_keys{$id} = 1;
376	$all{$id} = $b;
377	my $c = $b;
378	if ($c =~ /^(.*?)\n/) { $c = $1; }
379	$c = sprintf("%-14s %s", $id, $c);
380	$c =~ s/:/./g;
381	$c =~ s/\n//g;
382	$descs{$id} = $c;
383}
384
385sub consume_mem
386{
387	my ($id) = @_;
388	my $b = consume_body();
389	$memmap_keys{$id} = 1;
390	$all{$id} = $b;
391	my $c = $b;
392	if ($c =~ /^(.*?)\n/) { $c = $1; }
393	$c = sprintf("%-14s %s", $id, $c);
394	$c =~ s/:/./g;
395	$c =~ s/\n//g;
396	$descs{$id} = $c;
397}
398
399sub consume_msr
400{
401	my ($id) = @_;
402	my $b = consume_body();
403	$msr_keys{$id} = 1;
404	$all{$id} = $b;
405	my $c = $b;
406	if ($c =~ /^(.*?)\n/) { $c = $1; }
407	$c = sprintf("%-14s %s", $id, $c);
408	$c =~ s/:/./g;
409	$c =~ s/\n//g;
410	$descs{$id} = $c;
411}
412
413sub consume_port
414{
415	my ($id) = @_;
416	my $b = consume_body();
417	$port_keys{$id} = 1;
418	$all{$id} = $b;
419	my $c = $b;
420	if ($c =~ /^(.*?)\n/) { $c = $1; }
421	$c = sprintf("%-14s %s", $id, $c);
422	$c =~ s/:/./g;
423	$c =~ s/\n//g;
424	$descs{$id} = $c;
425}
426
427sub consume_farcall
428{
429	my ($id) = @_;
430	my $b = consume_body();
431	$farcall_keys{$id} = 1;
432	$all{$id} = $b;
433	my $c = $b;
434	if ($c =~ /^(.*?)\n/) { $c = $1; }
435	$c = sprintf("%-14s %s", $id, $c);
436	$c =~ s/:/./g;
437	$c =~ s/\n//g;
438	$descs{$id} = $c;
439}
440
441sub consume_table
442{
443	my ($id, $prefix) = @_;
444	$table_keys{$id} = 1;
445	my $b = consume_body();
446	my $c = $prefix.$b;
447	$all{$id} = "Table $id\n".$c;
448	if ($c =~ /^(.*?)\n/) {
449		$c = $1;
450	} else {
451		$c = "";
452	}
453	$c = "$id ".$c;
454	$c =~ s/:/./g;
455	$c =~ s/\n//g;
456	$descs{$id} = $c;
457}
458
459sub consume_body()
460{
461	my $s="";
462	while (<>) {
463		$_ =~ s/\r//g;
464		last if (/^--------/);
465		if (/^\(Table (.\d*)\)/) {
466			my $id = $1;
467			my $x = <>;
468			chomp $x;
469			$s .= "$x (see #$id)\n";
470			consume_table($id, "$x.\n");
471			last;
472		} elsif (/\(Table (.\d*)\)$/) {
473			my $id = $1;
474			$s =~ s/\n(.*?)$//;
475			my $x = <>;
476			chomp $x;
477			$s .= "$x (see #$id)\n";
478			consume_table($id, $1."\n$x\n");
479			last;
480		}
481		$s.=$_;
482	}
483	return $s;
484}
485