This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Also add all utilities for building from units to repo
[metaconfig.git] / bin / metaconfig
1 #!/pro/bin/perl
2
3 chdir "/pro/3gl/CPAN/perl";
4 system "chown merijn Configure config_h.SH";
5 chmod 0775, "Configure", "config_h.SH";
6 #-d "merijn" or mkdir "merijn";
7 #system "cp -f Configure config_h.SH Porting/Glossary Porting/config.sh merijn/";
8 system "ls -l Configure config_h.SH";
9
10 #
11 # This perl program uses dynamic loading [generated by perload]
12 #
13
14 $ENV{LC_ALL} = 'C';
15
16 # $Id: mconfig.SH 4 2006-08-25 21:54:31Z rmanfredi $
17 #
18 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
19 #  
20 #  You may redistribute only under the terms of the Artistic Licence,
21 #  as specified in the README file that comes with the distribution.
22 #  You may reuse parts of this distribution only within the terms of
23 #  that same Artistic Licence; a copy of which may be found at the root
24 #  of the source tree for dist 4.0.
25 #
26 # Original Author: Larry Wall <lwall@netlabs.com>
27 # Key Contributor: Harlan Stenn <harlan@mumps.pfcs.com>
28 #
29 # $Log: mconfig.SH,v $
30 # Revision 3.0.1.5  1995/07/25  14:19:05  ram
31 # patch56: new -G option
32 #
33 # Revision 3.0.1.4  1994/06/20  07:11:04  ram
34 # patch30: new -L option to override public library path for testing
35 #
36 # Revision 3.0.1.3  1994/01/24  14:20:53  ram
37 # patch16: added ~/.dist_profile awareness
38 #
39 # Revision 3.0.1.2  1993/10/16  13:53:10  ram
40 # patch12: new -M option for magic symbols and confmagic.h production
41 #
42 # Revision 3.0.1.1  1993/08/19  06:42:26  ram
43 # patch1: leading config.sh searching was not aborting properly
44 #
45 # Revision 3.0  1993/08/18  12:10:17  ram
46 # Baseline for dist 3.0 netwide release.
47 #
48
49 # Perload ON
50
51 $MC = '/pro/3gl/CPAN/lib/dist';
52 $version = '3.5';
53 $patchlevel = '0';
54 $grep = '/usr/bin/grep';
55 chop($date = `date`);
56 &profile;                                               # Read ~/.dist_profile
57 require 'getopts.pl';
58 &usage unless &Getopts("dhkmostvwGMVL:");
59
60 $MC = $opt_L if $opt_L;                 # May override public library path
61 $MC = &tilda_expand($MC);               # ~name expansion
62 chop($WD = `pwd`);                              # Working directory
63 chdir $MC || die "Can't chdir to $MC: $!\n";
64 chop($MC = `pwd`);                              # Real metaconfig lib path (no symbolic links)
65 chdir $WD || die "Can't chdir back to $WD: $!\n";
66
67 ++$opt_k if $opt_d;
68 ++$opt_M if -f 'confmagic.h';   # Force -M if confmagic.h already there
69
70 if ($opt_V) {
71         print STDERR "metaconfig $version PL$patchlevel\n";
72         exit 0;
73 } elsif ($opt_h) {
74         &usage;
75 }
76
77 unlink 'Wanted' unless $opt_w;                  # Wanted rebuilt if no -w
78 unlink 'Obsolete' unless $opt_w;                # Obsolete file rebuilt if no -w
79 &readpackage;                                                   # Merely get the package's name
80 &init;                                                                  # Various initializations
81 `mkdir .MT 2>&1` unless -d '.MT';               # For private temporary files
82
83 &locate_units;                          # Fill in @ARGV with a unit list
84 &extract_dependencies;          # Extract dependencies from units
85 &extract_filenames;                     # Extract files to be scanned for
86 &build_wanted;                          # Build a list of wanted symbols in file Wanted
87 &build_makefile;                        # To do the transitive closure of dependencies
88 &solve_dependencies;            # Now run the makefile to close dependency graph
89 &create_configure;                      # Create the Configure script and related files
90 &cosmetic_update;                       # Update the manifests
91
92 if ($opt_k) {
93         print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
94                 unless $opt_s;
95 } else {
96         `rm -rf .MT 2>&1`;
97 }
98 system "Porting/config_h.pl";
99 print "Done.\n" unless $opt_s;
100
101 sub main'init { &auto_main'init; }
102 sub auto_main'init { &main'dataload; }
103
104 sub main'init_constants { &auto_main'init_constants; }
105 sub auto_main'init_constants { &main'dataload; }
106
107 sub main'init_except { &auto_main'init_except; }
108 sub auto_main'init_except { &main'dataload; }
109
110 sub main'usage { &auto_main'usage; }
111 sub auto_main'usage { &main'dataload; }
112
113 package locate;
114
115 sub main'locate_units { &auto_main'locate_units; }
116 sub auto_main'locate_units { &main'dataload; }
117
118 sub locate'dump_list { &auto_locate'dump_list; }
119 sub auto_locate'dump_list { &main'dataload; }
120
121 sub locate'private_units { &auto_locate'private_units; }
122 sub auto_locate'private_units { &main'dataload; }
123
124 sub locate'public_units { &auto_locate'public_units; }
125 sub auto_locate'public_units { &main'dataload; }
126
127 sub locate'units_path { &auto_locate'units_path; }
128 sub auto_locate'units_path { &main'dataload; }
129
130 package main;
131
132 sub main'init_extraction { &auto_main'init_extraction; }
133 sub auto_main'init_extraction { &main'dataload; }
134
135 sub main'end_extraction { &auto_main'end_extraction; }
136 sub auto_main'end_extraction { &main'dataload; }
137
138 sub main'p_make { &auto_main'p_make; }
139 sub auto_main'p_make { &main'dataload; }
140
141 sub main'p_obsolete { &auto_main'p_obsolete; }
142 sub auto_main'p_obsolete { &main'dataload; }
143
144 sub main'p_shell { &auto_main'p_shell; }
145 sub auto_main'p_shell { &main'dataload; }
146
147 sub main'p_c { &auto_main'p_c; }
148 sub auto_main'p_c { &main'dataload; }
149
150 sub main'p_config { &auto_main'p_config; }
151 sub auto_main'p_config { &main'dataload; }
152
153 sub main'p_magic { &auto_main'p_magic; }
154 sub auto_main'p_magic { &main'dataload; }
155
156 sub p_ignore {}         # Ignore comment line
157 sub p_lint {}           # Ignore lint directives
158 sub p_visible {}        # No visible checking in metaconfig
159 sub p_temp {}           # No temporary variable control
160 sub p_file {}           # Ignore produced file directives (for now)
161
162 sub main'p_wanted { &auto_main'p_wanted; }
163 sub auto_main'p_wanted { &main'dataload; }
164
165 sub main'p_init { &auto_main'p_init; }
166 sub auto_main'p_init { &main'dataload; }
167
168 sub main'p_default { &auto_main'p_default; }
169 sub auto_main'p_default { &main'dataload; }
170
171 sub main'p_public { &auto_main'p_public; }
172 sub auto_main'p_public { &main'dataload; }
173
174 sub main'p_layout { &auto_main'p_layout; }
175 sub auto_main'p_layout { &main'dataload; }
176
177 sub main'p_library { &auto_main'p_library; }
178 sub auto_main'p_library { &main'dataload; }
179
180 sub main'p_include { &auto_main'p_include; }
181 sub auto_main'p_include { &main'dataload; }
182
183 sub main'write_out { &auto_main'write_out; }
184 sub auto_main'write_out { &main'dataload; }
185
186 sub main'init_depend { &auto_main'init_depend; }
187 sub auto_main'init_depend { &main'dataload; }
188
189 sub main'extract_dependencies { &auto_main'extract_dependencies; }
190 sub auto_main'extract_dependencies { &main'dataload; }
191
192 sub main'complete_line { &auto_main'complete_line; }
193 sub auto_main'complete_line { &main'dataload; }
194
195 sub main'extract_filenames { &auto_main'extract_filenames; }
196 sub auto_main'extract_filenames { &main'dataload; }
197
198 sub main'build_filext { &auto_main'build_filext; }
199 sub auto_main'build_filext { &main'dataload; }
200
201 sub main'build_extfun { &auto_main'build_extfun; }
202 sub auto_main'build_extfun { &main'dataload; }
203
204 sub main'q { &auto_main'q; }
205 sub auto_main'q { &main'dataload; }
206
207 sub main'build_wanted { &auto_main'build_wanted; }
208 sub auto_main'build_wanted { &main'dataload; }
209
210 sub main'parse_files { &auto_main'parse_files; }
211 sub auto_main'parse_files { &main'dataload; }
212
213 sub main'cmaster { &auto_main'cmaster; }
214 sub auto_main'cmaster { &main'dataload; }
215
216 sub main'ofound { &auto_main'ofound; }
217 sub auto_main'ofound { &main'dataload; }
218
219 sub main'shmaster { &auto_main'shmaster; }
220 sub auto_main'shmaster { &main'dataload; }
221
222 sub main'add_obsolete { &auto_main'add_obsolete; }
223 sub auto_main'add_obsolete { &main'dataload; }
224
225 sub main'map_obsolete { &auto_main'map_obsolete; }
226 sub auto_main'map_obsolete { &main'dataload; }
227
228 sub main'record_obsolete { &auto_main'record_obsolete; }
229 sub auto_main'record_obsolete { &main'dataload; }
230
231 sub main'dump_obsolete { &auto_main'dump_obsolete; }
232 sub auto_main'dump_obsolete { &main'dataload; }
233
234 sub main'build_makefile { &auto_main'build_makefile; }
235 sub auto_main'build_makefile { &main'dataload; }
236
237 sub main'build_private { &auto_main'build_private; }
238 sub auto_main'build_private { &main'dataload; }
239
240 sub main'symbols { &auto_main'symbols; }
241 sub auto_main'symbols { &main'dataload; }
242
243 sub main'compute_loadable { &auto_main'compute_loadable; }
244 sub auto_main'compute_loadable { &main'dataload; }
245
246 # Now that we know all the desirable symbols, we have to rebuild
247 # another makefile, in order to have the units in a more optimal
248 # way.
249 # Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is
250 # wanted; then 'b' will be loaded. However, 'b' is a conditional
251 # dependency for 'a', and it would be better if 'b' were loaded
252 # before 'a' is, though this is not necessary.
253 # It is hard to know that 'b' will be loaded *before* the first make.
254
255 sub main'update_makefile { &auto_main'update_makefile; }
256 sub auto_main'update_makefile { &main'dataload; }
257
258 sub main'solve_dependencies { &auto_main'solve_dependencies; }
259 sub auto_main'solve_dependencies { &main'dataload; }
260
261 sub main'create_configure { &auto_main'create_configure; }
262 sub auto_main'create_configure { &main'dataload; }
263
264 sub main'process_command { &auto_main'process_command; }
265 sub auto_main'process_command { &main'dataload; }
266
267 sub main'skipped { &auto_main'skipped; }
268 sub auto_main'skipped { &main'dataload; }
269
270 sub main'cosmetic_update { &auto_main'cosmetic_update; }
271 sub auto_main'cosmetic_update { &main'dataload; }
272
273 sub main'mani_add { &auto_main'mani_add; }
274 sub auto_main'mani_add { &main'dataload; }
275
276 sub main'mani_remove { &auto_main'mani_remove; }
277 sub auto_main'mani_remove { &main'dataload; }
278
279 sub main'add_configure { &auto_main'add_configure; }
280 sub auto_main'add_configure { &main'dataload; }
281
282 package interpreter;
283
284 sub main'init_keep { &auto_main'init_keep; }
285 sub auto_main'init_keep { &main'dataload; }
286
287 sub main'init_priority { &auto_main'init_priority; }
288 sub auto_main'init_priority { &main'dataload; }
289
290 sub main'init_interp { &auto_main'init_interp; }
291 sub auto_main'init_interp { &main'dataload; }
292
293 sub interpreter'error { &auto_interpreter'error; }
294 sub auto_interpreter'error { &main'dataload; }
295
296 sub main'check_state { &auto_main'check_state; }
297 sub auto_main'check_state { &main'dataload; }
298
299 sub interpreter'push_val { &auto_interpreter'push_val; }
300 sub auto_interpreter'push_val { &main'dataload; }
301
302 sub interpreter'execute { &auto_interpreter'execute; }
303 sub auto_interpreter'execute { &main'dataload; }
304
305 sub interpreter'update_stack { &auto_interpreter'update_stack; }
306 sub auto_interpreter'update_stack { &main'dataload; }
307
308 sub interpreter'eval_expr { &auto_interpreter'eval_expr; }
309 sub auto_interpreter'eval_expr { &main'dataload; }
310
311 sub interpreter'evaluate { &auto_interpreter'evaluate; }
312 sub auto_interpreter'evaluate { &main'dataload; }
313
314 sub main'interpret { &auto_main'interpret; }
315 sub auto_main'interpret { &main'dataload; }
316                 
317 package main;
318
319 sub main'readpackage { &auto_main'readpackage; }
320 sub auto_main'readpackage { &main'dataload; }
321
322 sub main'manifake { &auto_main'manifake; }
323 sub auto_main'manifake { &main'dataload; }
324
325 sub main'tilda_expand { &auto_main'tilda_expand; }
326 sub auto_main'tilda_expand { &main'dataload; }
327
328 sub main'profile { &auto_main'profile; }
329 sub auto_main'profile { &main'dataload; }
330
331 # Load the calling function from DATA segment and call it. This function is
332 # called only once per routine to be loaded.
333 sub main'dataload {
334         local($__packname__) = (caller(1))[3];
335         $__packname__ =~ s/::/'/;
336         local($__rpackname__) = $__packname__;
337         local($__at__) = $@;
338         $__rpackname__ =~ s/^auto_//;
339         &perload'load_from_data($__rpackname__);
340         local($__fun__) = "$__rpackname__";
341         $__fun__ =~ s/'/'load_/;
342         eval "*$__packname__ = *$__fun__;";     # Change symbol table entry
343         die $@ if $@;           # Should not happen
344         $@ = $__at__;           # Restore value $@ had on entrance
345         &$__fun__;                      # Call newly loaded function
346 }
347
348 # Load function name given as argument, fatal error if not existent
349 sub perload'load_from_data {
350         package perload;
351         local($pos) = $Datapos{$_[0]};                  # Offset within DATA
352         # Avoid side effects by protecting special variables which will be changed
353         # by the dataloading operation.
354         local($., $_, $@);
355         $pos = &fetch_function_code unless $pos;
356         die "Function $_[0] not found in data section.\n" unless $pos;
357         die "Cannot seek to $pos into data section.\n"
358                 unless seek(main'DATA, $pos, 0);
359         local($/) = "\n}";
360         local($body) = scalar(<main'DATA>);
361         die "End of file found while loading $_[0].\n" unless $body =~ /^\}$/m;
362         eval $body;             # Load function into perl space
363         chop($@) && die "$@, while parsing code of $_[0].\n";
364 }
365
366 # This function is called only once, and fills in the %Datapos array with
367 # the offset of each of the dataloaded routines held in the data section.
368 sub perload'fetch_function_code {
369         package perload;
370         local($start) = 0;
371         local($., $_);
372         while (<main'DATA>) {                   # First move to start of offset table
373                 next if /^#/;
374                 last if /^$/ && ++$start > 2;   # Skip two blank line after end token
375         }
376         $start = tell(main'DATA);               # Offsets in table are relative to here
377         local($key, $value);
378         while (<main'DATA>) {                   # Load the offset table
379                 last if /^$/;                           # Ends with a single blank line
380                 ($key, $value) = split(' ');
381                 $Datapos{$key} = $value + $start;
382         }
383         $Datapos{$_[0]};                # All that pain to get this offset...
384 }
385
386 #
387 # The perl compiler stops here.
388 #
389
390 __END__
391
392 #
393 # Beyond this point lie functions we may never compile.
394 #
395
396 #
397 # DO NOT CHANGE A IOTA BEYOND THIS COMMENT!
398 # The following table lists offsets of functions within the data section.
399 # Should modifications be needed, change original code and rerun perload
400 # with the -o option to regenerate a proper offset table.
401 #
402
403                 interpreter'error      51675
404             interpreter'eval_expr      53822
405              interpreter'evaluate      56190
406               interpreter'execute      52464
407              interpreter'push_val      52099
408          interpreter'update_stack      52968
409                  locate'dump_list       5219
410              locate'private_units       5352
411               locate'public_units       6139
412                 locate'units_path       7632
413                main'add_configure      50796
414                 main'add_obsolete      33314
415                 main'build_extfun      26133
416                 main'build_filext      25782
417               main'build_makefile      37799
418                main'build_private      38542
419                 main'build_wanted      27394
420                  main'check_state      51824
421                      main'cmaster      31781
422                main'complete_line      24485
423             main'compute_loadable      40540
424              main'cosmetic_update      48406
425             main'create_configure      42431
426                main'dump_obsolete      35957
427               main'end_extraction       9995
428         main'extract_dependencies      21627
429            main'extract_filenames      24925
430                         main'init       2714
431               main'init_constants       3033
432                  main'init_depend      20477
433                  main'init_except       3575
434              main'init_extraction       9143
435                  main'init_interp      51524
436                    main'init_keep      51113
437                main'init_priority      51376
438                    main'interpret      57070
439                 main'locate_units       4602
440                     main'mani_add      49864
441                  main'mani_remove      50228
442                     main'manifake      59389
443                 main'map_obsolete      34152
444                       main'ofound      32371
445                          main'p_c      12564
446                     main'p_config      13870
447                    main'p_default      17683
448                    main'p_include      19574
449                       main'p_init      17541
450                     main'p_layout      19054
451                    main'p_library      19485
452                      main'p_magic      15626
453                       main'p_make      10347
454                   main'p_obsolete      11957
455                     main'p_public      17872
456                      main'p_shell      12111
457                     main'p_wanted      16526
458                  main'parse_files      27710
459              main'process_command      43224
460                      main'profile      60570
461                            main'q      27239
462                  main'readpackage      58877
463              main'record_obsolete      34904
464                     main'shmaster      32915
465                      main'skipped      48225
466           main'solve_dependencies      41708
467                      main'symbols      40026
468                 main'tilda_expand      60215
469              main'update_makefile      41191
470                        main'usage       3931
471                    main'write_out      19840
472
473 #
474 # End of offset table and beginning of dataloading section.
475 #
476
477 # General initializations
478 sub main'load_init {
479         package main;
480         &init_except;                   # Token which have upper-cased letters
481         &init_keep;                             # The keep status for built-in interpreter
482         &init_priority;                 # Priorities for diadic operators
483         &init_constants;                # Define global constants
484         &init_depend;                   # The %Depend array records control line handling
485 }
486
487 sub main'load_init_constants {
488         package main;
489         $NEWMANI = 'MANIFEST.new';              # List of files to be scanned
490         $MANI = 'MANIFEST';                             # For manifake
491
492         # The distinction between MANIFEST.new and MANIFEST can make sense
493         # when the "pat" tools are used, but if only metaconfig is used, then
494         # we can very well leave without a MANIFEST.new.  --RAM, 2006-08-25
495         $NEWMANI = $MANI if -f $MANI && ! -f $NEWMANI;
496 }
497
498 # Record the exceptions -- almost all symbols but these are lower case
499 # We also use three symbols from Unix.U for default file suffixes.
500 sub main'load_init_except {
501         package main;
502         $Except{'Author'}++;
503         $Except{'Date'}++;
504         $Except{'Header'}++;
505         $Except{'Id'}++;
506         $Except{'Locker'}++;
507         $Except{'Log'}++;
508         $Except{'RCSfile'}++;
509         $Except{'Revision'}++;
510         $Except{'Source'}++;
511         $Except{'State'}++;
512         $Except{'_a'}++;
513         $Except{'_o'}++;
514         $Except{'_exe'}++;
515 }
516
517 # Print out metaconfig's usage and exits
518 sub main'load_usage {
519         package main;
520         print STDERR <<'EOH';
521 Usage: metaconfig [-dhkmostvwGMV] [-L dir]
522   -d : debug mode.
523   -h : print this help message and exits.
524   -k : keep temporary directory.
525   -m : assume lots of memory and swap space.
526   -o : maps obsolete symbols on new ones.
527   -s : silent mode.
528   -t : trace symbols as they are found.
529   -v : verbose mode.
530   -w : trust Wanted file as being up-to-date.
531   -G : also provide a GNU configure-like front end.
532   -L : specify main units repository.
533   -M : activate production of confmagic.h.
534   -V : print version number and exits.
535 EOH
536         exit 1;
537 }
538
539 # Locate the units and push their path in @ARGV (sorted alphabetically)
540 sub main'load_locate_units {
541         package locate;
542         print "Locating units...\n" unless $main'opt_s;
543         local(*WD) = *main'WD;                  # Current working directory
544         local(*MC) = *main'MC;                  # Public metaconfig library
545         undef %myUlist;                                 # Records private units paths
546         undef %myUseen;                                 # Records private/public conflicts
547         &private_units;                                 # Locate private units in @myUlist
548         &public_units;                                  # Locate public units in @ARGV
549         @ARGV = sort @ARGV;                             # Sort it alphabetically
550         push(@ARGV, sort @myUlist);             # Append user's units sorted
551         &dump_list if $main'opt_v;              # Dump the list of units
552 }
553
554 # Dump the list of units on stdout
555 sub locate'load_dump_list {
556         package locate;
557         print "\t";
558         $, = "\n\t";
559         print @ARGV;
560         $, = '';
561         print "\n";
562 }
563
564 # Scan private units
565 sub locate'load_private_units {
566         package locate;
567         return unless -d 'U';                   # Nothing to be done if no 'U' entry
568         local(*ARGV) = *myUlist;                # Really fill in @myUlist
569         local($MC) = $WD;                               # We are really in the working directory
570         &units_path("U");                               # Locate units in the U directory
571         local($unit_name);                              # Unit's name (without .U)
572         local(@kept);                                   # Array of kept units
573         # Loop over the units and remove duplicates (the first one seen is the one
574         # we keep). Also set the %myUseen H table to record private units seen.
575         foreach (@ARGV) {
576                 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
577                 next if $myUseen{$unit_name};   # Already recorded
578                 $myUseen{$unit_name} = 1;               # Record pirvate unit
579                 push(@kept, $_);                                # Keep this unit
580         }
581         @ARGV = @kept;
582 }
583
584 # Scan public units
585 sub locate'load_public_units {
586         package locate;
587         chdir($MC) || die "Can't find directory $MC.\n";
588         &units_path("U");                               # Locate units in public U directory
589         chdir($WD) || die "Can't go back to directory $WD.\n";
590         local($path);                                   # Relative path from $WD
591         local($unit_name);                              # Unit's name (without .U)
592         local(*Unit) = *main'Unit;              # Unit is a global from main package
593         local(@kept);                                   # Units kept
594         local(%warned);                                 # Units which have already issued a message
595         # Loop over all the units and keep only the ones that were not found in
596         # the user's U directory. As it is possible two or more units with the same
597         # name be found in
598         foreach (@ARGV) {
599                 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
600                 next if $warned{$unit_name};    # We have already seen this unit
601                 $warned{$unit_name} = 1;                # Remember we have warned the user
602                 if ($myUseen{$unit_name}) {             # User already has a private unit
603                         $path = $Unit{$unit_name};      # Extract user's unit path
604                         next if $path eq $_;            # Same path, we must be in mcon/
605                         $path =~ s|^$WD/||o;            # Weed out leading working dir path
606                         print "    Your private $path overrides the public one.\n"
607                                 unless $main'opt_s;
608                 } else {
609                         push(@kept, $_);                        # We may keep this one
610                 }
611         }
612         @ARGV = @kept;
613 }
614
615 # Recursively locate units in the directory. Each file ending with .U has to be
616 # a unit. Others are stat()'ed, and if they are a directory, they are also
617 # scanned through. The $MC and @ARGV variable are dynamically set by the caller.
618 sub locate'load_units_path {
619         package locate;
620         local($dir) = @_;                                       # Directory where units are to be found
621         local(@contents);                                       # Contents of the directory
622         local($unit_name);                                      # Unit's name, without final .U
623         local($path);                                           # Full path of a unit
624         local(*Unit) = *main'Unit;                      # Unit is a global from main package
625         unless (opendir(DIR, $dir)) {
626                 warn("Cannot open directory $dir.\n");
627                 return;
628         }
629         print "Locating in $MC/$dir...\n" if $main'opt_v;
630         @contents = readdir DIR;                        # Slurp the whole thing
631         closedir DIR;                                           # And close dir, ready for recursion
632         foreach (@contents) {
633                 next if $_ eq '.' || $_ eq '..';
634                 if (/\.U$/) {                                   # A unit, definitely
635                         ($unit_name) = /^(.*)\.U$/;
636                         $path = "$MC/$dir/$_";                          # Full path of unit
637                         push(@ARGV, $path);                                     # Record its path
638                         if (defined $Unit{$unit_name}) {        # Already seen this unit
639                                 if ($main'opt_v) {
640                                         ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
641                                         print "    We've already seen $unit_name.U in $path.\n";
642                                 }
643                         } else {
644                                 $Unit{$unit_name} = $path;              # Map name to path
645                         }
646                         next;
647                 }
648                 # We have found a file which does not look like a unit. If it is a
649                 # directory, then scan it. Otherwise skip the file.
650                 unless (-d "$dir/$_") {
651                         print "    Skipping file $_ in $dir.\n" if $main'opt_v;
652                         next;
653                 }
654                 &units_path("$dir/$_");
655                 print "Back to $MC/$dir...\n" if $main'opt_v;
656         }
657 }
658
659 # Initialize the extraction process by setting some variables.
660 # We return a string to be eval to do more customized initializations.
661 sub main'load_init_extraction {
662         package main;
663         open(INIT, ">$WD/.MT/Init.U") ||
664                 die "Can't create .MT/Init.U\n";
665         open(CONF_H, ">$WD/.MT/Config_h.U") ||
666                 die "Can't create .MT/Config_h.U\n";
667         open(EXTERN, ">$WD/.MT/Extern.U") ||
668                 die "Can't create .MT/Extern.U\n";
669         open(MAGIC_H, ">$WD/.MT/Magic_h.U") ||
670                 die "Can't create .MT/Magic_h.U\n";
671
672         $c_symbol = '';                         # Current symbol seen in ?C: lines
673         $s_symbol = '';                         # Current symbol seen in ?S: lines
674         $m_symbol = '';                         # Current symbol seen in ?M: lines
675         $heredoc = '';                          # Last "here" document symbol seen
676         $heredoc_nosubst = 0;           # True for <<'EOM' here docs
677         $condlist = '';                         # List of conditional symbols
678         $defined = '';                          # List of defined symbols in the unit
679         $body = '';                                     # No procedure to handle body
680         $ending = '';                           # No procedure to clean-up
681 }
682
683 # End the extraction process
684 sub main'load_end_extraction {
685         package main;
686         close EXTERN;                   # External dependencies (libraries, includes...)
687         close CONF_H;                   # C symbol definition template
688         close INIT;                             # Required initializations
689         close MAGIC;                    # Magic C symbol redefinition templates
690
691         print $dependencies if $opt_v;  # Print extracted dependencies
692 }
693
694 # Process the ?MAKE: line
695 sub main'load_p_make {
696         package main;
697         local($_) = @_;
698         local(@ary);                                    # Locally defined symbols
699         local(@dep);                                    # Dependencies
700         if (/^[\w+ ]*:/) {                              # Main dependency rule
701                 s|^\s*||;                                       # Remove leading spaces
702                 chop;
703                 s/:(.*)//;
704                 @dep = split(' ', $1);                  # Dependencies
705                 @ary = split(' ');                              # Locally defined symbols
706                 foreach $sym (@ary) {
707                         # Symbols starting with a '+' are meant for internal use only.
708                         next if $sym =~ s/^\+//;
709                         # Only sumbols starting with a lowercase letter are to
710                         # appear in config.sh, excepted the ones listed in Except.
711                         if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
712                                 $shmaster{"\$$sym"} = undef;
713                                 push(@Master,"?$unit:$sym=''\n");       # Initializations
714                         }
715                 }
716                 $condlist = '';                         # List of conditional symbols
717                 local($sym);                            # Symbol copy, avoid @dep alteration
718                 foreach $dep (@dep) {
719                         if ($dep =~ /^\+[A-Za-z]/) {
720                                 ($sym = $dep) =~ s|^\+||;
721                                 $condlist .= "$sym ";
722                                 push(@Cond, $sym) unless $condseen{$sym};
723                                 $condseen{$sym}++;              # Conditionally wanted
724                         }
725                 }
726                 # Append to already existing dependencies. The 'defined' variable
727                 # is set for &write_out, used to implement ?L: and ?I: canvas. It is
728                 # reset each time a new unit is parsed.
729                 # NB: leading '+' for defined symbols (internal use only) have been
730                 # removed at this point, but conditional dependencies still bear it.
731                 $defined = join(' ', @ary);             # Symbols defined by this unit
732                 $dependencies .= $defined . ':' . join(' ', @dep) . "\n";
733                 $dependencies .= "      -cond $condlist\n" if $condlist;
734         } else {
735                 $dependencies .= $_;            # Building rules
736         }
737 }
738
739 # Process the ?O: line
740 sub main'load_p_obsolete {
741         package main;
742         local($_) = @_;
743         $Obsolete{"$unit.U"} .= $_;             # Message(s) to print if unit is used
744 }
745
746 # Process the ?S: lines
747 sub main'load_p_shell {
748         package main;
749         local($_) = @_;
750         unless ($s_symbol) {
751                 if (/^(\w+).*:/) {
752                         $s_symbol = $1;
753                         print "  ?S: $s_symbol\n" if $opt_d;
754                 } else {
755                         warn "\"$file\", line $.: syntax error in ?S: construct.\n";
756                         $s_symbol = $unit;
757                         return;
758                 }
759                 # Deal with obsolete symbol list (enclosed between parenthesis)
760                 &record_obsolete("\$$_") if /\(/;
761         }
762         m|^\.\s*$| && ($s_symbol = '');         # End of comment
763 }
764
765 # Process the ?C: lines
766 sub main'load_p_c {
767         package main;
768         local($_) = @_;
769         unless ($c_symbol) {
770                 if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
771                         # The ~ operator aliases the main C symbol to another symbol which
772                         # is to be used instead for definition in config.h. That is to say,
773                         # the line '?C:SYM ~ other:' would look for symbol 'other' instead,
774                         # and the documentation for symbol SYM would only be included in
775                         # config.h if 'other' were actually wanted.
776                         $c_symbol = $2;                 # Alias for definition in config.h
777                         print "  ?C: $1 ~ $c_symbol\n" if $opt_d;
778                 } elsif (/^(\w+).*:/) {
779                         # Default behaviour. Include in config.h if symbol is needed.
780                         $c_symbol = $1;
781                         print "  ?C: $c_symbol\n" if $opt_d;
782                 } else {
783                         warn "\"$file\", line $.: syntax error in ?C: construct.\n";
784                         $c_symbol = $unit;
785                         return;
786                 }
787                 # Deal with obsolete symbol list (enclosed between parenthesis) and
788                 # make sure that list do not appear in config.h.SH by removing it.
789                 &record_obsolete("$_") if /\(/;
790                 s/\s*\(.*\)//;                                  # Get rid of obsolete symbol list
791         }
792         s|^(\w+)\s*|?$c_symbol:/* $1| ||                                                # Start of comment
793         (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
794         s|^(.*)|?$c_symbol: *$1|;                                                               # Middle of comment
795         &p_config("$_");                                        # Add comments to config.h.SH
796 }
797
798 # Process the ?H: lines
799 sub main'load_p_config {
800         package main;
801         local($_) = @_;
802         local($constraint);                                     # Constraint to be used for inclusion
803         ++$old_version if s/^\?%1://;           # Old version
804         if (s/^\?(\w+)://) {                            # Remove leading '?var:'
805                 $constraint = $1;                               # Constraint is leading '?var'
806         } else {
807                 $constraint = '';                               # No constraint
808         }
809         if (/^#.*\$/) {                                         # Look only for cpp lines
810                 if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
811                         # Case: #$d_var VAR "$var"
812                         $constraint = $2 unless $constraint;
813                         print "  ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d;
814                         $cmaster{$2} = undef;
815                         $cwanted{$2} = "$1\n$3";
816                 } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
817                         # Case: #define VAR(x) $var
818                         $constraint = $1 unless $constraint;
819                         print "  ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d;
820                         $cmaster{$1} = undef;
821                         $cwanted{$1} = $3;
822                 } elsif (m|^#\$define\s+(\w+)|) {
823                         # Case: #$define VAR
824                         $constraint = $1 unless $constraint;
825                         print "  ?H: ($constraint) #define $1\n" if $opt_d;
826                         $cmaster{$1} = undef;
827                         $cwanted{$1} = "define\n$unit";
828                 } elsif (m|^#\$(\w+)\s+(\w+)|) {
829                         # Case: #$d_var VAR
830                         $constraint = $2 unless $constraint;
831                         print "  ?H: ($constraint) #\$$1 $2\n" if $opt_d;
832                         $cmaster{$2} = undef;
833                         $cwanted{$2} = $1;
834                 } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
835                         # Case: #define VAR "$var"
836                         $constraint = $1 unless $constraint;
837                         print "  ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d;
838                         $cmaster{$1} = undef;
839                         $cwanted{$1} = $2;
840                 } else {
841                         $constraint = $unit unless $constraint;
842                         print "  ?H: ($constraint) $_" if $opt_d;
843                 }
844         } else {
845                 print "  ?H: ($constraint) $_" if $opt_d;
846         }
847         # If not a single ?H:. line, add the leading constraint
848         s/^\.// || s/^/?$constraint:/;
849         print CONF_H;
850 }
851
852 # Process the ?M: lines
853 sub main'load_p_magic {
854         package main;
855         local($_) = @_;
856         unless ($m_symbol) {
857                 if (/^(\w+):\s*([\w\s]*)\n$/) {
858                         # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know
859                         # about the wantedness of sym later on when building confmagic.h.
860                         # Buf is sym is wanted, then the C symbol dependencies have to
861                         # be triggered. That is done by introducing sym in the mwanted
862                         # array, known by the Wanted file construction process...
863                         $m_symbol = $1;
864                         print "  ?M: $m_symbol\n" if $opt_d;
865                         $mwanted{$m_symbol} = $2;               # Record C dependencies
866                         &p_wanted("$unit:$m_symbol");   # Build fake ?W: line
867                 } else {
868                         warn "\"$file\", line $.: syntax error in ?M: construct.\n";
869                 }
870                 return;
871         }
872         (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) ||    # End of block
873         s/^/?$m_symbol:/;
874         print MAGIC_H;                                  # Definition goes to confmagic.h
875         print "  ?M: $_" if $opt_d;
876 }
877
878 # Process the ?W: lines
879 sub main'load_p_wanted {
880         package main;
881         # Syntax is ?W:<shell symbols>:<C symbols>
882         local($active) = $_[0] =~ /^([^:]*):/;          # Symbols to activate
883         local($look_symbols) = $_[0] =~ /:(.*)/;        # When those are used
884         local(@syms) = split(/ /, $look_symbols);       # Keep original spacing info
885         $active =~ s/\s+/\n/g;                                          # One symbol per line
886
887         # Concatenate quoted strings, so saying something like 'two words' will
888         # be introduced as one single symbol "two words".
889         local(@symbols);                                # Concatenated symbols to look for
890         local($concat) = '';                    # Concatenation buffer
891         foreach (@syms) {
892                 if (s/^\'//) {
893                         $concat = $_;
894                 } elsif (s/\'$//) {
895                         push(@symbols, $concat . ' ' . $_);
896                         $concat = '';
897                 } else {
898                         push(@symbols, $_) unless $concat;
899                         $concat .= ' ' . $_ if $concat;
900                 }
901         }
902
903         # Now record symbols in master and wanted tables
904         foreach (@symbols) {
905                 $cmaster{$_} = undef;                                   # Asks for look-up in C files
906                 $cwanted{$_} = "$active" if $active;    # Shell symbols to activate
907         }
908 }
909
910 # Process the ?INIT: lines
911 sub main'load_p_init {
912         package main;
913         local($_) = @_;
914         print INIT "?$unit:", $_;               # Wanted only if unit is loaded
915 }
916
917 # Process the ?D: lines
918 sub main'load_p_default {
919         package main;
920         local($_) = @_;
921         s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/
922                 && ($hasdefault{$1}++, print INIT $_);
923 }
924
925 # Process the ?P: lines
926 sub main'load_p_public {
927         package main;
928         local($_) = @_;
929         local($csym);                                   # C symbol(s) we're trying to look at
930         local($nosym);                                  # List of symbol(s) which mustn't be wanted
931         local($cfile);                                  # Name of file implementing csym (no .ext)
932         ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/;
933         unless ($csym eq '' || $cfile eq '') {
934                 # Add dependencies for each C symbol, of the form:
935                 #       -pick public <sym> <file> <notdef symbols list>
936                 # and the file will be added to config.c whenever sym is wanted and
937                 # none of the notdef symbols is wanted.
938                 foreach $sym (split(' ', $csym)) {
939                         $dependencies .= "\t-pick public $sym $cfile $nosym\n";
940                 }
941         }
942 }
943
944 # Process the ?Y: lines
945 # Valid layouts are for now are: top, bottom, default.
946 #
947 # NOTA BENE:
948 # This routine relies on the $defined variable, a global variable set
949 # during the ?MAKE: processing, which lists all the defined symbols in
950 # the unit (the optional leading '+' for internal symbols has been removed
951 # if present).
952 #
953 # The routine fills up a %Layout table, indexed by symbol, yielding the
954 # layout imposed to this unit. That table will then be used later on when
955 # we sort wanted symbols for the Makefile.
956 sub main'load_p_layout {
957         package main;
958         local($_) = @_;
959         local($layout) = /^\s*(\w+)/;
960         $layout =~ tr/A-Z/a-z/;         # Case is not significant for layouts
961         unless (defined $Lcmp{$layout}) {
962                 warn "\"$file\", line $.: unknown layout directive '$layout'.\n";
963                 return;
964         }
965         foreach $sym (split(' ', $defined)) {
966                 $Layout{$sym} = $Lcmp{$layout};
967         }
968 }
969
970 # Process the ?L: lines
971 # There should not be any '-l' in front of the library name
972 sub main'load_p_library {
973         package main;
974         &write_out("L:$_");
975 }
976
977 # Process the ?I: lines
978 sub main'load_p_include {
979         package main;
980         &write_out("I:$_");
981 }
982
983 # Write out line in file Extern.U. The information recorded there has the
984 # following prototypical format:
985 #   ?symbol:L:inet bsd
986 # If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted.
987 sub main'load_write_out {
988         package main;
989         local($_) = @_;
990         local($target) = $defined;              # By default, applies to defined symbols
991         $target = $1 if s/^(.*)://;             # List is qualified "?L:target:symbols"
992         local(@target) = split(' ', $target);
993         chop;
994         foreach $key (@target) {
995                 print EXTERN "?$key:$_\n";      # EXTERN file defined in xref.pl
996         }
997 }
998
999 # The %Depend array records the functions we use to process the configuration
1000 # lines in the unit, with a special meaning. It is important that all the
1001 # known control symbols be listed below, so that metalint does not complain.
1002 # The %Lcmp array contains valid layouts and their comparaison value.
1003 sub main'load_init_depend {
1004         package main;
1005         %Depend = (
1006                 'MAKE', 'p_make',                               # The ?MAKE: line records dependencies
1007                 'INIT', 'p_init',                               # Initializations printed verbatim
1008                 'LINT', 'p_lint',                               # Hints for metalint
1009                 'RCS', 'p_ignore',                              # RCS comments are ignored
1010                 'C', 'p_c',                                             # C symbols
1011                 'D', 'p_default',                               # Default value for conditional symbols
1012                 'E', 'p_example',                               # Example of usage
1013                 'F', 'p_file',                                  # Produced files
1014                 'H', 'p_config',                                # Process the config.h lines
1015                 'I', 'p_include',                               # Added includes
1016                 'L', 'p_library',                               # Added libraries
1017                 'M', 'p_magic',                                 # Process the confmagic.h lines
1018                 'O', 'p_obsolete',                              # Unit obsolescence
1019                 'P', 'p_public',                                # Location of PD implementation file
1020                 'S', 'p_shell',                                 # Shell variables
1021                 'T', 'p_temp',                                  # Shell temporaries used
1022                 'V', 'p_visible',                               # Visible symbols like 'rp', 'dflt'
1023                 'W', 'p_wanted',                                # Wanted value for interpreter
1024                 'X', 'p_ignore',                                # User comment is ignored
1025                 'Y', 'p_layout',                                # User-defined layout preference
1026         );
1027         %Lcmp = (
1028                 'top',          -1,
1029                 'default',      0,
1030                 'bottom',       1,
1031         );
1032 }
1033
1034 # Extract dependencies from units held in @ARGV
1035 sub main'load_extract_dependencies {
1036         package main;
1037         local($proc);                                           # Procedure used to handle a ctrl line
1038         local($file);                                           # Current file scanned
1039         local($dir, $unit);                                     # Directory and unit's name
1040         local($old_version) = 0;                        # True when old-version unit detected
1041         local($mc) = "$MC/U";                           # Public metaconfig directory
1042         local($line);                                           # Last processed line for metalint
1043
1044         printf "Extracting dependency lists from %d units...\n", $#ARGV+1
1045                 unless $opt_s;
1046
1047         chdir $WD;                                                      # Back to working directory
1048         &init_extraction;                                       # Initialize extraction files
1049         $dependencies = ' ' x (50 * @ARGV);     # Pre-extend
1050         $dependencies = '';
1051
1052         # We do not want to use the <> construct here, because we need the
1053         # name of the opened files (to get the unit's name) and we want to
1054         # reset the line number for each files, and do some pre-processing.
1055
1056         file: while ($file = shift(@ARGV)) {
1057                 close FILE;                                             # Reset line number
1058                 $old_version = 0;                               # True if unit is an old version
1059                 if (open(FILE, $file)) {
1060                         ($dir, $unit) = ('', $file)
1061                                 unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
1062                         $unit =~ s|\.U$||;                      # Remove extension
1063                 } else {
1064                         warn("Can't open $file.\n");
1065                 }
1066                 # If unit is in the standard public directory, keep only the unit name
1067                 $file = "$unit.U" if $dir eq $mc;
1068                 print "$dir/$unit.U:\n" if $opt_d;
1069                 line: while (<FILE>) {
1070                         $line = $_;                                     # Save last processed unit line
1071                         if (s/^\?([\w\-]+)://) {        # We may have found a control line
1072                                 $proc = $Depend{$1};    # Look for a procedure to handle it
1073                                 unless ($proc) {                # Unknown control line
1074                                         $proc = $1;                     # p_unknown expects symbol in '$proc'
1075                                         eval '&p_unknown';      # Signal error (metalint only)
1076                                         next line;                      # And go on next line
1077                                 }
1078                                 # Long lines may be escaped with a final backslash
1079                                 $_ .= &complete_line(FILE) if s/\\\s*$//;
1080                                 # Run macros substitutions
1081                                 s/%</$unit/g;                   # %< expands into the unit's name
1082                                 if (s/%\*/$unit/) {
1083                                         # %* expanded into the entire set of defined symbols
1084                                         # in the old version. Now it is only the unit's name.
1085                                         ++$old_version;
1086                                 }
1087                                 eval { &$proc($_) };            # Process the line
1088                         } else {
1089                                 next file unless $body;         # No procedure to handle body
1090                                 do {
1091                                         $line = $_;                             # Save last processed unit line
1092                                         eval { &$body($_) } ;   # From now on, it's the unit body
1093                                 } while (defined ($_ = <FILE>));
1094                                 next file;
1095                         }
1096                 }
1097         } continue {
1098                 warn("    Warning: $file is a pre-3.0 version.\n") if $old_version;
1099                 &$ending($line) if $ending;                     # Post-processing for metalint
1100         }
1101
1102         &end_extraction;                # End the extraction process
1103 }
1104
1105 # The first line was escaped with a final \ character. Every following line
1106 # is to be appended to it (until we found a real \n not escaped). Note that
1107 # the leading spaces of the continuation line are removed, so any space should
1108 # be added before the former \ if needed.
1109 sub main'load_complete_line {
1110         package main;
1111         local($file) = @_;              # File where lines come from
1112         local($_);
1113         local($read) = '';              # Concatenation of all the continuation lines found
1114         while (<$file>) {
1115                 s/^\s+//;                               # Remove leading spaces
1116                 if (s/\\\s*$//) {               # Still followed by a continuation line
1117                         $read .= $_;    
1118                 } else {                                # We've reached the end of the continuation
1119                         return $read . $_;
1120                 }
1121         }
1122 }
1123
1124 # Extract filenames from manifest
1125 sub main'load_extract_filenames {
1126         package main;
1127         &build_filext;                  # Construct &is_cfile and &is_shfile
1128         print "Extracting filenames (C and SH files) from $NEWMANI...\n"
1129                 unless $opt_s;
1130         open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n";
1131         local($file);
1132         while (<NEWMANI>) {
1133                 ($file) = split(' ');
1134                 next if $file eq 'config_h.SH';                 # skip config_h.SH
1135                 next if $file eq 'Configure';                   # also skip Configure
1136                 next if $file eq 'confmagic.h' && $opt_M;
1137                 push(@SHlist, $file) if &is_shfile($file);
1138                 push(@clist, $file) if &is_cfile($file);
1139         }
1140 }
1141
1142 # Construct two file identifiers based on the file suffix: one for C files,
1143 # and one for SH files (using the $cext and $shext variables) defined in
1144 # the .package file.
1145 # The &is_cfile and &is_shfile routine may then be called to known whether
1146 # a given file is a candidate for holding C or SH symbols.
1147 sub main'load_build_filext {
1148         package main;
1149         &build_extfun('is_cfile', $cext, '.c .h .y .l');
1150         &build_extfun('is_shfile', $shext, '.SH');
1151 }
1152
1153 # Build routine $name to identify extensions listed in $exts, ensuring
1154 # that $minimum is at least matched (both to be backward compatible with
1155 # older .package and because it is really the minimum requirred).
1156 sub main'load_build_extfun {
1157         package main;
1158         local($name, $exts, $minimum) = @_;
1159         local(@single);         # Single letter dot extensions (may be grouped)
1160         local(@others);         # Other extensions
1161         local(%seen);           # Avoid duplicate extensions
1162         foreach $ext (split(' ', "$exts $minimum")) {
1163                 next if $seen{$ext}++;
1164                 if ($ext =~ s/^\.(\w)$/$1/) {
1165                         push(@single, $ext);
1166                 } else {
1167                         # Convert into perl's regexp
1168                         $ext =~ s/\./\\./g;             # Escape .
1169                         $ext =~ s/\?/./g;               # ? turns into .
1170                         $ext =~ s/\*/.*/g;              # * turns into .*
1171                         push(@others, $ext);
1172                 }
1173         }
1174         local($fn) = &q(<<EOF);         # Function being built
1175 :sub $name {
1176 :       local(\$_) = \@_;
1177 EOF
1178         local($single);         # Single regexp: .c .h grouped into .[ch]
1179         $single = '\.[' . join('', @single) . ']' if @single;
1180         $fn .= &q(<<EOL) if @single;
1181 :       return 1 if /$single\$/;
1182 EOL
1183         foreach $ext (@others) {
1184                 $fn .= &q(<<EOL);
1185 :       return 1 if /$ext\$/;
1186 EOL
1187         }
1188         $fn .= &q(<<EOF);
1189 :       0;      # None of the extensions may be applied to file name
1190 :}
1191 EOF
1192         print $fn if $opt_d;
1193         eval $fn;
1194         chop($@) && die "Can't compile '$name':\n$fn\n$@.\n";
1195 }
1196
1197 # Remove ':' quotations in front of the lines
1198 sub main'load_q {
1199         package main;
1200         local($_) = @_;
1201         #ocal($*) =1;
1202         s/^://gm;
1203         $_;
1204 }
1205
1206 # Build a wanted file from the files held in @SHlist and @clist arrays
1207 sub main'load_build_wanted {
1208         package main;
1209         # If wanted file is already there, parse it to map obsolete if -o option
1210         # was used. Otherwise, build a new one.
1211         if (-f 'Wanted') {
1212                 &map_obsolete if $opt_o;                        # Build Obsol*.U files
1213                 &dump_obsolete;                                         # Dump obsolete symbols if any
1214                 return;
1215         }
1216         &parse_files;
1217 }
1218
1219 sub main'load_parse_files {
1220         package main;
1221         print "Building a Wanted file...\n" unless $opt_s;
1222         open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n";
1223         unless (-f $NEWMANI) {
1224                 &manifake;
1225                 die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI;
1226         }
1227
1228         local($search);                                                 # Where to-be-evaled script is held
1229         local($_) = ' ' x 50000 if $opt_m;              # Pre-extend pattern search space
1230         local(%visited);                                                # Records visited files
1231         local(%lastfound);                                              # Where last occurence of key was
1232
1233         # Now we are a little clever, and build a loop to eval so that we don't
1234         # have to recompile our patterns on every file.  We also use "study" since
1235         # we are searching the same string for many different things.  Hauls!
1236
1237         if (@clist) {
1238                 local($others) = $cext ? " $cext" : '';
1239                 print "    Scanning .[chyl]$others files for symbols...\n"
1240                         unless $opt_s;
1241                 $search = ' ' x (40 * (@cmaster + @ocmaster));  # Pre-extend
1242                 $search = "while (<>) {study;\n";                               # Init loop over ARGV
1243                 foreach $key (keys(%cmaster)) {
1244                         $search .= "&cmaster('$key') if /\\b$key\\b/;\n";
1245                 }
1246                 foreach $key (grep(!/^\$/, keys %Obsolete)) {
1247                         $search .= "&ofound('$key') if /\\b$key\\b/;\n";
1248                 }
1249                 $search .= "}\n";                       # terminate loop
1250                 print $search if $opt_d;
1251                 @ARGV = @clist;
1252                 # Swallow each file as a whole, if memory is available
1253                 undef $/ if $opt_m;
1254                 eval $search;
1255                 eval '';
1256                 $/ = "\n";
1257                 while (($key,$value) = each(%cmaster)) {
1258                         print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value;
1259                 }
1260         }
1261
1262         # If they don't use magic but use magically guarded symbols without
1263         # their corresponding C symbol dependency, warn them, since they might
1264         # not know about that portability issue.
1265
1266         if (@clist && !$opt_M) {
1267                 local($nused);                                  # list of non-used symbols
1268                 local($warning) = 0;                    # true when one warning issued
1269                 foreach $cmag (keys %mwanted) { # loop over all used magic symbols
1270                         next unless $cmaster{$cmag};
1271                         $nused = '';
1272                         foreach $cdep (split(' ', $mwanted{$cmag})) {
1273                                 $nused .= " $cdep" unless $cmaster{$cdep};
1274                         }
1275                         $nused =~ s/^ //;
1276                         $nused = "one of " . $nused if $nused =~ s/ /, /g;
1277                         if ($nused ne '') {
1278                                 print "    Warning: $cmag is used without $nused.\n";
1279                                 $warning++;
1280                         }
1281                 }
1282                 if ($warning) {
1283                         local($those) = $warning == 1 ? 'that' : 'those';
1284                         local($s) = $warning == 1 ? '' : 's';
1285                         print "Note: $those previous warning$s may be suppressed by -M.\n";
1286                 }
1287         }
1288
1289         # Cannot remove $cmaster as it is used later on when building Configure
1290         undef @clist;
1291         undef %cwanted;
1292         undef %mwanted;
1293         %visited = ();
1294         %lastfound = ();
1295
1296         if (@SHlist) {
1297                 local($others) = $shext ? " $shext" : '';
1298                 print "    Scanning .SH$others files for symbols...\n" unless $opt_s;
1299                 $search = ' ' x (40 * (@shmaster + @oshmaster));        # Pre-extend
1300                 $search = "while (<>) {study;\n";
1301                 # All the keys already have a leading '$'
1302                 foreach $key (keys(%shmaster)) {
1303                         $search .= "&shmaster('$key') if /\\$key\\b/;\n";
1304                 }
1305                 foreach $key (grep (/^\$/, keys %Obsolete)) {
1306                         $search .= "&ofound('$key') if /\\$key\\b/;\n";
1307                 }
1308                 $search .= "}\n";
1309                 print $search if $opt_d;
1310                 @ARGV = @SHlist;
1311                 # Swallow each file as a whole, if memory is available
1312                 undef $/ if $opt_m;
1313                 eval $search;
1314                 eval '';
1315                 $/ = "\n";
1316                 while (($key,$value) = each(%shmaster)) {
1317                         if ($value) {
1318                                 $key =~ s/^\$//;
1319                                 print WANTED $key, "\n";
1320                         }
1321                 }
1322         }
1323
1324         # Obsolete symbols, if any, are written in the Wanted file preceded by a
1325         # '!' character. In case -w is used, we'll thus be able to correctly build
1326         # the Obsol_h.U and Obsol_sh.U files.
1327
1328         &add_obsolete;                                          # Add obsolete symbols in Wanted file
1329
1330         close WANTED;
1331
1332         # If obsolete symbols where found, write an Obsolete file which lists where
1333         # each of them appear and the new symbol to be used. Also write Obsol_h.U
1334         # and Obsol_sh.U in .MT for later perusal.
1335
1336         &dump_obsolete;                                         # Dump obsolete symbols if any
1337
1338         die "No desirable symbols found--aborting.\n" unless -s 'Wanted';
1339
1340         # Clean-up memory by freeing useless data structures
1341         undef @SHlist;
1342         undef %shmaster;
1343 }
1344
1345 # This routine records matches of C master keys
1346 sub main'load_cmaster {
1347         package main;
1348         local($key) = @_;
1349         $cmaster{$key}++;                                       # This symbol is wanted
1350         return unless $opt_t || $opt_M;         # Return if neither -t nor -M
1351         if ($opt_t &&
1352                 $lastfound{$key} ne $ARGV               # Never mentionned for this file ?
1353         ) {
1354                 $visited{$ARGV}++ || print $ARGV,":\n";
1355                 print "\t$key\n";
1356                 $lastfound{$key} = $ARGV;
1357         }
1358         if ($opt_M &&
1359                 defined($mwanted{$key})                 # Found a ?M: symbol
1360         ) {
1361                 foreach $csym (split(' ', $mwanted{$key})) {
1362                         $cmaster{$csym}++;                      # Activate C symbol dependencies
1363                 }
1364         }
1365 }
1366
1367 # This routine records matches of obsolete keys (C or shell)
1368 sub main'load_ofound {
1369         package main;
1370         local($key) = @_;
1371         local($_) = $Obsolete{$key};            # Value of new symbol
1372         $ofound{"$ARGV $key $_"}++;                     # Record obsolete match
1373         $cmaster{$_}++ unless /^\$/;            # A C hit
1374         $shmaster{$_}++ if /^\$/;                       # Or a shell one
1375         return unless $opt_t;                           # Continue if trace option on
1376         if ($lastfound{$key} ne $ARGV) {        # Never mentionned for this file ?
1377                 $visited{$ARGV}++ || print $ARGV,":\n";
1378                 print "\t$key (obsolete, use $_)\n";
1379                 $lastfound{$key} = $ARGV;
1380         }
1381 }
1382
1383 # This routine records matches of shell master keys
1384 sub main'load_shmaster {
1385         package main;
1386         local($key) = @_;
1387         $shmaster{$key}++;                                      # This symbol is wanted
1388         return unless $opt_t;                           # Continue if trace option on
1389         if ($lastfound{$key} ne $ARGV) {        # Never mentionned for this file ?
1390                 $visited{$ARGV}++ || print $ARGV,":\n";
1391                 print "\t$key\n";
1392                 $lastfound{$key} = $ARGV;
1393         }
1394 }
1395
1396 # Write obsolete symbols into the Wanted file for later perusal by -w.
1397 sub main'load_add_obsolete {
1398         package main;
1399         local($file);                                           # File where obsolete symbol was found
1400         local($old);                                            # Name of this old symbol
1401         local($new);                                            # Value of the new symbol to be used
1402         foreach $key (sort keys %ofound) {
1403                 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1404                 if ($new =~ s/^\$//) {                  # We found an obsolete shell symbol
1405                         print WANTED "!$old\n";
1406                 } else {                                                # We found an obsolete C symbol
1407                         print WANTED "!>$old\n";
1408                 }
1409         }
1410 }
1411
1412 # Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete
1413 # to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed
1414 # during the Configure building phase to actually do the remaping.
1415 # The obsolete symbols found are entered in the %ofound array, tagged as from
1416 # file 'XXX', which is specially recognized by dump_obsolete.
1417 sub main'load_map_obsolete {
1418         package main;
1419         open(WANTED, 'Wanted') || die "Can't open Wanted file.\n";
1420         local($new);                            # New symbol to be used instead of obsolete one
1421         while (<WANTED>) {
1422                 chop;
1423                 next unless s/^!//;             # Skip non-obsolete symbols
1424                 if (s/^>//) {                                   # C symbol
1425                         $new = $Obsolete{$_};           # Fetch new symbol
1426                         $ofound{"XXX $_ $new"}++;       # Record obsolete match (XXX = no file)
1427                 } else {                                                # Shell symbol
1428                         $new = $Obsolete{"\$$_"};       # Fetch new symbol
1429                         $ofound{"XXX \$$_ $new"}++;     # Record obsolete match (XXX = no file)
1430                 }
1431         }
1432         close WANTED;
1433 }
1434
1435 # Record obsolete symbols association (new versus old), that is to say for a
1436 # given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
1437 # for all shell variables
1438 sub main'load_record_obsolete {
1439         package main;
1440         local($_) = @_;
1441         local(@obsoleted);                                      # List of obsolete symbols
1442         local($symbol);                                         # New symbol which must be used
1443         local($dollar) = s/^\$// ? '$':'';      # The '$' or a null string
1444         # Syntax for obsolete symbols specification is
1445         #    list of symbols (obsolete ones):
1446         if (/^(\w+)\s*\((.*)\)\s*:$/) {
1447                 $symbol = "$dollar$1";
1448                 @obsoleted = split(' ', $2);            # List of obsolete symbols
1449         } else {
1450                 if (/^(\w+)\s*\((.*):$/) {
1451                         warn "\"$file\", line $.: final ')' before ':' missing.\n";
1452                         $symbol = "$dollar$1";
1453                         @obsoleted = split(' ', $2);
1454                 } else {
1455                         warn "\"$file\", line $.: syntax error.\n";
1456                         return;
1457                 }
1458         }
1459         foreach $val (@obsoleted) {
1460                 $_ = $dollar . $val;
1461                 if (defined $Obsolete{$_}) {
1462                 warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
1463                 } else {
1464                         $Obsolete{$_} = $symbol;        # Record (old, new) tuple
1465                 }
1466         }
1467 }
1468
1469 # Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
1470 # Obsol_sh.U to record old versus new mappings if the -o option was used.
1471 sub main'load_dump_obsolete {
1472         package main;
1473         unless (-f 'Obsolete') {
1474                 open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
1475         }
1476         open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
1477         open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
1478         local($file);                                           # File where obsolete symbol was found
1479         local($old);                                            # Name of this old symbol
1480         local($new);                                            # Value of the new symbol to be used
1481         # Leave a blank line at the top so that anny added ^L will stand on a line
1482         # by itself (the formatting process adds a ^L when a new page is needed).
1483         format OBSOLETE_TOP =
1484
1485               File                 |      Old symbol      |      New symbol
1486 -----------------------------------+----------------------+---------------------
1487 .
1488         format OBSOLETE =
1489 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
1490 $file,                               $old,                  $new
1491 .
1492         local(%seen);
1493         foreach $key (sort keys %ofound) {
1494                 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1495                 write(OBSOLETE) unless $file eq 'XXX';
1496                 next unless $opt_o;                             # Obsolete mapping done only with -o
1497                 next if $seen{$old}++;                  # Already remapped, thank you
1498                 if ($new =~ s/^\$//) {                  # We found an obsolete shell symbol
1499                         $old =~ s/^\$//;
1500                         print OBSOL_SH "$old=\"\$$new\"\n";
1501                 } else {                                                # We found an obsolete C symbol
1502                         print OBSOL_H "#ifdef $new\n";
1503                         print OBSOL_H "#define $old $new\n";
1504                         print OBSOL_H "#endif\n\n";
1505                 }
1506         }
1507         close OBSOLETE;
1508         close OBSOL_H;
1509         close OBSOL_SH;
1510         if (-s 'Obsolete') {
1511                 print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
1512         } else {
1513                 unlink 'Obsolete';
1514         }
1515         undef %ofound;                          # Not needed any more
1516 }
1517
1518 # Build the private makefile we use to compute the transitive closure of the
1519 # previously determined dependencies.
1520 sub main'load_build_makefile {
1521         package main;
1522         print "Computing optimal dependency graph...\n" unless $opt_s;
1523         chdir('.MT') || die "Can't chdir to .MT\n";
1524         local($wanted);                 # Wanted shell symbols
1525         &build_private;                 # Build a first makefile from dependencies
1526         &compute_loadable;              # Compute loadable units
1527         &update_makefile;               # Update makefile using feedback from first pass
1528         chdir($WD) || die "Can't chdir back to $WD\n";
1529         # Free memory by removing useless data structures
1530         undef $dependencies;
1531         undef $saved_dependencies;
1532 }
1533
1534 # First pass: build a private makefile from the extracted dependency, changing
1535 # conditional units to truly wanted ones if the symbol is used, removing the
1536 # dependency otherwise. The original dependencies are saved.
1537 sub main'load_build_private {
1538         package main;
1539         print "    Building private make file...\n" unless $opt_s;
1540         open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n";
1541         $wanted = ' ' x 2000;   # Pre-extend string
1542         $wanted = '';
1543         while (<WANTED>) {
1544                 chop;
1545                 next if /^!/;           # Skip obsolete symbols
1546                 if (s/^>//) {
1547                         $cmaster{$_}++;
1548                 } else {
1549                         $wanted .= "$_ ";
1550                 }
1551         }
1552         close WANTED;
1553
1554         # The wanted symbols are sorted so that d_* (checking for C library symbol)
1555         # come first and i_* (checking for includes) comes at the end. Grouping the
1556         # d_* symbols together has good chances of improving the locality of the
1557         # other questions and i_* symbols must come last since some depend on h_*
1558         # values which prevent incompatible headers inclusions.
1559         $wanted = join(' ', sort symbols split(' ', $wanted));
1560
1561         # Now generate the first makefile, which will be used to determine which
1562         # symbols we really need, so that conditional dependencies may be solved.
1563         open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1564         print MAKEFILE "SHELL = /bin/sh\n";
1565         print MAKEFILE "W = $wanted\n";
1566         $saved_dependencies = $dependencies;
1567         foreach $sym (@Cond) {
1568                 if ($symwanted{$sym}) {
1569                         $dependencies =~ s/\+($sym\s)/$1/gm;
1570                 } else {
1571                         $dependencies =~ s/\+$sym(\s)/$1/gm;
1572                 }
1573         }
1574         print MAKEFILE $dependencies;
1575         close MAKEFILE;
1576 }
1577
1578 # Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones.
1579 # If any layout priority is defined in %Layout, it is used to order the
1580 # symbols.
1581 sub main'load_symbols {
1582         package main;
1583         local($r) = $Layout{$a} <=> $Layout{$b};
1584         return $r if $r;
1585         # If we come here, both symbols have the same layout priority.
1586         if ($a =~ /^d_/) {
1587                 return -1 unless $b =~ /^d_/;
1588         } elsif ($b =~ /^d_/) {
1589                 return 1;
1590         } elsif ($a =~ /^i_/) {
1591                 return 1 unless $b =~ /^i_/;
1592         } elsif ($b =~ /^i_/) {
1593                 return -1;
1594         }
1595         $a cmp $b;
1596 }
1597
1598 # Run the makefile produced in the first pass to find the whole set of units we
1599 # have to load, filling in the %symwanted and %condwanted structures.
1600 sub main'load_compute_loadable {
1601         package main;
1602         print "    Determining loadable units...\n" unless $opt_s;
1603         open(MAKE, "make -n |") || die "Can't run make";
1604         while (<MAKE>) {
1605                 s|^\s+||;                               # Some make print tabs before command
1606                 if (/^pick/) {
1607                         print "\t$_" if $opt_v;
1608                         ($pick,$cmd,$symbol,$unit) = split(' ');
1609                         $symwanted{$symbol}++;
1610                         $symwanted{$unit}++;
1611                 } elsif (/^cond/) {
1612                         print "\t$_" if $opt_v;
1613                         ($pick,@symbol) = split(' ');
1614                         for (@symbol) {
1615                                 $condwanted{$_}++;      # Default value is requested
1616                         }
1617                 }
1618         }
1619         close MAKE;
1620 }
1621
1622 # Back to the original dependencies, make loadable units truly wanted ones and
1623 # remove optional ones.
1624 sub main'load_update_makefile {
1625         package main;
1626         print "    Updating make file...\n" unless $opt_s;
1627         open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n";
1628         print MAKEFILE "SHELL = /bin/sh\n";
1629         print MAKEFILE "W = $wanted\n";
1630         foreach $sym (@Cond) {
1631                 if ($symwanted{$sym}) {
1632                         $saved_dependencies =~ s/\+($sym\s)/$1/gm;
1633                 } else {
1634                         $saved_dependencies =~ s/\+$sym(\s)/$1/gm;
1635                 }
1636         }
1637         print MAKEFILE $saved_dependencies;
1638         close MAKEFILE;
1639 }
1640
1641 # Solve dependencies by saving the 'pick' command in @cmdwanted
1642 sub main'load_solve_dependencies {
1643         package main;
1644         local(%unitseen);                       # Record already picked units (avoid duplicates)
1645         print "Determining the correct order for the units...\n" unless $opt_s;
1646         chdir('.MT') || die "Can't chdir to .MT: $!.\n";
1647         open(MAKE, "make -n |") || die "Can't run make";
1648         while (<MAKE>) {
1649                 s|^\s+||;                               # Some make print tabs before command
1650                 print "\t$_" if $opt_v;
1651                 if (/^pick/) {
1652                         ($pick,$cmd,$symbol,$unit) = split(' ');
1653                         push(@cmdwanted,"$cmd $symbol $unit")
1654                                 unless $unitseen{"$cmd:$unit"}++;
1655                 } elsif (/^cond/) {
1656                         # Ignore conditional symbol request
1657                 } else {
1658                         chop;
1659                         system;
1660                 }
1661         }
1662         chdir($WD) || die "Can't chdir to $WD: $!.\n";
1663         close MAKE;
1664 }
1665
1666 # Create the Configure script
1667 sub main'load_create_configure {
1668         package main;
1669         print "Creating Configure...\n" unless $opt_s;
1670         open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n";
1671         open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n";
1672         if ($opt_M) {
1673                 open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n";
1674         }
1675
1676         chdir('.MT') || die "Can't cd to .MT: $!\n";
1677         for (@cmdwanted) {
1678                 &process_command($_);           # Run the makefile command
1679         }
1680         chdir($WD) || die "Can't cd back to $WD\n";
1681         close CONFIGURE;
1682         print CONF_H "#endif\n";                # Close the opened #ifdef (see Config_h.U)
1683         print CONF_H "!GROK!THIS!\n";
1684         close CONF_H;
1685         if ($opt_M) {
1686                 print MAGIC_H "#endif\n";       # Close the opened #ifdef (see Magic_h.U)
1687                 close MAGIC_H;
1688         }
1689         `chmod +x Configure`;
1690 }
1691
1692 # Process a Makefile 'pick' command
1693 sub main'load_process_command {
1694         package main;
1695         local($cmd, $target, $unit_name) = split(' ', $_[0]);
1696         local($name) = $unit_name . '.U';       # Restore missing .U
1697         local($file) = $name;                           # Where unit is located
1698         unless ($file =~ m|^\./|) {                     # Unit produced earlier by metaconfig
1699                 $file = $Unit{$unit_name};              # Fetch unit from U directory
1700         }
1701         if (defined $Obsolete{$name}) {         # Signal use of an obsolete unit
1702                 warn "\tObsolete unit $name is used:\n";
1703                 local(@msg) = split(/\n/, $Obsolete{$name});
1704                 foreach $msg (@msg) {
1705                         warn "\t    $msg\n";
1706                 }
1707         }
1708         die "Can't open $file.\n" unless open(UNIT, $file);
1709         print "\t$cmd $file\n" if $opt_v;
1710         &init_interp;                                           # Initializes the interpreter
1711
1712         # The 'add' command adds the unit to Configure.
1713         if ($cmd eq 'add') {
1714                 while (<UNIT>) {
1715                         print CONFIGURE unless &skipped || !&interpret($_);
1716                 }
1717         }
1718
1719         # The 'weed' command adds the unit to Configure, but
1720         # makes some tests for the lines starting with '?' or '%'.
1721         # These lines are kept only if the symbol is wanted.
1722         elsif ($cmd eq 'weed') {
1723                 while (<UNIT>) {
1724                         if (/^\?(\w+):/) {
1725                                 s/^\?\w+:// if $symwanted{$1};
1726                         }
1727                         if (/^%(\w+):/) {
1728                                 s/^%\w+:// if $condwanted{$1};
1729                         }
1730                         print CONFIGURE unless &skipped || !&interpret($_);
1731                 }
1732         }
1733
1734         # The 'wipe' command adds the unit to Configure, but
1735         # also substitues some hardwired macros.
1736         elsif ($cmd eq 'wipe') {
1737                 while (<UNIT>) {
1738                         s/<PACKAGENAME>/$package/g;
1739                         s/<MAINTLOC>/$maintloc/g;
1740                         s/<VERSION>/$version/g;                 # This is metaconfig's version
1741                         s/<PATCHLEVEL>/$patchlevel/g;   # And patchlevel information
1742                         s/<DATE>/$date/g;
1743                         s/<BASEREV>/$baserev/g;
1744                         s/<\$(\w+)>/eval("\$$1")/ge;    # <$var> -> $var substitution
1745                         print CONFIGURE unless &skipped || !&interpret($_);
1746                 }
1747         }
1748
1749         # The 'add.Null' command adds empty initializations
1750         # to Configure for all the shell variable used.
1751         elsif ($cmd eq 'add.Null') {
1752                 for (sort @Master) {
1753                         if (/^\?(\w+):/) {
1754                                 s/^\?\w+:// if $symwanted{$1};
1755                         }
1756                         print CONFIGURE unless &skipped;
1757                 }
1758                 for (sort @Cond) {
1759                         print CONFIGURE "$_=''\n"
1760                                 unless $symwanted{$_} || $hasdefault{$_};
1761                 }
1762                 while (<UNIT>) {
1763                         print CONFIGURE unless &skipped || !&interpret($_);
1764                 }
1765                 print CONFIGURE "CONFIG=''\n\n";
1766         }
1767
1768         # The 'add.Config_sh' command fills in the production of
1769         # the config.sh script within Configure. Only the used
1770         # variable are added, the conditional ones are skipped.
1771         elsif ($cmd eq 'add.Config_sh') {
1772                 while (<UNIT>) {
1773                         print CONFIGURE unless &skipped || !&interpret($_);
1774                 }
1775                 for (sort @Master) {
1776                         if (/^\?(\w+):/) {
1777                                 # Can't use $shmaster, because config.sh must
1778                                 # also contain some internal defaults used by
1779                                 # Configure (e.g. nm_opt, libc, etc...).
1780                                 s/^\?\w+:// if $symwanted{$1};
1781                         }
1782                         s/^(\w+)=''/$1='\$$1'/;
1783                         print CONFIGURE unless &skipped;
1784                 }
1785         }
1786
1787         # The 'close.Config_sh' command adds the final EOT line at
1788         # the end of the here-document construct which produces the
1789         # config.sh file within Configure.
1790         elsif ($cmd eq 'close.Config_sh') {
1791                 print CONFIGURE "EOT\n\n";      # Ends up file
1792         }
1793
1794         # The 'c_h_weed' command produces the config_h.SH file.
1795         # Only the necessary lines are kept. If no conditional line is
1796         # ever printed, then the file is useless and will be removed.
1797         elsif ($cmd eq 'c_h_weed') {
1798                 $printed = 0;
1799                 while (<UNIT>) {
1800                         if (/^\?(\w+):/) {
1801                                 s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1802                         }
1803                         unless (&skipped || !&interpret($_)) {
1804                                 if (/^$/) {
1805                                         print CONF_H "\n" if $printed;
1806                                         $printed = 0;
1807                                 } else {
1808                                         print CONF_H;
1809                                         ++$printed;
1810                                 }
1811                         }
1812                 }
1813         }
1814
1815         # The 'cm_h_weed' command produces the confmagic.h file.
1816         # Only the necessary lines are kept. If no conditional line is
1817         # ever printed, then the file is useless and will be removed.
1818         elsif ($cmd eq 'cm_h_weed') {
1819                 if ($opt_M) {
1820                         $printed = 0;
1821                         while (<UNIT>) {
1822                                 if (/^\?(\w+):/) {
1823                                         s/^\?\w+:// if $cmaster{$1} || $symwanted{$1};
1824                                 }
1825                                 unless (&skipped || !&interpret($_)) {
1826                                         if (/^$/) {
1827                                                 print MAGIC_H "\n" if $printed;
1828                                                 $printed = 0;
1829                                         } else {
1830                                                 print MAGIC_H;
1831                                                 ++$printed;
1832                                         }
1833                                 }
1834                         }
1835                 }
1836         }
1837
1838         # The 'prepend' command will add the content of the target to
1839         # the current file (held in $file, the one which UNIT refers to),
1840         # if the file is not empty.
1841         elsif ($cmd eq 'prepend') {
1842                 if (-s $file) {
1843                         open(PREPEND, ">.prepend") ||
1844                                 die "Can't create .MT/.prepend.\n";
1845                         open(TARGET, $Unit{$target}) ||
1846                                 die "Can't open $Unit{$target}.\n";
1847                         while (<TARGET>) {
1848                                 print PREPEND unless &skipped;
1849                         }
1850                         print PREPEND <UNIT>;   # Now add original file contents
1851                         close PREPEND;
1852                         close TARGET;
1853                         rename('.prepend', $file) ||
1854                                 die "Can't rename .prepend into $file.\n";
1855                 }
1856         }
1857
1858         # Command not found
1859         else {
1860                 die "Unrecognized command from Makefile: $cmd\n";
1861         }
1862         &check_state;           # Make sure there are no pending statements
1863         close UNIT;
1864 }
1865
1866 # Skip lines starting with ? or %, including all the following continuation
1867 # lines, if any. Return 0 if the line was not to be skipped, 1 otherwise.
1868 sub main'load_skipped {
1869         package main;
1870         return 0 unless /^\?|^%/;
1871         &complete_line(UNIT) if /\\\s*$/;       # Swallow continuation lines
1872         1;
1873 }
1874
1875 # Update the MANIFEST.new file if necessary
1876 sub main'load_cosmetic_update {
1877         package main;
1878         # Check for an "empty" config_h.SH (2 blank lines only). This test relies
1879         # on the actual text held in Config_h.U. If the unit is modified, then the
1880         # following might need adjustments.
1881         local($blank_lines) = 0;
1882         local($spaces) = 0;
1883         open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n";
1884         while(<CONF_H>) {
1885                 ++$blank_lines if /^$/;
1886         }
1887         unlink 'config_h.SH' unless $blank_lines > 3;
1888
1889         open(NEWMANI,$NEWMANI);
1890         $_ = <NEWMANI>;
1891         /(\S+\s+)\S+/ && ($spaces = length($1));        # Spaces wanted
1892         close NEWMANI;
1893         $spaces = 29 if ($spaces < 12);                         # Default value
1894         open(NEWMANI,$NEWMANI);
1895         $/ = "\001";                    # Swallow the whole file
1896         $_ = <NEWMANI>;
1897         $/ = "\n";
1898         close NEWMANI;
1899
1900         &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m;
1901         &mani_add('config_h.SH', 'Produces config.h', $spaces)
1902                 unless /^config_h\.SH\b/m || !-f 'config_h.SH';
1903         &mani_add('confmagic.h', 'Magic symbol remapping', $spaces)
1904                 if $opt_M && !/^confmagic\.h\b/m;
1905
1906         &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH';
1907         &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M;
1908
1909         if ($opt_G) {                   # Want a GNU-like configure wrapper
1910                 &add_configure;
1911                 &mani_add('configure', 'GNU configure-like wrapper', $spaces)
1912                         if !/^configure\s/m && -f 'configure';
1913         } else {
1914                 &mani_remove('configure') if /^configure\s/m && !-f 'configure';
1915         }
1916 }
1917
1918 # Add file to MANIFEST.new, with properly indented comment
1919 sub main'load_mani_add {
1920         package main;
1921         local($file, $comment, $spaces) = @_;
1922         print "Adding $file to your $NEWMANI file...\n" unless $opt_s;
1923         open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n";
1924         local($blank) = ' ' x ($spaces - length($file));
1925         print NEWMANI "${file}${blank}${comment}\n";
1926         close NEWMANI;
1927 }
1928
1929 # Remove file from MANIFEST.new
1930 sub main'load_mani_remove {
1931         package main;
1932         local($file) = @_;
1933         print "Removing $file from $NEWMANI...\n" unless $opt_s;
1934         unless (open(NEWMANI, ">$NEWMANI.x")) {
1935                 warn "Can't create backup $NEWMANI copy: $!\n";
1936                 return;
1937         }
1938         unless (open(OLDMANI, $NEWMANI)) {
1939                 warn "Can't open $NEWMANI: $!\n";
1940                 return;
1941         }
1942         local($_);
1943         while (<OLDMANI>) {
1944                 print NEWMANI unless /^$file\b/
1945         }
1946         close OLDMANI;
1947         close NEWMANI;
1948         rename("$NEWMANI.x", $NEWMANI) ||
1949                 warn "Couldn't restore $NEWMANI from $NEWMANI.x\n";
1950 }
1951
1952 # Copy GNU-like configure wrapper to the package root directory
1953 sub main'load_add_configure {
1954         package main;
1955         if (-f "$MC/configure") {
1956                 print "Copying GNU configure-like front end...\n" unless $opt_s;
1957                 system "cp $MC/configure ./configure";
1958                 `chmod +x configure`;
1959         } else {
1960                 warn "Can't locate $MC/configure: $!\n";
1961         }
1962 }
1963
1964 # States used by our interpeter -- in sync with @Keep
1965 sub main'load_init_keep {
1966         package interpreter;
1967         # Status in which we keep lines -- $Keep[$status]
1968         @Keep = (0, 1, 1, 0, 1);
1969
1970         # Available status ($status)
1971         $SKIP = 0;
1972         $IF = 1;
1973         $ELSE = 2;
1974         $NOT = 3;
1975         $OUT = 4;
1976 }
1977
1978 # Priorities for operators -- magic numbers :-)
1979 sub main'load_init_priority {
1980         package interpreter;
1981         $Priority{'&&'} = 4;
1982         $Priority{'||'} = 3;
1983 }
1984
1985 # Initializes the state stack of the interpreter
1986 sub main'load_init_interp {
1987         package interpreter;
1988         @state = ();
1989         push(@state, $OUT);
1990 }
1991
1992 # Print error messages -- asssumes $unit and $. correctly set.
1993 sub interpreter'load_error {
1994         package interpreter;
1995         warn "\"$main'file\", line $.: @_.\n";
1996 }
1997
1998 # If some states are still in the stack, warn the user
1999 sub main'load_check_state {
2000         package interpreter;
2001         &error("one statement pending") if $#state == 1;
2002         &error("$#state statements pending") if $#state > 1;
2003 }
2004
2005 # Add a value on the stack, modified by all the monadic operators.
2006 # We use the locals @val and @mono from eval_expr.
2007 sub interpreter'load_push_val {
2008         package interpreter;
2009         local($val) = shift(@_);
2010         while ($#mono >= 0) {
2011                 # Cheat... the only monadic operator is '!'.
2012                 pop(@mono);
2013                 $val = !$val;
2014         }
2015         push(@val, $val);
2016 }
2017
2018 # Execute a stacked operation, leave result in stack.
2019 # We use the locals @val and @op from eval_expr.
2020 # If the value stack holds only one operand, do nothing.
2021 sub interpreter'load_execute {
2022         package interpreter;
2023         return unless $#val > 0;
2024         local($op) = pop(@op);
2025         local($val1) = pop(@val);
2026         local($val2) = pop(@val);
2027         push(@val, eval("$val1 $op $val2") ? 1: 0);
2028 }
2029
2030 # Given an operator, either we add it in the stack @op, because its
2031 # priority is lower than the one on top of the stack, or we first execute
2032 # the stacked operations until we reach the end of stack or an operand
2033 # whose priority is lower than ours.
2034 # We use the locals @val and @op from eval_expr.
2035 sub interpreter'load_update_stack {
2036         package interpreter;
2037         local($op) = shift(@_);         # Operator
2038         if (!$Priority{$op}) {
2039                 &error("illegal operator $op");
2040                 return;
2041         } else {
2042                 if ($#val < 0) {
2043                         &error("missing first operand for '$op' (diadic operator)");
2044                         return;
2045                 }
2046                 # Because of the special behaviour of do-SUBR with the while modifier,
2047                 # I'm using a while-BLOCK construct. I consider this to be a bug of perl
2048                 # 4.0 PL19, although it is clearly documented in the man page.
2049                 while (
2050                         $Priority{$op[$#op]} > $Priority{$op}   # Higher priority op
2051                         && $#val > 0                                                    # At least 2 values
2052                 ) {
2053                         &execute;               # Execute an higher priority stacked operation
2054                 }
2055                 push(@op, $op);         # Everything at higher priority has been executed
2056         }
2057 }
2058
2059 # This is the heart of our little interpreter. Here, we evaluate
2060 # a logical expression and return its value.
2061 sub interpreter'load_eval_expr {
2062         package interpreter;
2063         local(*expr) = shift(@_);       # Expression to parse
2064         local(@val) = ();                       # Stack of values
2065         local(@op) = ();                        # Stack of diadic operators
2066         local(@mono) =();                       # Stack of monadic operators
2067         local($tmp);
2068         $_ = $expr;
2069         while (1) {
2070                 s/^\s+//;                               # Remove spaces between words
2071                 # The '(' construct
2072                 if (s/^\(//) {
2073                         &push_val(&eval_expr(*_));
2074                         # A final '\' indicates an end of line
2075                         &error("missing final parenthesis") if !s/^\\//;
2076                 }
2077                 # Found a ')' or end of line
2078                 elsif (/^\)/ || /^$/) {
2079                         s/^\)/\\/;                                              # Signals: left parenthesis found
2080                         $expr = $_;                                             # Remove interpreted stuff
2081                         &execute() while $#val > 0;             # Executed stacked operations
2082                         while ($#op >= 0) {
2083                                 $_ = pop(@op);
2084                                 &error("missing second operand for '$_' (diadic operator)");
2085                         }
2086                         return $val[0];
2087                 }
2088                 # A perl statement '{{'
2089                 elsif (s/^\{\{//) {
2090                         if (s/^(.*)\}\}//) {
2091                                 &push_val((system
2092                                         ('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
2093                                         ))? 0 : 1);
2094                         } else {
2095                                 &error("incomplete perl statement");
2096                         }
2097                 }
2098                 # A shell statement '{'
2099                 elsif (s/^\{//) {
2100                         if (s/^(.*)\}//) {
2101                                 &push_val((system
2102                                         ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
2103                                         ))? 0 : 1);
2104                         } else {
2105                                 &error("incomplete shell statement");
2106                         }
2107                 }
2108                 # Operator '||' and '&&'
2109                 elsif (s/^(\|\||&&)//) {
2110                         $tmp = $1;                      # Save for perl5 (Dataloaded update_stack)
2111                         &update_stack($tmp);
2112                 }
2113                 # Unary operator '!'
2114                 elsif (s/^!//) {
2115                         push(@mono,'!');
2116                 }
2117                 # Everything else is a test for a defined value
2118                 elsif (s/^([\?%]?\w+)//) {
2119                         $tmp = $1;
2120                         # Test for wanted
2121                         if ($tmp =~ s/^\?//) {
2122                                 &push_val(($main'symwanted{$tmp})? 1 : 0);
2123                         }
2124                         # Test for conditionally wanted
2125                         elsif ($tmp =~ s/^%//) {
2126                                 &push_val(($main'condwanted{$tmp})? 1 : 0);
2127                         }
2128                         # Default: test for definition (see op @define)
2129                         else {
2130                                 &push_val((
2131                                         $main'symwanted{$tmp} ||
2132                                         $main'cmaster{$tmp} ||
2133                                         $main'userdef{$tmp}) ? 1 : 0);
2134                         }
2135                 }
2136                 # An error occured -- we did not recognize the expression
2137                 else {
2138                         s/^([^\s\(\)\{\|&!]+)//;        # Skip until next meaningful char
2139                 }
2140         }
2141 }
2142
2143 # Given an expression in a '@' command, returns a boolean which is
2144 # the result of the evaluation. Evaluate is collecting all the lines
2145 # in the expression into a single string, and then calls eval_expr to
2146 # really evaluate it.
2147 sub interpreter'load_evaluate {
2148         package interpreter;
2149         local($val);                    # Value returned
2150         local($expr) = "";              # Expression to be parsed
2151         chop;
2152         while (s/\\$//) {               # While end of line escaped
2153                 $expr .= $_;
2154                 $_ = <UNIT>;            # Fetch next line
2155                 unless ($_) {
2156                         &error("EOF in expression");
2157                         last;
2158                 }
2159                 chop;
2160         }
2161         $expr .= $_;
2162         while ($expr ne '') {
2163                 $val = &eval_expr(*expr);               # Expression will be modified
2164                 # We return from eval_expr either when a closing parenthisis
2165                 # is found, or when the expression has been fully analysed.
2166                 &error("extra closing parenthesis ignored") if $expr ne '';
2167         } 
2168         $val;
2169 }
2170
2171 # Given a line, we search for commands (lines starting with '@').
2172 # If there is no command in the line, then we return the boolean state.
2173 # Otherwise, the command is analysed and a new state is computed.
2174 # The returned value of interpret is 1 if the line is to be printed.
2175 sub main'load_interpret {
2176         package interpreter;
2177         local($value);
2178         local($status) = $state[$#state];               # Current status
2179         if (s|^\s*@\s*(\w+)\s*(.*)|$2|) {
2180                 local($cmd) = $1;
2181                 $cmd =~ y/A-Z/a-z/;             # Canonicalize to lower case
2182                 # The 'define' command
2183                 if ($cmd eq 'define') {
2184                         chop;
2185                         $userdef{$_}++ if $Keep[$status];
2186                         return 0;
2187                 }
2188                 # The 'if' command
2189                 elsif ($cmd eq 'if') {
2190                         # We always evaluate, in order to find possible errors
2191                         $value = &evaluate($_);
2192                         if (!$Keep[$status]) {
2193                                 # We have to skip until next 'end'
2194                                 push(@state, $SKIP);            # Record structure
2195                                 return 0;
2196                         }
2197                         if ($value) {                   # True
2198                                 push(@state, $IF);
2199                                 return 0;
2200                         } else {                                # False
2201                                 push(@state, $NOT);
2202                                 return 0;
2203                         }
2204                 }
2205                 # The 'else' command
2206                 elsif ($cmd eq 'else') {
2207                         &error("expression after 'else' ignored") if /\S/;
2208                         $state[$#state] = $SKIP if $state[$#state] == $IF;
2209                         return 0 if $state[$#state] == $SKIP;
2210                         if ($state[$#state] == $OUT) {
2211                                 &error("unexpected 'else'");
2212                                 return 0;
2213                         }
2214                         $state[$#state] = $ELSE;
2215                         return 0;
2216                 }
2217                 # The 'elsif' command
2218                 elsif ($cmd eq 'elsif') {
2219                         # We always evaluate, in order to find possible errors
2220                         $value = &evaluate($_);
2221                         $state[$#state] = $SKIP if $state[$#state] == $IF;
2222                         return 0 if $state[$#state] == $SKIP;
2223                         if ($state[$#state] == $OUT) {
2224                                 &error("unexpected 'elsif'");
2225                                 return 0;
2226                         }
2227                         if ($value) {                   # True
2228                                 $state[$#state] = $IF;
2229                                 return 0;
2230                         } else {                                # False
2231                                 $state[$#state] = $NOT;
2232                                 return 0;
2233                         }
2234                 }
2235                 # The 'end' command
2236                 elsif ($cmd eq 'end') {
2237                         &error("expression after 'end' ignored") if /\S/;
2238                         pop(@state);
2239                         &error("unexpected 'end'") if $#state < 0;
2240                         return 0;
2241                 }
2242                 # Unknown command
2243                 else {
2244                         &error("unknown command '$cmd'");
2245                         return 0;
2246                 }
2247         }
2248         $Keep[$status];
2249 }
2250
2251 sub main'load_readpackage {
2252         package main;
2253         if (! -f '.package') {
2254                 if (
2255                         -f '../.package' ||
2256                         -f '../../.package' ||
2257                         -f '../../../.package' ||
2258                         -f '../../../../.package'
2259                 ) {
2260                         die "Run in top level directory only.\n";
2261                 } else {
2262                         die "No .package file!  Run packinit.\n";
2263                 }
2264         }
2265         open(PACKAGE,'.package');
2266         while (<PACKAGE>) {
2267                 next if /^:/;
2268                 next if /^#/;
2269                 if (($var,$val) = /^\s*(\w+)=(.*)/) {
2270                         $val = "\"$val\"" unless $val =~ /^['"]/;
2271                         eval "\$$var = $val;";
2272                 }
2273         }
2274         close PACKAGE;
2275 }
2276
2277 sub main'load_manifake {
2278         package main;
2279     # make MANIFEST and MANIFEST.new say the same thing
2280     if (! -f $NEWMANI) {
2281         if (-f $MANI) {
2282             open(IN,$MANI) || die "Can't open $MANI";
2283             open(OUT,">$NEWMANI") || die "Can't create $NEWMANI";
2284             while (<IN>) {
2285                 if (/---/) {
2286                                         # Everything until now was a header...
2287                                         close OUT;
2288                                         open(OUT,">$NEWMANI") ||
2289                                                 die "Can't recreate $NEWMANI";
2290                                         next;
2291                                 }
2292                 s/^\s*(\S+\s+)[0-9]*\s*(.*)/$1$2/;
2293                                 print OUT;
2294                                 print OUT "\n" unless /\n$/;    # If no description
2295             }
2296             close IN;
2297                         close OUT;
2298         }
2299         else {
2300 die "You need to make a $NEWMANI file, with names and descriptions.\n";
2301         }
2302     }
2303 }
2304
2305 # Perform ~name expansion ala ksh...
2306 # (banish csh from your vocabulary ;-)
2307 sub main'load_tilda_expand {
2308         package main;
2309         local($path) = @_;
2310         return $path unless $path =~ /^~/;
2311         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
2312         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
2313         $path;
2314 }
2315
2316 # Set up profile components into %Profile, add any profile-supplied options
2317 # into @ARGV and return the command invocation name.
2318 sub main'load_profile {
2319         package main;
2320         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
2321         local($me) = $0;                # Command name
2322         $me =~ s|.*/(.*)|$1|;   # Keep only base name
2323         return $me unless -s $profile;
2324         local(*PROFILE);                # Local file descriptor
2325         local($options) = '';   # Options we get back from profile
2326         unless (open(PROFILE, $profile)) {
2327                 warn "$me: cannot open $profile: $!\n";
2328                 return;
2329         }
2330         local($_);
2331         local($component);
2332         while (<PROFILE>) {
2333                 next if /^\s*#/;        # Skip comments
2334                 next unless /^$me/o;
2335                 if (s/^$me://o) {       # progname: options
2336                         chop;
2337                         $options .= $_; # Merge options if more than one line
2338                 }
2339                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
2340                         $component = $1;
2341                         chop;
2342                         s/^\s+//;               # Trim leading and trailing spaces
2343                         s/\s+$//;
2344                         $Profile{$component} = $_;
2345                 }
2346         }
2347         close PROFILE;
2348         return unless $options;
2349         require 'shellwords.pl';
2350         local(@opts);
2351         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
2352         unshift(@ARGV, @opts);
2353         return $me;                             # Return our invocation name
2354 }
2355
2356 #
2357 # End of dataloading section.
2358 #
2359