[llvm-commits] CVS: llvm-test/filepp Makefile.nagfortran
Nate Begeman
natebegeman at mac.com
Tue Feb 28 10:09:06 PST 2006
Changes in directory llvm-test:
filepp added (r1.1)
Makefile.nagfortran updated: 1.5 -> 1.6
---
Log message:
Add support for "preprocessed FORTRAN" source *shudder*
---
Diffs of the changes: (+2735 -2)
Makefile.nagfortran | 4
filepp | 2733 ++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 2735 insertions(+), 2 deletions(-)
Index: llvm-test/filepp
diff -c /dev/null llvm-test/filepp:1.1
*** /dev/null Tue Feb 28 12:09:04 2006
--- llvm-test/filepp Tue Feb 28 12:08:54 2006
***************
*** 0 ****
--- 1,2733 ----
+ #!/usr/bin/perl -w
+ ########################################################################
+ #
+ # filepp is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU General Public License as published by
+ # the Free Software Foundation; either version 2 of the License, or
+ # (at your option) any later version.
+ #
+ # This program is distributed in the hope that it will be useful,
+ # but WITHOUT ANY WARRANTY; without even the implied warranty of
+ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ # GNU General Public License for more details.
+ #
+ # You should have received a copy of the GNU General Public License
+ # along with this program; see the file COPYING. If not, write to
+ # the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ #
+ ########################################################################
+ #
+ # Project : File Preprocessor
+ # Filename : $RCSfile: filepp,v $
+ # Author : $Author: sampo $
+ # Maintainer : Darren Miller: darren at cabaret.demon.co.uk
+ # File version : $Revision: 1.1 $
+ # Last changed : $Date: 2006/02/28 18:08:54 $
+ # Description : Main program
+ # Licence : GNU copyleft
+ #
+ ########################################################################
+
+ package Filepp;
+
+ use strict "vars";
+ use strict "subs";
+ # Used to all filepp to work with any char, not just ascii,
+ # feel free to remove this if it causes you problems
+ use bytes;
+
+ # version number of program
+ my $VERSION = '1.7.1';
+
+ # list of paths to search for modules, normal Perl list + module dir
+ push(@INC, "/usr/local/share/filepp/modules");
+
+ # index of keywords supported and functions to deal with them
+ my %Keywords = (
+ 'comment' => \&Comment,
+ 'define' => \&Define,
+ 'elif' => \&Elif,
+ 'else' => \&Else,
+ 'endif' => \&Endif,
+ 'error' => \&Error,
+ 'if' => \&If,
+ 'ifdef' => \&Ifdef,
+ 'ifndef' => \&Ifndef,
+ 'include' => \&Include,
+ 'pragma' => \&Pragma,
+ 'undef' => \&Undef,
+ 'warning' => \&Warning
+ );
+
+ # set of functions which process the file in the Parse routine.
+ # Processors are functions which take in a line and return the processed line.
+ # Note: this is done as a string rather than pointer to a function because
+ # it makes list easier to modify/remove from/print.
+ my @Processors = ( "Filepp::ParseKeywords", "Filepp::ReplaceDefines" );
+ # processor types say what the processor should be run on: choice is:
+ # 0: Everything (default)
+ # 1: Full lines only (lines originating from Parse function)
+ # 2: Part lines only (lines originating from within keywords, eg:
+ # #if "condition", "condition" is a part line)
+ my %ProcessorTypes = (
+ 'Filepp::ParseKeywords' => 1,
+ 'Filepp::ReplaceDefines' => 0
+ );
+
+ # functions to run each time a new base input file is opened or closed
+ my @OpenInputFuncs = ();
+ my @CloseInputFuncs = ();
+
+ # functions to run each time a new output file is opened or closed
+ my @OpenOutputFuncs = ();
+ my @CloseOutputFuncs = ();
+
+ # safe mode is for the paranoid, when enabled turns off #pragma filepp,
+ # enabled by default
+ my $safe_mode = 0;
+
+ # test for shebang mode, used for "filepp script", ie. executable file with
+ # "#!/usr/bin/perl /usr/local/bin/filepp" at the top
+ my $shebang = 1;
+
+ # allow $keywordchar, $contchar, $optlineendchar and $macroprefix
+ # to be perl regexps
+ my $charperlre = 0;
+
+ # character(s) which prefix environment variables - defaults to shell-style '$'
+ my $envchar = "\$";
+
+ # boolean determining whether line continuation is implicit if there are more
+ # open brackets than close brackets on a line
+ # disabled by default
+ my $parselineend = \&Filepp::ParseLineEnd;
+
+ # character(s) which replace continuation char(s) - defaults to C-style nothing
+ my $contrepchar = "";
+
+ # character(s) which prefix keywords - defaults to C-style '#'
+ my $keywordchar;
+ if($charperlre) { $keywordchar = "\#"; }
+ else { $keywordchar = "\Q#\E"; }
+
+ # character(s) which signifies continuation of a line - defaults to C-style '\'
+ my $contchar;
+ if($charperlre) { $contchar = "\\\\"; }
+ else { $contchar = "\Q\\\E"; }
+
+ # character(s) which optionally signifies the end of a line -
+ # defaults to empty string ''
+ my $optlineendchar = "";
+
+ # character(s) which prefix macros - defaults to nothing
+ my $macroprefix = "";
+
+ # flag to use macro prefix in keywords (on by default)
+ my $macroprefixinkeywords = 1;
+
+ # check if macros must occur as words when replacing, set this to '\b' if
+ # you prefer cpp style behaviour as default
+ my $bound = '';
+
+ # number of line currently being parsed (int)
+ my $line = 0;
+
+ # file currently being parsed
+ my $file = "";
+
+ # list of input files
+ my @Inputfiles;
+
+ # list of files to include macros from
+ my @Imacrofiles;
+
+ # flag to control when output is written
+ my $output = 1;
+
+ # name of outputfile - defaults to STDOUT
+ my $outputfile = "";
+
+ # overwrite mode - automatically overwrites old file with new file
+ my $overwrite = 0;
+
+ # overwrite conversion mode - conversion from input filename to output filename
+ my $overwriteconv = "";
+
+ # list of keywords which have "if" functionality
+ my %Ifwords = ('if', '',
+ 'ifdef', '',
+ 'ifndef', '');
+
+ # list of keywords which have "else" functionality
+ my %Elsewords = ('else', '',
+ 'elif', '');
+
+ # list of keywords which have "endif" functionality
+ my %Endifwords = ('endif', '');
+
+ # current level of include files
+ my $include_level = -1;
+
+ # suppress blank lines in header files (indexed by include level)
+ my $blanksuppopt = 0;
+ my @blanksupp;
+ # try to keep same number lines in output file as input file
+ my $preserveblank = 0;
+
+ # counter of recursion level for detecting recursive macros
+ my $recurse_level = -1;
+
+ # debugging info, 1=on, 0=off
+ my $debug = 0;
+ # send debugging info to stdout rather than stderr
+ my $debugstdout = 0;
+ # debug prefix character or string
+ my $debugprefix = "";
+ # debug postfix character or string
+ my $debugpostfix = "\n";
+
+ # hash of macros defined - standard ones already included
+ my %Defines = (
+ '__BASE_FILE__' => "",
+ '__DATE__' => "",
+ '__FILEPP_INPUT__' => "Generated automatically from __BASE_FILE__ by filepp",
+ '__FILE__' => $file,
+ '__INCLUDE_LEVEL__' => $include_level,
+ '__ISO_DATE__' => "",
+ '__LINE__' => $line,
+ '__NEWLINE__' => "\n",
+ '__NULL__' => "",
+ '__TAB__' => "\t",
+ '__TIME__' => "",
+ '__VERSION__' => $VERSION
+ );
+ # hash of first chars in each macro
+ my %DefineLookup;
+ # length of longest and shortest define
+ my ($defmax, $defmin);
+ GenerateDefinesKeys();
+
+ # set default values for date and time
+ {
+ # conversions of month number into letters (0-11)
+ my @MonthChars = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
+ 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
+ #prepare standard defines
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isbst) =
+ localtime(time());
+ $year += 1900;
+ $sec = sprintf("%02d", $sec);
+ $min = sprintf("%02d", $min);
+ $hour = sprintf("%02d", $hour);
+ $mday = sprintf("%02d", $mday);
+ $mon = sprintf("%02d", $mon);
+ Redefine("__TIME__", $hour.":".$min.":".$sec);
+ Redefine("__DATE__", $MonthChars[$mon]." ".$mday." ".$year);
+ $mon = sprintf("%02d", ++$mon);
+ Redefine("__ISO_DATE__", $year."-".$mon."-".$mday);
+ }
+
+ # hash table for arguments to macros which need them
+ my %DefinesArgs = ();
+
+ # hash table for functions which macros should call (if any)
+ my %DefinesFuncs = ();
+
+ # eat-trailing-whitespace flag for each macro
+ my %EatTrail = ();
+
+ # list of include paths
+ my @IncludePaths;
+
+ # help string
+ my $usage = "filepp: generic file preprocessor, version ".$VERSION."
+ usage: filepp [options] inputfile(s)
+ options:
+ -b\t\tsuppress blank lines from include files
+ -c\t\tread input from STDIN instead of file
+ -Dmacro[=defn]\tdefine macros (same as #define)
+ -d\t\tprint debugging information
+ -dd\t\tprint verbose debugging information
+ -dl\t\tprint some (light) debugging information
+ -dpre char\tprefix all debugging information with char
+ -dpost char\tpostfix all debugging information with char, defaults to newline
+ -ds\t\tsend debugging info to stdout rather than stderr
+ -e\t\tdefine all environment variables as macros
+ -ec char\tset environment variable prefix char to \"char\" (default \$)
+ -ecn\t\tset environment variable prefix char to nothing (default \$)
+ -h\t\tprint this help message
+ -Idir\t\tdirectory to search for include files
+ -imacros file\tread in macros from file, but discard rest of file
+ -k\t\tturn off parsing of all keywords, just macro expansion is done
+ -kc char\tset keyword prefix char to \"char\" (defaults to #)
+ -lc char\tset line continuation character to \"char\" (defaults to \\)
+ -lec char\tset optional keyword line end char to \"char\"
+ -lr char\tset line continuation replacement character to \"char\"
+ -lrn\t\tset line continuation replacement character to newline
+ -m module\tload module
+ -mp char\tprefix all macros with \"char\" (defaults to no prefix)
+ -mpnk\t\tdo not use macro prefix char in keywords
+ -Mdir\t\tdirectory to search for filepp modules
+ -o output\tname of output file (defaults to stdout)
+ -ov\t\toverwrite mode - output file will overwrite input file
+ -ovc IN=OUT\toutput file(s) will have be input file(s) with IN conveted to OUT
+ -pb\t\tpreseve blank lines in output that would normally be removed
+ -s\t\trun in safe mode (turns off pragma keyword)
+ -re\t\ttreat keyword and macro prefixes and line cont chars as reg exps
+ -u\t\tundefine all predefined macros
+ -v\t\tprint version and exit
+ -w\t\tturn on word boundaries when replacing macros
+ all other arguments are assumed to be input files
+ ";
+
+
+ ##############################################################################
+ # SetDebug - controls debugging level
+ ##############################################################################
+ sub SetDebug
+ {
+ $debug = shift;
+ Debug("Debugging level set to $debug", 1);
+ }
+
+
+ ##############################################################################
+ # Debugging info
+ ##############################################################################
+ sub Debug
+ {
+ # print nothing if not debugging
+ if($debug == 0) { return; }
+ my $msg = shift;
+ my $level = 1;
+ # check if level has been provided
+ if($#_ > -1) { $level = shift; }
+ if($level <= $debug) {
+ # if currently parsing a file show filename and line number
+ if($file ne "" && $line > 0) {
+ $msg = $file.":".$line.": ".$msg;
+ }
+ # else show program name
+ else { $msg = "filepp: ".$msg; }
+ if($debugstdout) {
+ print(STDOUT $debugprefix.$msg.$debugpostfix);
+ }
+ else {
+ print(STDERR $debugprefix.$msg.$debugpostfix);
+ }
+ }
+ }
+
+
+ ##############################################################################
+ # Standard error handler.
+ # #error msg - print error message "msg" and exit
+ ##############################################################################
+ sub Error
+ {
+ my $msg = shift;
+ # close and delete output file if created
+ close(OUTPUT);
+ if($outputfile ne "-") { # output is not stdout
+ my $inputfile;
+ my $found = 0;
+ # do paranoid check to make sure we are not deleting an input file
+ foreach $inputfile (@Inputfiles) {
+ if($outputfile eq $inputfile) { $found = 1; last; }
+ }
+ # delete output file
+ if($found == 0) { unlink($outputfile); }
+ }
+ # print error message
+ $debug = 1;
+ Debug($msg, 0);
+ exit(1);
+ }
+
+
+ ##############################################################################
+ # SafeMode - turns safe mode on
+ ##############################################################################
+ sub SafeMode
+ {
+ $safe_mode = 1;
+ Debug("Filepp safe mode enabled", 2);
+ }
+
+
+ ##############################################################################
+ # CleanStart($sline) - strip leading whitespace from start of $sline.
+ ##############################################################################
+ sub CleanStart
+ {
+ my $sline = shift;
+ for($sline) {
+ # '^' = start of line, '\s+' means all whitespace, replace with nothing
+ s/^\s+//;
+ }
+ return $sline;
+ }
+
+
+ ##############################################################################
+ # Strip($sline, $char, $level) - strip $char's from start and end of $sline
+ # removes up to $level $char's from start and end of line, it is not an
+ # error if $level chars do not exist at the start or end of line
+ ##############################################################################
+ sub Strip
+ {
+ my $sline = shift;
+ my $char = shift;
+ my $level = shift;
+ # strip leading chars from line
+ $sline =~ s/\A([$char]{0,$level})//g;
+ # strip trailing chars from line
+ $sline =~ s/([$char]{0,$level})\Z//g;
+ return $sline;
+ }
+
+
+ ##############################################################################
+ # SetMacroPrefix $string - prefixs all macros with $string
+ ##############################################################################
+ sub SetMacroPrefix
+ {
+ $macroprefix = shift;
+ # make sure prefix will not be treated as a Perl regular expression
+ if(!$charperlre) { $macroprefix = "\Q$macroprefix\E"; }
+ Debug("Setting macro prefix to <".$macroprefix.">", 2);
+ }
+
+
+ ##############################################################################
+ # SetKeywordchar $string - sets the first char(s) of each keyword to
+ # something other than "#"
+ ##############################################################################
+ sub SetKeywordchar
+ {
+ $keywordchar = shift;
+ # make sure char will not be treated as a Perl regular expression
+ if(!$charperlre) { $keywordchar = "\Q$keywordchar\E"; }
+ Debug("Setting keyword prefix character to <".$keywordchar.">", 2);
+ }
+
+ ##############################################################################
+ # GetKeywordchar - returns the current keywordchar
+ ##############################################################################
+ sub GetKeywordchar
+ {
+ return $keywordchar;
+ }
+
+
+ ##############################################################################
+ # SetContchar $string - sets the line continuation char to something other
+ # than "\"
+ ##############################################################################
+ sub SetContchar
+ {
+ $contchar = shift;
+ # make sure char will not be treated as a Perl regular expression
+ if(!$charperlre) { $contchar = "\Q$contchar\E"; }
+ Debug("Setting line continuation character to <".$contchar.">", 2);
+ }
+
+
+ ##############################################################################
+ # SetContrepchar $string - sets the replace of the line continuation char to
+ # something other than ""
+ ##############################################################################
+ sub SetContrepchar
+ {
+ $contrepchar = shift;
+ Debug("Setting line continuation replacement character to <".$contrepchar.">", 2);
+ }
+
+
+ ##############################################################################
+ # SetOptLineEndchar $string - sets the optional line end char to something
+ # other than ""
+ ##############################################################################
+ sub SetOptLineEndchar
+ {
+ $optlineendchar = shift;
+ # make sure char will not be treated as a Perl regular expression
+ if(!$charperlre) { $optlineendchar = "\Q$optlineendchar\E"; }
+ Debug("Setting optional line end character to <".$optlineendchar.">", 2);
+ }
+
+
+ ##############################################################################
+ # SetEnvchar $string - sets the first char(s) of each defined environment
+ # variable to $string - NOTE: change only takes effect when DefineEnv run
+ ##############################################################################
+ sub SetEnvchar
+ {
+ $envchar = shift;
+ Debug("Setting environment variable prefix character to <".$envchar.">",2);
+ }
+
+ ##############################################################################
+ # RunProcessors $string, $calledfrom
+ # run the current processing chain on the string
+ # $string is the string to be processed and should be returned by the processor
+ # $calledfrom says where the processors are called from, the choice is:
+ #
+ # 0 or default: Part line (from within a keyword) - if called recursively
+ # runs all processors AFTER current processor, then continues with processing.
+ # This is used when a keyword want to run all remaining processors on a line
+ # before doing its keyword task.
+ #
+ # 1: Full line (from Parse function) - if called recursively runs all
+ # processors BEFORE current processor, then continues with processing
+ #
+ # 2: Part line (from within a keyword) - if called recursively runs all
+ # processors BEFORE current processor, then continues with processing.
+ # This is used when keywords are using text taken from somewhere other than
+ # the current line, this text needs to go through the same processors as
+ # the current line has been through so it can "catch up" (eg: regexp.pm).
+ #
+ ##############################################################################
+ my @Running;
+ my @Currentproc;
+ sub RunProcessors
+ {
+ my $string = shift;
+ my $calledfrom = 0;
+ if($#_ > -1) { $calledfrom = shift; }
+ my $i;
+
+ # turn off macoprefix if in a keyword
+ my $tmpprefix = "";
+ if($calledfrom != 1 && $macroprefixinkeywords == 0) {
+ $tmpprefix = $macroprefix;
+ $macroprefix = "";
+ }
+
+ # These tests are done to make RunProcessors recursion safe.
+ # If RunProcessors is called from with a function that was itself called
+ # by RunProcessors, then the second calling of RunProcessors will only
+ # execute the processors before the currently running processor in the
+ # chain.
+ my $recursing = 0;
+ my $firstproc = 0;
+ my $lastproc = $#Processors;
+ if($Running[$include_level]) {
+ if($calledfrom == 0) {
+ $firstproc = $Currentproc[$include_level] + 1;
+ }
+ else {
+ $lastproc = $Currentproc[$include_level] - 1;
+ }
+ $recursing = 1;
+ }
+ else { $Running[$include_level] = 1; }
+
+ for($i = $firstproc; $i <= $lastproc; $i++) {
+ if(!$recursing) { $Currentproc[$include_level] = $i; }
+ # called from anywhere (default)
+ if($ProcessorTypes{$Processors[$i]} == 0 ||
+ # called from keyword (part lines only - within keywords)
+ (($calledfrom == 0 || $calledfrom == 2) &&
+ $ProcessorTypes{$Processors[$i]} == 2) ||
+ # called from Parse function (whole lines only)
+ ($calledfrom == 1 && $ProcessorTypes{$Processors[$i]} == 1)) {
+ # run processor
+ # Debug("Running processor $Processors[$i] on \"$string\"", 2);
+ $string = $Processors[$i]->($string);
+ }
+ # check that no processors have been deleted (bigdef.pm)
+ if($lastproc > $#Processors) { $lastproc = $#Processors; }
+ }
+
+ if(!$recursing) { $Running[$include_level] = 0; }
+
+ # return macro prefix to its former glory
+ if($calledfrom != 1 && $macroprefixinkeywords == 0) {
+ $macroprefix = $tmpprefix;
+ }
+
+ return $string;
+ }
+
+ ##############################################################################
+ # PrintProcessors
+ # print the current processing chain
+ ##############################################################################
+ sub PrintProcessors
+ {
+ my $processor;
+ Debug("Current processing chain:", 3);
+ my $i = 0;
+ foreach $processor (@Processors) {
+ Debug($processor." type ".$ProcessorTypes{$Processors[$i]}, 3);
+ $i++;
+ }
+ }
+
+ ##############################################################################
+ # AddProcessor(function[, first[, type]])
+ # add a line processor to processing chain, defaults to end of chain
+ # if "first" is set to one adds processor to start of chain
+ ##############################################################################
+ sub AddProcessor
+ {
+ my $function = shift;
+ my $first = 0;
+ my $type = 0;
+ # check if flag to add processor to start of chain is set
+ if($#_ > -1) { $first = shift; }
+ # check if processor has a type
+ if($#_ > -1) { $type = shift; }
+ # adding processor to start of chasin
+ if($first) {
+ @Processors = reverse(@Processors);
+ }
+ push(@Processors, $function);
+ if($first) {
+ @Processors = reverse(@Processors);
+ }
+ $ProcessorTypes{$function} = $type;
+ Debug("Added processor ".$function." of type ".$type, 2);
+ if($debug > 1) { PrintProcessors(); }
+ }
+
+ ##############################################################################
+ # AddProcessorAfter(function, processor[, type])
+ # add a line processor to processing chain immediately after an existing
+ # processor, if existing processor not found, new processor is added to
+ # end of chain
+ ##############################################################################
+ sub AddProcessorAfter
+ {
+ my $function = shift;
+ my $existing = shift;
+ my $type = 0;
+ # check if processor has a type
+ if($#_ > -1) { $type = shift; }
+ my $i = 0;
+ my $found = 0;
+ my @CurrentProcessors = @Processors;
+ my $processor;
+ # reset processing chain
+ @Processors = ();
+ foreach $processor (@CurrentProcessors) {
+ push(@Processors, $processor);
+ if(!$found) {
+ # check done as regular expression for greater flexibility
+ if($processor =~ /$existing/) {
+ push(@Processors, $function);
+ $found = 1;
+ }
+ }
+ }
+ if(!$found) {
+ Warning("Did not find processor $existing in chain, processor $processor added to end of list");
+ AddProcessor($function, 0, $type);
+ return;
+ }
+ $ProcessorTypes{$function} = $type;
+ Debug("Added processor ".$function." of type ".$type, 2);
+ if($debug > 1) { PrintProcessors(); }
+ }
+
+ ##############################################################################
+ # AddProcessorBefore(function, processor[, type])
+ # add a line processor to processing chain immediately after an existing
+ # processor, if existing processor not found, new processor is added to
+ # end of chain
+ ##############################################################################
+ sub AddProcessorBefore
+ {
+ my $function = shift;
+ my $existing = shift;
+ my $type = 0;
+ # check if processor has a type
+ if($#_ > -1) { $type = shift; }
+ my $i = 0;
+ my $found = 0;
+ my @CurrentProcessors = @Processors;
+ my $processor;
+ # reset processing chain
+ @Processors = ();
+ foreach $processor (@CurrentProcessors) {
+ if(!$found) {
+ # check done as regular expression for greater flexibility
+ if($processor =~ /$existing/) {
+ push(@Processors,$function);
+ $found = 1;
+ }
+ }
+ push(@Processors, $processor);
+ }
+ if(!$found) {
+ Warning("Did not find processor $existing in chain, processor $processor added to start of list");
+ AddProcessor($function, 1, $type);
+ return;
+ }
+ $ProcessorTypes{$function} = $type;
+ Debug("Added processor ".$function." of type ".$type, 2);
+ if($debug > 1) { PrintProcessors(); }
+ }
+
+ ##############################################################################
+ # RemoveProcessor(function)
+ # remove a processor name "function" from list
+ ##############################################################################
+ sub RemoveProcessor
+ {
+ my $function = shift;
+ my $i = 0;
+ # find function
+ while($i <= $#Processors && $Processors[$i] ne $function) { $i++; }
+ # check function found
+ if($i > $#Processors) {
+ Warning("Attempt to remove function ".$function.
+ " which does not exist");
+ return;
+ }
+ # remove function
+ for(; $i<$#Processors; $i++) {
+ $Processors[$i] = $Processors[$i+1];
+ }
+ pop(@Processors);
+ delete($ProcessorTypes{$function});
+ Debug("Removed processor ".$function, 2);
+ PrintProcessors();
+ }
+
+
+ ##############################################################################
+ # Add a function to run each time a base file is opened
+ ##############################################################################
+ sub AddOpenInputFunc
+ {
+ my $func = shift;
+ push(@OpenInputFuncs, $func);
+ }
+
+ ##############################################################################
+ # Add a function to run each time a base file is closed
+ ##############################################################################
+ sub AddCloseInputFunc
+ {
+ my $func = shift;
+ push(@CloseInputFuncs, $func);
+ }
+
+ ##############################################################################
+ # Add a function to run each time a base file is opened
+ ##############################################################################
+ sub AddOpenOutputFunc
+ {
+ my $func = shift;
+ push(@OpenOutputFuncs, $func);
+ }
+
+ ##############################################################################
+ # Add a function to run each time a base file is closed
+ ##############################################################################
+ sub AddCloseOutputFunc
+ {
+ my $func = shift;
+ push(@CloseOutputFuncs, $func);
+ }
+
+
+ ##############################################################################
+ # AddKeyword(keyword, function)
+ # Define a new keyword, when keyword (preceded by keyword char) is found,
+ # function is run on the remainder of the line.
+ ##############################################################################
+ sub AddKeyword
+ {
+ my $keyword = shift;
+ my $function = shift;
+ $Keywords{$keyword} = $function;
+ Debug("Added keyword ".$keyword." which runs ".$function, 2);
+ }
+
+
+ ##############################################################################
+ # RemoveKeyword(keyword)
+ # Keyword is deleted from list, all occurrences of keyword found in
+ # document are ignored.
+ ##############################################################################
+ sub RemoveKeyword
+ {
+ my $keyword = shift;
+ delete $Keywords{$keyword};
+ # sort keywords index into reverse order, this ensures #if[n]def comes
+ # before #if when comparing input with keywords
+ Debug("Removed keyword ".$keyword, 2);
+ }
+
+
+ ##############################################################################
+ # RemoveAllKeywords - removes all current keywords.
+ ##############################################################################
+ sub RemoveAllKeywords
+ {
+ %Keywords = ();
+ Debug("Removed all current keywords", 2);
+ }
+
+
+ ##############################################################################
+ # AddIfword - adds a keyword to ifword hash
+ ##############################################################################
+ sub AddIfword
+ {
+ my $ifword = shift;
+ $Ifwords{$ifword} = '';
+ Debug("Added Ifword: ".$ifword, 2);
+ }
+
+ ##############################################################################
+ # RemoveIfword - removes a keyword from ifword hash
+ ##############################################################################
+ sub RemoveIfword
+ {
+ my $ifword = shift;
+ delete $Ifwords{$ifword};
+ Debug("Removed Ifword: ".$ifword, 2);
+ }
+
+ ##############################################################################
+ # AddElseword - adds a keyword to elseword hash
+ ##############################################################################
+ sub AddElseword
+ {
+ my $elseword = shift;
+ $Elsewords{$elseword} = '';
+ Debug("Added Elseword: ".$elseword, 2);
+ }
+
+ ##############################################################################
+ # RemoveElseword - removes a keyword from elseword hash
+ ##############################################################################
+ sub RemoveElseword
+ {
+ my $elseword = shift;
+ delete $Elsewords{$elseword};
+ Debug("Removed Elseword: ".$elseword, 2);
+ }
+
+ ##############################################################################
+ # AddEndifword - adds a keyword to endifword hash
+ ##############################################################################
+ sub AddEndifword
+ {
+ my $endifword = shift;
+ $Endifwords{$endifword} = '';
+ Debug("Added Endifword: ".$endifword, 2);
+ }
+
+ ##############################################################################
+ # RemoveEndifword - removes a keyword from endifword hash
+ ##############################################################################
+ sub RemoveEndifword
+ {
+ my $endifword = shift;
+ delete $Endifwords{$endifword};
+ Debug("Removed Endifword: ".$endifword, 2);
+ }
+
+
+ ##############################################################################
+ # AddIncludePath - adds another include path to the list
+ ##############################################################################
+ sub AddIncludePath
+ {
+ my $path = shift;
+ push(@IncludePaths, $path);
+ Debug("Added include path: \"".$path."\"", 2);
+ }
+
+
+ ##############################################################################
+ # AddModulePath - adds another module search path to the list
+ ##############################################################################
+ sub AddModulePath
+ {
+ my $path = shift;
+ push(@INC, $path);
+ Debug("Added module path: \"".$path."\"", 2);
+ }
+
+
+ # set if file being written to has same name as input file
+ my $same_file = "";
+
+ ##############################################################################
+ # OpenOutputFile - opens the output file
+ ##############################################################################
+ sub OpenOutputFile
+ {
+ $outputfile = shift;
+ Debug("Output file: ".$outputfile, 1);
+
+ # check for outputfile name, if not specified use STDOUT
+ if($outputfile eq "") { $outputfile = "-"; }
+
+ # output is not stdout and file with that name already exists
+ if($outputfile ne "-" && FileExists($outputfile) ) {
+ $same_file = $outputfile;
+ # paranoid: check file is writable and normal file
+ if(-w $outputfile && -f $outputfile) {
+ $outputfile = $outputfile.".fpp".$$;
+ my $i=0; # paranoid: check temp file does not exist
+ while(FileExists($outputfile)) {
+ $outputfile = $outputfile.$i;
+ $i++;
+ if($i >= 10) { Error("Cound not get temp filename"); }
+ }
+ }
+ else {
+ Error("Cannot read or write to ".$outputfile);
+ }
+ }
+ if(!open(OUTPUT, ">".$outputfile)) {
+ Error("Cannot open output file: ".$outputfile);
+ }
+ # run any open functions
+ my $func;
+ foreach $func (@OpenOutputFuncs) { $func->(); }
+ }
+
+
+ ##############################################################################
+ # CloseOutputFile - close the output file
+ ##############################################################################
+ sub CloseOutputFile
+ {
+ # run any close functions
+ my $func;
+ foreach $func (@CloseOutputFuncs) { $func->(); }
+ close(OUTPUT);
+
+ # if input and output have same name, rename output to input now
+ if($same_file ne "") {
+ if(rename($same_file, $same_file."~") == -1) {
+ Error("Could not rename ".$same_file." ".$same_file."~");
+ }
+ if(rename($outputfile, $same_file) == -1) {
+ Error("Could not rename ".$outputfile." ".$same_file);
+ }
+ }
+ # reset same_file
+ $same_file = "";
+ }
+
+
+ ##############################################################################
+ # ChangeOutputFile - change the output file
+ ##############################################################################
+ sub ChangeOutputFile
+ {
+ CloseOutputFile();
+ $outputfile = shift;
+ OpenOutputFile($outputfile);
+ }
+
+
+ ##############################################################################
+ # AddInputFile - adds another input file to the list
+ ##############################################################################
+ sub AddInputFile
+ {
+ my $file = shift;
+ push(@Inputfiles, $file);
+ Debug("Added input file: \"".$file."\"", 2);
+ }
+
+
+ ##############################################################################
+ # UseModule(module)
+ # Module "module.pm" is used, "module.pm" can be any perl module and can use
+ # or replace any of the functions in this package
+ ##############################################################################
+ sub UseModule
+ {
+ my $module = shift;
+ Debug("Loading module ".$module, 1);
+ require $module;
+ if($@) { Error($@); }
+ }
+
+
+ ##############################################################################
+ # find end of next word in $sline, assumes leading whitespace removed
+ ##############################################################################
+ sub GetNextWordEnd
+ {
+ my $sline = shift;
+ # check for whitespace in this string
+ if($sline =~ /\s/) {
+ # return length of everything up to first whitespace
+ return length($`);
+ }
+ # whitespace not found, return length of the whole string
+ return length($sline);
+ }
+
+
+ ##############################################################################
+ # Print current table of defines - used for debugging
+ ##############################################################################
+ sub PrintDefines
+ {
+ my $define;
+ Debug("Current ".$keywordchar."define's:", 3);
+ foreach $define (keys(%Defines)) {
+ Debug(" macro:\"".$define."\", definition:\"".$Defines{$define}."\"",3);
+ }
+ }
+
+
+ ##############################################################################
+ # DefineEnv - define's all environment variables to macros, each prefixed
+ # by $envchar
+ ##############################################################################
+ sub DefineEnv
+ {
+ my $macro;
+ Debug("Defining environment variables as macros", 2);
+ foreach $macro (keys(%ENV)) {
+ Define($envchar.$macro." ".$ENV{$macro});
+ }
+ }
+
+
+ ##############################################################################
+ # Find out if arguments have been used with macro
+ ##############################################################################
+ sub DefineArgsUsed
+ {
+ my $string = shift;
+ # check '(' is first non-whitespace char after macro
+ if($string =~ /^\s*\(/) {
+ return 1;
+ }
+ return 0;
+ }
+
+
+ ##############################################################################
+ # ParseArgs($string) - find the arguments in a string of form
+ # (arg1, arg2, arg3...) trailing chars
+ # or
+ # arg1, arg2, arg3...
+ ##############################################################################
+ sub ParseArgs
+ {
+ my $string = shift;
+ $string = CleanStart($string);
+ my @Chars;
+ my $char;
+ # split string into chars (can't use split coz it deletes \n at end)
+ for($char=0; $char<length($string); $char++) {
+ push(@Chars, substr($string, $char, 1));
+ }
+ my @Args; # list of Args
+ my $arg = "";
+ my @Endchar;
+ # special characters - no processing is done between character pairs
+ my %SpecialChars = ('(' => ')', '"' => '"', '\'' => '\'');
+ my $s = -1; # start of chars
+ my $backslash = 0;
+ # number of special char pairs to allow
+ my $pairs = 1;
+
+ # deal with first '(' if there (ie func(args) rather than func args)
+ if($#Chars >= 0 && $Chars[0] eq '(') {
+ push(@Endchar, ')');
+ $Chars[0] = '';
+ $s++;
+ $pairs++; # ignore this pair of special char pairs
+ }
+
+ # replace args with their values
+ foreach $char (@Chars) {
+ # deal with end of special chars, ),",' etc.
+ if($#Endchar > -1 && $char eq $Endchar[$#Endchar]) {
+ # if char before this was a backslash, ignore this char
+ if($backslash) {
+ chop($arg); # delete backslash from string
+ }
+ else {
+ # pop end char of list and reduce pairs if its a bracket
+ if(pop(@Endchar) eq ')') { $pairs--; }
+ }
+ }
+ # deal with start of special chars
+ elsif(exists($SpecialChars{$char})) {
+ # if char before this was a backslash, ignore this char
+ if($backslash) {
+ chop($arg); # delete backslash from string
+ }
+ # only start new pair if not already in special char pair
+ # (not including main args brackets of course)
+ elsif($#Endchar < $pairs-1) {
+ push(@Endchar, $SpecialChars{$char});
+ # need to treat brackets differently for macros within
+ # macros "this(that(tother)))", otherwise lose track of ()'s
+ if($char eq '(') { $pairs++; }
+ }
+ }
+ # deal with ',', add arg to list and start search for next one
+ elsif($#Endchar == $s && $char eq ',') {
+ # if char before this was a backslash, ignore this char
+ if($backslash) {
+ chop($arg); # delete backslash from string
+ }
+ else {
+ push(@Args, CleanStart($arg));
+ $char = '';
+ $arg = "";
+ next;
+ }
+ }
+ # deal \\ with an escaping \ ie. \" or \, or \\
+ if($char eq '\\') {
+ if($backslash) { # found \\
+ $backslash = 0; # second backslash ignored
+ chop($arg); # delete backslash from string
+ }
+ else{$backslash = 1;}
+ }
+ elsif($backslash) { $backslash = 0; }
+ # check for end of args string
+ if($#Endchar < $s) {
+ push(@Args, CleanStart($arg));
+ $char = '';
+ # put remainder of string back together
+ $arg = join('', @Chars);
+ last;
+ }
+ $arg = $arg.$char; # add char to current arg
+ $char = ''; # set char to null
+ }
+
+ # deal with last arg or string following args if it exists
+ push(@Args, $arg);
+
+ return @Args;
+ }
+
+
+ ##############################################################################
+ # Find the arguments in a macro and replace them
+ ##############################################################################
+ sub FindDefineArgs
+ {
+ my $substring = shift;
+ my $macro = shift;
+
+ # get definition list for this macro
+ my @Argnames = split(/\,/, $DefinesArgs{$macro});
+
+ # check to see if macro can have any number of arguments (last arg ...)
+ my $anyargs = ($#Argnames >= 0 && $Argnames[$#Argnames] =~ /\.\.\.\Z/o);
+
+ # get arguments passed to this macro
+ my @Argvals = ParseArgs($substring);
+ # everything following macro args should be returned as tail
+ my $tail = pop(@Argvals);
+
+ # check the right number of args have been passed, should be all args
+ # present plus string at end of args (assuming macro cannot have any number
+ # of arguments)
+ if(!$anyargs && $#Argvals != $#Argnames) {
+ # show warning if wrong args (unless macro should have zero args and
+ # 1 arg provided which is blank space
+ if(!($#Argnames == -1 && $#Argvals == 0 && $Argvals[0] =~ /\A\s*\Z/)) {
+ Warning("Macro \'".$macro."\' used with ".$#Argvals.
+ " args, expected ".($#Argnames+1));
+ }
+ # delete all excess args
+ while($#Argvals > $#Argnames) { pop(@Argvals); }
+ }
+ # make all missing args blanks
+ while($#Argvals < $#Argnames) { push(@Argvals, ""); }
+
+ return (@Argvals, $tail);
+ }
+
+
+ ##############################################################################
+ # FunctionMacro: used with functions to inform a module which macro
+ # was being replaced when the function was called - used in bigfunc.pm
+ ##############################################################################
+ my $functionmacro = "";
+ sub FunctionMacro
+ {
+ return $functionmacro;
+ }
+
+
+ ##############################################################################
+ # Replace all defined macro's arguments with their values
+ # Inputs:
+ # $macro = the macro to be replaces
+ # $string = the string following the occurrence of macro
+ ##############################################################################
+ sub ReplaceDefineArgs
+ {
+ my ($string, $tail, %Used) = @_;
+ # check if args used, if not do nothing
+ if(DefineArgsUsed($tail)) {
+ my $macro = $string;
+ # get arguments following macro
+ my @Argvals = FindDefineArgs($tail, $macro);
+ $tail = pop(@Argvals); # tail returned as last element
+
+ my @Argnames = split(/\,/, $DefinesArgs{$macro});
+ my ($i, $j);
+
+ # replace previous macro with defn + args
+ $string = $Defines{$macro};
+
+ # check if macro should call a function
+ if(exists($DefinesFuncs{$macro})) {
+ # replace all macros in argument list
+ for($i=0; $i<=$#Argvals; $i++) {
+ $Argvals[$i] = ReplaceDefines($Argvals[$i]);
+ }
+ if($debug > 1) {
+ my $argstring = "";
+ if($#Argvals >= 0) { $argstring = join(", ", @Argvals); }
+ Debug("Running function $DefinesFuncs{$macro} with args (".
+ $argstring.")", 2);
+ }
+ # set name of macro which is being parse (needed in bigfunc.pm)
+ $functionmacro = $macro;
+ $string = $DefinesFuncs{$macro}->(@Argvals);
+ # don't need do anything else, return now
+ return $string, $tail;
+ }
+
+ # check if last arg ends in ... (allows any number of args in macro)
+ if($#Argnames >= 0 && $Argnames[$#Argnames] =~ s/\.\.\.\Z//o) {
+ # concatanate all extra args into final arg
+ while($#Argvals > $#Argnames) {
+ my $arg1 = pop(@Argvals);
+ my $arg2 = pop(@Argvals);
+ push(@Argvals, $arg2.", ".$arg1);
+ }
+ # check for ## at start of macro name in args list
+ if($string =~ /\#\#$Argnames[$#Argnames]/) {
+ # if last argument is empty remove preciding ","
+ if($#Argvals == $#Argnames && $Argvals[$#Argnames] eq "") {
+ $string =~ s/\,\s*\#\#$Argnames[$#Argnames]//g;
+ }
+ else {
+ $string =~
+ s/\#\#$Argnames[$#Argnames]/$Argnames[$#Argnames]/g;
+ }
+ }
+ }
+
+ # to get args passed to macro to same processed level as rest of
+ # macro, they need to be checked for occurrences of all used macros,
+ # this is a nasty hack to temporarily change defines list to %Used
+ {
+ my %RealDefines = %Defines;
+ my $realdefmin = $defmin;
+ my $realdefmax = $defmax;
+ my %RealDefineLookup = %DefineLookup;
+ %Defines = %Used;
+ GenerateDefinesKeys();
+
+ for($i=0; $i<=$#Argvals; $i++) {
+ $Argvals[$i] = ReplaceDefines($Argvals[$i]);
+ }
+
+ # return defines to normal
+ %Defines = %RealDefines;
+ $defmin = $realdefmin;
+ $defmax = $realdefmax;
+ %DefineLookup = %RealDefineLookup;
+ }
+
+ # The next step replaces argnames with argvals. Once a bit of string
+ # has been replaced it is removed from further processing to avoid
+ # unwanted recursive macro replacement.
+ my @InString = ( $string ); # string to be replaced
+ my @InDone = ( 0 ); # flag to say if string section replaced
+ my @OutString; # output of string sections after each
+ # macro has been replaced
+ my @OutDone; # output flags
+ my $k = 0;
+ for($i=0; $i<=$#Argnames; $i++) {
+ for($j=0; $j<=$#InString; $j++) {
+ if($InDone[$j] == 0) {
+ # replace macros and split up string so replaced part
+ # is flagged as done and rest is left for further
+ # processing
+ while($InString[$j] =~ /$bound$Argnames[$i]$bound/) {
+ $OutString[$k] = $`; $OutDone[$k] = 0;
+ $k++;
+ $OutString[$k] = $Argvals[$i]; $OutDone[$k] = 1;
+ $k++;
+ $InString[$j] = $'; # one more quote for emacs '
+ }
+ }
+ $OutString[$k] = $InString[$j]; $OutDone[$k] = $InDone[$j];
+ $k++;
+ }
+ @InString = @OutString; @InDone = @OutDone;
+ $k = 0;
+ }
+ # rebuild string
+ $string = join('', @InString);
+
+ Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2);
+ }
+ else {
+ Debug("Macro \"".$string."\" found without args, ignored", 2);
+ }
+ return ($string, $tail);
+ }
+
+
+ ##############################################################################
+ # When replacing macros with args, the macro and everything following the
+ # macro (the tail) are passed to ReplaceDefineArgs. The function extracts
+ # the args from the tail and then returns the replaced macro and the new
+ # tail. This function extracts the remaining part of the real tail from
+ # the current input string.
+ ##############################################################################
+ sub ReclaimTail
+ {
+ my ($input, $tail) = @_;
+ # split strings into chars and compare each one until difference found
+ my @Input = split(//, $input);
+ my @Tail = split(//, $tail);
+ $tail = $input = "";
+ while($#Input >= 0 && $#Tail >= 0 && $Input[$#Input] eq $Tail[$#Tail]) {
+ $tail = pop(@Tail).$tail;
+ pop(@Input);
+ }
+ while($#Input >=0) { $input = pop(@Input).$input; }
+ return ($input, $tail);
+ }
+
+
+ ##############################################################################
+ # Replace all defined macro's in a line with their value. Recursively run
+ # through macros as many times as needed (to find macros within macros).
+ # Inputs:
+ # $input = string to process
+ # $tail = rest of line following $string (if any), this will only be used
+ # if string contains a macro with args, the args will probably be
+ # at the start of the tail
+ # %Used = all macros found in $string so far, these will not be checked
+ # again to avoid possible recursion
+ # Initially just $input is passed in, other args are added for recursive calls
+ ##############################################################################
+ sub ReplaceDefines
+ {
+ my ($input, $tail, %Used) = @_;
+ # check for recursive macro madness (set to same level as Perl warning)
+ if(++$recurse_level > 97) {
+ $recurse_level--;
+ Warning("Recursive macro detected in \"".$input."\"");
+ if($tail) { return ($input, $tail); }
+ return $input;
+ }
+
+ my $out = ""; # initialise output to empty string
+ OUTER : while($input =~ /\S/o) {
+ my ($macro, $string);
+ my @Words;
+
+
+ ######################################################################
+ # if macros start with prefix, skip to next prefix
+ ######################################################################
+ if($macroprefix ne "") {
+ my $found = 0;
+ # find next potential macro in line if any
+ while(!$found && $input =~ /$macroprefix\S/) {
+ # everything before prefix
+ $out = $out.$`;
+ # reclaim first char in macro
+ my $match = $&;
+ # everything after prefix
+ $input = chop($match).$'; # one more quote for emacs '
+ # check if first chars are in macro
+ if(exists($DefineLookup{substr($input, 0, $defmin)})) {
+ $found = 1;
+ }
+ # put prefix back onto output and carry on searching
+ else { $out = $out.$match; }
+ }
+ # no more macros
+ if(!$found) { $out = $out.$input; $input = ""; last OUTER; }
+ }
+
+
+ ######################################################################
+ # replacing macros which are "words" only - quick and easy
+ ######################################################################
+ if($bound eq '\b') {
+ @Words = split(/(\w+)/, $input, 2);
+ $out = $out.$Words[0];
+ if($#Words == 2) { $macro = $Words[1]; $input = $Words[2]; }
+ else { $input = ""; last OUTER; }
+ }
+
+ ######################################################################
+ # replacing all types of macro - slow and horrid
+ ######################################################################
+ else {
+ # forward string to next non-whitespace char that starts a macro
+ while(!exists($DefineLookup{substr($input, 0, $defmin)})) {
+ if($input =~ /^\s/ ) { # remove preceding whitespace
+ @Words = split(/^(\s+)/, $input, 2);
+ $out = $out.$Words[1];
+ $input = $Words[2];
+ }
+ else { # skip to next char
+ $out = $out.substr($input, 0, 1);
+ $input = substr($input, 1);
+ }
+ if($input eq "") { last OUTER; }
+ }
+ # remove the longest possible potential macro (containing no
+ # whitespace) from the start of input
+ @Words = split(/(\s+)/, $input, 2);
+ $macro = $Words[0];
+ if($#Words == 2) {$input = $Words[1].$Words[2]; }
+ else {$input = ""; }
+ # shorten macro if too long
+ if(length($macro) > $defmax) {
+ $input = substr($macro, $defmax).$input;
+ $macro = substr($macro, 0, $defmax);
+ }
+ # see if a macro exists in "macro"
+ while(length($macro) > $defmin &&
+ !(exists($Defines{$macro}) && !exists($Used{$macro}))) {
+ # chop a char off macro and try again
+ $input = chop($macro).$input;
+ }
+ }
+
+ # check if macro is at start of string and has not been used yet
+ if(exists($Defines{$macro}) && !exists($Used{$macro})) {
+ # set macro as used
+ $Used{$macro} = $Defines{$macro};
+ # temporarily add tail to input
+ if($tail) { $input = $input.$tail; }
+ # replace macro with defn
+ if(CheckDefineArgs($macro)) {
+ ($string, $input) = ReplaceDefineArgs($macro, $input, %Used);
+ }
+ else {
+ $string = $Defines{$macro};
+ Debug("Replaced \"".$macro."\" for \"".$string."\" [".$recurse_level."]", 2);
+ }
+
+ ($string=~ m/\#\#/) and ($string=~ s/\s*\#\#\s*//gm);
+
+ @Words = ReplaceDefines($string, $input, %Used);
+ $out = $out.$Words[0];
+ if($#Words == 0) { $input = ""; }
+ else {
+ # remove space up to start of next char
+ if(CheckEatTrail($macro)) { $Words[1] =~ s/^[ \t]*//o; }
+ $input = $Words[1];
+ }
+ delete($Used{$macro});
+ # reclaim all unparsed tail
+ if($tail && $tail ne "") {
+ ($input, $tail) = ReclaimTail($input, $tail);
+ }
+ }
+ # macro not matched, add to output and move swiftly on
+ else {
+ if($bound eq '\b') { $out = $out.$macro; }
+ else {
+ $out = $out.substr($macro, 0, 1);
+ $input = substr($macro, 1).$input;
+ }
+ }
+ }
+ $recurse_level--;
+ # append any whitespace left in string and return it
+ if($tail) { return ($out.$input, $tail); }
+ return $out.$input;
+ }
+
+
+ ##############################################################################
+ # GenerateDefinesKey creates all keys and indices needed for %Defines
+ ##############################################################################
+ sub GenerateDefinesKeys
+ {
+ # find longest and shortest macro
+ my ($define, $length) = each %Defines;
+ $defmin = $defmax = length($define);
+ %DefineLookup = ();
+ foreach $define (keys(%Defines)) {
+ $length = length($define);
+ if($length > $defmax) { $defmax = $length; }
+ if($length < $defmin) { $defmin = $length; }
+ }
+ # regenerate lookup table of first letters
+ foreach $define (keys(%Defines)) {
+ $DefineLookup{substr($define, 0, $defmin)} = 1;
+ }
+ }
+
+
+ ##############################################################################
+ # Set a define
+ ##############################################################################
+ sub SetDefine
+ {
+ my ($macro, $value) = @_;
+ # add macro and value to hash table
+ $Defines{$macro} = $value;
+ # add define to keys
+ my $length = length($macro);
+ if($length < $defmin || $defmin == 0) { GenerateDefinesKeys(); }
+ else {
+ if($length > $defmax) { $defmax = $length; }
+ $length = substr($macro, 0, $defmin);
+ $DefineLookup{$length} = 1;
+ }
+ }
+
+
+ ##############################################################################
+ # Get a define without doing any macro replacement
+ ##############################################################################
+ sub GetDefine
+ {
+ my $macro = shift;
+ return $Defines{$macro};
+ }
+
+
+ ##############################################################################
+ # Replace a define, checks if macro defined and only redefine's if it is
+ ##############################################################################
+ sub Redefine
+ {
+ my $macro = shift;
+ my $value = shift;
+ # check if defined
+ if(CheckDefine($macro)) { SetDefine($macro, $value); }
+ }
+
+
+ ##############################################################################
+ # Set a define argument list
+ ##############################################################################
+ sub SetDefineArgs
+ {
+ my $macro = shift;
+ my $args = shift;
+ # add macro args to hash table
+ $DefinesArgs{$macro} = $args;
+ }
+
+
+ ##############################################################################
+ # Set a function which should be called when a macro is found
+ ##############################################################################
+ sub SetDefineFuncs
+ {
+ my $macro = shift;
+ my $func = shift;
+ # add macro function to hash table
+ $DefinesFuncs{$macro} = $func;
+ }
+
+
+ ##############################################################################
+ # Check if a macro is defined
+ ##############################################################################
+ sub CheckDefine
+ {
+ my $macro = shift;
+ return exists($Defines{$macro});
+ }
+
+
+ ##############################################################################
+ # Check if a macro is defined and has arguments
+ ##############################################################################
+ sub CheckDefineArgs
+ {
+ my $macro = shift;
+ return exists($DefinesArgs{$macro});
+ }
+
+
+ ##############################################################################
+ # Check if a macro is defined and calls a function
+ ##############################################################################
+ sub CheckDefineFuncs
+ {
+ my $macro = shift;
+ return exists($DefinesFuncs{$macro});
+ }
+
+
+ ##############################################################################
+ # Check if a macro is defined and eats trailing whitespace
+ ##############################################################################
+ sub CheckEatTrail
+ {
+ my $macro = shift;
+ return exists($EatTrail{$macro});
+ }
+
+
+ ##############################################################################
+ # Set eat-trailing-whitespace for a macro
+ ##############################################################################
+ sub SetEatTrail
+ {
+ my $macro = shift;
+ $EatTrail{$macro} = 1;
+ }
+
+
+ ##############################################################################
+ # Test if a file exists and is readable
+ ##############################################################################
+ sub FileExists
+ {
+ my $filename = shift;
+ # test if file is readable and not a directory
+ if( !(-r $filename) || -d $filename ) {
+ Debug("Checking for file: ".$filename."...not found!", 2);
+ return 0;
+ }
+ Debug("Checking for file: ".$filename."...found!", 2);
+ return 1;
+ }
+
+
+ ##############################################################################
+ # #comment - rest of line ignored as a comment
+ ##############################################################################
+ sub Comment
+ {
+ # nothing to be done here
+ Debug("Commented line", 2);
+ }
+
+
+ ##############################################################################
+ # Define a variable, accepted inputs:
+ # $macrodefn = $macro $defn - $macro associated with $defn
+ # ie: #define TEST test string
+ # $macro = TEST, $defn = "test string"
+ # Note: $defn = rest of line after $macro
+ # $macrodefn = $macro - $macro defined without a defn, rest of line ignored
+ # ie: #define TEST_DEFINE
+ # $macro = TEST_DEFINE, $defn = "1"
+ ##############################################################################
+ sub Define
+ {
+ my $macrodefn = shift;
+ my $macro;
+ my $defn;
+ my $i;
+
+ # check there is an argument
+ if($macrodefn !~ /\S/o) {
+ Filepp::Error("define keyword used without arguments");
+ }
+
+ # find end of macroword - assume separated by space or tab
+ $i = GetNextWordEnd($macrodefn);
+
+ # separate macro and defn (can't use split, doesn't work with '0')
+ $macro = substr($macrodefn, 0, $i);
+ $defn = substr($macrodefn, $i);
+
+ # strip leading whitespace from $defn
+ if($defn) {
+ $defn =~ s/^[ \t]*//;
+ }
+ else {
+ $defn = "";
+ }
+
+ # check if macro has arguments (will be a '(' in macro)
+ if($macro =~ /\(/) {
+ # split up macro, args and defn - delimiters = space, (, ), ','
+ my @arglist = split(/([\s,\(,\),\,])/, $macro." ".$defn);
+ my $macroargs = "";
+ my $arg;
+
+ # macro is first element in list, remove it from list
+ $macro = $arglist[0];
+ $arglist[0] = "";
+ # loop through list until ')' and find all args
+ foreach $arg (@arglist) {
+ if($arg) {
+ # end of arg list, leave loop
+ if($arg eq ")") {
+ $arg = "";
+ last;
+ }
+ # ignore space, ',' and '('
+ elsif($arg =~ /([\s,\,,\(])/) {
+ $arg = "";
+ }
+ # argument found, add to ',' separated list
+ else {
+ $macroargs = $macroargs.",".$arg;
+ $arg = "";
+ }
+ }
+ }
+ $macroargs = Strip($macroargs, ",", 1);
+ # store args
+ SetDefineArgs($macro, $macroargs);
+
+ Debug("Define: macro ".$macro." has args (".$macroargs.")", 2);
+ # put rest of defn back together
+ $defn = join('', at arglist);
+ $defn = CleanStart($defn);
+ }
+ # make sure macro is not being redefined and used to have args
+ else {
+ delete($DefinesArgs{$macro});
+ delete($DefinesFuncs{$macro});
+ }
+
+ # define the macro defn pair
+ SetDefine($macro, $defn);
+
+ Debug("Defined \"".$macro."\" to be \"".$defn."\"", 2);
+ if($debug > 2) { PrintDefines(); }
+ }
+
+
+
+ ##############################################################################
+ # Else, standard if[n][def]-else-endif
+ # usage: #else somewhere between #if[n][def] key and #endif
+ ##############################################################################
+ sub Else
+ {
+ # else always true - only ran when all preceding 'if's have failed
+ return 1;
+ }
+
+
+ ##############################################################################
+ # Endif, standard ifdef-[else]-endif
+ # usage: #endif somewhere after #ifdef key and optionally #else
+ ##############################################################################
+ sub Endif
+ {
+ # this always terminates an if block
+ return 1;
+ }
+
+
+ ##############################################################################
+ # If conditionally includes or ignores parts of a file based on expr
+ # usage: #if expr
+ # expr is evaluated to true(1) or false(0) and include usual ==, !=, > etc.
+ # style comparisons. The "defined" keyword can also be used, ie:
+ # #if defined MACRO || !defined(MACRO)
+ ##############################################################################
+ sub If
+ {
+ my $expr = shift;
+ Debug("If: parsing: \"".$expr."\"", 2);
+
+ # check for any "defined MACRO" tests and evaluate them
+ if($expr =~ /defined/) {
+ my $indefined = 0;
+
+ # split expr up into its component parts, the split is done on the
+ # following list of chars and strings: '!','(',')','&&','||', space
+ my @Exprs = split(/([\s,\!,\(,\)]|\&\&|\|\|)/, $expr);
+
+ # search through parts for "defined" keyword and check if macros
+ # are defined
+ foreach $expr (@Exprs) {
+ if($indefined == 1) {
+ # previously found a defined keyword, check if next word
+ # could be the macro to test for (not any of the listed chars)
+ if($expr && $expr !~ /([\s,\!,\(,\)]|\&\&|\|\|)/) {
+ # replace macro with 0 or 1 depending if it is defined
+ Debug("If: testing if \"".$expr."\" defined...", 2);
+ if(CheckDefine($expr)) {
+ $expr = 1;
+ Debug("If: defined", 2);
+ }
+ else {
+ $expr = 0;
+ Debug("If: NOT defined", 2);
+ }
+ $indefined = 0;
+ }
+ }
+ elsif($expr eq "defined") {
+ # get rid of defined keyword
+ $expr = "";
+ # search for next macro following "defined"
+ $indefined = 1;
+ }
+ }
+
+ # put full expr string back together
+ my $newexpr = join('', at Exprs);
+ $expr = $newexpr;
+ }
+
+ # pass parsed line though processors
+ $expr = RunProcessors($expr);
+
+ # evaluate line and return result (1 = true)
+ Debug("If: evaluating \"".$expr."\"", 2);
+ my $result = eval($expr);
+ # check if statement is valid
+ if(!defined($result)) { Warning($@); }
+ elsif($result) {
+ Debug("If: \"".$expr."\" true", 1);
+ return 1;
+ }
+ Debug("If: \"".$expr."\" false", 1);
+ return 0;
+ }
+
+
+ ##############################################################################
+ # Elif equivalent to "else if". Placed between #if[n][def] and #endif,
+ # equivalent to nesting #if's
+ ##############################################################################
+ sub Elif
+ {
+ my $input = shift;
+ return If($input);
+ }
+
+
+ ##############################################################################
+ # Ifdef conditionally includes or ignores parts of a file based on macro,
+ # usage: #ifdef MACRO
+ # if macro has been previously #define'd everything following the
+ # #ifdef will be included, else it will be ignored until #else or #endif
+ ##############################################################################
+ sub Ifdef
+ {
+ my $macro = shift;
+
+ # separate macro from any trailing garbage
+ $macro = substr($macro, 0, GetNextWordEnd($macro));
+
+ # check if macro defined - if not set to be #ifdef'ed out
+ if(CheckDefine($macro)) {
+ Debug("Ifdef: ".$macro." defined", 1);
+ return 1;
+ }
+ Debug("Ifdef: ".$macro." not defined", 1);
+ return 0;
+ }
+
+
+ ##############################################################################
+ # Ifndef conditionally includes or ignores parts of a file based on macro,
+ # usage: #ifndef MACRO
+ # if macro has been previously #define'd everything following the
+ # #ifndef will be ignored, else it will be included until #else or #endif
+ ##############################################################################
+ sub Ifndef
+ {
+ my $macro = shift;
+
+ # separate macro from any trailing garbage
+ $macro = substr($macro, 0, GetNextWordEnd($macro));
+
+ # check if macro defined - if not set to be #ifdef'ed out
+ if(CheckDefine($macro)) {
+ Debug("Ifndef: ".$macro." defined", 1);
+ return 0;
+ }
+ Debug("Ifndef: ".$macro." not defined", 1);
+ return 1;
+ }
+
+
+ ##############################################################################
+ # Parses all macros from file, but discards all other output
+ ##############################################################################
+ sub IncludeMacros
+ {
+ my $file = shift;
+ my $currentoutput = $output;
+ SetOutput(0);
+ Parse($file);
+ SetOutput($currentoutput);
+ }
+
+
+ ##############################################################################
+ # Include $filename in output file, format:
+ # #include "filename" - local include file, ie. in same directory, try -Ipath
+ # also if not not found in current directory
+ # #include <filename> - system include file, use -Ipath
+ ##############################################################################
+ sub Include
+ {
+ my $input = shift;
+ my $filename = $input;
+ my $fullname;
+ my $sysinclude = 0;
+ my $found = 0;
+ my $i;
+
+ # check for recursive includes (level set to same as Perl recurse warn)
+ if($include_level >= 98) {
+ Warning("Include recursion too deep - skipping \"".$filename."\"\n");
+ return;
+ }
+
+ # replace any defined values in the include line
+ $filename = RunProcessors($filename);
+
+ # check if it is a system include file (#include <filename>) or a local
+ # include file (#include "filename")
+ if(substr($filename, 0, 1) eq "<") {
+ $sysinclude = 1;
+ # remove <> from filename
+ $filename = substr($filename, 1);
+ ($filename) = split(/\>/, $filename, 2);
+ }
+ elsif(substr($filename, 0, 1) eq "\"") {
+ # remove double quotes from filename
+ $filename = substr($filename, 1);
+ ($filename) = split(/\"/, $filename, 2);
+ }
+ # else assume filename given without "" or <>, naughty but allowed
+
+ # check for file in current directory
+ if($sysinclude == 0) {
+ # get name of directory base file is in
+ my $dir = "";
+ if($file =~ /\//) {
+ my @Dirs = split(/(\/)/, $file);
+ for($i=0; $i<$#Dirs; $i++) {
+ $dir = $dir.$Dirs[$i];
+ }
+ }
+ if(FileExists($dir.$filename)) {
+ $fullname = $dir.$filename;
+ $found = 1;
+ }
+ }
+
+ # search for file in include paths, first path on command line first
+ $i = 0;
+ while($found == 0 && $i <= $#IncludePaths) {
+ $fullname = $IncludePaths[$i]."/".$filename;
+ if(FileExists($fullname)) { $found = 1; }
+ $i++;
+ }
+
+ # include file if found, error if not
+ if($found == 1) {
+ Debug("Including file: \"".$fullname."\"", 1);
+ # recursively call Parse
+ Parse($fullname);
+ }
+ else {
+ Warning("Include file \"".$filename."\" not found", 1);
+ }
+ }
+
+
+
+ ##############################################################################
+ # Pragma filepp Function Args
+ # Pragma executes a filepp function, everything following the function name
+ # is passed as arguments to the function.
+ # The format is:
+ # #pragma filepp function args...
+ # If pragma is not followed by "filepp", it is ignored.
+ ##############################################################################
+ sub Pragma
+ {
+ my $input = shift;
+
+ # check for "filepp" in string
+ if($input =~ /^filepp\b/) {
+ my ($function, $args);
+ ($input, $function, $args) = split(/\s/, $input, 3);
+ if($function) {
+ if(!$args) { $args = ""; }
+ if($safe_mode) {
+ Debug("Safe mode enabled, NOT running: ".$function."(".$args.")", 1);
+ }
+ else {
+ my @Args = ParseArgs($args);
+ Debug("Running function: ".$function."(".$args.")", 1);
+ $function->(@Args);
+ }
+ }
+ }
+ }
+
+
+ ##############################################################################
+ # Turn normal output on/off (does not affect any output produced by keywords)
+ # 1 = on, 0 = off
+ ##############################################################################
+ sub SetOutput
+ {
+ $output = shift;
+ Debug("Output set to ".$output, 2);
+ }
+
+
+ ##############################################################################
+ # Turn blank suppression on and off at this include level
+ # 1 = on, 0 = off
+ ##############################################################################
+ sub SetBlankSupp
+ {
+ $blanksupp[$include_level] = shift;
+ Debug("Blank suppression set to ".$blanksupp[$include_level], 2);
+ }
+
+
+ ##############################################################################
+ # Reset blank suppression to command-line value (except at level 0)
+ ##############################################################################
+ sub ResetBlankSupp
+ {
+ if($include_level == 0) {
+ $blanksupp[$include_level] = 0;
+ } else {
+ $blanksupp[$include_level] = $blanksuppopt;
+ }
+ Debug("Blank suppression reset to ".$blanksupp[$include_level], 2);
+ }
+
+
+ ##############################################################################
+ # Set if macros are only replaced if the macro is a 'word'
+ ##############################################################################
+ sub SetWordBoundaries
+ {
+ my $on = shift;
+ if($on) {
+ $bound = '\b';
+ Debug("Word Boundaries turned on", 2);
+ }
+ else {
+ $bound = '';
+ Debug("Word Boundaries turned off", 2);
+ }
+ }
+
+ ##############################################################################
+ # DEPRECATED - this function will be removed in later versions, use Set
+ # Toggle if macros are only replaced if the macro is a 'word'
+ ##############################################################################
+ sub ToggleWordBoundaries
+ {
+ if($bound eq '\b') { SetWordBoundaries(1); }
+ else { SetWordBoundaries(0); }
+ }
+
+
+ ##############################################################################
+ # Set treating keywordchar, contchar, macroprefix and optlineendchar as
+ # Perl regexps
+ ##############################################################################
+ sub SetCharPerlre
+ {
+ $charperlre = shift;
+ Debug("Characters treated as Perl regexp's : ".$charperlre, 2);
+ }
+
+
+ ##############################################################################
+ # Undef a previously defined variable, usage:
+ # #undef $macro
+ ##############################################################################
+ sub Undef
+ {
+ my $macro = shift;
+ my $i;
+
+ # separate macro from any trailing garbage
+ $macro = substr($macro, 0, GetNextWordEnd($macro));
+
+ # delete macro from table
+ delete $Defines{$macro};
+ delete $DefinesArgs{$macro};
+ delete $DefinesFuncs{$macro};
+
+ # and remove its eat-trailing-whitespace flag
+ if(CheckEatTrail($macro)) { delete $EatTrail{$macro}; }
+
+ # regenerate keys
+ GenerateDefinesKeys();
+
+ Debug("Undefined macro \"".$macro."\"", 2);
+ if($debug > 1) { PrintDefines(); }
+ }
+
+
+ ##############################################################################
+ # UndefAll - undefines ALL macros
+ ##############################################################################
+ sub UndefAll
+ {
+ %Defines = ();
+ %DefineLookup = ();
+ %EatTrail = ();
+ $defmin = $defmax = 0;
+ Debug("Undefined ALL macros", 2);
+ if($debug > 1) { PrintDefines(); }
+ }
+
+
+ ##############################################################################
+ # #warning msg - print warning message "msg"
+ ##############################################################################
+ sub Warning
+ {
+ my $msg = shift;
+ my $lastdebug = $debug;
+ $debug = 1;
+ Debug($msg, 1);
+ $debug = $lastdebug;
+ }
+
+
+ ##############################################################################
+ # ParseLineEnd - takes in line from input most recently read and checks
+ # if line should be continued (ie. next line in input read and appended
+ # to current line).
+ # Returns two values:
+ # $more - boolean, 1 = read another line from input to append to this one
+ # 0 = no line continuation
+ # $line - the line to be read. If any modification needs to be done to the
+ # line for line contination, it is done here.
+ # Example: if line is to be continued: set $more = 1, then
+ # remove line continuation character and newline from end of
+ # $line and replace with line continuation character.
+ ##############################################################################
+ sub ParseLineEnd
+ {
+ my $thisline = shift;
+ my $more = 0;
+ # check if end of line has a continuation char, if it has get next line
+ if($thisline =~ /$contchar$/) {
+ $more = 1;
+ # remove backslash and newline
+ $thisline =~ s/$contchar\n\Z//;
+ # append line continuation character
+ $thisline = $thisline.$contrepchar;
+ }
+ return ($more, $thisline);
+ }
+
+
+ ##############################################################################
+ # Set name of function to take check if line shoule be continued
+ ##############################################################################
+ sub SetParseLineEnd
+ {
+ my $func = shift;
+ $parselineend = $func;
+ }
+
+ ##############################################################################
+ # Get name of function to take check if line shoule be continued
+ ##############################################################################
+ sub GetParseLineEnd
+ {
+ return $parselineend;
+ }
+
+
+ ##############################################################################
+ # GetNextLine - returns the next line of the current INPUT line,
+ # line continuation is taken care of here.
+ ##############################################################################
+ sub GetNextLine
+ {
+ my $thisline = <INPUT>;
+ if($thisline) {
+ Redefine("__LINE__", ++$line);
+ my $more = 0;
+ ($more, $thisline) = $parselineend->($thisline);
+ while($more) {
+ Debug("Line continuation", 2);
+ my $nextline = <INPUT>;
+ if(!$nextline) { return $thisline; }
+ # increment line count
+ Redefine("__LINE__", ++$line);
+ ($more, $thisline) = $parselineend->($thisline.$nextline);
+ # maintain same number of lines in input as output
+ if($preserveblank) { Filepp::Output("\n"); }
+ }
+ }
+ return $thisline;
+ }
+
+
+ ##############################################################################
+ # Write($string) - writes $string to OUTPUT file
+ ##############################################################################
+ sub Write
+ {
+ my $string = shift;
+ print(OUTPUT $string);
+ }
+
+
+ ##############################################################################
+ # Output($string) - conditionally writes $string to OUTPUT file
+ ##############################################################################
+ sub Output
+ {
+ my $string = shift;
+ if($output) { Write($string); }
+ }
+
+ # counter for number of #if[n][def] loops currently in
+ my $iflevel = 0;
+ # flag to control when to write output
+ my @Writing = (1); # initialise default to 'writing'
+ # flag to show if current 'if' block has passed a 'true if'
+ my @Ifdone = (0); # initialise first to 'not passed true if'
+
+ ##############################################################################
+ # Keyword parsing routine
+ ##############################################################################
+ sub ParseKeywords
+ {
+ # input is next line in file
+ my $inline = shift;
+ my $outline = "";
+
+ my $thisline = $inline;
+ my $keyword;
+ my $found = 0;
+ # remove whitespace from start of line
+ $thisline = CleanStart($thisline);
+ # check if first char on line is a #
+ if($thisline && $thisline =~ /^$keywordchar/) {
+ # remove "#" and any following whitespace
+ $thisline =~ s/^$keywordchar\s*//g;
+ # remove the optional end line char
+ if($optlineendchar ne "") {
+ $thisline =~ s/$optlineendchar\Z//g;
+ }
+ # check for keyword
+ if($thisline && $thisline =~ /^\w+\b/ && exists($Keywords{$&})) {
+ $keyword = $&;
+ $found = 1;
+ # remove newline from line
+ chomp($thisline);
+ # remove leading whitespace and keyword from line
+ my $inline = CleanStart(substr($thisline, length($keyword)));
+
+ # check for 'if' style keyword
+ if(exists($Ifwords{$keyword})) {
+ # increment ifblock level and set ifdone to same
+ # value as previous block
+ $iflevel++;
+ $Ifdone[$iflevel] = 0;
+ $Writing[$iflevel] = $Writing[$iflevel - 1];
+ if(!$Writing[$iflevel]) { $Ifdone[$iflevel] = 1; }
+ }
+ # check for out of place 'else' or 'endif' style keyword
+ elsif($iflevel <= 0 && (exists($Elsewords{$keyword}) ||
+ exists($Endifwords{$keyword}) )) {
+ Warning($keywordchar.$keyword." found without preceding ".
+ $keywordchar."[else]ifword");
+ }
+
+ # decide if to run 'if' or 'else' keyword
+ if(exists($Ifwords{$keyword}) || exists($Elsewords{$keyword})){
+ if(!($Ifdone[$iflevel])) {
+ # check return value of 'if'
+ if($Keywords{$keyword}->($inline)) {
+ $Ifdone[$iflevel] = 1;
+ $Writing[$iflevel] = 1;
+ }
+ else { $Writing[$iflevel] = 0; }
+ }
+ else { $Writing[$iflevel] = 0; }
+ }
+ # check for 'endif' style keyword
+ elsif(exists($Endifwords{$keyword})) {
+ # run endif keyword and decrement iflevel if true
+ if($Keywords{$keyword}->($inline)) { $iflevel--; }
+ }
+ # run all other keywords
+ elsif($Writing[$iflevel]) { $Keywords{$keyword}->($inline); }
+
+ # write a blank line if preserving blank lines
+ # (assumes keywords have no output)
+ if($preserveblank) { $outline = $outline."\n"; }
+
+ } # keyword if statement
+ }
+ # no keywords in line - write line to file if not #ifdef'ed out
+ if(!$found && $Writing[$iflevel]) {
+ $outline = $outline.$inline;
+ }
+ # keep same number of files in output and input
+ elsif(!$found && $preserveblank) { $outline = $outline."\n"; }
+
+ return $outline;
+ }
+
+ ##############################################################################
+ # Main parsing routine
+ ##############################################################################
+ sub Parse
+ {
+ # change file being parsed to this file, remember last filename so
+ # it can be returned at the end
+ my $lastparse = $file;
+ $file = shift;
+
+ Debug("Parsing ".$file."...", 1);
+ Redefine("__FILE__", $file);
+
+ # reset line count, remembering previous count for future reference
+ my $lastcount = $line;
+ $line = 0;
+ Redefine("__LINE__", $line);
+
+ # increment include level
+ Redefine("__INCLUDE_LEVEL__", ++$include_level);
+
+ # set blank line suppression:
+ # no suppression for top level files
+ if($include_level == 0) {
+ $blanksupp[$include_level] = 0;
+ }
+ # include level 1 - set suppression to command line given value
+ elsif($include_level == 1) {
+ # inherit root value if set
+ if($blanksupp[0]) { $blanksupp[$include_level] = 1; }
+ else {$blanksupp[$include_level] = $blanksuppopt; }
+ }
+ # all other include levels - keep suppression at existing value
+ else {
+ $blanksupp[$include_level] = $blanksupp[$include_level - 1];
+ }
+
+ # reset RunProcessors function for this file
+ $Running[$include_level] = 0;
+ $Currentproc[$include_level] = 0;
+
+ # open file and set its handle to INPUT
+ local *INPUT;
+ if(!open(INPUT, $file)) {
+ Error("Could not open file ".$file);
+ }
+
+ # if a base file, run any initialisation functions
+ if($include_level == 0) {
+ my $func;
+ foreach $func (@OpenInputFuncs) { $func->(); }
+ }
+
+ # parse each line of file
+ $_ = GetNextLine();
+ # if in "shebang" mode, throw away first line (the #!/blah bit)
+ if($shebang) {
+ # check for "#!...perl ...filepp..."
+ if($_ && $_ =~ /^\#\!.*perl.+filepp/) {
+ Debug("Skipping first line (shebang): ".$_, 1);
+ $_ = GetNextLine();
+ }
+ }
+
+ while($_) {
+ # unless blank lines are suppressed at this include level
+ unless($blanksupp[$include_level] && /^\s*$/) {
+ # run processing chain (defaults to ReplaceDefines)
+ $_ = RunProcessors($_, 1);
+ # write output to file or STDOUT
+ if($output) { Write($_); }
+ }
+ $_ = GetNextLine();
+ }
+
+ # run any close functions
+ if($include_level == 0) {
+ my $func;
+ foreach $func (@CloseInputFuncs) { $func->(); }
+ }
+
+ # check all #if blocks have been closed at end of parsing
+ if($lastparse eq "" && $iflevel > 0) { Warning("Unterminated if block"); }
+
+ # close file
+ close(INPUT);
+ Debug("Parsing ".$file." done. (".$line." lines processed)", 1);
+
+ # reset $line
+ $line = $lastcount;
+ Redefine("__LINE__", $line);
+
+ # reset $file
+ $file = $lastparse;
+ Redefine("__FILE__", $file);
+ if($file ne "") {
+ Debug("Parsing returned to ".$file." at line ".$line, 1);
+ }
+
+ # decrement include level
+ Redefine("__INCLUDE_LEVEL__", --$include_level);
+
+ }
+
+ ##############################################################################
+ # Main routine
+ ##############################################################################
+
+ # parse command line
+ my $i=0;
+ my $argc=0;
+ while($ARGV[$argc]) { $argc++; }
+
+ while($ARGV[$i]) {
+
+ # suppress blank lines in header files
+ if($ARGV[$i] eq "-b") {
+ $blanksuppopt = 1;
+ }
+
+ # read from stdin instead of file
+ elsif($ARGV[$i] eq "-c") {
+ AddInputFile("-");
+ }
+
+ # Defines: -Dmacro[=defn] or -D macro[=defn]
+ elsif(substr($ARGV[$i], 0, 2) eq "-D") {
+ my $macrodefn;
+ # -D macro[=defn] format
+ if(length($ARGV[$i]) == 2) {
+ if($i+1 >= $argc) {
+ Error("Argument to `-D' is missing");
+ }
+ $macrodefn = $ARGV[++$i];
+ }
+ # -Dmacro[=defn] format
+ else {
+ $macrodefn = substr($ARGV[$i], 2);
+ }
+ my $macro = $macrodefn;
+ my $defn = "";
+ my $j = index($macrodefn, "=");
+ if($j > -1) {
+ $defn = substr($macrodefn, $j+1);
+ $macro = substr($macrodefn, 0, $j);
+ }
+ # add macro and defn to hash table
+ Define($macro." ".$defn);
+ }
+
+ # Debugging turned on: -d
+ elsif($ARGV[$i] eq "-d") {
+ SetDebug(2);
+ }
+
+ # Full debugging turned on: -dd
+ elsif($ARGV[$i] eq "-dd") {
+ SetDebug(3);
+ }
+
+ # Light debugging turned on: -dl
+ elsif($ARGV[$i] eq "-dl") {
+ SetDebug(1);
+ }
+
+ # Send debugging info to stdout rather than stderr
+ elsif($ARGV[$i] eq "-ds") {
+ $debugstdout = 1;
+ }
+
+ # prefix all debugging info with string
+ elsif($ARGV[$i] eq "-dpre") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-dpre' is missing");
+ }
+ $debugprefix = ReplaceDefines($ARGV[++$i]);
+ }
+
+ # prefix all debugging info with string
+ elsif($ARGV[$i] eq "-dpost") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-dpost' is missing");
+ }
+ # replace defines is called here in case a newline is required,
+ # this allows it to be added as __NEWLINE__
+ $debugpostfix = ReplaceDefines($ARGV[++$i]);
+ }
+
+ # define environment variables as macros: -e
+ elsif($ARGV[$i] eq "-e") {
+ DefineEnv();
+ }
+
+ # set environment variable prefix char
+ elsif($ARGV[$i] eq "-ec") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-ec' is missing");
+ }
+ SetEnvchar($ARGV[++$i]);
+ }
+
+ # set environment variable prefix char to nothing
+ elsif($ARGV[$i] eq "-ecn") {
+ SetEnvchar("");
+ }
+
+ # show help
+ elsif($ARGV[$i] eq "-h") {
+ print(STDERR $usage);
+ exit(0);
+ }
+
+ # Include paths: -Iinclude or -I include
+ elsif(substr($ARGV[$i], 0, 2) eq "-I") {
+ # -I include format
+ if(length($ARGV[$i]) == 2) {
+ if($i+1 >= $argc) {
+ Error("Argument to `-I' is missing");
+ }
+ AddIncludePath($ARGV[++$i]);
+ }
+ # -Iinclude format
+ else {
+ AddIncludePath(substr($ARGV[$i], 2));
+ }
+ }
+
+ # Include macros from file: -imacros file
+ elsif($ARGV[$i] eq "-imacros") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-imacros' is missing");
+ }
+ push(@Imacrofiles, $ARGV[++$i]);
+ }
+
+ # turn off keywords
+ elsif($ARGV[$i] eq "-k") {
+ RemoveAllKeywords();
+ }
+
+ # set keyword prefix char
+ elsif($ARGV[$i] eq "-kc") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-kc' is missing");
+ }
+ SetKeywordchar($ARGV[++$i]);
+ }
+
+ # set line continuation character
+ elsif($ARGV[$i] eq "-lc") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-lc' is missing");
+ }
+ SetContchar($ARGV[++$i]);
+ }
+
+ # set optional line end character
+ elsif($ARGV[$i] eq "-lec") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-lec' is missing");
+ }
+ SetOptLineEndchar($ARGV[++$i]);
+ }
+
+ # set line continuation replacement char to newline
+ elsif($ARGV[$i] eq "-lrn") {
+ SetContrepchar("\n");
+ }
+
+ # set line continuation replacement character
+ elsif($ARGV[$i] eq "-lr") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-lr' is missing");
+ }
+ SetContrepchar($ARGV[++$i]);
+ }
+
+ # Module paths: -Minclude or -M include
+ elsif(substr($ARGV[$i], 0, 2) eq "-M") {
+ # -M include format
+ if(length($ARGV[$i]) == 2) {
+ if($i+1 >= $argc) {
+ Error("Argument to `-M' is missing");
+ }
+ AddModulePath($ARGV[++$i]);
+ }
+ # -Minclude format
+ else {
+ AddModulePath(substr($ARGV[$i], 2));
+ }
+ }
+
+ # use module
+ elsif($ARGV[$i] eq "-m") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-m' is missing");
+ }
+ UseModule($ARGV[++$i]);
+ }
+
+ # set macro prefix
+ elsif($ARGV[$i] eq "-mp") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-mp' is missing");
+ }
+ SetMacroPrefix($ARGV[++$i]);
+ }
+
+ # turn off macro prefix within keywords
+ elsif($ARGV[$i] eq "-mpnk") {
+ $macroprefixinkeywords = 0;
+ }
+
+ # turn on overwrite mode
+ elsif($ARGV[$i] eq "-ov") {
+ $overwrite = 1;
+ }
+
+ # turn on overwrite conversion mode
+ elsif($ARGV[$i] eq "-ovc") {
+ if($i+1 >= $argc) {
+ Error("Argument to `-ovc' is missing");
+ }
+ $overwriteconv = $ARGV[++$i];
+ if($overwriteconv !~ /=/) {
+ Error("-ovc argument is of form IN=OUT");
+ }
+ $overwrite = 1;
+ }
+
+ # Output filename: -o filename or -ofilename
+ elsif(substr($ARGV[$i], 0, 2) eq "-o") {
+ # -o filename
+ if(length($ARGV[$i]) == 2) {
+ if($i+1 >= $argc) {
+ Error("Argument to `-o' is missing");
+ }
+ $outputfile = $ARGV[++$i];
+ }
+ # -ofilename
+ else {
+ $outputfile = substr($ARGV[$i], 2);
+ }
+ }
+
+ # preserve blank lines in output file
+ elsif($ARGV[$i] eq "-pb") {
+ $preserveblank = 1;
+ }
+
+ # treat $keywordchar, $contchar and $optlineendchar as regular expressions
+ elsif($ARGV[$i] eq "-re") {
+ if($charperlre) { SetCharPerlre(0); }
+ else { SetCharPerlre(1); }
+ }
+
+ # Safe mode - turns off #pragma
+ elsif($ARGV[$i] eq "-s") {
+ SafeMode();
+ }
+
+ # Undefine all macros
+ elsif($ARGV[$i] eq "-u") {
+ UndefAll();
+ }
+
+ # print version number and exit
+ elsif($ARGV[$i] eq "-v") {
+ print(STDERR "filepp version ".$VERSION."\n");
+ exit(0);
+ }
+
+ # only replace macros if they appear as 'words'
+ elsif($ARGV[$i] eq "-w") {
+ if($bound eq '') { SetWordBoundaries(1); }
+ else { SetWordBoundaries(0); }
+ }
+
+ # default - an input file name
+ else {
+ if(!FileExists($ARGV[$i])) {
+ Error("Input file \"".$ARGV[$i]."\" not readable");
+ }
+ AddInputFile($ARGV[$i]);
+ }
+
+ $i++;
+ }
+
+ # check input files have been specified
+ if($#Inputfiles == -1) {
+ Error("No input files given");
+ }
+
+ # import macros from file if any
+ if($#Imacrofiles >= 0) {
+ my $file;
+ foreach $file (@Imacrofiles) { IncludeMacros($file); }
+ }
+
+ # print initial defines if debugging
+ if($debug > 1) { PrintDefines(); }
+
+ # open the output file
+ if(!$overwrite) { OpenOutputFile($outputfile); }
+
+ # parse all input files in order given on command line
+ my $base_file = "";
+ foreach $base_file (@Inputfiles) {
+ Redefine("__BASE_FILE__", $base_file);
+ # set open output file if in overwrite mode
+ if($overwrite) {
+ if($overwriteconv ne "") { # convert output filename if needed
+ my ($in,$out) = split(/=/, $overwriteconv, 2);
+ my $outfile = $base_file;
+ $outfile =~ s/\Q$in\E/$out/;
+ OpenOutputFile($outfile);
+ }
+ else { OpenOutputFile($base_file); }
+ }
+ Parse($base_file);
+ # close output file if in overwrite mode
+ if($overwrite) { CloseOutputFile(); }
+ }
+
+ # close output file
+ if(!$overwrite) { CloseOutputFile(); }
+
+ exit(0);
+
+ # Hey emacs !!
+ # Local Variables:
+ # mode: perl
+ # End:
+
+ ########################################################################
+ # End of file
+ ########################################################################
Index: llvm-test/Makefile.nagfortran
diff -u llvm-test/Makefile.nagfortran:1.5 llvm-test/Makefile.nagfortran:1.6
--- llvm-test/Makefile.nagfortran:1.5 Mon Feb 27 16:11:35 2006
+++ llvm-test/Makefile.nagfortran Tue Feb 28 12:08:54 2006
@@ -39,13 +39,13 @@
$(F95) -w -S -O2 $< -o $@ $(NAGFORTRAN_FLAGS)
%.f: %.F
- $(CPP) -x c $< -o - $(CPPFLAGS) -traditional-cpp | $(SED) '/^# /d' > $@
+ $(LEVEL)/filepp $< -o $@ -M $(SPEC_BENCH_DIR)/src/ $(FPPFLAGS)
%.c: %.f90
$(F95) -w -S -O2 $< -o $@ $(NAGFORTRAN_FLAGS)
%.f90: %.F90
- $(CPP) -x c $< -o - $(CPPFLAGS) -traditional-cpp | $(SED) '/^# /d' > $@
+ $(LEVEL)/filepp $< -o $@ -M $(SPEC_BENCH_DIR)/src/ $(FPPFLAGS)
CPPFLAGS += -I$(F95_DIR)/lib/NAGWare
LDFLAGS += $(F95_DIR)/lib/NAGWare/quickfit.o -Xlinker -flat_namespace $(F95_DIR)/lib/NAGWare/libf97.dylib $(F95_DIR)/lib/NAGWare/libf96.a
More information about the llvm-commits
mailing list