summaryrefslogtreecommitdiff
path: root/mcon/pl/xwant.pl
blob: 273449431c6de79b05e3b6deb3001e9300a2cfdf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;# $Id: xwant.pl 1 2006-08-24 12:32:52Z rmanfredi $
;#
;#  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
;#  
;#  You may redistribute only under the terms of the Artistic Licence,
;#  as specified in the README file that comes with the distribution.
;#  You may reuse parts of this distribution only within the terms of
;#  that same Artistic Licence; a copy of which may be found at the root
;#  of the source tree for dist 4.0.
;#
;# $Log: xwant.pl,v $
;# Revision 3.0  1993/08/18  12:10:32  ram
;# Baseline for dist 3.0 netwide release.
;#
;# 
;# These two arrays record the file names of the files which may (or may not)
;# contain shell or C symbols known by metaconfig.
;#  @SHlist records the .SH files
;#  @clist records the C-like files (i.e. .[chyl])
;#
# Parse files and build cross references
sub build_xref {
	print "Building cross-reference files...\n" unless $opt_s;
	unless (-f $NEWMANI) {
		&manifake;
		die "No $NEWMANI--don't know who to scan.\n" unless -f $NEWMANI;
	}

	open(FUI, "|sort | uniq >I.fui") || die "Can't create I.fui.\n";
	open(UIF, "|sort | uniq >I.uif") || die "Can't create I.uif.\n";

	local($search);							# Where to-be-evaled script is held
	local($_) = ' ' x 50000 if $opt_m;		# Pre-extend pattern search space
	local(%visited);						# Records visited files
	local(%lastfound);						# Where last occurence of key was

	# Map shell symbol names to units by reverse engineering the @Master array
	# which records all the known shell symbols and the units where they
	# are defined.
	foreach $init (@Master) {
		$init =~ /^\?(.*):(.*)=''/ && ($shwanted{"\$$2"} = $1);
	}

	# Now we are a little clever, and build a loop to eval so that we don't
	# have to recompile our patterns on every file.  We also use "study" since
	# we are searching the same string for many different things.  Hauls!

	if (@clist) {
		print "    Scanning .[chyl] files for symbols...\n" unless $opt_s;
		$search = ' ' x (40 * (@cmaster + @ocmaster));	# Pre-extend
		$search = "while (<>) {study;\n";				# Init loop over ARGV
		foreach $key (keys(cmaster)) {
			$search .= "\$cmaster{'$key'} .= \"\$ARGV#\" if /\\b$key\\b/;\n";
		}
		foreach $key (grep(!/^\$/, keys %Obsolete)) {
			$search .= "&ofound('$key') if /\\b$key\\b/;\n";
		}
		$search .= "}\n";			# terminate loop
		print $search if $opt_d;
		@ARGV = @clist;
		# Swallow each file as a whole, if memory is available
		undef $/ if $opt_m;
		eval $search;
		eval '';
		$/ = "\n";
		while (($key,$value) = each(cmaster)) {
			next if $value eq '';
			foreach $file (sort(split(/#/, $value))) {
				next if $file eq '';
				# %cwanted may contain value separated by \n -- take last one
				@sym = split(/\n/, $cwanted{$key});
				$sym = pop(@sym);
				$shell = "\$$sym";
				print FUI
					pack("A35", $file),
					pack("A20", "$shwanted{$shell}.U"),
					$key, "\n";
				print UIF
					pack("A20", "$shwanted{$shell}.U"),
					pack("A25", $key),
					$file, "\n";
			}
		}
	}

	undef @clist;
	undef %cwanted;
	undef %cmaster;		# We're not building Configure, we may delete this
	%visited = ();
	%lastfound = ();

	if (@SHlist) {
		print "    Scanning .SH files for symbols...\n" unless $opt_s;
		$search = ' ' x (40 * (@shmaster + @oshmaster));	# Pre-extend
		$search = "while (<>) {study;\n";
		# All the keys already have a leading '$'
		foreach $key (keys(shmaster)) {
			$search .= "\$shmaster{'$key'} .= \"\$ARGV#\" if /\\$key\\b/;\n";
		}
		foreach $key (grep (/^\$/, keys %Obsolete)) {
			$search .= "&ofound('$key') if /\\$key\\b/;\n";
		}
		$search .= "}\n";
		print $search if $opt_d;
		@ARGV = @SHlist;
		# Swallow each file as a whole, if memory is available
		undef $/ if $opt_m;
		eval $search;
		eval '';
		$/ = "\n";
		while (($key,$value) = each(shmaster)) {
			next if $value eq '';
			foreach $file (sort(split(/#/, $value))) {
				next if $file eq '';
				print FUI
					pack("A35", $file),
					pack("A20", "$shwanted{$key}.U"),
					$key, "\n";
				print UIF
					pack("A20", "$shwanted{$key}.U"),
					pack("A25", $key),
					$file, "\n";
			}
		}
	}

	close FUI;
	close UIF;

	# If obsolete symbols where found, write an Obsolete file which lists where
	# each of them appear and the new symbol to be used. Also write Obsol_h.U
	# and Obsol_sh.U in .MT for later perusal.

	&dump_obsolete;						# Dump obsolete symbols if any

	# Clean-up memory by freeing useless data structures
	undef @SHlist;
	undef %shmaster;
}

# This routine records matches of obsolete keys (C or shell)
sub ofound {
	local($key) = @_;
	local($_) = $Obsolete{$key};		# Value of new symbol
	$ofound{"$ARGV $key $_"}++;			# Record obsolete match
	$cmaster{$_} .= "$ARGV#" unless /^\$/;	# A C hit
	$shmaster{$_} .= "$ARGV#" if /^\$/;		# Or a shell one
}