Add a trivial script to extract the times from *.report.txt files.
[llvm-testsuite.git] / filepp
bloba5b813022b11e111d093a58e9d479b0768d1ad23
1 #!/usr/bin/perl -w
2 ########################################################################
4 # filepp is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation; either version 2 of the License, or
7 # (at your option) any later version.
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program; see the file COPYING. If not, write to
16 # the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
18 ########################################################################
20 # Project : File Preprocessor
21 # Filename : $RCSfile$
22 # Author : $Author$
23 # Maintainer : Darren Miller: darren@cabaret.demon.co.uk
24 # File version : $Revision$
25 # Last changed : $Date$
26 # Description : Main program
27 # Licence : GNU copyleft
29 ########################################################################
31 package Filepp;
33 use strict "vars";
34 use strict "subs";
35 # Used to all filepp to work with any char, not just ascii,
36 # feel free to remove this if it causes you problems
37 use bytes;
39 # version number of program
40 my $VERSION = '1.7.1';
42 # list of paths to search for modules, normal Perl list + module dir
43 push(@INC, "/usr/local/share/filepp/modules");
45 # index of keywords supported and functions to deal with them
46 my %Keywords = (
47 'comment' => \&Comment,
48 'define' => \&Define,
49 'elif' => \&Elif,
50 'else' => \&Else,
51 'endif' => \&Endif,
52 'error' => \&Error,
53 'if' => \&If,
54 'ifdef' => \&Ifdef,
55 'ifndef' => \&Ifndef,
56 'include' => \&Include,
57 'pragma' => \&Pragma,
58 'undef' => \&Undef,
59 'warning' => \&Warning
62 # set of functions which process the file in the Parse routine.
63 # Processors are functions which take in a line and return the processed line.
64 # Note: this is done as a string rather than pointer to a function because
65 # it makes list easier to modify/remove from/print.
66 my @Processors = ( "Filepp::ParseKeywords", "Filepp::ReplaceDefines" );
67 # processor types say what the processor should be run on: choice is:
68 # 0: Everything (default)
69 # 1: Full lines only (lines originating from Parse function)
70 # 2: Part lines only (lines originating from within keywords, eg:
71 # #if "condition", "condition" is a part line)
72 my %ProcessorTypes = (
73 'Filepp::ParseKeywords' => 1,
74 'Filepp::ReplaceDefines' => 0
77 # functions to run each time a new base input file is opened or closed
78 my @OpenInputFuncs = ();
79 my @CloseInputFuncs = ();
81 # functions to run each time a new output file is opened or closed
82 my @OpenOutputFuncs = ();
83 my @CloseOutputFuncs = ();
85 # safe mode is for the paranoid, when enabled turns off #pragma filepp,
86 # enabled by default
87 my $safe_mode = 0;
89 # test for shebang mode, used for "filepp script", ie. executable file with
90 # "#!/usr/bin/perl /usr/local/bin/filepp" at the top
91 my $shebang = 1;
93 # allow $keywordchar, $contchar, $optlineendchar and $macroprefix
94 # to be perl regexps
95 my $charperlre = 0;
97 # character(s) which prefix environment variables - defaults to shell-style '$'
98 my $envchar = "\$";
100 # boolean determining whether line continuation is implicit if there are more
101 # open brackets than close brackets on a line
102 # disabled by default
103 my $parselineend = \&Filepp::ParseLineEnd;
105 # character(s) which replace continuation char(s) - defaults to C-style nothing
106 my $contrepchar = "";
108 # character(s) which prefix keywords - defaults to C-style '#'
109 my $keywordchar;
110 if($charperlre) { $keywordchar = "\#"; }
111 else { $keywordchar = "\Q#\E"; }
113 # character(s) which signifies continuation of a line - defaults to C-style '\'
114 my $contchar;
115 if($charperlre) { $contchar = "\\\\"; }
116 else { $contchar = "\Q\\\E"; }
118 # character(s) which optionally signifies the end of a line -
119 # defaults to empty string ''
120 my $optlineendchar = "";
122 # character(s) which prefix macros - defaults to nothing
123 my $macroprefix = "";
125 # flag to use macro prefix in keywords (on by default)
126 my $macroprefixinkeywords = 1;
128 # check if macros must occur as words when replacing, set this to '\b' if
129 # you prefer cpp style behaviour as default
130 my $bound = '';
132 # number of line currently being parsed (int)
133 my $line = 0;
135 # file currently being parsed
136 my $file = "";
138 # list of input files
139 my @Inputfiles;
141 # list of files to include macros from
142 my @Imacrofiles;
144 # flag to control when output is written
145 my $output = 1;
147 # name of outputfile - defaults to STDOUT
148 my $outputfile = "";
150 # overwrite mode - automatically overwrites old file with new file
151 my $overwrite = 0;
153 # overwrite conversion mode - conversion from input filename to output filename
154 my $overwriteconv = "";
156 # list of keywords which have "if" functionality
157 my %Ifwords = ('if', '',
158 'ifdef', '',
159 'ifndef', '');
161 # list of keywords which have "else" functionality
162 my %Elsewords = ('else', '',
163 'elif', '');
165 # list of keywords which have "endif" functionality
166 my %Endifwords = ('endif', '');
168 # current level of include files
169 my $include_level = -1;
171 # suppress blank lines in header files (indexed by include level)
172 my $blanksuppopt = 0;
173 my @blanksupp;
174 # try to keep same number lines in output file as input file
175 my $preserveblank = 0;
177 # counter of recursion level for detecting recursive macros
178 my $recurse_level = -1;
180 # debugging info, 1=on, 0=off
181 my $debug = 0;
182 # send debugging info to stdout rather than stderr
183 my $debugstdout = 0;
184 # debug prefix character or string
185 my $debugprefix = "";
186 # debug postfix character or string
187 my $debugpostfix = "\n";
189 # hash of macros defined - standard ones already included
190 my %Defines = (
191 '__BASE_FILE__' => "",
192 '__DATE__' => "",
193 '__FILEPP_INPUT__' => "Generated automatically from __BASE_FILE__ by filepp",
194 '__FILE__' => $file,
195 '__INCLUDE_LEVEL__' => $include_level,
196 '__ISO_DATE__' => "",
197 '__LINE__' => $line,
198 '__NEWLINE__' => "\n",
199 '__NULL__' => "",
200 '__TAB__' => "\t",
201 '__TIME__' => "",
202 '__VERSION__' => $VERSION
204 # hash of first chars in each macro
205 my %DefineLookup;
206 # length of longest and shortest define
207 my ($defmax, $defmin);
208 GenerateDefinesKeys();
210 # set default values for date and time
212 # conversions of month number into letters (0-11)
213 my @MonthChars = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
214 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
215 #prepare standard defines
216 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isbst) =
217 localtime(time());
218 $year += 1900;
219 $sec = sprintf("%02d", $sec);
220 $min = sprintf("%02d", $min);
221 $hour = sprintf("%02d", $hour);
222 $mday = sprintf("%02d", $mday);
223 $mon = sprintf("%02d", $mon);
224 Redefine("__TIME__", $hour.":".$min.":".$sec);
225 Redefine("__DATE__", $MonthChars[$mon]." ".$mday." ".$year);
226 $mon = sprintf("%02d", ++$mon);
227 Redefine("__ISO_DATE__", $year."-".$mon."-".$mday);
230 # hash table for arguments to macros which need them
231 my %DefinesArgs = ();
233 # hash table for functions which macros should call (if any)
234 my %DefinesFuncs = ();
236 # eat-trailing-whitespace flag for each macro
237 my %EatTrail = ();
239 # list of include paths
240 my @IncludePaths;
242 # help string
243 my $usage = "filepp: generic file preprocessor, version ".$VERSION."
244 usage: filepp [options] inputfile(s)
245 options:
246 -b\t\tsuppress blank lines from include files
247 -c\t\tread input from STDIN instead of file
248 -Dmacro[=defn]\tdefine macros (same as #define)
249 -d\t\tprint debugging information
250 -dd\t\tprint verbose debugging information
251 -dl\t\tprint some (light) debugging information
252 -dpre char\tprefix all debugging information with char
253 -dpost char\tpostfix all debugging information with char, defaults to newline
254 -ds\t\tsend debugging info to stdout rather than stderr
255 -e\t\tdefine all environment variables as macros
256 -ec char\tset environment variable prefix char to \"char\" (default \$)
257 -ecn\t\tset environment variable prefix char to nothing (default \$)
258 -h\t\tprint this help message
259 -Idir\t\tdirectory to search for include files
260 -imacros file\tread in macros from file, but discard rest of file
261 -k\t\tturn off parsing of all keywords, just macro expansion is done
262 -kc char\tset keyword prefix char to \"char\" (defaults to #)
263 -lc char\tset line continuation character to \"char\" (defaults to \\)
264 -lec char\tset optional keyword line end char to \"char\"
265 -lr char\tset line continuation replacement character to \"char\"
266 -lrn\t\tset line continuation replacement character to newline
267 -m module\tload module
268 -mp char\tprefix all macros with \"char\" (defaults to no prefix)
269 -mpnk\t\tdo not use macro prefix char in keywords
270 -Mdir\t\tdirectory to search for filepp modules
271 -o output\tname of output file (defaults to stdout)
272 -ov\t\toverwrite mode - output file will overwrite input file
273 -ovc IN=OUT\toutput file(s) will have be input file(s) with IN conveted to OUT
274 -pb\t\tpreseve blank lines in output that would normally be removed
275 -s\t\trun in safe mode (turns off pragma keyword)
276 -re\t\ttreat keyword and macro prefixes and line cont chars as reg exps
277 -u\t\tundefine all predefined macros
278 -v\t\tprint version and exit
279 -w\t\tturn on word boundaries when replacing macros
280 all other arguments are assumed to be input files
284 ##############################################################################
285 # SetDebug - controls debugging level
286 ##############################################################################
287 sub SetDebug
289 $debug = shift;
290 Debug("Debugging level set to $debug", 1);
294 ##############################################################################
295 # Debugging info
296 ##############################################################################
297 sub Debug
299 # print nothing if not debugging
300 if($debug == 0) { return; }
301 my $msg = shift;
302 my $level = 1;
303 # check if level has been provided
304 if($#_ > -1) { $level = shift; }
305 if($level <= $debug) {
306 # if currently parsing a file show filename and line number
307 if($file ne "" && $line > 0) {
308 $msg = $file.":".$line.": ".$msg;
310 # else show program name
311 else { $msg = "filepp: ".$msg; }
312 if($debugstdout) {
313 print(STDOUT $debugprefix.$msg.$debugpostfix);
315 else {
316 print(STDERR $debugprefix.$msg.$debugpostfix);
322 ##############################################################################
323 # Standard error handler.
324 # #error msg - print error message "msg" and exit
325 ##############################################################################
326 sub Error
328 my $msg = shift;
329 # close and delete output file if created
330 close(OUTPUT);
331 if($outputfile ne "-") { # output is not stdout
332 my $inputfile;
333 my $found = 0;
334 # do paranoid check to make sure we are not deleting an input file
335 foreach $inputfile (@Inputfiles) {
336 if($outputfile eq $inputfile) { $found = 1; last; }
338 # delete output file
339 if($found == 0) { unlink($outputfile); }
341 # print error message
342 $debug = 1;
343 Debug($msg, 0);
344 exit(1);
348 ##############################################################################
349 # SafeMode - turns safe mode on
350 ##############################################################################
351 sub SafeMode
353 $safe_mode = 1;
354 Debug("Filepp safe mode enabled", 2);
358 ##############################################################################
359 # CleanStart($sline) - strip leading whitespace from start of $sline.
360 ##############################################################################
361 sub CleanStart
363 my $sline = shift;
364 for($sline) {
365 # '^' = start of line, '\s+' means all whitespace, replace with nothing
366 s/^\s+//;
368 return $sline;
372 ##############################################################################
373 # Strip($sline, $char, $level) - strip $char's from start and end of $sline
374 # removes up to $level $char's from start and end of line, it is not an
375 # error if $level chars do not exist at the start or end of line
376 ##############################################################################
377 sub Strip
379 my $sline = shift;
380 my $char = shift;
381 my $level = shift;
382 # strip leading chars from line
383 $sline =~ s/\A([$char]{0,$level})//g;
384 # strip trailing chars from line
385 $sline =~ s/([$char]{0,$level})\Z//g;
386 return $sline;
390 ##############################################################################
391 # SetMacroPrefix $string - prefixs all macros with $string
392 ##############################################################################
393 sub SetMacroPrefix
395 $macroprefix = shift;
396 # make sure prefix will not be treated as a Perl regular expression
397 if(!$charperlre) { $macroprefix = "\Q$macroprefix\E"; }
398 Debug("Setting macro prefix to <".$macroprefix.">", 2);
402 ##############################################################################
403 # SetKeywordchar $string - sets the first char(s) of each keyword to
404 # something other than "#"
405 ##############################################################################
406 sub SetKeywordchar
408 $keywordchar = shift;
409 # make sure char will not be treated as a Perl regular expression
410 if(!$charperlre) { $keywordchar = "\Q$keywordchar\E"; }
411 Debug("Setting keyword prefix character to <".$keywordchar.">", 2);
414 ##############################################################################
415 # GetKeywordchar - returns the current keywordchar
416 ##############################################################################
417 sub GetKeywordchar
419 return $keywordchar;
423 ##############################################################################
424 # SetContchar $string - sets the line continuation char to something other
425 # than "\"
426 ##############################################################################
427 sub SetContchar
429 $contchar = shift;
430 # make sure char will not be treated as a Perl regular expression
431 if(!$charperlre) { $contchar = "\Q$contchar\E"; }
432 Debug("Setting line continuation character to <".$contchar.">", 2);
436 ##############################################################################
437 # SetContrepchar $string - sets the replace of the line continuation char to
438 # something other than ""
439 ##############################################################################
440 sub SetContrepchar
442 $contrepchar = shift;
443 Debug("Setting line continuation replacement character to <".$contrepchar.">", 2);
447 ##############################################################################
448 # SetOptLineEndchar $string - sets the optional line end char to something
449 # other than ""
450 ##############################################################################
451 sub SetOptLineEndchar
453 $optlineendchar = shift;
454 # make sure char will not be treated as a Perl regular expression
455 if(!$charperlre) { $optlineendchar = "\Q$optlineendchar\E"; }
456 Debug("Setting optional line end character to <".$optlineendchar.">", 2);
460 ##############################################################################
461 # SetEnvchar $string - sets the first char(s) of each defined environment
462 # variable to $string - NOTE: change only takes effect when DefineEnv run
463 ##############################################################################
464 sub SetEnvchar
466 $envchar = shift;
467 Debug("Setting environment variable prefix character to <".$envchar.">",2);
470 ##############################################################################
471 # RunProcessors $string, $calledfrom
472 # run the current processing chain on the string
473 # $string is the string to be processed and should be returned by the processor
474 # $calledfrom says where the processors are called from, the choice is:
476 # 0 or default: Part line (from within a keyword) - if called recursively
477 # runs all processors AFTER current processor, then continues with processing.
478 # This is used when a keyword want to run all remaining processors on a line
479 # before doing its keyword task.
481 # 1: Full line (from Parse function) - if called recursively runs all
482 # processors BEFORE current processor, then continues with processing
484 # 2: Part line (from within a keyword) - if called recursively runs all
485 # processors BEFORE current processor, then continues with processing.
486 # This is used when keywords are using text taken from somewhere other than
487 # the current line, this text needs to go through the same processors as
488 # the current line has been through so it can "catch up" (eg: regexp.pm).
490 ##############################################################################
491 my @Running;
492 my @Currentproc;
493 sub RunProcessors
495 my $string = shift;
496 my $calledfrom = 0;
497 if($#_ > -1) { $calledfrom = shift; }
498 my $i;
500 # turn off macoprefix if in a keyword
501 my $tmpprefix = "";
502 if($calledfrom != 1 && $macroprefixinkeywords == 0) {
503 $tmpprefix = $macroprefix;
504 $macroprefix = "";
507 # These tests are done to make RunProcessors recursion safe.
508 # If RunProcessors is called from with a function that was itself called
509 # by RunProcessors, then the second calling of RunProcessors will only
510 # execute the processors before the currently running processor in the
511 # chain.
512 my $recursing = 0;
513 my $firstproc = 0;
514 my $lastproc = $#Processors;
515 if($Running[$include_level]) {
516 if($calledfrom == 0) {
517 $firstproc = $Currentproc[$include_level] + 1;
519 else {
520 $lastproc = $Currentproc[$include_level] - 1;
522 $recursing = 1;
524 else { $Running[$include_level] = 1; }
526 for($i = $firstproc; $i <= $lastproc; $i++) {
527 if(!$recursing) { $Currentproc[$include_level] = $i; }
528 # called from anywhere (default)
529 if($ProcessorTypes{$Processors[$i]} == 0 ||
530 # called from keyword (part lines only - within keywords)
531 (($calledfrom == 0 || $calledfrom == 2) &&
532 $ProcessorTypes{$Processors[$i]} == 2) ||
533 # called from Parse function (whole lines only)
534 ($calledfrom == 1 && $ProcessorTypes{$Processors[$i]} == 1)) {
535 # run processor
536 # Debug("Running processor $Processors[$i] on \"$string\"", 2);
537 $string = $Processors[$i]->($string);
539 # check that no processors have been deleted (bigdef.pm)
540 if($lastproc > $#Processors) { $lastproc = $#Processors; }
543 if(!$recursing) { $Running[$include_level] = 0; }
545 # return macro prefix to its former glory
546 if($calledfrom != 1 && $macroprefixinkeywords == 0) {
547 $macroprefix = $tmpprefix;
550 return $string;
553 ##############################################################################
554 # PrintProcessors
555 # print the current processing chain
556 ##############################################################################
557 sub PrintProcessors
559 my $processor;
560 Debug("Current processing chain:", 3);
561 my $i = 0;
562 foreach $processor (@Processors) {
563 Debug($processor." type ".$ProcessorTypes{$Processors[$i]}, 3);
564 $i++;
568 ##############################################################################
569 # AddProcessor(function[, first[, type]])
570 # add a line processor to processing chain, defaults to end of chain
571 # if "first" is set to one adds processor to start of chain
572 ##############################################################################
573 sub AddProcessor
575 my $function = shift;
576 my $first = 0;
577 my $type = 0;
578 # check if flag to add processor to start of chain is set
579 if($#_ > -1) { $first = shift; }
580 # check if processor has a type
581 if($#_ > -1) { $type = shift; }
582 # adding processor to start of chasin
583 if($first) {
584 @Processors = reverse(@Processors);
586 push(@Processors, $function);
587 if($first) {
588 @Processors = reverse(@Processors);
590 $ProcessorTypes{$function} = $type;
591 Debug("Added processor ".$function." of type ".$type, 2);
592 if($debug > 1) { PrintProcessors(); }
595 ##############################################################################
596 # AddProcessorAfter(function, processor[, type])
597 # add a line processor to processing chain immediately after an existing
598 # processor, if existing processor not found, new processor is added to
599 # end of chain
600 ##############################################################################
601 sub AddProcessorAfter
603 my $function = shift;
604 my $existing = shift;
605 my $type = 0;
606 # check if processor has a type
607 if($#_ > -1) { $type = shift; }
608 my $i = 0;
609 my $found = 0;
610 my @CurrentProcessors = @Processors;
611 my $processor;
612 # reset processing chain
613 @Processors = ();
614 foreach $processor (@CurrentProcessors) {
615 push(@Processors, $processor);
616 if(!$found) {
617 # check done as regular expression for greater flexibility
618 if($processor =~ /$existing/) {
619 push(@Processors, $function);
620 $found = 1;
624 if(!$found) {
625 Warning("Did not find processor $existing in chain, processor $processor added to end of list");
626 AddProcessor($function, 0, $type);
627 return;
629 $ProcessorTypes{$function} = $type;
630 Debug("Added processor ".$function." of type ".$type, 2);
631 if($debug > 1) { PrintProcessors(); }
634 ##############################################################################
635 # AddProcessorBefore(function, processor[, type])
636 # add a line processor to processing chain immediately after an existing
637 # processor, if existing processor not found, new processor is added to
638 # end of chain
639 ##############################################################################
640 sub AddProcessorBefore
642 my $function = shift;
643 my $existing = shift;
644 my $type = 0;
645 # check if processor has a type
646 if($#_ > -1) { $type = shift; }
647 my $i = 0;
648 my $found = 0;
649 my @CurrentProcessors = @Processors;
650 my $processor;
651 # reset processing chain
652 @Processors = ();
653 foreach $processor (@CurrentProcessors) {
654 if(!$found) {
655 # check done as regular expression for greater flexibility
656 if($processor =~ /$existing/) {
657 push(@Processors,$function);
658 $found = 1;
661 push(@Processors, $processor);
663 if(!$found) {
664 Warning("Did not find processor $existing in chain, processor $processor added to start of list");
665 AddProcessor($function, 1, $type);
666 return;
668 $ProcessorTypes{$function} = $type;
669 Debug("Added processor ".$function." of type ".$type, 2);
670 if($debug > 1) { PrintProcessors(); }
673 ##############################################################################
674 # RemoveProcessor(function)
675 # remove a processor name "function" from list
676 ##############################################################################
677 sub RemoveProcessor
679 my $function = shift;
680 my $i = 0;
681 # find function
682 while($i <= $#Processors && $Processors[$i] ne $function) { $i++; }
683 # check function found
684 if($i > $#Processors) {
685 Warning("Attempt to remove function ".$function.
686 " which does not exist");
687 return;
689 # remove function
690 for(; $i<$#Processors; $i++) {
691 $Processors[$i] = $Processors[$i+1];
693 pop(@Processors);
694 delete($ProcessorTypes{$function});
695 Debug("Removed processor ".$function, 2);
696 PrintProcessors();
700 ##############################################################################
701 # Add a function to run each time a base file is opened
702 ##############################################################################
703 sub AddOpenInputFunc
705 my $func = shift;
706 push(@OpenInputFuncs, $func);
709 ##############################################################################
710 # Add a function to run each time a base file is closed
711 ##############################################################################
712 sub AddCloseInputFunc
714 my $func = shift;
715 push(@CloseInputFuncs, $func);
718 ##############################################################################
719 # Add a function to run each time a base file is opened
720 ##############################################################################
721 sub AddOpenOutputFunc
723 my $func = shift;
724 push(@OpenOutputFuncs, $func);
727 ##############################################################################
728 # Add a function to run each time a base file is closed
729 ##############################################################################
730 sub AddCloseOutputFunc
732 my $func = shift;
733 push(@CloseOutputFuncs, $func);
737 ##############################################################################
738 # AddKeyword(keyword, function)
739 # Define a new keyword, when keyword (preceded by keyword char) is found,
740 # function is run on the remainder of the line.
741 ##############################################################################
742 sub AddKeyword
744 my $keyword = shift;
745 my $function = shift;
746 $Keywords{$keyword} = $function;
747 Debug("Added keyword ".$keyword." which runs ".$function, 2);
751 ##############################################################################
752 # RemoveKeyword(keyword)
753 # Keyword is deleted from list, all occurrences of keyword found in
754 # document are ignored.
755 ##############################################################################
756 sub RemoveKeyword
758 my $keyword = shift;
759 delete $Keywords{$keyword};
760 # sort keywords index into reverse order, this ensures #if[n]def comes
761 # before #if when comparing input with keywords
762 Debug("Removed keyword ".$keyword, 2);
766 ##############################################################################
767 # RemoveAllKeywords - removes all current keywords.
768 ##############################################################################
769 sub RemoveAllKeywords
771 %Keywords = ();
772 Debug("Removed all current keywords", 2);
776 ##############################################################################
777 # AddIfword - adds a keyword to ifword hash
778 ##############################################################################
779 sub AddIfword
781 my $ifword = shift;
782 $Ifwords{$ifword} = '';
783 Debug("Added Ifword: ".$ifword, 2);
786 ##############################################################################
787 # RemoveIfword - removes a keyword from ifword hash
788 ##############################################################################
789 sub RemoveIfword
791 my $ifword = shift;
792 delete $Ifwords{$ifword};
793 Debug("Removed Ifword: ".$ifword, 2);
796 ##############################################################################
797 # AddElseword - adds a keyword to elseword hash
798 ##############################################################################
799 sub AddElseword
801 my $elseword = shift;
802 $Elsewords{$elseword} = '';
803 Debug("Added Elseword: ".$elseword, 2);
806 ##############################################################################
807 # RemoveElseword - removes a keyword from elseword hash
808 ##############################################################################
809 sub RemoveElseword
811 my $elseword = shift;
812 delete $Elsewords{$elseword};
813 Debug("Removed Elseword: ".$elseword, 2);
816 ##############################################################################
817 # AddEndifword - adds a keyword to endifword hash
818 ##############################################################################
819 sub AddEndifword
821 my $endifword = shift;
822 $Endifwords{$endifword} = '';
823 Debug("Added Endifword: ".$endifword, 2);
826 ##############################################################################
827 # RemoveEndifword - removes a keyword from endifword hash
828 ##############################################################################
829 sub RemoveEndifword
831 my $endifword = shift;
832 delete $Endifwords{$endifword};
833 Debug("Removed Endifword: ".$endifword, 2);
837 ##############################################################################
838 # AddIncludePath - adds another include path to the list
839 ##############################################################################
840 sub AddIncludePath
842 my $path = shift;
843 push(@IncludePaths, $path);
844 Debug("Added include path: \"".$path."\"", 2);
848 ##############################################################################
849 # AddModulePath - adds another module search path to the list
850 ##############################################################################
851 sub AddModulePath
853 my $path = shift;
854 push(@INC, $path);
855 Debug("Added module path: \"".$path."\"", 2);
859 # set if file being written to has same name as input file
860 my $same_file = "";
862 ##############################################################################
863 # OpenOutputFile - opens the output file
864 ##############################################################################
865 sub OpenOutputFile
867 $outputfile = shift;
868 Debug("Output file: ".$outputfile, 1);
870 # check for outputfile name, if not specified use STDOUT
871 if($outputfile eq "") { $outputfile = "-"; }
873 # output is not stdout and file with that name already exists
874 if($outputfile ne "-" && FileExists($outputfile) ) {
875 $same_file = $outputfile;
876 # paranoid: check file is writable and normal file
877 if(-w $outputfile && -f $outputfile) {
878 $outputfile = $outputfile.".fpp".$$;
879 my $i=0; # paranoid: check temp file does not exist
880 while(FileExists($outputfile)) {
881 $outputfile = $outputfile.$i;
882 $i++;
883 if($i >= 10) { Error("Cound not get temp filename"); }
886 else {
887 Error("Cannot read or write to ".$outputfile);
890 if(!open(OUTPUT, ">".$outputfile)) {
891 Error("Cannot open output file: ".$outputfile);
893 # run any open functions
894 my $func;
895 foreach $func (@OpenOutputFuncs) { $func->(); }
899 ##############################################################################
900 # CloseOutputFile - close the output file
901 ##############################################################################
902 sub CloseOutputFile
904 # run any close functions
905 my $func;
906 foreach $func (@CloseOutputFuncs) { $func->(); }
907 close(OUTPUT);
909 # if input and output have same name, rename output to input now
910 if($same_file ne "") {
911 if(rename($same_file, $same_file."~") == -1) {
912 Error("Could not rename ".$same_file." ".$same_file."~");
914 if(rename($outputfile, $same_file) == -1) {
915 Error("Could not rename ".$outputfile." ".$same_file);
918 # reset same_file
919 $same_file = "";
923 ##############################################################################
924 # ChangeOutputFile - change the output file
925 ##############################################################################
926 sub ChangeOutputFile
928 CloseOutputFile();
929 $outputfile = shift;
930 OpenOutputFile($outputfile);
934 ##############################################################################
935 # AddInputFile - adds another input file to the list
936 ##############################################################################
937 sub AddInputFile
939 my $file = shift;
940 push(@Inputfiles, $file);
941 Debug("Added input file: \"".$file."\"", 2);
945 ##############################################################################
946 # UseModule(module)
947 # Module "module.pm" is used, "module.pm" can be any perl module and can use
948 # or replace any of the functions in this package
949 ##############################################################################
950 sub UseModule
952 my $module = shift;
953 Debug("Loading module ".$module, 1);
954 require $module;
955 if($@) { Error($@); }
959 ##############################################################################
960 # find end of next word in $sline, assumes leading whitespace removed
961 ##############################################################################
962 sub GetNextWordEnd
964 my $sline = shift;
965 # check for whitespace in this string
966 if($sline =~ /\s/) {
967 # return length of everything up to first whitespace
968 return length($`);
970 # whitespace not found, return length of the whole string
971 return length($sline);
975 ##############################################################################
976 # Print current table of defines - used for debugging
977 ##############################################################################
978 sub PrintDefines
980 my $define;
981 Debug("Current ".$keywordchar."define's:", 3);
982 foreach $define (keys(%Defines)) {
983 Debug(" macro:\"".$define."\", definition:\"".$Defines{$define}."\"",3);
988 ##############################################################################
989 # DefineEnv - define's all environment variables to macros, each prefixed
990 # by $envchar
991 ##############################################################################
992 sub DefineEnv
994 my $macro;
995 Debug("Defining environment variables as macros", 2);
996 foreach $macro (keys(%ENV)) {
997 Define($envchar.$macro." ".$ENV{$macro});
1002 ##############################################################################
1003 # Find out if arguments have been used with macro
1004 ##############################################################################
1005 sub DefineArgsUsed
1007 my $string = shift;
1008 # check '(' is first non-whitespace char after macro
1009 if($string =~ /^\s*\(/) {
1010 return 1;
1012 return 0;
1016 ##############################################################################
1017 # ParseArgs($string) - find the arguments in a string of form
1018 # (arg1, arg2, arg3...) trailing chars
1019 # or
1020 # arg1, arg2, arg3...
1021 ##############################################################################
1022 sub ParseArgs
1024 my $string = shift;
1025 $string = CleanStart($string);
1026 my @Chars;
1027 my $char;
1028 # split string into chars (can't use split coz it deletes \n at end)
1029 for($char=0; $char<length($string); $char++) {
1030 push(@Chars, substr($string, $char, 1));
1032 my @Args; # list of Args
1033 my $arg = "";
1034 my @Endchar;
1035 # special characters - no processing is done between character pairs
1036 my %SpecialChars = ('(' => ')', '"' => '"', '\'' => '\'');
1037 my $s = -1; # start of chars
1038 my $backslash = 0;
1039 # number of special char pairs to allow
1040 my $pairs = 1;
1042 # deal with first '(' if there (ie func(args) rather than func args)
1043 if($#Chars >= 0 && $Chars[0] eq '(') {
1044 push(@Endchar, ')');
1045 $Chars[0] = '';
1046 $s++;
1047 $pairs++; # ignore this pair of special char pairs
1050 # replace args with their values
1051 foreach $char (@Chars) {
1052 # deal with end of special chars, ),",' etc.
1053 if($#Endchar > -1 && $char eq $Endchar[$#Endchar]) {
1054 # if char before this was a backslash, ignore this char
1055 if($backslash) {
1056 chop($arg); # delete backslash from string
1058 else {
1059 # pop end char of list and reduce pairs if its a bracket
1060 if(pop(@Endchar) eq ')') { $pairs--; }
1063 # deal with start of special chars
1064 elsif(exists($SpecialChars{$char})) {
1065 # if char before this was a backslash, ignore this char
1066 if($backslash) {
1067 chop($arg); # delete backslash from string
1069 # only start new pair if not already in special char pair
1070 # (not including main args brackets of course)
1071 elsif($#Endchar < $pairs-1) {
1072 push(@Endchar, $SpecialChars{$char});
1073 # need to treat brackets differently for macros within
1074 # macros "this(that(tother)))", otherwise lose track of ()'s
1075 if($char eq '(') { $pairs++; }
1078 # deal with ',', add arg to list and start search for next one
1079 elsif($#Endchar == $s && $char eq ',') {
1080 # if char before this was a backslash, ignore this char
1081 if($backslash) {
1082 chop($arg); # delete backslash from string
1084 else {
1085 push(@Args, CleanStart($arg));
1086 $char = '';
1087 $arg = "";
1088 next;
1091 # deal \\ with an escaping \ ie. \" or \, or \\
1092 if($char eq '\\') {
1093 if($backslash) { # found \\
1094 $backslash = 0; # second backslash ignored
1095 chop($arg); # delete backslash from string
1097 else{$backslash = 1;}
1099 elsif($backslash) { $backslash = 0; }
1100 # check for end of args string
1101 if($#Endchar < $s) {
1102 push(@Args, CleanStart($arg));
1103 $char = '';
1104 # put remainder of string back together
1105 $arg = join('', @Chars);
1106 last;
1108 $arg = $arg.$char; # add char to current arg
1109 $char = ''; # set char to null
1112 # deal with last arg or string following args if it exists
1113 push(@Args, $arg);
1115 return @Args;
1119 ##############################################################################
1120 # Find the arguments in a macro and replace them
1121 ##############################################################################
1122 sub FindDefineArgs
1124 my $substring = shift;
1125 my $macro = shift;
1127 # get definition list for this macro
1128 my @Argnames = split(/\,/, $DefinesArgs{$macro});
1130 # check to see if macro can have any number of arguments (last arg ...)
1131 my $anyargs = ($#Argnames >= 0 && $Argnames[$#Argnames] =~ /\.\.\.\Z/o);
1133 # get arguments passed to this macro
1134 my @Argvals = ParseArgs($substring);
1135 # everything following macro args should be returned as tail
1136 my $tail = pop(@Argvals);
1138 # check the right number of args have been passed, should be all args
1139 # present plus string at end of args (assuming macro cannot have any number
1140 # of arguments)
1141 if(!$anyargs && $#Argvals != $#Argnames) {
1142 # show warning if wrong args (unless macro should have zero args and
1143 # 1 arg provided which is blank space
1144 if(!($#Argnames == -1 && $#Argvals == 0 && $Argvals[0] =~ /\A\s*\Z/)) {
1145 Warning("Macro \'".$macro."\' used with ".$#Argvals.
1146 " args, expected ".($#Argnames+1));
1148 # delete all excess args
1149 while($#Argvals > $#Argnames) { pop(@Argvals); }
1151 # make all missing args blanks
1152 while($#Argvals < $#Argnames) { push(@Argvals, ""); }
1154 return (@Argvals, $tail);
1158 ##############################################################################
1159 # FunctionMacro: used with functions to inform a module which macro
1160 # was being replaced when the function was called - used in bigfunc.pm
1161 ##############################################################################
1162 my $functionmacro = "";
1163 sub FunctionMacro
1165 return $functionmacro;
1169 ##############################################################################
1170 # Replace all defined macro's arguments with their values
1171 # Inputs:
1172 # $macro = the macro to be replaces
1173 # $string = the string following the occurrence of macro
1174 ##############################################################################
1175 sub ReplaceDefineArgs
1177 my ($string, $tail, %Used) = @_;
1178 # check if args used, if not do nothing
1179 if(DefineArgsUsed($tail)) {
1180 my $macro = $string;
1181 # get arguments following macro
1182 my @Argvals = FindDefineArgs($tail, $macro);
1183 $tail = pop(@Argvals); # tail returned as last element
1185 my @Argnames = split(/\,/, $DefinesArgs{$macro});
1186 my ($i, $j);
1188 # replace previous macro with defn + args
1189 $string = $Defines{$macro};
1191 # check if macro should call a function
1192 if(exists($DefinesFuncs{$macro})) {
1193 # replace all macros in argument list
1194 for($i=0; $i<=$#Argvals; $i++) {
1195 $Argvals[$i] = ReplaceDefines($Argvals[$i]);
1197 if($debug > 1) {
1198 my $argstring = "";
1199 if($#Argvals >= 0) { $argstring = join(", ", @Argvals); }
1200 Debug("Running function $DefinesFuncs{$macro} with args (".
1201 $argstring.")", 2);
1203 # set name of macro which is being parse (needed in bigfunc.pm)
1204 $functionmacro = $macro;
1205 $string = $DefinesFuncs{$macro}->(@Argvals);
1206 # don't need do anything else, return now
1207 return $string, $tail;
1210 # check if last arg ends in ... (allows any number of args in macro)
1211 if($#Argnames >= 0 && $Argnames[$#Argnames] =~ s/\.\.\.\Z//o) {
1212 # concatanate all extra args into final arg
1213 while($#Argvals > $#Argnames) {
1214 my $arg1 = pop(@Argvals);
1215 my $arg2 = pop(@Argvals);
1216 push(@Argvals, $arg2.", ".$arg1);
1218 # check for ## at start of macro name in args list
1219 if($string =~ /\#\#$Argnames[$#Argnames]/) {
1220 # if last argument is empty remove preciding ","
1221 if($#Argvals == $#Argnames && $Argvals[$#Argnames] eq "") {
1222 $string =~ s/\,\s*\#\#$Argnames[$#Argnames]//g;
1224 else {
1225 $string =~
1226 s/\#\#$Argnames[$#Argnames]/$Argnames[$#Argnames]/g;
1231 # to get args passed to macro to same processed level as rest of
1232 # macro, they need to be checked for occurrences of all used macros,
1233 # this is a nasty hack to temporarily change defines list to %Used
1235 my %RealDefines = %Defines;
1236 my $realdefmin = $defmin;
1237 my $realdefmax = $defmax;
1238 my %RealDefineLookup = %DefineLookup;
1239 %Defines = %Used;
1240 GenerateDefinesKeys();
1242 for($i=0; $i<=$#Argvals; $i++) {
1243 $Argvals[$i] = ReplaceDefines($Argvals[$i]);
1246 # return defines to normal
1247 %Defines = %RealDefines;
1248 $defmin = $realdefmin;
1249 $defmax = $realdefmax;
1250 %DefineLookup = %RealDefineLookup;
1253 # The next step replaces argnames with argvals. Once a bit of string
1254 # has been replaced it is removed from further processing to avoid
1255 # unwanted recursive macro replacement.
1256 my @InString = ( $string ); # string to be replaced
1257 my @InDone = ( 0 ); # flag to say if string section replaced
1258 my @OutString; # output of string sections after each
1259 # macro has been replaced
1260 my @OutDone; # output flags
1261 my $k = 0;
1262 for($i=0; $i<=$#Argnames; $i++) {
1263 for($j=0; $j<=$#InString; $j++) {
1264 if($InDone[$j] == 0) {
1265 # replace macros and split up string so replaced part
1266 # is flagged as done and rest is left for further
1267 # processing
1268 while($InString[$j] =~ /$bound$Argnames[$i]$bound/) {
1269 $OutString[$k] = $`; $OutDone[$k] = 0;
1270 $k++;
1271 $OutString[$k] = $Argvals[$i]; $OutDone[$k] = 1;
1272 $k++;
1273 $InString[$j] = $'; # one more quote for emacs '
1276 $OutString[$k] = $InString[$j]; $OutDone[$k] = $InDone[$j];
1277 $k++;
1279 @InString = @OutString; @InDone = @OutDone;
1280 $k = 0;
1282 # rebuild string
1283 $string = join('', @InString);
1285 Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2);
1287 else {
1288 Debug("Macro \"".$string."\" found without args, ignored", 2);
1290 return ($string, $tail);
1294 ##############################################################################
1295 # When replacing macros with args, the macro and everything following the
1296 # macro (the tail) are passed to ReplaceDefineArgs. The function extracts
1297 # the args from the tail and then returns the replaced macro and the new
1298 # tail. This function extracts the remaining part of the real tail from
1299 # the current input string.
1300 ##############################################################################
1301 sub ReclaimTail
1303 my ($input, $tail) = @_;
1304 # split strings into chars and compare each one until difference found
1305 my @Input = split(//, $input);
1306 my @Tail = split(//, $tail);
1307 $tail = $input = "";
1308 while($#Input >= 0 && $#Tail >= 0 && $Input[$#Input] eq $Tail[$#Tail]) {
1309 $tail = pop(@Tail).$tail;
1310 pop(@Input);
1312 while($#Input >=0) { $input = pop(@Input).$input; }
1313 return ($input, $tail);
1317 ##############################################################################
1318 # Replace all defined macro's in a line with their value. Recursively run
1319 # through macros as many times as needed (to find macros within macros).
1320 # Inputs:
1321 # $input = string to process
1322 # $tail = rest of line following $string (if any), this will only be used
1323 # if string contains a macro with args, the args will probably be
1324 # at the start of the tail
1325 # %Used = all macros found in $string so far, these will not be checked
1326 # again to avoid possible recursion
1327 # Initially just $input is passed in, other args are added for recursive calls
1328 ##############################################################################
1329 sub ReplaceDefines
1331 my ($input, $tail, %Used) = @_;
1332 # check for recursive macro madness (set to same level as Perl warning)
1333 if(++$recurse_level > 97) {
1334 $recurse_level--;
1335 Warning("Recursive macro detected in \"".$input."\"");
1336 if($tail) { return ($input, $tail); }
1337 return $input;
1340 my $out = ""; # initialise output to empty string
1341 OUTER : while($input =~ /\S/o) {
1342 my ($macro, $string);
1343 my @Words;
1346 ######################################################################
1347 # if macros start with prefix, skip to next prefix
1348 ######################################################################
1349 if($macroprefix ne "") {
1350 my $found = 0;
1351 # find next potential macro in line if any
1352 while(!$found && $input =~ /$macroprefix\S/) {
1353 # everything before prefix
1354 $out = $out.$`;
1355 # reclaim first char in macro
1356 my $match = $&;
1357 # everything after prefix
1358 $input = chop($match).$'; # one more quote for emacs '
1359 # check if first chars are in macro
1360 if(exists($DefineLookup{substr($input, 0, $defmin)})) {
1361 $found = 1;
1363 # put prefix back onto output and carry on searching
1364 else { $out = $out.$match; }
1366 # no more macros
1367 if(!$found) { $out = $out.$input; $input = ""; last OUTER; }
1371 ######################################################################
1372 # replacing macros which are "words" only - quick and easy
1373 ######################################################################
1374 if($bound eq '\b') {
1375 @Words = split(/(\w+)/, $input, 2);
1376 $out = $out.$Words[0];
1377 if($#Words == 2) { $macro = $Words[1]; $input = $Words[2]; }
1378 else { $input = ""; last OUTER; }
1381 ######################################################################
1382 # replacing all types of macro - slow and horrid
1383 ######################################################################
1384 else {
1385 # forward string to next non-whitespace char that starts a macro
1386 while(!exists($DefineLookup{substr($input, 0, $defmin)})) {
1387 if($input =~ /^\s/ ) { # remove preceding whitespace
1388 @Words = split(/^(\s+)/, $input, 2);
1389 $out = $out.$Words[1];
1390 $input = $Words[2];
1392 else { # skip to next char
1393 $out = $out.substr($input, 0, 1);
1394 $input = substr($input, 1);
1396 if($input eq "") { last OUTER; }
1398 # remove the longest possible potential macro (containing no
1399 # whitespace) from the start of input
1400 @Words = split(/(\s+)/, $input, 2);
1401 $macro = $Words[0];
1402 if($#Words == 2) {$input = $Words[1].$Words[2]; }
1403 else {$input = ""; }
1404 # shorten macro if too long
1405 if(length($macro) > $defmax) {
1406 $input = substr($macro, $defmax).$input;
1407 $macro = substr($macro, 0, $defmax);
1409 # see if a macro exists in "macro"
1410 while(length($macro) > $defmin &&
1411 !(exists($Defines{$macro}) && !exists($Used{$macro}))) {
1412 # chop a char off macro and try again
1413 $input = chop($macro).$input;
1417 # check if macro is at start of string and has not been used yet
1418 if(exists($Defines{$macro}) && !exists($Used{$macro})) {
1419 # set macro as used
1420 $Used{$macro} = $Defines{$macro};
1421 # temporarily add tail to input
1422 if($tail) { $input = $input.$tail; }
1423 # replace macro with defn
1424 if(CheckDefineArgs($macro)) {
1425 ($string, $input) = ReplaceDefineArgs($macro, $input, %Used);
1427 else {
1428 $string = $Defines{$macro};
1429 Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2);
1432 ($string=~ m/\#\#/) and ($string=~ s/\s*\#\#\s*//gm);
1434 @Words = ReplaceDefines($string, $input, %Used);
1435 $out = $out.$Words[0];
1436 if($#Words == 0) { $input = ""; }
1437 else {
1438 # remove space up to start of next char
1439 if(CheckEatTrail($macro)) { $Words[1] =~ s/^[ \t]*//o; }
1440 $input = $Words[1];
1442 delete($Used{$macro});
1443 # reclaim all unparsed tail
1444 if($tail && $tail ne "") {
1445 ($input, $tail) = ReclaimTail($input, $tail);
1448 # macro not matched, add to output and move swiftly on
1449 else {
1450 if($bound eq '\b') { $out = $out.$macro; }
1451 else {
1452 $out = $out.substr($macro, 0, 1);
1453 $input = substr($macro, 1).$input;
1457 $recurse_level--;
1458 # append any whitespace left in string and return it
1459 if($tail) { return ($out.$input, $tail); }
1460 return $out.$input;
1464 ##############################################################################
1465 # GenerateDefinesKey creates all keys and indices needed for %Defines
1466 ##############################################################################
1467 sub GenerateDefinesKeys
1469 # find longest and shortest macro
1470 my ($define, $length) = each %Defines;
1471 $defmin = $defmax = length($define);
1472 %DefineLookup = ();
1473 foreach $define (keys(%Defines)) {
1474 $length = length($define);
1475 if($length > $defmax) { $defmax = $length; }
1476 if($length < $defmin) { $defmin = $length; }
1478 # regenerate lookup table of first letters
1479 foreach $define (keys(%Defines)) {
1480 $DefineLookup{substr($define, 0, $defmin)} = 1;
1485 ##############################################################################
1486 # Set a define
1487 ##############################################################################
1488 sub SetDefine
1490 my ($macro, $value) = @_;
1491 # add macro and value to hash table
1492 $Defines{$macro} = $value;
1493 # add define to keys
1494 my $length = length($macro);
1495 if($length < $defmin || $defmin == 0) { GenerateDefinesKeys(); }
1496 else {
1497 if($length > $defmax) { $defmax = $length; }
1498 $length = substr($macro, 0, $defmin);
1499 $DefineLookup{$length} = 1;
1504 ##############################################################################
1505 # Get a define without doing any macro replacement
1506 ##############################################################################
1507 sub GetDefine
1509 my $macro = shift;
1510 return $Defines{$macro};
1514 ##############################################################################
1515 # Replace a define, checks if macro defined and only redefine's if it is
1516 ##############################################################################
1517 sub Redefine
1519 my $macro = shift;
1520 my $value = shift;
1521 # check if defined
1522 if(CheckDefine($macro)) { SetDefine($macro, $value); }
1526 ##############################################################################
1527 # Set a define argument list
1528 ##############################################################################
1529 sub SetDefineArgs
1531 my $macro = shift;
1532 my $args = shift;
1533 # add macro args to hash table
1534 $DefinesArgs{$macro} = $args;
1538 ##############################################################################
1539 # Set a function which should be called when a macro is found
1540 ##############################################################################
1541 sub SetDefineFuncs
1543 my $macro = shift;
1544 my $func = shift;
1545 # add macro function to hash table
1546 $DefinesFuncs{$macro} = $func;
1550 ##############################################################################
1551 # Check if a macro is defined
1552 ##############################################################################
1553 sub CheckDefine
1555 my $macro = shift;
1556 return exists($Defines{$macro});
1560 ##############################################################################
1561 # Check if a macro is defined and has arguments
1562 ##############################################################################
1563 sub CheckDefineArgs
1565 my $macro = shift;
1566 return exists($DefinesArgs{$macro});
1570 ##############################################################################
1571 # Check if a macro is defined and calls a function
1572 ##############################################################################
1573 sub CheckDefineFuncs
1575 my $macro = shift;
1576 return exists($DefinesFuncs{$macro});
1580 ##############################################################################
1581 # Check if a macro is defined and eats trailing whitespace
1582 ##############################################################################
1583 sub CheckEatTrail
1585 my $macro = shift;
1586 return exists($EatTrail{$macro});
1590 ##############################################################################
1591 # Set eat-trailing-whitespace for a macro
1592 ##############################################################################
1593 sub SetEatTrail
1595 my $macro = shift;
1596 $EatTrail{$macro} = 1;
1600 ##############################################################################
1601 # Test if a file exists and is readable
1602 ##############################################################################
1603 sub FileExists
1605 my $filename = shift;
1606 # test if file is readable and not a directory
1607 if( !(-r $filename) || -d $filename ) {
1608 Debug("Checking for file: ".$filename."...not found!", 2);
1609 return 0;
1611 Debug("Checking for file: ".$filename."...found!", 2);
1612 return 1;
1616 ##############################################################################
1617 # #comment - rest of line ignored as a comment
1618 ##############################################################################
1619 sub Comment
1621 # nothing to be done here
1622 Debug("Commented line", 2);
1626 ##############################################################################
1627 # Define a variable, accepted inputs:
1628 # $macrodefn = $macro $defn - $macro associated with $defn
1629 # ie: #define TEST test string
1630 # $macro = TEST, $defn = "test string"
1631 # Note: $defn = rest of line after $macro
1632 # $macrodefn = $macro - $macro defined without a defn, rest of line ignored
1633 # ie: #define TEST_DEFINE
1634 # $macro = TEST_DEFINE, $defn = "1"
1635 ##############################################################################
1636 sub Define
1638 my $macrodefn = shift;
1639 my $macro;
1640 my $defn;
1641 my $i;
1643 # check there is an argument
1644 if($macrodefn !~ /\S/o) {
1645 Filepp::Error("define keyword used without arguments");
1648 # find end of macroword - assume separated by space or tab
1649 $i = GetNextWordEnd($macrodefn);
1651 # separate macro and defn (can't use split, doesn't work with '0')
1652 $macro = substr($macrodefn, 0, $i);
1653 $defn = substr($macrodefn, $i);
1655 # strip leading whitespace from $defn
1656 if($defn) {
1657 $defn =~ s/^[ \t]*//;
1659 else {
1660 $defn = "";
1663 # check if macro has arguments (will be a '(' in macro)
1664 if($macro =~ /\(/) {
1665 # split up macro, args and defn - delimiters = space, (, ), ','
1666 my @arglist = split(/([\s,\(,\),\,])/, $macro." ".$defn);
1667 my $macroargs = "";
1668 my $arg;
1670 # macro is first element in list, remove it from list
1671 $macro = $arglist[0];
1672 $arglist[0] = "";
1673 # loop through list until ')' and find all args
1674 foreach $arg (@arglist) {
1675 if($arg) {
1676 # end of arg list, leave loop
1677 if($arg eq ")") {
1678 $arg = "";
1679 last;
1681 # ignore space, ',' and '('
1682 elsif($arg =~ /([\s,\,,\(])/) {
1683 $arg = "";
1685 # argument found, add to ',' separated list
1686 else {
1687 $macroargs = $macroargs.",".$arg;
1688 $arg = "";
1692 $macroargs = Strip($macroargs, ",", 1);
1693 # store args
1694 SetDefineArgs($macro, $macroargs);
1696 Debug("Define: macro ".$macro." has args (".$macroargs.")", 2);
1697 # put rest of defn back together
1698 $defn = join('',@arglist);
1699 $defn = CleanStart($defn);
1701 # make sure macro is not being redefined and used to have args
1702 else {
1703 delete($DefinesArgs{$macro});
1704 delete($DefinesFuncs{$macro});
1707 # define the macro defn pair
1708 SetDefine($macro, $defn);
1710 Debug("Defined \"".$macro."\" to be \"".$defn."\"", 2);
1711 if($debug > 2) { PrintDefines(); }
1716 ##############################################################################
1717 # Else, standard if[n][def]-else-endif
1718 # usage: #else somewhere between #if[n][def] key and #endif
1719 ##############################################################################
1720 sub Else
1722 # else always true - only ran when all preceding 'if's have failed
1723 return 1;
1727 ##############################################################################
1728 # Endif, standard ifdef-[else]-endif
1729 # usage: #endif somewhere after #ifdef key and optionally #else
1730 ##############################################################################
1731 sub Endif
1733 # this always terminates an if block
1734 return 1;
1738 ##############################################################################
1739 # If conditionally includes or ignores parts of a file based on expr
1740 # usage: #if expr
1741 # expr is evaluated to true(1) or false(0) and include usual ==, !=, > etc.
1742 # style comparisons. The "defined" keyword can also be used, ie:
1743 # #if defined MACRO || !defined(MACRO)
1744 ##############################################################################
1745 sub If
1747 my $expr = shift;
1748 Debug("If: parsing: \"".$expr."\"", 2);
1750 # check for any "defined MACRO" tests and evaluate them
1751 if($expr =~ /defined/) {
1752 my $indefined = 0;
1754 # split expr up into its component parts, the split is done on the
1755 # following list of chars and strings: '!','(',')','&&','||', space
1756 my @Exprs = split(/([\s,\!,\(,\)]|\&\&|\|\|)/, $expr);
1758 # search through parts for "defined" keyword and check if macros
1759 # are defined
1760 foreach $expr (@Exprs) {
1761 if($indefined == 1) {
1762 # previously found a defined keyword, check if next word
1763 # could be the macro to test for (not any of the listed chars)
1764 if($expr && $expr !~ /([\s,\!,\(,\)]|\&\&|\|\|)/) {
1765 # replace macro with 0 or 1 depending if it is defined
1766 Debug("If: testing if \"".$expr."\" defined...", 2);
1767 if(CheckDefine($expr)) {
1768 $expr = 1;
1769 Debug("If: defined", 2);
1771 else {
1772 $expr = 0;
1773 Debug("If: NOT defined", 2);
1775 $indefined = 0;
1778 elsif($expr eq "defined") {
1779 # get rid of defined keyword
1780 $expr = "";
1781 # search for next macro following "defined"
1782 $indefined = 1;
1786 # put full expr string back together
1787 my $newexpr = join('',@Exprs);
1788 $expr = $newexpr;
1791 # pass parsed line though processors
1792 $expr = RunProcessors($expr);
1794 # evaluate line and return result (1 = true)
1795 Debug("If: evaluating \"".$expr."\"", 2);
1796 my $result = eval($expr);
1797 # check if statement is valid
1798 if(!defined($result)) { Warning($@); }
1799 elsif($result) {
1800 Debug("If: \"".$expr."\" true", 1);
1801 return 1;
1803 Debug("If: \"".$expr."\" false", 1);
1804 return 0;
1808 ##############################################################################
1809 # Elif equivalent to "else if". Placed between #if[n][def] and #endif,
1810 # equivalent to nesting #if's
1811 ##############################################################################
1812 sub Elif
1814 my $input = shift;
1815 return If($input);
1819 ##############################################################################
1820 # Ifdef conditionally includes or ignores parts of a file based on macro,
1821 # usage: #ifdef MACRO
1822 # if macro has been previously #define'd everything following the
1823 # #ifdef will be included, else it will be ignored until #else or #endif
1824 ##############################################################################
1825 sub Ifdef
1827 my $macro = shift;
1829 # separate macro from any trailing garbage
1830 $macro = substr($macro, 0, GetNextWordEnd($macro));
1832 # check if macro defined - if not set to be #ifdef'ed out
1833 if(CheckDefine($macro)) {
1834 Debug("Ifdef: ".$macro." defined", 1);
1835 return 1;
1837 Debug("Ifdef: ".$macro." not defined", 1);
1838 return 0;
1842 ##############################################################################
1843 # Ifndef conditionally includes or ignores parts of a file based on macro,
1844 # usage: #ifndef MACRO
1845 # if macro has been previously #define'd everything following the
1846 # #ifndef will be ignored, else it will be included until #else or #endif
1847 ##############################################################################
1848 sub Ifndef
1850 my $macro = shift;
1852 # separate macro from any trailing garbage
1853 $macro = substr($macro, 0, GetNextWordEnd($macro));
1855 # check if macro defined - if not set to be #ifdef'ed out
1856 if(CheckDefine($macro)) {
1857 Debug("Ifndef: ".$macro." defined", 1);
1858 return 0;
1860 Debug("Ifndef: ".$macro." not defined", 1);
1861 return 1;
1865 ##############################################################################
1866 # Parses all macros from file, but discards all other output
1867 ##############################################################################
1868 sub IncludeMacros
1870 my $file = shift;
1871 my $currentoutput = $output;
1872 SetOutput(0);
1873 Parse($file);
1874 SetOutput($currentoutput);
1878 ##############################################################################
1879 # Include $filename in output file, format:
1880 # #include "filename" - local include file, ie. in same directory, try -Ipath
1881 # also if not not found in current directory
1882 # #include <filename> - system include file, use -Ipath
1883 ##############################################################################
1884 sub Include
1886 my $input = shift;
1887 my $filename = $input;
1888 my $fullname;
1889 my $sysinclude = 0;
1890 my $found = 0;
1891 my $i;
1893 # check for recursive includes (level set to same as Perl recurse warn)
1894 if($include_level >= 98) {
1895 Warning("Include recursion too deep - skipping \"".$filename."\"\n");
1896 return;
1899 # replace any defined values in the include line
1900 $filename = RunProcessors($filename);
1902 # check if it is a system include file (#include <filename>) or a local
1903 # include file (#include "filename")
1904 if(substr($filename, 0, 1) eq "<") {
1905 $sysinclude = 1;
1906 # remove <> from filename
1907 $filename = substr($filename, 1);
1908 ($filename) = split(/\>/, $filename, 2);
1910 elsif(substr($filename, 0, 1) eq "\"") {
1911 # remove double quotes from filename
1912 $filename = substr($filename, 1);
1913 ($filename) = split(/\"/, $filename, 2);
1915 # else assume filename given without "" or <>, naughty but allowed
1917 # check for file in current directory
1918 if($sysinclude == 0) {
1919 # get name of directory base file is in
1920 my $dir = "";
1921 if($file =~ /\//) {
1922 my @Dirs = split(/(\/)/, $file);
1923 for($i=0; $i<$#Dirs; $i++) {
1924 $dir = $dir.$Dirs[$i];
1927 if(FileExists($dir.$filename)) {
1928 $fullname = $dir.$filename;
1929 $found = 1;
1933 # search for file in include paths, first path on command line first
1934 $i = 0;
1935 while($found == 0 && $i <= $#IncludePaths) {
1936 $fullname = $IncludePaths[$i]."/".$filename;
1937 if(FileExists($fullname)) { $found = 1; }
1938 $i++;
1941 # include file if found, error if not
1942 if($found == 1) {
1943 Debug("Including file: \"".$fullname."\"", 1);
1944 # recursively call Parse
1945 Parse($fullname);
1947 else {
1948 Warning("Include file \"".$filename."\" not found", 1);
1954 ##############################################################################
1955 # Pragma filepp Function Args
1956 # Pragma executes a filepp function, everything following the function name
1957 # is passed as arguments to the function.
1958 # The format is:
1959 # #pragma filepp function args...
1960 # If pragma is not followed by "filepp", it is ignored.
1961 ##############################################################################
1962 sub Pragma
1964 my $input = shift;
1966 # check for "filepp" in string
1967 if($input =~ /^filepp\b/) {
1968 my ($function, $args);
1969 ($input, $function, $args) = split(/\s/, $input, 3);
1970 if($function) {
1971 if(!$args) { $args = ""; }
1972 if($safe_mode) {
1973 Debug("Safe mode enabled, NOT running: ".$function."(".$args.")", 1);
1975 else {
1976 my @Args = ParseArgs($args);
1977 Debug("Running function: ".$function."(".$args.")", 1);
1978 $function->(@Args);
1985 ##############################################################################
1986 # Turn normal output on/off (does not affect any output produced by keywords)
1987 # 1 = on, 0 = off
1988 ##############################################################################
1989 sub SetOutput
1991 $output = shift;
1992 Debug("Output set to ".$output, 2);
1996 ##############################################################################
1997 # Turn blank suppression on and off at this include level
1998 # 1 = on, 0 = off
1999 ##############################################################################
2000 sub SetBlankSupp
2002 $blanksupp[$include_level] = shift;
2003 Debug("Blank suppression set to ".$blanksupp[$include_level], 2);
2007 ##############################################################################
2008 # Reset blank suppression to command-line value (except at level 0)
2009 ##############################################################################
2010 sub ResetBlankSupp
2012 if($include_level == 0) {
2013 $blanksupp[$include_level] = 0;
2014 } else {
2015 $blanksupp[$include_level] = $blanksuppopt;
2017 Debug("Blank suppression reset to ".$blanksupp[$include_level], 2);
2021 ##############################################################################
2022 # Set if macros are only replaced if the macro is a 'word'
2023 ##############################################################################
2024 sub SetWordBoundaries
2026 my $on = shift;
2027 if($on) {
2028 $bound = '\b';
2029 Debug("Word Boundaries turned on", 2);
2031 else {
2032 $bound = '';
2033 Debug("Word Boundaries turned off", 2);
2037 ##############################################################################
2038 # DEPRECATED - this function will be removed in later versions, use Set
2039 # Toggle if macros are only replaced if the macro is a 'word'
2040 ##############################################################################
2041 sub ToggleWordBoundaries
2043 if($bound eq '\b') { SetWordBoundaries(1); }
2044 else { SetWordBoundaries(0); }
2048 ##############################################################################
2049 # Set treating keywordchar, contchar, macroprefix and optlineendchar as
2050 # Perl regexps
2051 ##############################################################################
2052 sub SetCharPerlre
2054 $charperlre = shift;
2055 Debug("Characters treated as Perl regexp's : ".$charperlre, 2);
2059 ##############################################################################
2060 # Undef a previously defined variable, usage:
2061 # #undef $macro
2062 ##############################################################################
2063 sub Undef
2065 my $macro = shift;
2066 my $i;
2068 # separate macro from any trailing garbage
2069 $macro = substr($macro, 0, GetNextWordEnd($macro));
2071 # delete macro from table
2072 delete $Defines{$macro};
2073 delete $DefinesArgs{$macro};
2074 delete $DefinesFuncs{$macro};
2076 # and remove its eat-trailing-whitespace flag
2077 if(CheckEatTrail($macro)) { delete $EatTrail{$macro}; }
2079 # regenerate keys
2080 GenerateDefinesKeys();
2082 Debug("Undefined macro \"".$macro."\"", 2);
2083 if($debug > 1) { PrintDefines(); }
2087 ##############################################################################
2088 # UndefAll - undefines ALL macros
2089 ##############################################################################
2090 sub UndefAll
2092 %Defines = ();
2093 %DefineLookup = ();
2094 %EatTrail = ();
2095 $defmin = $defmax = 0;
2096 Debug("Undefined ALL macros", 2);
2097 if($debug > 1) { PrintDefines(); }
2101 ##############################################################################
2102 # #warning msg - print warning message "msg"
2103 ##############################################################################
2104 sub Warning
2106 my $msg = shift;
2107 my $lastdebug = $debug;
2108 $debug = 1;
2109 Debug($msg, 1);
2110 $debug = $lastdebug;
2114 ##############################################################################
2115 # ParseLineEnd - takes in line from input most recently read and checks
2116 # if line should be continued (ie. next line in input read and appended
2117 # to current line).
2118 # Returns two values:
2119 # $more - boolean, 1 = read another line from input to append to this one
2120 # 0 = no line continuation
2121 # $line - the line to be read. If any modification needs to be done to the
2122 # line for line contination, it is done here.
2123 # Example: if line is to be continued: set $more = 1, then
2124 # remove line continuation character and newline from end of
2125 # $line and replace with line continuation character.
2126 ##############################################################################
2127 sub ParseLineEnd
2129 my $thisline = shift;
2130 my $more = 0;
2131 # check if end of line has a continuation char, if it has get next line
2132 if($thisline =~ /$contchar$/) {
2133 $more = 1;
2134 # remove backslash and newline
2135 $thisline =~ s/$contchar\n\Z//;
2136 # append line continuation character
2137 $thisline = $thisline.$contrepchar;
2139 return ($more, $thisline);
2143 ##############################################################################
2144 # Set name of function to take check if line shoule be continued
2145 ##############################################################################
2146 sub SetParseLineEnd
2148 my $func = shift;
2149 $parselineend = $func;
2152 ##############################################################################
2153 # Get name of function to take check if line shoule be continued
2154 ##############################################################################
2155 sub GetParseLineEnd
2157 return $parselineend;
2161 ##############################################################################
2162 # GetNextLine - returns the next line of the current INPUT line,
2163 # line continuation is taken care of here.
2164 ##############################################################################
2165 sub GetNextLine
2167 my $thisline = <INPUT>;
2168 if($thisline) {
2169 Redefine("__LINE__", ++$line);
2170 my $more = 0;
2171 ($more, $thisline) = $parselineend->($thisline);
2172 while($more) {
2173 Debug("Line continuation", 2);
2174 my $nextline = <INPUT>;
2175 if(!$nextline) { return $thisline; }
2176 # increment line count
2177 Redefine("__LINE__", ++$line);
2178 ($more, $thisline) = $parselineend->($thisline.$nextline);
2179 # maintain same number of lines in input as output
2180 if($preserveblank) { Filepp::Output("\n"); }
2183 return $thisline;
2187 ##############################################################################
2188 # Write($string) - writes $string to OUTPUT file
2189 ##############################################################################
2190 sub Write
2192 my $string = shift;
2193 print(OUTPUT $string);
2197 ##############################################################################
2198 # Output($string) - conditionally writes $string to OUTPUT file
2199 ##############################################################################
2200 sub Output
2202 my $string = shift;
2203 if($output) { Write($string); }
2206 # counter for number of #if[n][def] loops currently in
2207 my $iflevel = 0;
2208 # flag to control when to write output
2209 my @Writing = (1); # initialise default to 'writing'
2210 # flag to show if current 'if' block has passed a 'true if'
2211 my @Ifdone = (0); # initialise first to 'not passed true if'
2213 ##############################################################################
2214 # Keyword parsing routine
2215 ##############################################################################
2216 sub ParseKeywords
2218 # input is next line in file
2219 my $inline = shift;
2220 my $outline = "";
2222 my $thisline = $inline;
2223 my $keyword;
2224 my $found = 0;
2225 # remove whitespace from start of line
2226 $thisline = CleanStart($thisline);
2227 # check if first char on line is a #
2228 if($thisline && $thisline =~ /^$keywordchar/) {
2229 # remove "#" and any following whitespace
2230 $thisline =~ s/^$keywordchar\s*//g;
2231 # remove the optional end line char
2232 if($optlineendchar ne "") {
2233 $thisline =~ s/$optlineendchar\Z//g;
2235 # check for keyword
2236 if($thisline && $thisline =~ /^\w+\b/ && exists($Keywords{$&})) {
2237 $keyword = $&;
2238 $found = 1;
2239 # remove newline from line
2240 chomp($thisline);
2241 # remove leading whitespace and keyword from line
2242 my $inline = CleanStart(substr($thisline, length($keyword)));
2244 # check for 'if' style keyword
2245 if(exists($Ifwords{$keyword})) {
2246 # increment ifblock level and set ifdone to same
2247 # value as previous block
2248 $iflevel++;
2249 $Ifdone[$iflevel] = 0;
2250 $Writing[$iflevel] = $Writing[$iflevel - 1];
2251 if(!$Writing[$iflevel]) { $Ifdone[$iflevel] = 1; }
2253 # check for out of place 'else' or 'endif' style keyword
2254 elsif($iflevel <= 0 && (exists($Elsewords{$keyword}) ||
2255 exists($Endifwords{$keyword}) )) {
2256 Warning($keywordchar.$keyword." found without preceding ".
2257 $keywordchar."[else]ifword");
2260 # decide if to run 'if' or 'else' keyword
2261 if(exists($Ifwords{$keyword}) || exists($Elsewords{$keyword})){
2262 if(!($Ifdone[$iflevel])) {
2263 # check return value of 'if'
2264 if($Keywords{$keyword}->($inline)) {
2265 $Ifdone[$iflevel] = 1;
2266 $Writing[$iflevel] = 1;
2268 else { $Writing[$iflevel] = 0; }
2270 else { $Writing[$iflevel] = 0; }
2272 # check for 'endif' style keyword
2273 elsif(exists($Endifwords{$keyword})) {
2274 # run endif keyword and decrement iflevel if true
2275 if($Keywords{$keyword}->($inline)) { $iflevel--; }
2277 # run all other keywords
2278 elsif($Writing[$iflevel]) { $Keywords{$keyword}->($inline); }
2280 # write a blank line if preserving blank lines
2281 # (assumes keywords have no output)
2282 if($preserveblank) { $outline = $outline."\n"; }
2284 } # keyword if statement
2286 # no keywords in line - write line to file if not #ifdef'ed out
2287 if(!$found && $Writing[$iflevel]) {
2288 $outline = $outline.$inline;
2290 # keep same number of files in output and input
2291 elsif(!$found && $preserveblank) { $outline = $outline."\n"; }
2293 return $outline;
2296 ##############################################################################
2297 # Main parsing routine
2298 ##############################################################################
2299 sub Parse
2301 # change file being parsed to this file, remember last filename so
2302 # it can be returned at the end
2303 my $lastparse = $file;
2304 $file = shift;
2306 Debug("Parsing ".$file."...", 1);
2307 Redefine("__FILE__", $file);
2309 # reset line count, remembering previous count for future reference
2310 my $lastcount = $line;
2311 $line = 0;
2312 Redefine("__LINE__", $line);
2314 # increment include level
2315 Redefine("__INCLUDE_LEVEL__", ++$include_level);
2317 # set blank line suppression:
2318 # no suppression for top level files
2319 if($include_level == 0) {
2320 $blanksupp[$include_level] = 0;
2322 # include level 1 - set suppression to command line given value
2323 elsif($include_level == 1) {
2324 # inherit root value if set
2325 if($blanksupp[0]) { $blanksupp[$include_level] = 1; }
2326 else {$blanksupp[$include_level] = $blanksuppopt; }
2328 # all other include levels - keep suppression at existing value
2329 else {
2330 $blanksupp[$include_level] = $blanksupp[$include_level - 1];
2333 # reset RunProcessors function for this file
2334 $Running[$include_level] = 0;
2335 $Currentproc[$include_level] = 0;
2337 # open file and set its handle to INPUT
2338 local *INPUT;
2339 if(!open(INPUT, $file)) {
2340 Error("Could not open file ".$file);
2343 # if a base file, run any initialisation functions
2344 if($include_level == 0) {
2345 my $func;
2346 foreach $func (@OpenInputFuncs) { $func->(); }
2349 # parse each line of file
2350 $_ = GetNextLine();
2351 # if in "shebang" mode, throw away first line (the #!/blah bit)
2352 if($shebang) {
2353 # check for "#!...perl ...filepp..."
2354 if($_ && $_ =~ /^\#\!.*perl.+filepp/) {
2355 Debug("Skipping first line (shebang): ".$_, 1);
2356 $_ = GetNextLine();
2360 while($_) {
2361 # unless blank lines are suppressed at this include level
2362 unless($blanksupp[$include_level] && /^\s*$/) {
2363 # run processing chain (defaults to ReplaceDefines)
2364 $_ = RunProcessors($_, 1);
2365 # write output to file or STDOUT
2366 if($output) { Write($_); }
2368 $_ = GetNextLine();
2371 # run any close functions
2372 if($include_level == 0) {
2373 my $func;
2374 foreach $func (@CloseInputFuncs) { $func->(); }
2377 # check all #if blocks have been closed at end of parsing
2378 if($lastparse eq "" && $iflevel > 0) { Warning("Unterminated if block"); }
2380 # close file
2381 close(INPUT);
2382 Debug("Parsing ".$file." done. (".$line." lines processed)", 1);
2384 # reset $line
2385 $line = $lastcount;
2386 Redefine("__LINE__", $line);
2388 # reset $file
2389 $file = $lastparse;
2390 Redefine("__FILE__", $file);
2391 if($file ne "") {
2392 Debug("Parsing returned to ".$file." at line ".$line, 1);
2395 # decrement include level
2396 Redefine("__INCLUDE_LEVEL__", --$include_level);
2400 ##############################################################################
2401 # Main routine
2402 ##############################################################################
2404 # parse command line
2405 my $i=0;
2406 my $argc=0;
2407 while($ARGV[$argc]) { $argc++; }
2409 while($ARGV[$i]) {
2411 # suppress blank lines in header files
2412 if($ARGV[$i] eq "-b") {
2413 $blanksuppopt = 1;
2416 # read from stdin instead of file
2417 elsif($ARGV[$i] eq "-c") {
2418 AddInputFile("-");
2421 # Defines: -Dmacro[=defn] or -D macro[=defn]
2422 elsif(substr($ARGV[$i], 0, 2) eq "-D") {
2423 my $macrodefn;
2424 # -D macro[=defn] format
2425 if(length($ARGV[$i]) == 2) {
2426 if($i+1 >= $argc) {
2427 Error("Argument to `-D' is missing");
2429 $macrodefn = $ARGV[++$i];
2431 # -Dmacro[=defn] format
2432 else {
2433 $macrodefn = substr($ARGV[$i], 2);
2435 my $macro = $macrodefn;
2436 my $defn = "";
2437 my $j = index($macrodefn, "=");
2438 if($j > -1) {
2439 $defn = substr($macrodefn, $j+1);
2440 $macro = substr($macrodefn, 0, $j);
2442 # add macro and defn to hash table
2443 Define($macro." ".$defn);
2446 # Debugging turned on: -d
2447 elsif($ARGV[$i] eq "-d") {
2448 SetDebug(2);
2451 # Full debugging turned on: -dd
2452 elsif($ARGV[$i] eq "-dd") {
2453 SetDebug(3);
2456 # Light debugging turned on: -dl
2457 elsif($ARGV[$i] eq "-dl") {
2458 SetDebug(1);
2461 # Send debugging info to stdout rather than stderr
2462 elsif($ARGV[$i] eq "-ds") {
2463 $debugstdout = 1;
2466 # prefix all debugging info with string
2467 elsif($ARGV[$i] eq "-dpre") {
2468 if($i+1 >= $argc) {
2469 Error("Argument to `-dpre' is missing");
2471 $debugprefix = ReplaceDefines($ARGV[++$i]);
2474 # prefix all debugging info with string
2475 elsif($ARGV[$i] eq "-dpost") {
2476 if($i+1 >= $argc) {
2477 Error("Argument to `-dpost' is missing");
2479 # replace defines is called here in case a newline is required,
2480 # this allows it to be added as __NEWLINE__
2481 $debugpostfix = ReplaceDefines($ARGV[++$i]);
2484 # define environment variables as macros: -e
2485 elsif($ARGV[$i] eq "-e") {
2486 DefineEnv();
2489 # set environment variable prefix char
2490 elsif($ARGV[$i] eq "-ec") {
2491 if($i+1 >= $argc) {
2492 Error("Argument to `-ec' is missing");
2494 SetEnvchar($ARGV[++$i]);
2497 # set environment variable prefix char to nothing
2498 elsif($ARGV[$i] eq "-ecn") {
2499 SetEnvchar("");
2502 # show help
2503 elsif($ARGV[$i] eq "-h") {
2504 print(STDERR $usage);
2505 exit(0);
2508 # Include paths: -Iinclude or -I include
2509 elsif(substr($ARGV[$i], 0, 2) eq "-I") {
2510 # -I include format
2511 if(length($ARGV[$i]) == 2) {
2512 if($i+1 >= $argc) {
2513 Error("Argument to `-I' is missing");
2515 AddIncludePath($ARGV[++$i]);
2517 # -Iinclude format
2518 else {
2519 AddIncludePath(substr($ARGV[$i], 2));
2523 # Include macros from file: -imacros file
2524 elsif($ARGV[$i] eq "-imacros") {
2525 if($i+1 >= $argc) {
2526 Error("Argument to `-imacros' is missing");
2528 push(@Imacrofiles, $ARGV[++$i]);
2531 # turn off keywords
2532 elsif($ARGV[$i] eq "-k") {
2533 RemoveAllKeywords();
2536 # set keyword prefix char
2537 elsif($ARGV[$i] eq "-kc") {
2538 if($i+1 >= $argc) {
2539 Error("Argument to `-kc' is missing");
2541 SetKeywordchar($ARGV[++$i]);
2544 # set line continuation character
2545 elsif($ARGV[$i] eq "-lc") {
2546 if($i+1 >= $argc) {
2547 Error("Argument to `-lc' is missing");
2549 SetContchar($ARGV[++$i]);
2552 # set optional line end character
2553 elsif($ARGV[$i] eq "-lec") {
2554 if($i+1 >= $argc) {
2555 Error("Argument to `-lec' is missing");
2557 SetOptLineEndchar($ARGV[++$i]);
2560 # set line continuation replacement char to newline
2561 elsif($ARGV[$i] eq "-lrn") {
2562 SetContrepchar("\n");
2565 # set line continuation replacement character
2566 elsif($ARGV[$i] eq "-lr") {
2567 if($i+1 >= $argc) {
2568 Error("Argument to `-lr' is missing");
2570 SetContrepchar($ARGV[++$i]);
2573 # Module paths: -Minclude or -M include
2574 elsif(substr($ARGV[$i], 0, 2) eq "-M") {
2575 # -M include format
2576 if(length($ARGV[$i]) == 2) {
2577 if($i+1 >= $argc) {
2578 Error("Argument to `-M' is missing");
2580 AddModulePath($ARGV[++$i]);
2582 # -Minclude format
2583 else {
2584 AddModulePath(substr($ARGV[$i], 2));
2588 # use module
2589 elsif($ARGV[$i] eq "-m") {
2590 if($i+1 >= $argc) {
2591 Error("Argument to `-m' is missing");
2593 UseModule($ARGV[++$i]);
2596 # set macro prefix
2597 elsif($ARGV[$i] eq "-mp") {
2598 if($i+1 >= $argc) {
2599 Error("Argument to `-mp' is missing");
2601 SetMacroPrefix($ARGV[++$i]);
2604 # turn off macro prefix within keywords
2605 elsif($ARGV[$i] eq "-mpnk") {
2606 $macroprefixinkeywords = 0;
2609 # turn on overwrite mode
2610 elsif($ARGV[$i] eq "-ov") {
2611 $overwrite = 1;
2614 # turn on overwrite conversion mode
2615 elsif($ARGV[$i] eq "-ovc") {
2616 if($i+1 >= $argc) {
2617 Error("Argument to `-ovc' is missing");
2619 $overwriteconv = $ARGV[++$i];
2620 if($overwriteconv !~ /=/) {
2621 Error("-ovc argument is of form IN=OUT");
2623 $overwrite = 1;
2626 # Output filename: -o filename or -ofilename
2627 elsif(substr($ARGV[$i], 0, 2) eq "-o") {
2628 # -o filename
2629 if(length($ARGV[$i]) == 2) {
2630 if($i+1 >= $argc) {
2631 Error("Argument to `-o' is missing");
2633 $outputfile = $ARGV[++$i];
2635 # -ofilename
2636 else {
2637 $outputfile = substr($ARGV[$i], 2);
2641 # preserve blank lines in output file
2642 elsif($ARGV[$i] eq "-pb") {
2643 $preserveblank = 1;
2646 # treat $keywordchar, $contchar and $optlineendchar as regular expressions
2647 elsif($ARGV[$i] eq "-re") {
2648 if($charperlre) { SetCharPerlre(0); }
2649 else { SetCharPerlre(1); }
2652 # Safe mode - turns off #pragma
2653 elsif($ARGV[$i] eq "-s") {
2654 SafeMode();
2657 # Undefine all macros
2658 elsif($ARGV[$i] eq "-u") {
2659 UndefAll();
2662 # print version number and exit
2663 elsif($ARGV[$i] eq "-v") {
2664 print(STDERR "filepp version ".$VERSION."\n");
2665 exit(0);
2668 # only replace macros if they appear as 'words'
2669 elsif($ARGV[$i] eq "-w") {
2670 if($bound eq '') { SetWordBoundaries(1); }
2671 else { SetWordBoundaries(0); }
2674 # default - an input file name
2675 else {
2676 if(!FileExists($ARGV[$i])) {
2677 Error("Input file \"".$ARGV[$i]."\" not readable");
2679 AddInputFile($ARGV[$i]);
2682 $i++;
2685 # check input files have been specified
2686 if($#Inputfiles == -1) {
2687 Error("No input files given");
2690 # import macros from file if any
2691 if($#Imacrofiles >= 0) {
2692 my $file;
2693 foreach $file (@Imacrofiles) { IncludeMacros($file); }
2696 # print initial defines if debugging
2697 if($debug > 1) { PrintDefines(); }
2699 # open the output file
2700 if(!$overwrite) { OpenOutputFile($outputfile); }
2702 # parse all input files in order given on command line
2703 my $base_file = "";
2704 foreach $base_file (@Inputfiles) {
2705 Redefine("__BASE_FILE__", $base_file);
2706 # set open output file if in overwrite mode
2707 if($overwrite) {
2708 if($overwriteconv ne "") { # convert output filename if needed
2709 my ($in,$out) = split(/=/, $overwriteconv, 2);
2710 my $outfile = $base_file;
2711 $outfile =~ s/\Q$in\E/$out/;
2712 OpenOutputFile($outfile);
2714 else { OpenOutputFile($base_file); }
2716 Parse($base_file);
2717 # close output file if in overwrite mode
2718 if($overwrite) { CloseOutputFile(); }
2721 # close output file
2722 if(!$overwrite) { CloseOutputFile(); }
2724 exit(0);
2726 # Hey emacs !!
2727 # Local Variables:
2728 # mode: perl
2729 # End:
2731 ########################################################################
2732 # End of file
2733 ########################################################################