[ViewVC] Contents of: group/trunk/OOPSE-4/scripts/filepp

#!/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: tim $
#  Maintainer   :  Darren Miller: darren@cabaret.demon.co.uk
#  File version :  $Revision: 1.5 $
#  Last changed :  $Date: 2004-10-11 21:10:28 $
#  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, "/home/maul/gezelter/tim/code/OOPSE-2.0/scripts/filepp-1.7.1/modules/f90dpend/");

# 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
";


# visited table
my %visitedTable = ();

#object directory
my $objDir ="";

# f90moduleList
my %parsedModList = ();

#
my %f90ModList = ();

# suffix of fortran object file
my $objExt = '.o';

# suffix of fortran 90 module
my $modSuffix = "mod";

# case of basename of fortran 90 module
my $modBasenameCase = "lower";

#flag for generating dependency, by default, it is off
my $dependency = 0;

#skip system header file
my $skipSysInclude = 0;

#saved command line define macro
my @savedDefine;

##############################################################################
# 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('',@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('',@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
    
    #if skipSysInclude option is turned on, skip current file
    if ($skipSysInclude && $sysinclude) {
        return;
    }
    
    # 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);
        
        #if $filename is already visited, just return
        if (IsVisited($fullname)){
                return;
        } else {
        # recursively call Parse
                print " " . $fullname . " \\\n";
                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;
    
    if(!$dependency){
        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/) {
    if($thisline) {
        # 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{$&})) {
        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);
    }
    
    # change the behavior of OpenInputFuncs
    # every time a file is open, the functions in @OpenInputFuncs
    # are called.
    # 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);

}

##############################################################################
# module keyword - declare a fortran90 module
##############################################################################
sub Module{
    my $modulename = shift;
    my $modulefile;
    my $file;
    if ($modulename !~ /^procedure/){
        
        $modulename =~ s/\s+$//;
        $parsedModList{GetModBasename($modulename) .  "." . $modSuffix}
                    =  Filepp::GetDefine('__FILE__');
        
        #$modulefile = Filepp::GetDefine('__BASE_FILE__');
        #print $modulefile;
        #$file = Filepp::GetDefine('__FILE__');
        #print $modulefile;
    }
}

##############################################################################
# add use keyword
##############################################################################
Filepp::AddKeyword("module", "Filepp::Module");

##############################################################################
# use keyword - use other fortran90 module
##############################################################################
sub Use{
    my $line = shift;
    $line =~ /^(\w+).*/;
    my $f90module = $1;
    $f90module =~ s/\s+$//;
    $f90module = uc($f90module);
    
    print " " . $objDir . GetModBasename($f90module) . "." . $modSuffix . " \\\n";
}

##############################################################################
# add use keyword
##############################################################################
Filepp::AddKeyword("use", "Filepp::Use");

##############################################################################
# add include keyword which is the same as c's #include  
##############################################################################
Filepp::AddKeyword("include", "Filepp::Include");

##############################################################################
# test whether a file is visited or not
##############################################################################
sub IsVisited {
        my $fullfile = shift;
        
        if (exists($visitedTable{$fullfile})){
                return 1;
        } else {
                $visitedTable{$fullfile} = 1;
                return 0;
        }
}

##############################################################################
# Clean Visited Table
##############################################################################
sub cleanVisited {
    my $visitedFile;
    foreach $visitedFile (keys %visitedTable) {
        delete $visitedTable{$visitedFile};
    }

}

sub AddModule {
        my $modulename = shift;

        if (!exists($f90ModList{$modulename})){
                $f90ModList{$modulename} = 1;
        } else {
                $f90ModList{$modulename}++;
        
        }

}

##############################################################################
# Generate rules for fortran 90 module
##############################################################################
sub printModule {
        my $modname;
        my $objname;
        print "\n";
        foreach $modname (keys %parsedModList) {
                $objname = GetObjFile($parsedModList{$modname});
                print $objDir . $modname  . " : " . $objDir . $objname . "\n";
        }
}

##############################################################################
# Get the object file name
##############################################################################
sub GetObjFile {
        use File::Basename;
        my $fullname = shift;
        my $filename;
        my $dir;
        my $suffix;
        ($filename, $dir, $suffix) = fileparse($fullname, '\.[^.]*');   
        return $filename . $objExt;
}

##############################################################################
# Get the base name of fortran 90 module
##############################################################################
sub GetModBasename {
        my $modname = shift;
        
        if ($modBasenameCase eq "lower") {
            $modname = lc($modname);
            
        } elsif ($modBasenameCase eq "upper") {
            $modname = uc($modname);
        } elsif ($modBasenameCase eq "mixed") {
            $modname = ucfirst(lc($modname));
        }
        
        return $modname;
}

sub RestoreCommandLineDefine {
    my $macro;
    
    foreach $macro(@savedDefine) {
        Define($macro);
    }
}

sub SaveCommandLineDefine {
    my $macro = shift;
    push @savedDefine, $macro;
}
##############################################################################
# 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);
        
        #save define macro from command line
        #it will be restored when next source file is processed
        SaveCommandLineDefine($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]);
    #}

    # make dependency
    elsif($ARGV[$i] eq "-M") {
        $dependency = 1;
    }

    # make dependency (skip system header files)
    elsif($ARGV[$i] eq "-MM") {
        $dependency = 1;
        $skipSysInclude = 1;
    }

    #case of basename of fortran module
    elsif($ARGV[$i] eq "-mc") {
        my $tempVar = lc($ARGV[++$i]);
        if ($modBasenameCase ne 'lower' && $modBasenameCase ne 'upper'
                                        && $modBasenameCase ne 'mixed'){
            Error("Valid argument for `-om' are lower, upper or mixed");
        }
        $modBasenameCase = $tempVar;
    }
    
    #the suffix of fortran module
    elsif($ARGV[$i] eq "-ms") {
        $modSuffix = $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;
    }

    # tells filepp that the object and
    # module files will be built in a separate directory from the sources.
    elsif($ARGV[$i] eq "-od") {
        $objDir = $ARGV[++$i];
    }
    
    # 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); }
    }
    
    #clean visitedTable
    cleanVisited();
    
    #clear all define
    UndefAll();
    
    #restore command line define
    RestoreCommandLineDefine();
    
    #print dependency rule
    print "\n";
    print $objDir . GetObjFile($base_file) . " : " . $base_file . " \\";
    print "\n";

    Parse($base_file);
    # close output file if in overwrite mode
    if($overwrite) { CloseOutputFile(); }    
}

printModule();

# close output file
if(!$overwrite) { CloseOutputFile(); }

exit(0);

# Hey emacs !!
# Local Variables:
# mode: perl
# End:

########################################################################
# End of file
########################################################################
Revision:	1556
Committed:	Mon Oct 11 21:10:28 2004 UTC (19 years, 8 months ago) by tim
File size:	91180 byte(s)
Log Message:	filepp can be used to generate dependencies for c/c++ now